defoxpro.bas

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

                modulename = Left(s1, s - 1) + PP(" of ") + Right(s1, strlen(s1) - s)
            End If
            moduleofs = fxpfileinfo.aprocadress(moduleno)
        Else
            modulename = procname(moduleno)
            moduleofs = procaddr(moduleno)
        End If
        If modulename = "" Then
            Exit For
        End If
    End If
    
    If moduleofs >= UBound(FileData) Then
       GoTo Finish:
    End If
    
    If appv >= 30 Then
        If moduleno > 0 Then
            If fxpfileinfo.aproctype(moduleno) = "c" Then
                outlin ("")
                seekadr = Seek(2)
                outlin (modulename)
            End If
        End If

        If moduleno > 0 Then
            outlin ("")
            seekadr = Seek(2)
            If fxpfileinfo.aproctype(moduleno) = "cp" Then
                If LCase(fxpfileinfo.aproctype2(moduleno)) <> "public " Then
                    outlin (fxpfileinfo.aproctype2(moduleno) + PP("function ") + modulename)
                Else
                    outlin (PP("function ") + modulename)
                End If
            ElseIf fxpfileinfo.aproctype(moduleno) = "m" Then
                outlin (PP("procedure ") + modulename)
            End If
        End If
    ElseIf moduleno > 0 Then
            outlin ("")
            seekadr = Seek(2)
            outlin (PP("procedure ") + modulename)
    End If
        
        datapointer = moduleofs
        
        If datapointer >= UBound(FileData) Then
           GoTo Finish:
        End If
        
        Dim p As Integer
        Dim sss As Long

        'sss = FileData(datapointer + 1) + FileData(datapointer + 2) * 256
        CopyMemory sss, FileData(datapointer + 1), 2
        datapointer = datapointer + 2

        modulength = sss

        datapointer = modulength + moduleofs + 2

        Dim nsymbols1 As Integer
        
If modulength > 3 Then
        On Error Resume Next
        nsymbols1 = FileData(datapointer + 1) + FileData(datapointer + 2) * 256
        On Error GoTo nextline
End If
        datapointer = datapointer + 2

        Dim ttt As String
        Dim Position As Integer
        Dim Cnt As Long

        datapointer = modulength + moduleofs + 4
        
        If datapointer > UBound(FileData) Or nsymbols1 > 10000 Then
           GoTo ok:
        End If

On Error GoTo nextline

        ReDim namvars(1 To 65536) As String
        
        If nsymbols1 > 0 Then
            
            For I = 1 To nsymbols1
                ttt = ""
                Cnt = 0
                Dim tp As Long
                If appv >= 30 Then
                    ' 变量名的长度，在 vfp 中，它是变化的，由变量名前两字节指明
                    tp = FileData(datapointer + 2) * 16
                    tp = tp * 16
                    Cnt = FileData(datapointer + 1) + tp
                    If Cnt <= 128 Then
                        datapointer = datapointer + 2
                        For p = 1 To Cnt
                            ttt = ttt + ChrB(FileData(datapointer + p))
                        Next
                    Else
                        Exit For
                    End If
                    datapointer = datapointer + Cnt
                Else
                    ' 在 foxbase 和 foxpro 中,变量名长度是固定不变的，为 10 字节长
                    For p = 1 To 10
                        ttt = ttt + ChrB(FileData(datapointer + p))
                    Next
                    datapointer = datapointer + 10
                End If

                ttt = StrConv(ttt, vbUnicode)

                If InStr(ttt, chr(0)) <> 0 Then
                    namvars(I) = Left(ttt, InStr(ttt, chr(0)) - 1)
                Else
                    namvars(I) = ttt
                End If
            Next
        End If
        
        If typinp = 1 Then typinp = 2

        datapointer = moduleofs + 2
        Dim Tmp() As Byte

        If typinp = 2 Or typinp = 7 Then
            ReDim Tmp(0) As Byte
            Tmp(0) = FileData(datapointer + 1)
            datapointer = datapointer + 1
        Else
            ReDim Tmp(1) As Byte
            Tmp(0) = FileData(datapointer + 1)
            Tmp(1) = FileData(datapointer + 2)
            datapointer = datapointer + 2
        End If

        Dim add1 As Long
        If typinp = 2 Or typinp = 7 Then
            add1 = 0
        Else
            add1 = 16 * Tmp(1)
            add1 = add1 * 16
        End If
        
        If add1 < 4096 Then
            lencmd = Tmp(0) + add1
        Else
            lencmd = Tmp(0)
        End If
        
        Dim ln As Integer

        ln = lencmd - IIf((typinp = 2 Or typinp = 7), 0, 2)
        If ln <= 0 Then GoTo ok
        ReDim Line1(1 To ln) As Byte

        If typinp = 2 Or typinp = 7 Then
            datapointer = moduleofs + 3
        Else
            datapointer = moduleofs + 4
        End If

        For I = 1 To ln
            Line1(I) = FileData(datapointer + I)
        Next
        
        datapointer = datapointer + ln
        ReDim stack(0 To 120) As String
        ReDim stack2(0 To 120) As String

        command = Line1(1)
        Dim addb As Integer
        addb = 1
        
        percent = Int(datapointer / (UBound(FileData)) * 100)
        form1.ProgressBar1.Value = percent
        form1.Refresh
        indent = 0
        
        Do While command <> 85 And command <> 0
            
            linpos = 1
            txt = ""

