modglobals.bas

反编译vb软件,可以把vb打包的软件直接翻译成源码,非常好用,

'Used for Memory Map
Public gVBFile As clsFile
Public gMemoryMap As clsMemoryMap

'Variables for .vbp file
Global ProjectExename As String                            ' Project exename. MaxLength: 0x104 (260d)
Global ProjectTitle As String                              ' Project title. MaxLength: 0x28 (40d)
Global HelpFile As String                                  ' Helpfile. MaxLength: 0x28 (40d)
Global ProjectName As String                               ' Project name. MaxLength: 0x104 (260d)
Global ProjectDescription As String

'Get File Information File Version Properties
Public Type FILEPROPERTIE
    CompanyName As String
    FileDescription As String
    FileVersion As String
    InternalName As String
    LegalCopyright As String
    OrigionalFileName As String
    ProductName As String
    ProductVersion As String
    LanguageID As String
End Type
Global gFileInfo As FILEPROPERTIE
Declare Function GetFileVersionInfo Lib "Version.dll" Alias _
        "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal _
        dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias _
        "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
        lpdwHandle As Long) As Long
Declare Function VerQueryValue Lib "Version.dll" Alias _
        "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
        lplpBuffer As Any, puLen As Long) As Long
Declare Function GetSystemDirectory Lib "kernel32" Alias _
        "GetSystemDirectoryA" (ByVal path As String, ByVal cbBytes As _
        Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        Dest As Any, ByVal Source As Long, ByVal length As Long)
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" ( _
        ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Public Const LANG_ENGLISH = &H9

Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Public Type FIRSTCHAR_INFO
    sChar As String
    lCursor As Long
End Type

Global gUpdateText As Boolean                              'Update Syntax Coloring?
Global gIdentSpaces As Integer                             'For identing code
Global gDllProject As Boolean                              'Is it a dll project?
Global CancelDecompile As Boolean

