modify.bas

一款反编译VFP程序的代码的工具

    FUNCTION = Dest

End Function

Function GetFileNoExtension(FileName As String) As String
' Returns filename from drive:\path\path\filename.ext or filename.ext
  Dim i As Integer
  GetFileNoExtension = FileName     ' Just in case there is no "." in the file
  For i = 1 To Len(FileName)
    If Mid$(FileName, Len(FileName) - i, 1) = "." Then
      GetFileNoExtension = Mid$(FileName, 1, Len(FileName) - (i + 1))
      Exit For
    End If
  Next
End Function

Function SHL(VALUE As Long, BITS As Long) As Long
    DIM RET AS LOCAL LONG
    ret = VALUE
    SHIFT LEFT RET,BITS
    FUNCTION = RET
End Function

Function SHR(VALUE As Long, BITS As Long) As Long
    DIM RET AS LOCAL LONG
    ret = VALUE
    SHIFT RIGHT RET,BITS
    FUNCTION = RET
End Function

Sub MakeCrcs(lpData() As Byte, ForDecrypt As Long)
  Dim CheckSum As Long, i As Long, Ptr1 As Integer, Ptr2 As Integer
    CheckSum = &HFEF2

    If ForDecrypt Then
        lpData(2) = &HFF
        For i = 21 To 38
            lpData(i) = 0
        Next i
    End If

    i = &H25

    While i > 0
        CheckSum = ((SHL((CheckSum), 8)) + (SHR(CheckSum, 8) And &HFF)) And &HFFFF
        CheckSum = lpData(Ptr1) Xor CheckSum
        CheckSum = CheckSum Xor (SHR(CheckSum, 4) And &HF)
        CheckSum = CheckSum Xor (SHL((((SHL(CheckSum, 7) Xor CheckSum) And &HFF) + (SHL(CheckSum, 7) And &HFF00)), 5))
        Ptr1 = Ptr1 + 1
        i = i - 1
    Wend
    CheckSum = LOWRD(CheckSum)
    CopyMemory ByVal VarPtr(lpData(39)), ByVal VarPtr(CheckSum), 2

End Sub


'//GLOBAL TSTR AS STRING

Function Exe2App(strFilePath As String, DestBuffer() As Byte) As Long
    'DIM ExeFileSize AS LONG
    'DIM lngRet AS LONG
    'DIM hFileHandle AS LONG
    'DIM OfData AS OFSTRUCT

    Dim AppFileSize As Long, tSize As Long

    DIM F AS LOCAL INTEGER
    DIM TSTR AS LOCAL STRING

    F = FreeFile
    Open strFilePath For Binary As #F
    '//TSTR = SPACE$(LOF(F))
    Get #F, LOF(F), tstr
    Close #F

    'TELL HEX$(VARPTR(TSTR))
    DIM EXESIZE AS LOCAL LONG
    exesize = Len(tstr)
    DIM TSTR3 AS LOCAL STRING

    Select Case Left$(tstr, 2)
        Case "MZ"
            TSTR3 = Right$(tstr, 4)
            CopyMemory ByVal VarPtr(tSize), ByVal StrPtr(TSTR3), 4
            tstr = Mid$(tstr, exesize - tSize + 1)
        Case chr$(&HFE) + chr$(&HF2)
            tstr = tstr
        Case Else
            FUNCTION = -1
            Exit Function
    End Select


    ReDim DestBuffer(0 To Len(tstr) - 1)
    CopyMemory ByVal VarPtr(DestBuffer(0)), ByVal StrPtr(tstr), Len(tstr)
    FUNCTION = 1
    'hFileHandle = OpenFile(BYCOPY strFilePath, OfData, %OF_READ)

    'ExeFileSize = GetFileSize(hFileHandle, 0)

    'CALL SetFilePointer(hFileHandle, ExeFileSize - 4, 0, %FILE_BEGIN)

    'ReadFile hFileHandle, AppFileSize, 4, lngRet, BYVAL 0&

    'CALL SetFilePointer(hFileHandle, ExeFileSize - AppFileSize, 0, %FILE_BEGIN)

    'AppFileSize = AppFileSize - 14

    'REDIM DestBuffer(0 TO AppFileSize - 1)



    'ReadFile hFileHandle, DestBuffer(0), UBOUND(DestBuffer), lngRet, BYVAL 0&


    'CloseHandle hFileHandle

    'If DestBuffer(2) = &HEE Then
    '   Call DeCrypt(DestBuffer)
    'End If

