modpeskeleton.bas

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

    OptHeader.DataDirectory(5).Address = GetDWord()
    OptHeader.DataDirectory(5).Size = GetDWord()
    OptHeader.DataDirectory(6).Name = "DEBUG"
    OptHeader.DataDirectory(6).Address = GetDWord()
    OptHeader.DataDirectory(6).Size = GetDWord()
    OptHeader.DataDirectory(7).Name = "COPYRIGHT"
    OptHeader.DataDirectory(7).Address = GetDWord()
    OptHeader.DataDirectory(7).Size = GetDWord()
    OptHeader.DataDirectory(8).Name = "GLOBALPTR"
    OptHeader.DataDirectory(8).Address = GetDWord()
    OptHeader.DataDirectory(8).Size = GetDWord()
    OptHeader.DataDirectory(9).Name = "TLS"
    OptHeader.DataDirectory(9).Address = GetDWord()
    OptHeader.DataDirectory(9).Size = GetDWord()
    OptHeader.DataDirectory(10).Name = "LOAD_CONFIG"
    OptHeader.DataDirectory(10).Address = GetDWord()
    OptHeader.DataDirectory(10).Size = GetDWord()
    OptHeader.DataDirectory(11).Name = "unused"
    OptHeader.DataDirectory(11).Address = GetDWord()
    OptHeader.DataDirectory(11).Size = GetDWord()
    OptHeader.DataDirectory(12).Name = "unused"
    OptHeader.DataDirectory(12).Address = GetDWord()
    OptHeader.DataDirectory(12).Size = GetDWord()
    OptHeader.DataDirectory(13).Name = "unused"
    OptHeader.DataDirectory(13).Address = GetDWord()
    OptHeader.DataDirectory(13).Size = GetDWord()
    OptHeader.DataDirectory(14).Name = "unused"
    OptHeader.DataDirectory(14).Address = GetDWord()
    OptHeader.DataDirectory(14).Size = GetDWord()
    OptHeader.DataDirectory(15).Name = "unused"
    OptHeader.DataDirectory(15).Address = GetDWord()
    OptHeader.DataDirectory(15).Size = GetDWord()

End Sub

Public Sub GetPEHeader()

    'Fill up the PE header structure
    PEHeader.Machine = GetWord()
    PEHeader.NumSections = GetWord()
    PEHeader.TimeDate = GetDWord()
    PEHeader.SymbolTablePointer = GetDWord()
    PEHeader.NumSymbols = GetDWord()
    PEHeader.OptionalHdrSize = GetWord()
    PEHeader.Properties = GetWord()

End Sub

