frmmain.frm

VB的反编译分析代码,很强的功能,能分析VB生成的EXE、DLL文件的结构

    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

'For Syntax Coloring
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_LINESCROLL = &HB6


'Used for syntax highlighting
Dim prevCountLine As Long
Dim LinesCheck() As String

Private Sub cmdCancel_Click()
    CancelDecompile = True
End Sub

Private Sub Form_Load()
    '*****************************
    'Purpose: To set all our decompiler and load any functions that need to be loaded.
    '*****************************
    Me.Caption = "Semi VB Decompiler by vbgamer45 Version: " & Version
    Call PrintReadMe
    'Setup Variables
    gSkipCom = False
    gDumpData = False
    gShowOffsets = True
    gShowColors = True
    gPcodeDecompile = True
    CancelDecompile = False
    'Get the recent file list
    Dim Recent1Title As String
    Dim Recent2Title As String
    Dim Recent3Title As String
    Dim Recent4Title As String

    Recent1Title = GetSetting("VB Decompiler", "Options", "Recent1FileTitle", "")
    Recent2Title = GetSetting("VB Decompiler", "Options", "Recent2FileTitle", "")
    Recent3Title = GetSetting("VB Decompiler", "Options", "Recent3FileTitle", "")
    Recent4Title = GetSetting("VB Decompiler", "Options", "Recent4FileTitle", "")

    If Recent1Title <> "" Then
        mnuFileRecent1.Visible = True
        mnuFileSep1.Visible = True
        mnuFileRecent1.Caption = Recent1Title
    End If
    If Recent2Title <> "" Then
        mnuFileRecent2.Visible = True
        mnuFileRecent2.Caption = Recent2Title
    End If
    If Recent3Title <> "" Then
        mnuFileRecent3.Visible = True
        mnuFileRecent3.Caption = Recent3Title
    End If
    If Recent4Title <> "" Then
        mnuFileRecent4.Visible = True
        mnuFileRecent4.Caption = Recent4Title
    End If

    'Setup the COM Functions
    Set tliTypeLibInfo = New TypeLibInfo
    'GUID for vb6.olb used to find the gui opcodes of the standard controls
    tliTypeLibInfo.LoadRegTypeLib "{FCFB3D2E-A0FA-1068-A738-08002B3371B5}", 6, 0, 9
    Call ProcessTypeLibrary
    tliTypeLibInfo.AppObjString = "<Global>"
    'Load the functions
    '  Call getFunctionsFromFile("C:\Program Files\Microsoft Visual Studio\VB98\VB6.OLB")
    'Load Com Hacks
    Call modGlobals.LoadCOMFIX
    'Load Events Opcodes for standard controls
    'Call getEventsFromFile(App.Path & "\VB6.OLB")

    'Load the vb Function list
    Call modNative.VBFunction_Description_Init(App.path & "\VB60_APIDEF.txt")
    'Init the Asm Engine
    Call modAsm.Init_unASM


    ReDim LinesCheck(0)
    LinesCheck(0) = txtCode
    gUpdateText = False
End Sub

Private Sub Form_Resize()
    '*****************************
    'Purpose: When the form is resized adjust all our controls.
    '*****************************
    On Error Resume Next
    tvProject.Height = Me.Height - StatusBar1.Height - 700
    sstViewFile.Height = Me.Height - StatusBar1.Height - 700
    txtCode.Height = sstViewFile.Height - 420
    Me.fxgEXEInfo.Height = sstViewFile.Height - 600
    sstViewFile.Width = Me.Width - tvProject.Width - 200   ' - sstViewFile.Width
    txtCode.Width = sstViewFile.Width - 200
    fxgEXEInfo.Width = sstViewFile.Width - 200
    picPreview.Width = sstViewFile.Width - 200
    picPreview.Height = sstViewFile.Height - 600
End Sub

Private Sub lstMembers_Click()
    'Not used(Debug Only)
    Dim tliInvokeKinds As InvokeKinds
    tliInvokeKinds = lstMembers.ItemData(lstMembers.ListIndex)

    If lstTypeInfos.ListIndex <> -1 Then
        MsgBox ReturnDataType(lstTypeInfos.ItemData(lstTypeInfos.ListIndex), tliInvokeKinds, lstMembers.[_Default])
    End If