End Function

Function ModifyX(szFileName As String, DestArray() As Byte) As String

    Dim FileNumber As Integer          '文件数目
    Dim MainFileInList As Integer      '主文件在文件列表中的次序
    Dim MainFile As String             '主文件名称
    Dim FileNameListStart As Long      '文件列表开始地址
    Dim FileStructureListStart As Long '文件列表结构描述开始地址
    Dim FileNameListSize As Long

    Dim FileDataStart() As Long
    Dim FileDataEnd() As Long
    Dim FileName() As String
    Dim FileSize() As Long
    Dim FileTypes() As Byte

    Dim M As Long
    Dim N As Long

'---------------------------------------------------------------------------------------
    Dim FileNameStartPos() As Long
    Dim FileNameEndPos() As Long
    Dim FileNameLen() As Long
    Dim FileNameData(255) As Byte     '用来储存各个文件的临时数据
'---------------------------------------------------------------------------------------

'---------------------------------------------------------------------------------------
    tell "Reading Exe Information, Please wait..."
    If Exe2App(szFileName, DestArray()) <> 1 Then  '将EXE转换成APP
        tell "Invild VFP File!"
        Exit Function
    End If
'---------------------------------------------------------------------------------------


'---------------------------------------------------------------------------------------
    CopyMemory ByVal VarPtr(FileNumber), ByVal VarPtr(DestArray(5)), 2
    CopyMemory ByVal VarPtr(MainFileInList), ByVal VarPtr(DestArray(7)), 2
    CopyMemory ByVal VarPtr(FileStructureListStart), ByVal VarPtr(DestArray(9)), 4
    CopyMemory ByVal VarPtr(FileNameListStart), ByVal VarPtr(DestArray(13)), 4
    CopyMemory ByVal VarPtr(FileNameListSize), ByVal VarPtr(DestArray(17)), 4
'---------------------------------------------------------------------------------------

'---------------------------------------------------------------------------------------
' 重新定义数组大小
    ReDim FileDataStart(FileNumber): ReDim FileNameStartPos(FileNumber): ReDim FileNameEndPos(FileNumber)
    ReDim FileName(FileNumber): ReDim FileDataEnd(FileNumber)
    ReDim FileTypes(FileNumber): ReDim FileSize(FileNumber)

'---------------------------------------------------------------------------------------

'---------------------------------------------------------------------------------------
    FileNameStartPos(FileNumber) = FileNameListStart + FileNameListSize
    FileDataStart(FileNumber) = FileNameListStart
'---------------------------------------------------------------------------------------

    Dim TempString As String
    Dim pString As ASCIIZ
    Dim RetStr As String

'---------------------------------------------------------------------------------------
    For M = 0 To FileNumber - 1
        CopyMemory ByVal VarPtr(FileTypes(M)), ByVal VarPtr(DestArray(FileStructureListStart + M * 25)), 1
        CopyMemory ByVal VarPtr(FileDataStart(M)), ByVal VarPtr(DestArray(FileStructureListStart + M * 25 + 1)), 4
        CopyMemory ByVal VarPtr(FileDataEnd(M)), ByVal VarPtr(DestArray(FileStructureListStart + M * 25 + 5)), 4
        FileSize(M) = FileDataEnd(M) - FileDataStart(M)


