defoxpro.bas

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

    Dim classflag As Long
    da = datapointer
    Dim classadress As Long
    Dim temp As Long
    
    If isapp = False Then
        classnum = FileData(45 + refoxed)
        classnum = FileData(44 + refoxed) + classnum * 256
    Else
        classnum = FileData(4)
        classnum = FileData(3) + classnum * 256
    End If
    
    If classnum > 255 Then
        getmodulecnt = 65536
        Exit Function
    End If
    
    'Stop
    
    fxpfileinfo.classnumber = classnum
    classflag = 0
    
    If appv = 30 Or appv = 60 Then
        classflag = 1
    End If

    If classnum > 0 And classnum < 65000 Then

        If isapp = False Then
            CopyMemory classadress, FileData(53 + classflag + refoxed), 4
            classadress = classadress + 41
        Else
            CopyMemory classadress, FileData(12 + classflag + refoxed), 4
        End If
        datapointer = classadress
        If classnum <> 0 And classnum < 512 Then
            ReDim aclass(1 To classnum) As String
            ReDim aclassadress(1 To classnum) As Long
            ReDim abaseclass(1 To classnum) As String
            
            
        Dim abaseclassF() As Integer
        ReDim abaseclassF(0 To classnum)
            
            
            
            Dim p As Integer
            
            For I = 1 To classnum
                ttt = ""
                Cnt = 0
                ' 类名的长度是不定的，由类名前两字节指明
                Cnt = FileData(datapointer + 2)
                Cnt = FileData(datapointer + 1) + Cnt * 256
                
                If Cnt > 128 Then
                   datapointer = datapointer - 4
                   Cnt = FileData(datapointer + 2)
                   Cnt = FileData(datapointer + 1) + Cnt * 256
                End If
                
                datapointer = datapointer + 2
                For p = 1 To Cnt
                    ttt = ttt + ChrB(FileData(datapointer + p))
                Next

                datapointer = datapointer + Cnt
                ttt = StrConv(ttt, vbUnicode)
                aclass(I) = ttt
                Cnt = FileData(datapointer + 2)
                Cnt = FileData(datapointer + 1) + Cnt * 256
                datapointer = datapointer + 2
                ttt = ""
                For p = 1 To Cnt
                    ttt = ttt + ChrB(FileData(datapointer + p))
                Next
                datapointer = datapointer + Cnt
                ttt = StrConv(ttt, vbUnicode)
                abaseclass(I) = ttt
                CopyMemory aclassadress(I), FileData(datapointer + 1), 4
                aclassadress(I) = aclassadress(I) + dfoxfile(1, 3)
                
                Dim a As Integer
                a = InStr(abaseclass(I), ":")
                If a <> 0 Then
                   abaseclass(I) = Left(abaseclass(I), a - 1) + PP(" of ") + Mid(abaseclass(I), a + 1)
                End If
                
                datapointer = datapointer + 4
                CopyMemory abaseclassF(I), FileData(datapointer + 1), 2
                
                If appv = 30 Then
                    datapointer = datapointer + 4
                Else
                    datapointer = datapointer + 6            ' 01003500f101
                    'datapointer = datapointer + 2
                                                             ' 00003500b101
                    'If FileData(1) = &H3C And FileData(3) = &HA Then
                    '   datapointer = datapointer - 4
                    'End If
                    
                End If
            Next
        End If
    End If
End If

datapointer = da

If isapp = True Then
    ' app 中分离出的 fxp 等
    Select Case appv
    Case 25
        datapointer = 6
    Case 30
        datapointer = 8
    Case 50, 60
        datapointer = 8
    End Select
End If

CopyMemory procstab, FileData(datapointer + 1), 4
datapointer = datapointer + 4
procstab = procstab + IIf(oldfox = True, 0, dfoxfile(mainloop, 3)) - 1 + refoxed

fxpfileinfo.procnumbers = modulecnt1

