Wachtwoordbeveiliging verwijderen uit Excel bestand

Moderator: Theet

Post Reply
Theet
Posts: 200
Joined: Mon 27 Sep 2010, 16:35

Wachtwoordbeveiliging verwijderen uit Excel bestand

Post by Theet »

Het wachtwoord verwijderen uit een bestand kan op 2 manieren:

Methode 1: workbookProtection of sheetProtection script verwijderen in xlm sheet
  • Maak een kopie van het voorbeeldbestand en pas de extensie aan naar .zip
    Open het bestand “bestand met wachtwoord.zip”.
    Open het bestand \xl\workbooks.xml in om een beveiligde werkmap te ontgrendelen.
    Open het bestand \xl\worksheets\sheet1.xml om een beveiligd werkblad te ontgrendelen.
    In het omkaderde gedeelte staat de code waarin het wachtwoord voor de werkmap staat gecodeerd.
    Verwijder dit gedeelte uit het xml-bestand en sla het op.
    Plaats de aangepaste bestanden terug in het zip-bestand en pas de extensie aan naar .xlsx.
Zoek in het xlm bestand naar de tekst "sheetProtection"

Code: Select all

<sheetProtection algorithmName="SHA-512" hashValue="APhY+CVgV7s01vm3vdJaKDs5A1CPXiJad/IN6F2e3WkE1KyULbM02ZsmSz9C5+zATQ4CGb2A1Yk2mR5ArOfY+Q==" saltValue="qovlVmSaV0Dw+YgCYnMDSg==" spinCount="100000" sheet="1" objects="1" scenarios="1" selectLockedCells="1" selectUnlockedCells="1"/>
Methode 2: kraken met een macro

Methode is eenvoudiger door het uitvoeren van een macro. Maak een nieuw Excel-bestand en kopieer onderstaande code in een standaard module van de Visual Basic Editor. (werkt alleen met xlsx bestanden)

Code: Select all

Sub RemoveProtection()
 
Dim dialogBox As FileDialog
Dim sourceFullName As String
Dim sourceFilePath As String
Dim sourceFileName As String
Dim sourceFileType As String
Dim newFileName As Variant
Dim tempFileName As String
Dim zipFilePath As Variant
Dim oApp As Object
Dim FSO As Object
Dim xmlSheetFile As String
Dim xmlFile As Integer
Dim xmlFileContent As String
Dim xmlStartProtectionCode As Double
Dim xmlEndProtectionCode As Double
Dim xmlProtectionString As String
 
'Open dialog box to select a file
Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
dialogBox.AllowMultiSelect = False
dialogBox.Title = "Select file to remove protection from"
 
If dialogBox.Show = -1 Then
    sourceFullName = dialogBox.SelectedItems(1)
Else
    Exit Sub
End If
 
'Get folder path, file type and file name from the sourceFullName
sourceFilePath = Left(sourceFullName, InStrRev(sourceFullName, "\"))
sourceFileType = Mid(sourceFullName, InStrRev(sourceFullName, ".") + 1)
sourceFileName = Mid(sourceFullName, Len(sourceFilePath) + 1)
sourceFileName = Left(sourceFileName, InStrRev(sourceFileName, ".") - 1)
 
'Use the date and time to create a unique file name
tempFileName = "Temp" & Format(Now, " dd-mmm-yy h-mm-ss")
 
'Copy and rename original file to a zip file with a unique name
newFileName = sourceFilePath & tempFileName & ".zip"
On Error Resume Next
FileCopy sourceFullName, newFileName
 
If Err.Number <> 0 Then
    MsgBox "Unable to copy " & sourceFullName & vbNewLine _
        & "Check the file is closed and try again"
    Exit Sub
End If
On Error GoTo 0
 
'Create folder to unzip to
zipFilePath = sourceFilePath & tempFileName & "\"
MkDir zipFilePath
 
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(zipFilePath).CopyHere oApp.Namespace(newFileName).items
 
'loop through each file in the \xl\worksheets folder of the unzipped file
xmlSheetFile = Dir(zipFilePath & "\xl\worksheets\*.xml*")
Do While xmlSheetFile <> ""
 
    'Read text of the file to a variable
    xmlFile = FreeFile
    Open zipFilePath & "xl\worksheets\" & xmlSheetFile For Input As xmlFile
    xmlFileContent = Input(LOF(xmlFile), xmlFile)
    Close xmlFile
 
    'Manipulate the text in the file
    xmlStartProtectionCode = 0
    xmlStartProtectionCode = InStr(1, xmlFileContent, "<sheetProtection")
 
    If xmlStartProtectionCode > 0 Then
 
        xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
            xmlFileContent, "/>") + 2 '"/>" is 2 characters long
        xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
            xmlEndProtectionCode - xmlStartProtectionCode)
        xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")
 
    End If
 
    'Output the text of the variable to the file
    xmlFile = FreeFile
    Open zipFilePath & "xl\worksheets\" & xmlSheetFile For Output As xmlFile
    Print #xmlFile, xmlFileContent
    Close xmlFile
 
    'Loop to next xmlFile in directory
    xmlSheetFile = Dir
 
Loop
 