'--------------------------------------------------------------------------------------
'以下封闭代码为读取APP结构中的文件名相关
        CopyMemory ByVal VarPtr(FileNameStartPos(M)), ByVal VarPtr(DestArray(FileStructureListStart + M * 25 + 9)), 2
        CopyMemory ByVal VarPtr(FileNameEndPos(M)), ByVal VarPtr(DestArray(FileStructureListStart + M * 25 + 13)), 2
        pString = (VarPtr(DestArray(FileNameListStart + FileNameEndPos(M)))) 'FileName(M)
        FileName(M) = pString

        If InStr(FileName(M), "*") > 0 Then
            TempString = FileName(M)
            RetStr = RetStr + GetFileNoExtension(TempString) + ","
        End If

    Next M

    ModifyX = RetStr
    Dim F As Integer
    F = FreeFile
    Open UCase$(szFileName) + "_FILELIST.TXT" For Output As #F
    For M = 0 To FileNumber - 1
        Print #F, "|" + Format$(M, "000") + ". " + FileName(M) + Space$(30 - Len(FileName(M))) + Space$(4) + _
        Hex$(FileDataStart(M)) + Space$(8 - Len(Hex$(FileDataStart(M)))) + Space$(4) + _
        Hex$(FileDataEnd(M)) + Space$(8 - Len(Hex$(FileDataEnd(M)))) + Space$(4) + _
        Hex$(FileSize(M)) + Space$(8 - Len(Hex$(FileSize(M)))) + Space$(4) + _
        Hex$(FileTypes(M))
    Next M

    Close #F

    For M = 0 To FileNumber - 1
        If FileSize(M) < 0 Or FileDataStart(M) > FileStructureListStart Then
            FileNumber = M - 1
            Exit For
        End If
    Next M

    TempString = Trim$(UCase$(FileName(0)))

    If InStr(TempString, ".FXP") > 0 Then '//and FileTypes(M) <> 0 then
        FileStructureListStart = FileStructureListStart + 25
        MainFileInList = MainFileInList - 1
        FileNumber = FileNumber - 1
    End If

    CopyMemory ByVal VarPtr(DestArray(5)), ByVal VarPtr(FileNumber), 2
    CopyMemory ByVal VarPtr(DestArray(7)), ByVal VarPtr(MainFileInList), 2
    CopyMemory ByVal VarPtr(DestArray(9)), ByVal VarPtr(FileStructureListStart), 4

    MakeCrcs DestArray(), 0
End Function
Function PBMAIN() As Long

   If Len(command$) = 0 Then
    CALL tell( "No command line parameters were specified" + $CRLF )
      tell "Usage: Modify <FileName>"
      '//CALL usage()
      Exit Function
   End If
   Dim tFile As String
   tFile = command$


    Dim MB() As Byte
    ReDim MB(0)

    DIM F AS LOCAL LONG
    Dim Temp As String
    Temp = ModifyX(tFile, MB())
    Dim tData As String
    tData = PEEK$(VarPtr(MB(0)), UBound(MB()) + 1)
    Dim Lines As Long

    Lines = PARSECOUNT(Temp, ",")
    If Len(PARSE$(Temp, ",", Lines)) < 2 Then
        Lines = Lines - 1
    End If

    Dim i As Long

    '//MsgBox Str$(lines)

    Dim TempString As String
    Dim Temp1 As String
    Dim Temp2 As String

    For i = 1 To Lines
        Temp1 = PARSE$(Temp, ",", i)
        Temp2 = Temp1
        REPLACE "*" WITH "_" IN Temp2
        tell "Modify... " + Temp1 + Space$(20 - Len(Temp1)) + " To:   " + Temp2
        REPLACE Temp1 WITH Temp2 IN tData
    Next i

    F = FreeFile
    tData = Read_H() + tData

    Open tFile + "_.EXE" For Binary As #F
    PUT$ #F,tData
    Close #F
    tell $CRLF + "Done...The New File Is: " + tFile + "_.EXE"

End Function