Sub PrintReadMe()
    '*****************************
    'Prints the ReadMe of the program
    '*****************************
    On Error Resume Next
    Kill (App.path & "\readme.txt")

    Open App.path & "\ReadMe.txt" For Output As #1
    Print #1, "-------------------------------"
    Print #1, "Semi VB Decompiler by vbgamer45"
    Print #1, "Open Source"
    Print #1, "Version: " & Version
    Print #1, "-------------------------------"
    Print #1, "Contents"
    Print #1, "1. What's New?"
    Print #1, "2. Features"
    Print #1, "3. Questions?"
    Print #1, "4. Bugs"
    Print #1, "5. Contact"
    Print #1, "6. Credits"
    Print #1, ""
    Print #1, "1. What's New?"
    Print #1, ""
    Print #1, "   Version 0.03"
    Print #1, "     P-Code decoding started and image extraction."
    Print #1, "     Numerous bug fixes."
    Print #1, "     Event detection added."
    Print #1, "     Dll and OCX Support added."
    Print #1, "     External Components added to vbp file."
    Print #1, "     Begun work on a basic antidecompiler."
    Print #1, "     Form property editor, complete with a patch report generator."
    Print #1, "     Procedure names are recovered."
    Print #1, "     Api's used by the program are recovered."
    Print #1, "     Msvbvm60.dll imports are listed in the treeview."
    Print #1, "     Syntax coloring for Forms."
    Print #1, "     Fixed scrolling bug."
    Print #1, ""
    Print #1, "   Version 0.02"
    Print #1, "     Rebuilds the forms"
    Print #1, "     Gets most controls and their properties."
    Print #1, ""
    Print #1, "   Intial Release version 0.01"
    Print #1, ""
    Print #1, "2. Features"
    Print #1, "     Decompiling the pcode/native vb6/vb5 exe's"
    Print #1, "     Form Generation, P-Code code view"
    Print #1, "     Resource extraction wmf, ico, cur, gif, bmp, jpg, dib"
    Print #1, "     Form Editor"
    Print #1, "     P-Code Procedure Decompile View"
    Print #1, "     Shows offsets for controls"
    Print #1, "     SubMain Disassembly"
    Print #1, "     Memory Map of the exe file, so you can see what's going on."
    Print #1, "     Advanced decompiling using COM instead of hard coding property opcodes."
    Print #1, ""
    Print #1, "3. Questions?"
    Print #1, "   Q. What about Native Code Decompiling?"
    Print #1, "   A. It is in the works. I need to get a better understanding of how VBDE works before"
    Print #1, "      I begin to work on Native Code."
    Print #1, "      A site that is working on native vb decompiler is"
    Print #1, "      http://www.Decompiler.org"
    Print #1, "   Q. What the heck are the P-Code Tokens?"
    Print #1, "   A. P-Code tokens is the last step before turning the P-Code into readable VB Code."
    Print #1, "      All you have to do now is link the imports of the exe with the functions in P-Code."
    Print #1, "   Q. Why does it not show all the controls on my forms?"
    Print #1, "   A. Usally because its a property that is not detected by COM using vb6.olb."
    Print #1, "   Q. Why doesn't it get my procedure names for Modules?"
    Print #1, "   A. VB only saves procedures names for Form's and Classes."
    Print #1, "   Q. Why is there a ComFix file?"
    Print #1, "   A. Since Visual Basic does not support all the data types that IDL does it is needed."
    Print #1, "      Basicly it fixes when COM returns an integer when it should really be a VB byte."
    Print #1, "   Q. How does this decompiler work?"
    Print #1, "   A. First it gets all the main vb strutures from the exe."
    Print #1, "      Next it gets all the controls properties via COM using vb6.olb"
    Print #1, "      I am still looking for a static pointer for the table inside msvbvm60.dll to use instead."
    Print #1, "   Q. What files does this decompiler require?"
    Print #1, "   A. It requires the following files:"
    Print #1, "      TLBINF32.dll"
    Print #1, "      comdlg32.OCX"
    Print #1, "      RICHTX32.OCX"
    Print #1, "      MSCOMCTL.OCX"
    Print #1, "      TABCTL32.OCX"
    Print #1, "      MSFLXGRD.OCX"
    Print #1, "      Msvbvm60.dll"
    Print #1, "      And VB6.olb version 6.0.9"
    Print #1, "      All of the above files need to be registered!"
    Print #1, "   Q. Where can I learn more about Visual Basic 5/6 Decompiling?"
    Print #1, "   A. Head over to http://www.vb-decompiler.com/  tons of information on vb decompiling."
    Print #1, ""
    Print #1, "4. Bugs"
    Print #1, "     I know about most of them..."
    Print #1, "     MDI Forms and External Controls."
    Print #1, "     Some properties aren't handled yet dataformat, and some others"
    Print #1, "     P-Code decoding may hang use the disable P-Code option"
    Print #1, "     Overflow error is caused by a property that isn't detected yet..."
    Print #1, "     Currently it does not generate user control and property pages"
    Print #1, ""
    Print #1, "5. Contact"
    Print #1, "     Email=[e-mail]"
    Print #1, "     Aim=vbgamer45"
    Print #1, ""
    Print #1, "6. Credits"
    Print #1, "     I would like to thank the following people for helping me with this project."
    Print #1, "     Sarge, Mr. Unleaded, Moogman, _aLfa_, ionescu007, Warning and many others."

    Close #1

End Sub
Public Function sHexStringFromString(ByVal inp As String, Optional Spacing As Boolean = True) As String
    Dim hc As String
    Dim hs As String
    Dim c As Long
    While Len(inp)

        hc = Hex(Asc(Mid(inp, 1, 1)))
        inp = Mid(inp, 2)
        If Len(hc) = 1 Then hc = "0" & hc
        hs = hs & hc
        c = c + 1
        If Spacing Then
            If c Mod 4 = 0 Then
                hs = hs & "  "
            ElseIf c Mod 2 = 0 Then
                hs = hs & " "
            End If

        End If
    Wend
    sHexStringFromString = hs
End Function
Public Function PadHex(ByVal sHex As String, Optional Pad As Integer = 8) As String
    '*****************************
    'Purpose: To add extra zero's to a hexadecimal string
    '*****************************
    If Len(sHex) > Pad Then
        PadHex = sHex
    Else
        PadHex = String(Pad - Len(sHex), 48) & sHex
    End If
End Function

Public Function AddChar(Val As String, TheLen As Long, Optional Char As String = "0") As String    'Permet d'ajouter un charact鑢e ?une chaine de charact鑢e pour obtenir une certaine longueur.
    AddChar = Right(String(TheLen, Char) & Val, TheLen)
End Function
Public Function ExtString(DataStr As String) As String
    ExtString = Left(DataStr, lstrlen(DataStr))
