Zurück zur Homepage

Blattschutz aufheben

Ich habe lange überlegt, ob man Code zum Aufheben des Blattschutzes veröffentlichen kann. Ich meine ja.
Der Blattschutz von Excel ist nicht besonders sicher, ich denke, er ist eigentlich zum Schutz vor unbeabsichtigten Ändern implementiert worden. Nur deshalb setze ich ihn auch ein, und nicht etwa zum Schutz vor unbefugten Manipulationen Dafür sollten andere Sicherheitsmechanismen, wie etwa die Zugriffsrechte von NT benutzt werden.
Unter XL 97 konnte man mit einer Zeile Code den Schutz überlisten. Das geht unter XP nicht mehr. Wie schon angeführt, ist der Schutz nicht besonders sicher. Excel scheint aus dem Kennwort mittels einer Rechenvorschrift so etwas wie einen Hash-Code zu generieren, der dann mit einem in der Datei gespeicherten, verglichen wird. Man braucht also nur in Brute-Force Manier viele Kennwörter durchprobieren, es wird dann zwar nicht das richtige, aber ein mögliches gefunden. Und wenn es nur aus Einsen und Nullen besteht. Hier also ein Blattschutz-Crack, der auch unter XP funzt. Er ist zudem noch recht schnell und ziemlich kompakt.
Anbei noch eine Excel-Mappe zum probieren und eine kleine .exe (mein erster Gehversuch in Delphi).
Beispieldatei (XP_Unprotect.zip 14 kB)
Delphi PassRemove.zip 249 kB

 

Public Sub BlattschutzAufheben()
Dim a(0 To 17) As Byte, i&, k%, b
On Error Resume Next
For Each b In ActiveWorkbook.Worksheets
    For i = 0 To 2 ^ 17
        For k = 0 To 17
            a(17 - k) = Asc(CStr(Abs((i And 2 ^ k) = 0)))
        Next
        b.Unprotect StrConv(a, vbUnicode)
        If b.ProtectContents = False Then Exit For
    Next
Next
End Sub


Public Sub BlattschutzAufhebenPasswortAnzeigen()
Dim a(0 To 17) As Byte, i&, k%, m$, b
On Error Resume Next
For Each b In ActiveWorkbook.Worksheets
    For i = 0 To 2 ^ 17
        For k = 0 To 17
            a(17 - k) = Asc(CStr(Abs((i And 2 ^ k) = 0)))
        Next
        m = StrConv(a, vbUnicode)
        Application.StatusBar = "Loop Nr.: " & i
        b.Unprotect m
        If b.ProtectContents = False Then
            InputBox "Kennwort", "Zum Kopieren", m
            Exit For
        End If
    Next
    Application.StatusBar = False
Next
End Sub