Public Sub GetPESecHeader()

    Dim counter As Integer
    Dim Counter2 As Integer

    'Name = SecName
    'Address = RVA
    'RawDataPointer = Offset
    'Size = SizeRawData
    'Flags = Properties

    'All names are max 8 chars, starting with "."; get all 8 chars, remove the
    'trailing blanks, loop back until all sections done
    For counter = 1 To PEHeader.NumSections
        SecHeader(counter).SecName = Input(LENNAME, #InFileNumber%)
        For Counter2 = 1 To LENNAME
            'Remove the trailing blanks
            If Asc(Mid$(SecHeader(counter).SecName, Counter2, 1)) = 0 Then
                Mid$(SecHeader(counter).SecName, Counter2, 1) = ""
            End If
        Next

        'Fill in the rest of the structure
        SecHeader(counter).Misc = GetDWord()
        SecHeader(counter).Address = GetDWord()
        SecHeader(counter).SizeRawData = GetDWord()
        SecHeader(counter).RawDataPointer = GetDWord()
        SecHeader(counter).RelocationPointer = GetDWord()
        SecHeader(counter).LineNumPointer = GetDWord()
        SecHeader(counter).NumRelocations = GetWord()
        SecHeader(counter).NumLineNumbers = GetWord()
        SecHeader(counter).Properties = GetDWord()
    Next

End Sub

Public Sub GetVBStartHeader()

    'All VB start headers are a "Push" (5 bytes), followed by
    'a "Call" (5 bytes)

    VBStartHeader.PushStartOpcode = GetByte()
    VBStartHeader.PushStartAddress = GetDWord()
    VBStartHeader.CallStartOpcode = GetByte()
    VBStartHeader.CallStartAddress = GetDWord()

    ' MsgBox VBStartHeader.PushStartAddress
    'This should be the hex code "68 xx xx xx xx"
    If VBStartHeader.PushStartOpcode <> ConvertHex("68") And VBStartHeader.PushStartOpcode <> ConvertHex("5A") Then
        ErrorFlag = True
        Exit Sub
    End If

    'This should be the hex code "E8 xx xx xx xx"
    If VBStartHeader.CallStartOpcode <> ConvertHex("E8") And VBStartHeader.CallStartOpcode <> ConvertHex("11") Then
        ErrorFlag = True
    End If

End Sub
Sub GetVBHeader2()
    VBStartHeader.PushStartOpcode = GetByte()

    VBStartHeader.PushStartAddress = GetDWord()
    'VBStartHeader.CallStartAddress = GetDWord()

    'MsgBox "#" & VBStartHeader.CallStartAddress - OptHeader.ImageBase
    Dim i As Integer

    'Calculate the load offset mask
    DecLoadOffset# = OptHeader.ImageBase

    For i = 0 To 10
        MsgBox "Word" & GetWord                            ' - DecLoadOffset#
    Next

    'Get the APP data VB signature offset
    AppData.VBVerOffsetRaw = VBStartHeader.PushStartAddress

    'Calculate the APP offset
    AppData.VBVerOffsetMasked = AppData.VBVerOffsetRaw - DecLoadOffset#

End Sub
Public Sub GetVBVer()

    'Fill in the VBSignature structure
    Mid$(VBSignature.VBVer$, 1) = Chr$(GetByte())
    Mid$(VBSignature.VBVer$, 2) = Chr$(GetByte())
    Mid$(VBSignature.VBVer$, 3) = Chr$(GetByte())
    Mid$(VBSignature.VBVer$, 4) = Chr$(GetByte())

    'The version should be "VB5!"
    If VBSignature.VBVer$ <> VBVERTEXT Then
        ErrorFlag = True
    End If

End Sub

Public Sub GetVBIntrptr()

    'Get VB interpreter name
    VBSignature.VBIntrptr$ = GetDosString()

    'The interpreter should be "MSVBVM60.DLL" or "MSVBVM50.DLL"
    If VBSignature.VBIntrptr$ <> VBINTRPTRTEXT Then
        ErrorFlag = True
    End If

End Sub

Public Function GetDWord() As Double

    GetDWord# = GetWord()
    GetDWord# = GetDWord# + 65536# * GetWord()

End Function

Public Function GetWord() As Double

    GetWord# = GetByte()
    GetWord# = GetWord# + 256# * GetByte()

End Function

Public Function GetByte() As Byte

    Dim DataByte As Byte

    'Read the data
    Get #InFileNumber, , DataByte

    'Return it
    GetByte = DataByte

End Function


Public Function ConvertHex(HexData As String) As Double

    Dim count As Integer

    'Get HexData as a 8 byte leading zero string
    HexData$ = "0000000" & HexData$
    HexData$ = Right$(HexData$, 8)

    'Sum up powers of 16 for 8 byte values
    ConvertHex = 0#
    For count = 1 To 8
        ConvertHex = ConvertHex + 16 ^ (count - 1) * (HexToDec(Mid$(HexData$, 9 - count, 1)))
    Next

End Function


Public Function GetDosString() As String

    'Clear string
    GetDosString$ = ""

    'Get a Dos string char by char
    Do
        'Get a char
        GetDosString$ = GetDosString$ & Chr$(GetByte())

        'Continue until we get a "0"
    Loop Until (Asc(Right$(GetDosString$, 1)) = 0)

    'Remove trailing zero
    GetDosString$ = Left$(GetDosString$, Len(GetDosString$) - 1)

End Function


Public Function HexToDec(HexDigit As String) As Double

    'Simple brute force hex-to-decimal conversion
    If HexDigit = "F" Then
        HexToDec# = 15#
    ElseIf HexDigit = "E" Then
        HexToDec# = 14#
    ElseIf HexDigit = "D" Then
        HexToDec# = 13#
    ElseIf HexDigit = "C" Then
        HexToDec# = 12#
    ElseIf HexDigit = "B" Then
        HexToDec# = 11#
    ElseIf HexDigit = "A" Then
        HexToDec# = 10#
    Else
        HexToDec# = Val(HexDigit$)
    End If

End Function

Private Sub ScanTable(fp As Integer, ByVal OffsetADR As Long, ByVal OffsetSTR As Long, ByRef outADRarray() As IMPORT_API_LOOKUP)
    '*****************************
    'Purpose: Used for processing the import table
    '*****************************
    Dim l As Long, i As Long, s As Long


    i = UBound(outADRarray()) - 1
    Get #fp, OffsetADR, l
    Do
        i = i + 1
        ReDim Preserve outADRarray(1 To i)
        outADRarray(i).Address = l
        Get #fp, OffsetSTR, s
        If (s And &H80000000) = 0 Then
            'Import by Name
            outADRarray(i).ApiName = ScanString(fp, s + 3)
        Else
            'Import by ordinal
            outADRarray(i).ApiName = "!ordinal : " & (s And &H7FFFFFFF)
        End If


        OffsetSTR = OffsetSTR + 4
        OffsetADR = OffsetADR + 4
        Get #fp, OffsetADR, l
    Loop Until l = 0

End Sub
Private Function ScanString(fp As Integer, ByVal offset As Long) As String
    '*****************************
    'Purpose: Used for processing the import table
    '*****************************
    Dim b As Byte
    Get #fp, offset, b
    Do
        ScanString = ScanString & Chr$(b)
        offset = offset + 1
        Get #fp, offset, b
    Loop Until b = 0

End Function

Public Function GetPtrFromRVA(ByVal iRVA As Integer) As Long
    '*****************************
    'Purpose: To get the real entrypoint used for VB5
    '*****************************
    Dim num2 As Integer
    Dim num3 As Integer
    num3 = PEHeader.NumSections - 1
    num2 = 0
    Do While (num2 <= num3)
        If ((iRVA >= SecHeader(num2).Address) And (iRVA < (SecHeader(num2).Address + SecHeader(num2).SizeRawData))) Then

            GetPtrFromRVA = (iRVA - (SecHeader(num2).Address - SecHeader(num2).RawDataPointer))
        End If
        num2 = num2 + 1
    Loop
    GetPtrFromRVA = iRVA
End Function