End Function
Public Function GetUntilNull(FileNum As Variant) As String
    '*****************************
    'Purpose to get a null termintated string
    '*****************************
    Dim aList() As Byte
    Dim k As Byte
    k = 255
    ReDim aList(0)
    Do Until k = 0
        Get FileNum, , k
        ReDim Preserve aList(UBound(aList) + 1)
        aList(UBound(aList)) = k
        'MsgBox k
    Loop
    Dim i As Integer
    Dim Final As String
    For i = 1 To UBound(aList) - 1
        Final = Final & Chr(aList(i))

    Next i

    GetUntilNull = Final
End Function
Public Function GetUnicodeString(FileNum As Variant, length As Integer) As String
    '*****************************
    'Purpose to get a unicode string
    '*****************************
    Dim aList() As Byte

    ReDim aList((length * 2))
    Get FileNum, , aList

    Dim i As Integer
    Dim Final As String
    For i = 1 To UBound(aList) - 1
        If aList(i) <> 0 Then
            Final = Final & Chr(aList(i))
        End If
    Next i

    GetUnicodeString = Final
End Function
Public Function FileInfo(Optional ByVal PathWithFilename As String) As FILEPROPERTIE
    '*****************************
    'Purpose: To return file-properties of given file  (EXE , DLL , OCX)
    '*****************************

    Static BACKUP As FILEPROPERTIE                         ' backup info for next call without filename
    If Len(PathWithFilename) = 0 Then
        FileInfo = BACKUP
        Exit Function
    End If

    Dim lngBufferlen As Long
    Dim lngDummy As Long
    Dim lngRc As Long
    Dim lngVerPointer As Long
    Dim lngHexNumber As Long
    Dim bytBuffer() As Byte
    Dim bytBuff(255) As Byte
    Dim strBuffer As String
    Dim strLangCharset As String
    Dim strVersionInfo(7) As String
    Dim strTemp As String
    Dim intTemp As Integer

    ' size
    lngBufferlen = GetFileVersionInfoSize(PathWithFilename, lngDummy)
    If lngBufferlen > 0 Then
        ReDim bytBuffer(lngBufferlen)
        lngRc = GetFileVersionInfo(PathWithFilename, 0&, lngBufferlen, bytBuffer(0))
        If lngRc <> 0 Then
            lngRc = VerQueryValue(bytBuffer(0), "\VarFileInfo\Translation", _
                    lngVerPointer, lngBufferlen)
            If lngRc <> 0 Then
                'lngVerPointer is a pointer to four 4 bytes of Hex number,
                'first two bytes are language id, and last two bytes are code
                'page. However, strLangCharset needs a  string of
                '4 hex digits, the first two characters correspond to the
                'language id and last two the last two character correspond
                'to the code page id.
                MoveMemory bytBuff(0), lngVerPointer, lngBufferlen
                lngHexNumber = bytBuff(2) + bytBuff(3) * &H100 + _
                        bytBuff(0) * &H10000 + bytBuff(1) * &H1000000
                strLangCharset = Hex(lngHexNumber)
                'now we change the order of the language id and code page
                'and convert it into a string representation.
                'For example, it may look like 040904E4
                'Or to pull it all apart:
                '04------        = SUBLANG_ENGLISH_USA
                '--09----        = LANG_ENGLISH
                ' ----04E4 = 1252 = Codepage for Windows:Multilingual
                'Do While Len(strLangCharset) < 8
                '    strLangCharset = "0" & strLangCharset
                'Loop
                If Mid(strLangCharset, 2, 2) = LANG_ENGLISH Then
                    strLangCharset2 = "English (US)"


                End If

                Do While Len(strLangCharset) < 8
                    strLangCharset = "0" & strLangCharset
                Loop

                ' assign propertienames
                strVersionInfo(0) = "CompanyName"
                strVersionInfo(1) = "FileDescription"
                strVersionInfo(2) = "FileVersion"
                strVersionInfo(3) = "InternalName"
                strVersionInfo(4) = "LegalCopyright"
                strVersionInfo(5) = "OriginalFileName"
                strVersionInfo(6) = "ProductName"
                strVersionInfo(7) = "ProductVersion"
                ' loop and get fileproperties
                For intTemp = 0 To 7
                    strBuffer = String$(255, 0)
                    strTemp = "\StringFileInfo\" & strLangCharset _
                            & "\" & strVersionInfo(intTemp)
                    lngRc = VerQueryValue(bytBuffer(0), strTemp, _
                            lngVerPointer, lngBufferlen)
                    If lngRc <> 0 Then
                        ' get and format data
                        lstrcpy strBuffer, lngVerPointer