End Sub

Private Sub lstTypeInfos_Click()
    'Not Used(Debug Only)
    Dim tliTypeInfo As TypeInfo
    Set tliTypeInfo = tliTypeLibInfo.GetTypeInfo(Replace(Replace(lstTypeInfos.List(lstTypeInfos.ListIndex), "<", ""), ">", ""))
    'Use the ItemData in lstTypeInfos to set the SearchData for lstMembers
    tliTypeLibInfo.GetMembersDirect lstTypeInfos.ItemData(lstTypeInfos.ListIndex), lstMembers.hwnd, , , True

End Sub

Private Sub mnuFileAntiDecompiler_Click()
    '*****************************
    'Purpose: Show save dialog and encypt the current exe
    '*****************************
    Cd1.Filename = ""
    Cd1.DialogTitle = "Save File As"
    Cd1.Filter = "Exe Files(*.exe)|*.exe"

    Cd1.ShowSave

    If Cd1.Filename = "" Then Exit Sub

    Call modAntiDecompiler.LoadCrypter
    Call modAntiDecompiler.EncryptExe(SFilePath, Cd1.Filename)

End Sub

Private Sub mnuFileExit_Click()
    '*****************************
    'Purpose: To exit the decompiler and  clear any used memory
    '*****************************
    End
End Sub

Private Sub mnuFileExportMemoryMap_Click()
    '*****************************
    'Purpose: To generate a Memory Map of the current exe file.
    '*****************************
    Set gVBFile = Nothing
    Set gVBFile = New clsFile
    Call gVBFile.Setup(SFilePath)
    Dim strTitle As String
    strTitle = Me.Caption
    Me.Caption = "Generating Memory Map...Please Wait..."

    Set gMemoryMap = New clsMemoryMap

    'hascollision = gMemoryMap.AddSector(0, Len(DosHeader), "mz")
    hascollision = gMemoryMap.AddSector(AppData.PeHeaderOffset, Len(PEHeader), "pe")
    hascollision = gMemoryMap.AddSector(VBStartHeader.PushStartAddress - OptHeader.ImageBase, 102, "vb header")
    hascollision = gMemoryMap.AddSector(gVBHeader.aProjectInfo - OptHeader.ImageBase, 572, "project info")
    hascollision = gMemoryMap.AddSector(gProjectInfo.aObjectTable - OptHeader.ImageBase, 84, "objecttable")
    hascollision = gMemoryMap.AddSector(gVBHeader.aComRegisterData - OptHeader.ImageBase, Len(modGlobals.gCOMRegData), "ComRegisterData")

    Dim i As Integer
    For i = 0 To gObjectTable.ObjectCount1

    Next

    gMemoryMap.ExportToHTML                                'exports to File.Name & ".html"
    Me.Caption = strTitle
    MsgBox "Memory Map Created!"

End Sub

