Cara Membobol Excel Yang Terpassword

Banyak orang yang ingin merubah shell/kotak menggantinya  dengan keinginan anda sendiri, disini akan kami sajikan cara membobol excel yang terpassword dan kita dapat bebas meng-edit/menggantinya.
1. Buka excel yang terpassword tsb.
2. Tekan Alt + F11
3. Akan timbul aplikasi Visual Basic (VB) 
4. Pilih menu Insert pada Bar, lalu klik Module
5. Copy/Pastekan kode ini didalamnya :
   Public Sub DaystoryBreakerPassword()
        ' Breaks worksheet and workbook structure passwords. Hacked by Daystory23
        '  probably originator of base code algorithm modified for coverage
        '  of workbook structure / windows passwords and for multiple passwords
        ' Gunakan sabuk pengaman anda:p
        ' For Deby 31 Oktober 2011
        ' Modified 2003-Apr-04 by JEM: All msgs to constants, and
        '   eliminate one Exit Sub (Version 1.1.1)
        ' Reveals hashed passwords NOT original passwords
        Const DBLSPACE As String = vbNewLine & vbNewLine
        Const AUTHORS As String = DBLSPACE & vbNewLine & _
                "Hacked by Daystory23"
        Const HEADER As String = "DaystoryBreakerPassword"
        Const VERSION As String = DBLSPACE & "Hai Deby 31 Oktober 2011"
        Const REPBACK As String = DBLSPACE & "Hacked by Daystory 23"
        Const ALLCLEAR As String = DBLSPACE & "From SMPN 10 Jakarta" & _
                "Jln.Sumur Batu Raya" & _
                DBLSPACE & "Follow my twitter : @dikpryo" & _
                DBLSPACE & "Add my facebook : Didik Priyo Utomo" & _
                DBLSPACE & "My nickname in Graffiti Writer is Daystory23" & _
            DBLSPACE & "Thanks"
        Const MSGNOPWORDS1 As String = " Hai! "
        Const MSGNOPWORDS2 As String = " For TimotiusMardjono"
        Const MSGPWORDFOUND1 As String = "Hacked by Daystory23" & DBLSPACE & _
                "Passwordnya disini :" & DBLSPACE & "Hacked by Daystory23" & DBLSPACE & _
                "Thanks" & _
                "Assalamu'alaiku Wr Wb" & DBLSPACE & _
                ":)" & AUTHORS & VERSION
        Const MSGPWORDFOUND2 As String = "Hacked by Daystory23 " & DBLSPACE & "Passwordnya disini :" & _
                DBLSPACE & "$$" & DBLSPACE & "Hacked by Daystory23"
        Const MSGONLYONE As String = "Hai !" & _
                 ALLCLEAR & AUTHORS & VERSION & REPBACK
        Dim w1 As Worksheet, w2 As Worksheet
        Dim i As Integer, j As Integer, k As Integer, l As Integer
        Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
        Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
        Dim PWord1 As String
        Dim ShTag As Boolean, WinTag As Boolean
        
        Application.ScreenUpdating = False
        With ActiveWorkbook
            WinTag = .ProtectStructure Or .ProtectWindows
        End With
        ShTag = False
        For Each w1 In Worksheets
                ShTag = ShTag Or w1.ProtectContents
        Next w1
        If Not ShTag And Not WinTag Then
            MsgBox MSGONLYONE, vbInformation, HEADER
            Exit Sub
        End If
        MsgBox MSGONLYONE, vbInformation, HEADER
        If Not WinTag Then
            MsgBox MSGNOPWORDS2, vbInformation, HEADER
        Else
          On Error Resume Next
          Do      'dummy do loop
            For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
            For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
            For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
            For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
            With ActiveWorkbook
              .Unprotect Chr(i) & Chr(j) & Chr(k) & _
                 Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
                 Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
              If .ProtectStructure = False And _
              .ProtectWindows = False Then
                  PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
                    Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                    Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                  MsgBox Application.Substitute(MSGPWORDFOUND1, _
                        "$$", PWord1), vbInformation, HEADER
                  Exit Do  'Bypass all for...nexts
              End If
            End With
            Next: Next: Next: Next: Next: Next
            Next: Next: Next: Next: Next: Next
          Loop Until True
          On Error GoTo 0
        End If
        If WinTag And Not ShTag Then
          MsgBox MSGONLYONE, vbInformation, HEADER
          Exit Sub
        End If
        On Error Resume Next
        For Each w1 In Worksheets
          'Attempt clearance with PWord1
          w1.Unprotect PWord1
        Next w1
        On Error GoTo 0
        ShTag = False
        For Each w1 In Worksheets
          'Checks for all clear ShTag triggered to 1 if not.
          ShTag = ShTag Or w1.ProtectContents
        Next w1
        If ShTag Then
            For Each w1 In Worksheets
              With w1
                If .ProtectContents Then
                  On Error Resume Next
                  Do      'Dummy do loop
                    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
                    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
                    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
                    For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
                    .Unprotect Chr(i) & Chr(j) & Chr(k) & _
                      Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                      Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                    If Not .ProtectContents Then
                      PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
                        Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                        Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                      MsgBox Application.Substitute(MSGPWORDFOUND2, _
                            "$$", PWord1), vbInformation, HEADER
                      'leverage finding Pword by trying on other sheets
                      For Each w2 In Worksheets
                        w2.Unprotect PWord1
                      Next w2
                      Exit Do  'Bypass all for...nexts
                    End If
                    Next: Next: Next: Next: Next: Next
                    Next: Next: Next: Next: Next: Next
                  Loop Until True
                  On Error GoTo 0
                End If
              End With
            Next w1
        End If
        MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
    End Sub

6. Jika sudah, klik menu Tools pada Bar, lalu klik Macro
7. Terakhir tekan Run!
8. Selamat! Excel sudah terbuka dan kita bebas mengutak-atiknya.








0 Komentar