If appv >= 30 Then

    procstab = procstab + 1
    
    If procstab > FileLen(DeCompFilePath + inpfile) Then
        Exit Function
    End If
    
    datapointer = procstab
    
    If (modulecnt1 > 0 Or classnum > 0) And classnum < 65000 Then
        modnum = IIf(modulecnt1 > classnum, modulecnt1, classnum)
        modulecnt1 = modnum
        ReDim procname(1 To modnum) As String
        ReDim procaddr(1 To modnum) As Long
        ReDim procedure_type(0 To modnum) As Long
        ReDim class_order(0 To modnum) As Long
        
        For I = 1 To modnum
            ttt = ""
            ' 过程名的长度，在 vfp 中，它是变化的，由变量名前两字节指明
            If datapointer <= UBound(FileData) Then
                Cnt = FileData(datapointer + 2)
                Cnt = Cnt * 256 + FileData(datapointer + 1)
                datapointer = datapointer + 2
                If datapointer + Cnt <= UBound(FileData) Then
                    For p = 1 To Cnt
                        ttt = ttt + ChrB(FileData(datapointer + p))
                    Next
                    datapointer = datapointer + Cnt
                    ttt = StrConv(ttt, vbUnicode)
                    procname(I) = ttt
                    CopyMemory procaddr(I), FileData(datapointer + 1), 4
                    procaddr(I) = procaddr(I) + dfoxfile(1, 3) + refoxed
                    datapointer = datapointer + 4
                    If appv >= 30 And classnum > 0 Then
                        procedure_type(I) = FileData(datapointer + 2)
                        procedure_type(I) = FileData(datapointer + 1) + procedure_type(I) * 256
                        datapointer = datapointer + 2
                        class_order(I) = FileData(datapointer + 2)
                        class_order(I) = FileData(datapointer + 1) + class_order(I) * 256
                        datapointer = datapointer + 2
                    Else
                        datapointer = datapointer + 2
                        If appv >= 50 Then
                            datapointer = datapointer + 2
                        End If
                    End If
                End If
            End If
        Next
        
    End If
End If

'Stop

If appv >= 30 And (fxpfileinfo.procnumbers + fxpfileinfo.classnumber > 0) And classnum < 65000 Then

    Dim j As Integer
    Dim k As Integer
    ReDim fxpfileinfo.aprocname(1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber) As String
    ReDim fxpfileinfo.aprocadress(1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber) As Long
    ReDim fxpfileinfo.aproctype(1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber) As String
    ReDim fxpfileinfo.aproctype2(1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber) As String
    Cnt = 0
    j = 1
    Dim k1 As Integer
    k1 = 1

    For I = 1 To fxpfileinfo.procnumbers
        fxpfileinfo.aprocname(j) = procname(I)
        fxpfileinfo.aprocadress(j) = procaddr(I)
        If (class_order(I) = 65535) Or (procedure_type(I) = 0) Then
            fxpfileinfo.aproctype(j) = "m"
        Else
          If fxpfileinfo.classnumber > 0 Then
            If j = 1 Or _
             (j <> 1 And (((class_order(I - 1) = 65535) Or (procedure_type(I - 1) = 0)) And class_order(I) <> 65535)) Or _
             (class_order(I - 1) <> class_order(I)) Then
                If class_order(I) > Cnt Then
                    fxpfileinfo.aprocname(j) = PP("define class ") + aclass(class_order(I) + k1 - 1) + PP(" as ") + abaseclass(class_order(I) + k1 - 1)
                    
                    If abaseclassF(I) = 1 Then
                       fxpfileinfo.aprocname(j) = fxpfileinfo.aprocname(j) + PP(" OLEPUBLIC")
                    End If
                    
                    fxpfileinfo.aprocadress(j) = aclassadress(class_order(I) + k1 - 1)
                    fxpfileinfo.aproctype(j) = "c"
                    Cnt = Cnt + 1
                    j = j + 1
                End If
                
                    fxpfileinfo.aprocname(j) = PP("define class ") + aclass(class_order(I) + k1) + PP(" as ") + abaseclass(class_order(I) + k1)
                    
                    If abaseclassF(I) = 1 Then
                       fxpfileinfo.aprocname(j) = fxpfileinfo.aprocname(j) + PP(" OLEPUBLIC")
                    End If
                    
                    fxpfileinfo.aprocadress(j) = aclassadress(class_order(I) + k1)
                    fxpfileinfo.aproctype(j) = "c"
                    Cnt = Cnt + 1
                    j = j + 1
                    fxpfileinfo.aprocname(j) = procname(I)
                    fxpfileinfo.aprocadress(j) = procaddr(I)
                    fxpfileinfo.aproctype(j) = "cp"
            Else
                fxpfileinfo.aprocname(j) = procname(I)
                fxpfileinfo.aprocadress(j) = procaddr(I)
                fxpfileinfo.aproctype(j) = "cp"
            End If
          Else
                fxpfileinfo.aprocname(j) = procname(I)
                fxpfileinfo.aprocadress(j) = procaddr(I)
                fxpfileinfo.aproctype(j) = "cp"
          End If
        End If
        j = j + 1
    Next

    Dim aprocname() As String
    Dim aprocadress() As Long
    Dim aproctype() As String
    ReDim aprocname(1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber) As String
    ReDim aprocadress(1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber) As Long
    ReDim aproctype(1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber) As String
    
    For I = 1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber
       aprocname(I) = fxpfileinfo.aprocname(I)
       aprocadress(I) = fxpfileinfo.aprocadress(I)
       aproctype(I) = fxpfileinfo.aproctype(I)
       fxpfileinfo.aprocname(I) = ""
       fxpfileinfo.aprocadress(I) = 0
       fxpfileinfo.aproctype(I) = ""
    Next
    
    j = 1
    For I = 1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber
      If aproctype(I) = "m" Then
        fxpfileinfo.aprocname(j) = aprocname(I)
        fxpfileinfo.aprocadress(j) = aprocadress(I)
        fxpfileinfo.aproctype(j) = aproctype(I)
        j = j + 1
      End If
    Next
    
    For I = 1 To fxpfileinfo.procnumbers + fxpfileinfo.classnumber
      If aproctype(I) <> "m" Then
        fxpfileinfo.aprocname(j) = aprocname(I)
        fxpfileinfo.aprocadress(j) = aprocadress(I)
        fxpfileinfo.aproctype(j) = aproctype(I)
        j = j + 1
      End If
    Next
    