Private Sub mnuFileGenerate_Click()
    '*****************************
    'Purpose: To generate all the vb files from the decompiled exe.
    '*****************************
    Dim sPath As String
    Dim structFolder As BROWSEINFO
    Dim iNull As Integer
    Dim ret As Long
    structFolder.hOwner = Me.hwnd
    structFolder.lpszTitle = "Browse for folder"
    structFolder.ulFlags = BIF_NEWDIALOGSTYLE              'To create make new folder option
    'BIF_RETURNONLYFSDIRS &
    'structFolder.ulFlags = &H40


    ret = SHBrowseForFolder(structFolder)
    If ret Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList ret, sPath
        'free the block of memory
        CoTaskMemFree ret
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If

    If sPath = "" Then Exit Sub

    'Write The Project File
    Call WriteVBP(sPath & "\" & ProjectName & ".vbp")
    'Write the forms
    Call WriteForms(sPath & "\")
    'Write Forms frx files
    For i = 0 To UBound(gObject)
        If gObject(i).ObjectType = 98435 Then
            Call modOutput.WriteFormFrx(sPath, gObjectNameArray(i))
        End If
    Next
    'Write the modules
    For i = 0 To UBound(gObject)
        If gObject(i).ObjectType = 98305 Then
            Call modOutput.WriteModules(sPath & "\" & gObjectNameArray(i) & ".bas", gObjectNameArray(i))
        End If
    Next
    'Write the classes
    For i = 0 To UBound(gObject)
        If gObject(i).ObjectType = 1146883 Then
            Call modOutput.WriteClasses(sPath & "\" & gObjectNameArray(i) & ".cls", gObjectNameArray(i))
        End If
    Next
    'Write the user controls

    MsgBox "Done"
End Sub

Private Sub mnuFileOpen_Click()
    '*****************************
    'Purpose: Show Open Dialog and then call OpenVBExe
    '*****************************
    Cd1.Filename = ""
    Cd1.DialogTitle = "Select VB5/VB6 exe"
    Cd1.Filter = "VB Files(*.exe,*.ocx,*.dll)|*.exe;*.ocx;*.dll|All Files(*.*)|*.*;"
    Cd1.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNPathMustExist
    Cd1.ShowOpen

    If Cd1.Filename = "" Then Exit Sub

    If FileExists(Cd1.Filename) = True Then
        Call OpenVBExe(Cd1.Filename, Cd1.FileTitle)
    Else
        MsgBox "File Does not exist"
    End If
End Sub

Sub OpenVBExe(FilePath As String, FileTitle As String)
    '################################################
    'Purpose: Main function that gets all VB Sturtures
    '#################################################
    Dim bFormEndUsed As Boolean
    Dim i As Integer                                       'Loop Var
    Dim k As Integer                                       'Loop Var
    Dim addr As Integer                                    'Loop Var
    Dim StartOffset As Long                                'Holds Address of first VB Struture
    Dim f As Integer                                       'FileNumber holder

    'Erase existing data
    bFormEndUsed = False
    For i = 0 To txtFinal.UBound
        txtFinal(i).Text = ""
        txtFinal(i).Tag = ""
    Next
    mnuFileGenerate.Enabled = False
    mnuFileExportMemoryMap.Enabled = False
    mnuFileAntiDecompiler.Enabled = False
    SFilePath = ""
    SFile = ""
    ReDim gControlNameArray(0)                             'Treeveiw control list
    ReDim gProcedureList(0)
    ReDim gOcxList(0)
    ReDim FrxPreview(0)
    'Reset Change Types
    ReDim ByteChange(0)
    ReDim BooleanChange(0)
    ReDim IntegerChange(0)
    ReDim LongChange(0)
    ReDim SingleChange(0)
    ReDim StringChange(0)
    'Pcode
    ReDim EventProcList(0)
    ReDim SubNamelist(0)
    'clear the nodes
    tvProject.Nodes.Clear
    'Save name and path
    SFilePath = FilePath
    SFile = FileTitle

    'Reset the error flag
    ErrorFlag = False
    CancelDecompile = False
    'Get a file handle
    InFileNumber = FreeFile

    'Check for error
    'On Error GoTo AnalyzeError

    'Access the file
    Open SFilePath For Binary As #InFileNumber

    'Is it a VB6 file?
    If CheckHeader() = True Then
        'Good file

        Close #InFileNumber
    Else
        'Bad file
        MsgBox "Not a VB6 file.", vbOKOnly Or vbCritical Or vbApplicationModal, "Bad file!"
        Close #InFileNumber
        Exit Sub
    End If

    StartOffset = VBStartHeader.PushStartAddress - OptHeader.ImageBase

    MakeDir (App.path & "\dump")
    MakeDir (App.path & "\dump\" & FileTitle)

    'Setup the VB File class
    Set gVBFile = New clsFile
    Call gVBFile.Setup(SFilePath)
    f = gVBFile.FileNumber
    'Goto begining of vb header
    Seek f, StartOffset + 1
    'Get the vb header
    Get #f, , gVBHeader