'Read text of the xl\workbook.xml file to a variable
xmlFile = FreeFile
Open zipFilePath & "xl\workbook.xml" For Input As xmlFile
xmlFileContent = Input(LOF(xmlFile), xmlFile)
Close xmlFile
 
'Manipulate the text in the file to remove the workbook protection
xmlStartProtectionCode = 0
xmlStartProtectionCode = InStr(1, xmlFileContent, "<workbookProtection")
If xmlStartProtectionCode > 0 Then
 
    xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
        xmlFileContent, "/>") + 2 ''"/>" is 2 characters long
    xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
        xmlEndProtectionCode - xmlStartProtectionCode)
    xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")
 
End If
 
'Manipulate the text in the file to remove the modify password
xmlStartProtectionCode = 0
xmlStartProtectionCode = InStr(1, xmlFileContent, "<fileSharing")
If xmlStartProtectionCode > 0 Then
 
    xmlEndProtectionCode = InStr(xmlStartProtectionCode, xmlFileContent, _
        "/>") + 2 ''"/>" is 2 characters long
    xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
        xmlEndProtectionCode - xmlStartProtectionCode)
    xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")
 
End If
 
'Output the text of the variable to the file
xmlFile = FreeFile
Open zipFilePath & "xl\workbook.xml" & xmlSheetFile For Output As xmlFile
Print #xmlFile, xmlFileContent
Close xmlFile
 
'Create empty Zip File
Open sourceFilePath & tempFileName & ".zip" For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
 
'Move files into the zip file
oApp.Namespace(sourceFilePath & tempFileName & ".zip").CopyHere _
oApp.Namespace(zipFilePath).items
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(sourceFilePath & tempFileName & ".zip").items.Count = _
    oApp.Namespace(zipFilePath).items.Count
    Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
 
'Delete the files & folders created during the sub
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder sourceFilePath & tempFileName
 
'Rename the final file back to an xlsx file
Name sourceFilePath & tempFileName & ".zip" As sourceFilePath & sourceFileName _
& "_" & Format(Now, "dd-mmm-yy h-mm-ss") & "." & sourceFileType
 
'Show message box
MsgBox "The workbook and worksheet protection passwords have been removed.", _
vbInformation + vbOKOnly, Title:="Password protection"
 
End Sub
Voer de bovenstaande macro uit en selecteer het bestand waarvan het werkblad of werkmap is beveiligd. De macro maakt vervolgens een kopie van het bestand en verwijderd de wachtwoordbeveiliging(en).

Aanvullende info: Het kraken van een binair bestand

Met onderstaande macro is het mogelijk om een beveiligd VBA project te ontgrendelen. De macro is gemaakt door een Vietnamese softwareontwikkelaar. De originele code is te vinden op stackoverflow.
  • Open het bestand waarvan het VBA project is beveiligd met een wachtwoord.
    Maak een nieuw .xlsm-bestand en kopieer onderstaande code in een standaard module van de Visual Basic Editor.
    Voer het onderste gedeelte van de code uit en het wachtwoord is verwijderd.
Let op! Onderstaande macro werkt alleen op VBA-projecten welke zijn voorzien met een wachtwoord welke zijn gemaakt met de standaard Excel wachtwoord optie. Een VBA project wat is voorzien van een wachtwoord door Unviewable+ kunnen niet worden gekraakt.

Code: Select all

Private Const PAGE_EXECUTE_READWRITE = &H40
 
Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)
 
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, _
    ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr
 
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr
 
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _
    ByVal lpProcName As String) As LongPtr
 
Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, _
    ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
    ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
 
Dim HookBytes(0 To 11) As Byte
Dim OriginBytes(0 To 11) As Byte
Dim pFunc As LongPtr
Dim Flag As Boolean
 
Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
GetPtr = Value
End Function
 
Public Sub RecoverBytes()
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 12
End Sub
 
Public Function Hook() As Boolean
 
Dim TmpBytes(0 To 11) As Byte
Dim p As LongPtr, osi As Byte
Dim OriginProtect As LongPtr
 
Hook = False
 
#If Win64 Then
    osi = 1
#Else
    osi = 0
#End If
 
pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
 
If VirtualProtect(ByVal pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
 
    MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, osi+1
    If TmpBytes(osi) <> &HB8 Then
 
        MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 12
 
        p = GetPtr(AddressOf MyDialogBoxParam)
 
        If osi Then HookBytes(0) = &H48
        HookBytes(osi) = &HB8
        osi = osi + 1
        MoveMemory ByVal VarPtr(HookBytes(osi)), ByVal VarPtr(p), 4 * osi
        HookBytes(osi + 4 * osi) = &HFF
        HookBytes(osi + 4 * osi + 1) = &HE0
 
        MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 12
        Flag = True
        Hook = True
    End If
End If
 
End Function
 
Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
    ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
    ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
 
If pTemplateName = 4070 Then
    MyDialogBoxParam = 1
Else
    RecoverBytes
    MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
        hWndParent, lpDialogFunc, dwInitParam)
    Hook
End If
 
End Function
 
 
''''RUN THE CODE BELOW''''
Sub VBAUnprotected()
 
If Hook Then
    MsgBox "VBA Project is unprotected!", vbInformation, "*****"
End If
 
End Sub
Top
Post Reply

Return to “Excel 365”