End If

ex99:

On Error GoTo 0

End Function
Sub deco()

adjust   ' 根据 Fox 文件的版本，设置相应的命令码,函数码和菜单码值

For mainloop = 1 To UBound(dfoxfile, 1)
    If IsEmpty(dfoxfile(mainloop, 5)) <> True Then
        If dfoxfile(mainloop, 2) = chr(0) Then
            If isapp = True And SplitFxp <> True Then
                inpfile = getfoxfile.afilesname(mainloop - 1)
                If (inpfile <> "") And (dfoxfile(mainloop, 5) <> "") Then
                    Open DeCompFilePath + inpfile For Binary As #1
                    Dim fl As Long
                    fl = LOF(1)
                    leninp = fl
                    If fl <> 0 Then
                        ReDim FileData(1 To fl) As Byte
                        Get #1, , FileData()
                        
                        If LCase(Right(dfoxfile(mainloop, 1), 4)) = ".fxp" Or LCase(Right(dfoxfile(mainloop, 1), 4)) = ".qpx" Or LCase(Right(dfoxfile(mainloop, 1), 4)) = ".spx" Then
                            Open DeCompFilePath + dfoxfile(mainloop, 1) For Binary As #5
                            Put #5, , FileData()
                            Close #5
                        End If
                        
                    End If
                    Close #1
                Else
                    dfoxfile(mainloop, 5) = ""
                End If
            Else
                ' 单独打开的 fxp 或 .fox 文件
                ReDim FileData(1 To UBound(ddata) + 1) As Byte
                CopyMemory FileData(1), ddata(0), UBound(ddata) + 1
            End If
            If dfoxfile(mainloop, 5) <> "" Then decompfile
        End If
    End If
ne:
Next
End Sub
Sub decompfile()
Dim moduleofs As Long, seekadr, moduleno As Integer, modulength, nsymbols, modcnt
Dim command, lencmd
Dim procind, textind, I
Dim textindent
Dim txt As String
Dim s As String
Dim s1 As String
ReDim Line1(1) As Byte
outfilep = 0
linenum = 0
commstr = ""

'Stop

Close #2
Open DeCompFilePath + dfoxfile(mainloop, 5) For Output As #2

outfilep = 1
GoTo here:

Error:
MsgBox "打开输出文件时发生错误", , "错误"
Close #2
Exit Sub

here:

'Stop

If outfilep <= 0 Then
   Exit Sub
End If

If UBound(FileData) <= 43 Then
    Close #2
    Exit Sub
End If
indent = 0
indadd = 0
procstab = 0
seekadr = -1
procind = True
textind = False

modcnt = getmodulecnt()

If modcnt >= 65000 Then
   Close #2
   Exit Sub
End If

modcnt = fxpfileinfo.procnumbers + fxpfileinfo.classnumber

Dim percent As Long
form1.StatusBar1.Panels(1).Text = "正在反编译:" + inpfile

For moduleno = 0 To modcnt
    
    moduleofs = 0
    Dim modulename As String

    If (appv < 30) Or (moduleno = 0) Then
        Call getofsmod(moduleno, moduleofs, modulename)
    Else
        If fxpfileinfo.classnumber <> 0 Then
            modulename = fxpfileinfo.aprocname(moduleno)
            s = InStr(modulename, ":")
            s1 = modulename
            If s <> 0 Then