On Error GoTo nextline

            Select Case CMD(command)
            Case 1
                txt = macroline_()
            Case 2, 3
                txt = qm_()
            Case 4
                If typinp = 2 Or typinp = 7 Then
                    txt = saygetb()
                Else
                    txt = sayget_()
                End If
            Case 5
                txt = accept_()
            Case 6
                txt = append_()
            Case 7
                txt = PP("assist")
            Case 8
                txt = average_()
            Case 9
                txt = browse_()
            Case 10
                txt = call_()
            Case 11
                txt = PP("cancel")
            Case 12
                indadd = 3
                indent = IIf(indent > 0, indent - indadd, 0)
                txt = case_()
            Case 13
                txt = change_()
            Case 14
                txt = clear_()
            Case 15
                txt = close_()
            Case 16
                txt = PP("continue")
            Case 17
                txt = copy_()
            Case 18
                txt = count_()
            Case 19
                txt = create_()
            Case 20
                txt = delete_()
            Case 21
                txt = declare_()
            Case 22
                txt = dir_()
            Case 23
                txt = displ_()
            Case 24
                txt = do_()
                If LCase(txt) = "do case" Or LCase(Left(txt, 8)) = "do whil " Or LCase(Left(txt, 9)) = "do while " Then
                    indadd = 3
                End If
            Case 25
                txt = change_()
            Case 26
                txt = eject_()
            Case 27
                indadd = 3
                indent = IIf(indent > 0, indent - indadd, 0)
                txt = PP("else")
            Case 28
                indent = max_(indent - 3, 0)
                txt = PP("endcase")
            Case 29
                indent = max_(indent - 3, 0)
                txt = PP("enddo")
            Case 30, 184
                indent = max_(indent - 3, 0)
                txt = PP("endif")
            Case 31
                indent = textindent
                txt = PP("endtext")
                textind = False
            Case 32
                txt = erase_()
            Case 33
                txt = PP("exit")
            Case 34
                txt = PP("find ")
                linpos = linpos + 1
                txt = txt + every()
            Case 35
                txt = goto_()
            Case 36
                txt = helpdec_()
            Case 37
                indadd = 3
                On Error Resume Next   ' 主要用于防止类似于 Refox 的加密方法造成反编译错误
                txt = if_()
                If Trim(LCase(txt)) = "if" Then txt = PP("if *****  ")
                On Error GoTo 0
            Case 38
                txt = index_()
            Case 39
                txt = input_()
            Case 40
                txt = insert_()
            Case 41
                txt = join_()
            Case 42
                txt = label_()
            Case 43
                txt = displ_()
            Case 44
                txt = load_()
            Case 45
                txt = locate_()
            Case 46
                txt = PP("loop")
            Case 47
                txt = modify_()
            Case 49
                txt = on_()
            Case 50
                indadd = 3
                indent = IIf(indent > 0, indent - indadd, 0)
                txt = PP("otherwise")
            Case 51
                txt = pack_()
            Case 52
                txt = params_()
            Case 53
                txt = private_()
            Case 55
                txt = public_()
            Case 56
                txt = PP("quit")
            Case 57
                txt = read_()
            Case 58
                txt = recall_()
            Case 59
                txt = reindex_()
            Case 60
                txt = release_()
            Case 61
                txt = rename_()
            Case 62
                txt = replace_()
            Case 63
                txt = report_()
            Case 64
                txt = restore_()
            Case 65
                txt = PP("resume")
            Case 66
                txt = return_()
                If procind <> True And seekadr >= 0 Then
                    datapointer = seekadr
                    Print #2, , PP("function ")
                    Seek #2, LOF(2)
                    seekadr = -1
                End If
            Case 67
                txt = run_()
            Case 68
                txt = save_()
            Case 69
                txt = seek_()
            Case 70
                txt = sele_()
            Case 71
                If (typinp = 2 Or typinp = 7) Then
                    txt = setb()
                Else
                    txt = set_()
                End If
            Case 72
                txt = skip_()
            Case 73
                txt = sort_()
            Case 74
                txt = store_()
            Case 75
                txt = sum_()
            Case 76
                txt = PP("suspend")
            Case 77
                txt = text_()
                textindent = indent
                indadd = -indent
            Case 78
                txt = total_()
            Case 79
                txt = type_()
            Case 80
                txt = update_()
            Case 81
                txt = use_()
            Case 82
                txt = wait_()
            Case 83
                txt = PP("zap")
                If UBound(Line1) > 2 Then
                   txt = txt + PP(" in ")
                   linpos = linpos + 2
                   txt = txt + every()
                End If
            Case 84
                txt = assign_()
            Case 86
                txt = export_()
            Case 87
                txt = import_()
            Case 88
                txt = PP("retry")
            Case 89
                txt = PP("logout")