defoxpro.bas

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

    If (FileName <> "*") Then
       inpfile = FileName
    End If
End If

If inpfile = "" Then
    Exit Sub
End If

'app 和 exe 文件处理

If LCase(Right(inpfile, 4)) = ".app" Or LCase(Right(inpfile, 4)) = ".exe" Or LCase(Right(inpfile, 4)) = ".dll" Then
    isapp = True
    splitfileall getfoxfile, DeCompFilePath
    isapp = True
Else
    Open DeCompFilePath + inpfile For Binary As #2
    ReDim ddata(0 To FileLen(inpfile)) As Byte
    Get #2, , ddata()
    Close #2
    If appv = 0 Then
        If (SplitFxp = True) Then
            appv = 60
        Else
            appv = fileversion()
        End If
    End If

    isapp = False
End If

'Stop

If Prepaired = False Then
    Open DeCompFilePath + inpfile For Binary As #1
    fl = LOF(1)
    leninp = fl
    filelens = fl
    ReDim FileData(1 To fl) As Byte
    Get #1, , FileData()
    Close #1
Else
    ReDim FileData(1 To UBound(ddata) + 1) As Byte
    CopyMemory FileData(1), ddata(0), UBound(ddata)
    fl = UBound(ddata)
End If

If fl < 42 Then
    Exit Sub
End If

Dim Line1(0) As Byte
Dim I As Integer
Dim hbytes() As Byte, hbytes2 As String
Dim check20 As Boolean
Dim f As String

If isapp <> True Then '单独编译的 fxp 文件

    If SplitFxp <> True Then
        Dim j, k

        datapointer = 0
        
        ReDim hbytes(1 To 5) As Byte
        CopyMemory hbytes(1), FileData(datapointer + 1), 5
        datapointer = datapointer + 5
        
        ' Foxpro 1.0
        If hbytes(1) = &HFE And hbytes(2) = &H2A Then
            Call chk10xplus(inpfile, False, True)
        ElseIf hbytes(1) = &HFE And hbytes(2) = &H2B Then
            Call chk10xplus(inpfile, True, True)

        ' FoxBase
        ElseIf hbytes(1) = &HFB And hbytes(2) = &H2A Then
            isapp = False
            Decrypt ddata
            typinp = 2
            oldfox = True
        ElseIf hbytes(1) = &HFB And hbytes(2) = &H2B Then

            Dim procs As String, aproc
            datapointer = 4
            
            ReDim hbytes(1 To 2) As Byte
            hbytes(1) = FileData(datapointer + 1)
            hbytes(2) = FileData(datapointer + 2)
            datapointer = datapointer + 2
            
            procs = hbytes(1) + 256 * hbytes(2)
            CopyMemory aproc, FileData(datapointer + 1), 4
            datapointer = datapointer + 4

            If aproc = -1 Then
                typinp = -1
            End If

            If (procs = 0 And aproc <> 0) Or (procs <> 0 And aproc = 0) Or aproc >= leninp Then
                typinp = 10
            End If

            aproc = Mid(inpfile, InStr(inpfile, "\") + 1)
            oldfox = True
            typinp = 1
            isapp = False

        ElseIf hbytes(5) = &HC Or hbytes(5) = &HB Then
            newformat = 255 - hbytes(4)
        ElseIf hbytes(3) = &HFE Or hbytes(3) = &HFC Then
            If InStr(LCase(inpfile), ".app") <> 0 Then
                typinp = 14
            Else
                typinp = 5
                Decrypt ddata
            End If
            'isapp = True

        ElseIf (hbytes(1) = &HFF Or hbytes(2) = &HFD) And (hbytes(3) = &HB Or hbytes(4) = &HC Or hbytes(5) = &HD) Then

            Dim ptrtofiles, ptrtoenvir, nfiles
            datapointer = 6 + startofs
            
            ReDim hbytes(1 To 4) As Byte
            CopyMemory hbytes(1), FileData(datapointer + 1), 4
            datapointer = datapointer + 4
            
            nfiles = Asc(Left(hbytes, 1)) + 256 * Asc(Mid(hbytes, 2, 1))
            If nfiles <= Asc(Mid(hbytes, 3, 1)) + 256 * Asc(Right(hbytes, 1)) Or nfiles > 1 Then
                typinp = 10
                check20 = False
                GoTo there:
            End If
            
            CopyMemory ptrtofiles, FileData(datapointer + 1), 4
            datapointer = datapointer + 4
            
            CopyMemory ptrtoenvir, FileData(datapointer + 1), 4
            datapointer = datapointer + 4
            
            ptrtofiles = ptrtofiles + startofs
            ptrtoenvir = ptrtoenvir + startofs
            If ptrtofiles >= leninp Or ptrtoenvir >= leninp Then
                typinp = 10
                check20 = False
                GoTo there:
            End If
            check20 = True
there:
            If check20 <> True Then
                isapp = False
                Exit Sub
            End If
        ElseIf hbytes(1) = &HFE And hbytes(2) = &HF2 And hbytes(3) = &HEE Then ' vfp 6.0 encrypted
            f = Left(inpfile, strlen(inpfile) - 4) + "_.fxp"
            isapp = False
            Decrypt ddata
            inpfile = f
            oldfox = False

        End If


        ReDim dfoxfile(1, 6)
        dfoxfile(1, 1) = inpfile
        dfoxfile(1, 2) = chr(0)
        dfoxfile(1, 3) = IIf(appv >= 30, 41, 42)
        dfoxfile(1, 4) = 0

        Select Case LCase(Right(inpfile, 4))
        Case ".fxp", ".fox"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".prg"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case ".spx"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".spr"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case ".mpx"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".mpr"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case ".qpx"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".qpr"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case Else
            dfoxfile(1, 5) = ""
            dfoxfile(1, 6) = ""
        End Select
        
        newformat = 0
        
        'If typinp = 5 Then typinp = 7
    Else
    
        ReDim dfoxfile(1, 6)
        dfoxfile(1, 1) = inpfile
        dfoxfile(1, 2) = chr(0)
        dfoxfile(1, 3) = 0
        dfoxfile(1, 4) = 0
        
        If appv = 0 Then appv = 60
        
        isapp = True
        Select Case LCase(Right(inpfile, 4))
        Case ".fxp", ".fox"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".prg"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case ".spx"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".spr"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case ".mpx"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".mpr"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case ".qpx"
            dfoxfile(1, 5) = strleft(inpfile, strlen(inpfile) - 4) + ".qpr"
            dfoxfile(1, 6) = strleft(inpfile, strlen(inpfile) - 4) + LCase(Right(inpfile, 4))
        Case Else
            dfoxfile(1, 5) = ""
            dfoxfile(1, 6) = ""
        End Select
        
        newformat = 0
    End If
Else
    ReDim dfoxfile(1 To getfoxfile.afilenumbers, 6)
    For I = 1 To getfoxfile.afilenumbers
        dfoxfile(I, 1) = getfoxfile.afilesname(I - 1)
        dfoxfile(I, 2) = chr(0)
        dfoxfile(I, 3) = 0
        dfoxfile(I, 4) = 0
        Select Case LCase(Right(getfoxfile.afilesname(I - 1), 4))
        Case ".fxp"
            dfoxfile(I, 5) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + ".prg"
            dfoxfile(1, 6) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + LCase(Right(getfoxfile.afilesname(I - 1), 4))
        Case ".spx"
            dfoxfile(I, 5) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + ".spr"
            dfoxfile(1, 6) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + LCase(Right(getfoxfile.afilesname(I - 1), 4))
        Case ".mpx"
            dfoxfile(I, 5) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + ".mpr"
            dfoxfile(1, 6) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + LCase(Right(getfoxfile.afilesname(I - 1), 4))
        Case ".qpx"
            dfoxfile(I, 5) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + ".qpr"
            dfoxfile(1, 6) = strleft(getfoxfile.afilesname(I - 1), strlen(getfoxfile.afilesname(I - 1)) - 4) + LCase(Right(getfoxfile.afilesname(I - 1), 4))
        Case Else
            dfoxfile(I, 5) = ""
            dfoxfile(1, 6) = ""
        End Select
        
    Next
End If

setsysvar
deco

If (FileName <> "*") And (UCase(Right(FileName, 4)) = ".APP" Or UCase(Right(FileName, 4)) = ".EXE" Or UCase(Right(FileName, 4)) = ".DLL") Then
   MsgBox "反编译完成", , "确定"
End If
Exit Sub

pexit:
MsgBox "发生错误", , "确定"

End Sub
Sub getofsmod(no As Integer, ofs As Long, name As String)
Dim tmp1 As Long
name = ""
Dim po As Long

'主过程
If no = 0 Then
    name = "<main>"
    
    If oldfox = True Then
        ofs = 34
    Else
        datapointer = dfoxfile(mainloop, 3) + 2 + refoxed
        If appv >= 30 Then
            datapointer = datapointer + 2
        End If

        CopyMemory tmp1, FileData(datapointer + 1), 4
        datapointer = datapointer + 4
        
        ofs = dfoxfile(mainloop, 3) + tmp1 + refoxed
    End If
Else
    ' 是文件中所包含的过程或函数
    If appv >= 30 Then
    Else
        po = procstab + (no - 1) * IIf(oldfox = True, 14, 15)
        Select Case typinp
        Case 2, 7
            ReDim Tmp(1 To 10) As Byte
            po = po + 1
            datapointer = po

            Dim p As Integer
            For p = 1 To 10
                Tmp(p) = FileData(datapointer + p)
            Next
            datapointer = datapointer + 10

            Dim I As Integer
            For I = 1 To 10
                If Tmp(I) = 0 Then
                    Exit For
                End If
                name = name + ChrB(Tmp(I))
            Next
            name = StrConv(name, vbUnicode)
            CopyMemory ofs, FileData(datapointer + 1), 4
            datapointer = datapointer + 4
            
        Case 1, 6
            ReDim Tmp(1 To 10) As Byte
            datapointer = po

            For p = 1 To 10
                Tmp(p) = FileData(datapointer + p)
            Next

            datapointer = datapointer + 10

            For I = 1 To 10
                If Tmp(I) = 0 Then
                    Exit For
                End If
                name = name + ChrB(Tmp(I))
            Next
            name = StrConv(name, vbUnicode)
            CopyMemory ofs, FileData(datapointer + 1), 4
            datapointer = datapointer + 4
            
        Case Else

            ReDim Tmp(1 To 11) As Byte
            po = po + 1
            datapointer = po
            
            For p = 1 To 11
                Tmp(p) = FileData(datapointer + p)
            Next

            datapointer = datapointer + 11

            For I = 1 To 11
                If Tmp(I) = 0 Then
                    Exit For
                End If
                name = name + ChrB(Tmp(I))
            Next
            name = StrConv(name, vbUnicode)
            CopyMemory ofs, FileData(datapointer + 1), 4
            datapointer = datapointer + 4
            ofs = ofs + dfoxfile(mainloop, 3)
        End Select
    End If
End If
End Sub
Function getmodulecnt()

On Error GoTo ex99

Dim I As Integer
Dim Cnt As Long
Dim ttt As String

refoxed = 0

'Stop

If oldfox = True Then
    datapointer = 4
Else
    datapointer = dfoxfile(mainloop, 3)
End If

If UBound(FileData) >= 46 Then
    If FileData(42) = &H52 And FileData(43) = &H65 And FileData(44) = &H46 And FileData(45) = &H6F And FileData(46) = &H78 Then
        datapointer = 64
        refoxed = 23
    Else
        refoxed = 0
    End If
End If

Dim modulecnt1 As Long

modulecnt1 = FileData(datapointer + 2)
modulecnt1 = modulecnt1 * 256 + FileData(datapointer + 1)
datapointer = datapointer + 2

If oldfox <> True Then
   datapointer = dfoxfile(mainloop, 3) + 6 + refoxed
End If


Dim da As Long
da = datapointer

If appv >= 30 Then
    datapointer = datapointer + 2