foxtools.frm

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

    
    If CodeLen <> 0 Then
        On Error GoTo ne2
        RecNo = I
        CodeStartPos = GetMemoOffset(I, 12)
        CodeStartPos = CodeStartPos * BlockSize + 1 + 8
        
        ReDim FileData(1 To CodeLen) As Byte
        ObjNane = GetFieldValue(I, 7)
        CopyMemory FileData(1), FileDataSct(CodeStartPos), CodeLen
        form1.StatusBar1.Panels(1).Text = "正在分析文件:" + filename1 + " - 对象:" + ObjNane
       'scxlmt(i) = ObjNane
        methodtext = ""

        Dim cc As Integer
        Dim g1 As Long, g2 As Long, g3 As Long
        
        CopyMemory g1, FileData(10), 4
        CopyMemory g2, FileData(14), 4
        CopyMemory g3, FileData(18), 4
            
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' 检查是不是 foxtools 加密的文件,去掉此简单的检查就可以直接反编译 FoxTools 2 及以前的
        ' FoxTools 加密的文件了
        'If g1 - g2 = 1 Or g3 = 1 Then
        '   Close #1
        '   Close #2
        '   Exit Sub
        'End If
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        
        FileData(1) = 254
        FileData(2) = 242
        FileData(3) = 255
        FileData(4) = 32
        FileData(5) = 2
        Dim CodeMovOfs As Long
        CodeMovOfs = ScanFlag(FileData)
        
        If CodeMovOfs > 10 Then
           CodeMovOfs = 0
        End If
        
        cc = FileData(46)
        
        If FileData(46) = 54 Then
           FileData(46) = 37
        End If
        
        If CodeMovOfs <> 0 Then ' 存在着表单代码位移
           FileData(46) = 37 - CodeMovOfs
        End If
        
        sct_methods_length2 = ""
        sct_methods_length2 = decompobjcode()
        'scxcodext(i) = sct_methods_length2
        CurrentRecodNo = I
        If sct_methods_length2 <> "" Then
        RichTextBox1.Text = RichTextBox1.Text + sct_methods_length2
        End If
        If sct_methods_length2 <> "" And Left(sct_methods_length2, 3) <> "*!*" Then
            If Len(sct_methods_length2) > 16000 Then
                form1.Refresh
            Else
                form1.Refresh
            End If
            methodtext = sct_methods_length2
            MethodLen = strlen(sct_methods_length2)
            WriteMemoContents I, MethodLen, CurrentRecodNo, sct_methods_length2
                    
        Else
            '没有反编译出代码来, 用原有的表单代码偏移值再反编译一次
            FileData(46) = 37
            CurrentRecodNo = I
            sct_methods_length2 = ""
            sct_methods_length2 = decompobjcode()
            If sct_methods_length2 <> "" Then
        RichTextBox1.Text = RichTextBox1.Text + sct_methods_length2
        End If
            If sct_methods_length2 <> "" Then
                If Len(sct_methods_length2) > 16000 Then
                    form1.Refresh
                Else
                    form1.Refresh
                End If
                methodtext = sct_methods_length2
                MethodLen = strlen(sct_methods_length2)
                WriteMemoContents I, MethodLen, CurrentRecodNo, sct_methods_length2
            Else
                FileData(46) = cc
                sct_methods_length2 = ""
                sct_methods_length2 = decompobjcode()
                If sct_methods_length2 <> "" Then
        RichTextBox1.Text = RichTextBox1.Text + sct_methods_length2
        End If
                If sct_methods_length2 = "" Then ' 无代码?修复后再次反编译
                            
                    FileData(46) = cc
                    RepairEXE_APP FileData
                    CurrentRecodNo = I
                    sct_methods_length2 = ""
                    sct_methods_length2 = decompobjcode()
                    If sct_methods_length2 <> "" Then
        RichTextBox1.Text = RichTextBox1.Text + sct_methods_length2
        End If
                    If sct_methods_length2 = "" Then  ' 仍然没反出代码?????? 好吧,把 objcode 的内容保存为文件以供分析
                        Dim f As String, ff As String
                        f = GetFieldValue(I, 7)
                        'ff = App.path + "\" + "rec" + Trim(str(i)) + f + ".fxp"
                        If InStr(f, "\") <> 0 Or _
                           InStr(f, "/") <> 0 Or _
                           InStr(f, ":") <> 0 Or _
                           InStr(f, "*") <> 0 Or _
                           InStr(f, "?") <> 0 Or _
                           InStr(f, "<") <> 0 Or _
                           InStr(f, ",") <> 0 Or _
                           InStr(f, ">") <> 0 Or _
                           InStr(f, "|") Or f = "" Or Len(f) > 255 Then
                              ff = App.path + "\" + Trim(str(I)) + "recff" + ".fxp"
                         Else
                              ff = App.path + "\" + "rec" + Trim(str(I)) + f + ".fxp"
                         End If
                        'ff = App.path + "\" + "rec" + Trim(str(i)) + f + ".fxp"
                      
                        Open ff For Binary As #5
                        Put #5, , FileData()
                        Close #5
                    Else
                        methodtext = sct_methods_length2
                        MethodLen = strlen(sct_methods_length2)
                        WriteMemoContents I, MethodLen, CurrentRecodNo, sct_methods_length2
                    End If
                Else
                    methodtext = sct_methods_length2
                    MethodLen = strlen(sct_methods_length2)
                    WriteMemoContents I, MethodLen, CurrentRecodNo, sct_methods_length2
                End If
            End If
        End If
ne2:
    End If
Next

Close #10
Close #20
On Error GoTo Error 'sctvct
form1.StatusBar1.Panels(1).Text = "OK"
             ''''''''''''
           ' If RecNum > 0 Then
   '  ReDim scxcodex(1 To RecNum) '重新定义数据将生成的代码放到scxcodext数据中
'ReDim scxlm(1 To RecNum)
         '  Dim k As Integer
         '  k = 1
         '   For i = 1 To RecNum
         '  If scxlmt(i) <> "" Then
         '  scxlm(k) = scxlmt(i)
          ' scxcodex(k) = scxcodext(i)
          'List2.AddItem scxlm(k)
         ' 'RichTextBox1.Text = RichTextBox1.Text + scxcodex(k)
         ' k = k + 1
         '  End If
          '  Next
           ' End If
           ' RichTextBox1.Visible = True
           ' ReDim scxcodext(0) ' 释放数据
'ReDim scxlmt(0)
            On Error GoTo Error
            
            
            
            
           '''''''''''''''新代码结束
            Case Else
           On Error GoTo Error
             'List2.Clear
             RichTextBox1.Text = ""
           RichTextBox1.Visible = True
'           Image3.Visible = False
        'ListView2.ColumnHeaders.Clear
           'ListView2.Visible = False
          
           On Error GoTo Error
            End Select
            
Exit Sub
Error:
 'List2.Clear
             RichTextBox1.Text = ""
           RichTextBox1.Visible = True
'           Image3.Visible = False
        'ListView2.ColumnHeaders.Clear
           'ListView2.Visible = False
          
MsgBox "打开文件时发生错误", , "提示"
Exit Sub

End Sub
Private Sub form_unload(Cancel As Integer)
Reset
If apppath = "" Then Exit Sub
Dim DelFileOp As SHFILEOPSTRUCT
Dim result As Long

' 删除生成的临时文件
With DelFileOp
    .wFunc = fo_delete
    .pFrom = apppath + "~ft_tmp.*"
    .fFlags = fof_noconfirmation
End With
result = SHFileOperation(DelFileOp)
End Sub

Private Sub lstDetails_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
lstDetails.Sorted = True
Select Case Trim(ColumnHeader)
Case "文件名"
   lstDetails.SortKey = 0
Case "文件大小"
   lstDetails.SortKey = 1
End Select
Me.Refresh
End Sub
Private Sub lstdetails_dblclick()

' 双击 ListView 中的一个项时，打开此文件来查看其内容
If lstDetails.ListItems.Count = 0 Or appv < 30 Then Exit Sub

Reset

DeCompFilePath = ""

ReDim tmpfile(0) As Byte
Dim I As Integer
Dim j As Integer

For I = 1 To lstDetails.ListItems.Count
   If lstDetails.ListItems.Item(I).Selected = True Then
        Exit For
   End If
Next

Dim file2 As String
file2 = lstDetails.ListItems.Item(I).Default

If Len(file2) = 0 Then Exit Sub

file2 = Left(file2, Len(file2) - 1) + "T"

Dim itmFound As ListItem
Set itmFound = form1.ListView1.FindItem(file2, lvwText, , 0)

Dim beginpos As Long
Dim NFLEN As Long
Dim origdata() As Byte

If lstDetails.ListItems.Item(I).Default <> "" Then
    
    For j = strlen(selfile) To 1 Step -1
       If Mid(selfile, j, 1) = "\" Then
          apppath = Left(selfile, j)
          Exit For
       End If
    Next
    
    ReDim origdata(0 To UBound(ddata)) As Byte
    CopyMemory origdata(0), ddata(0), UBound(ddata) + 1
    fname = lstDetails.ListItems.Item(I).Default
    NFLEN = Val(lstDetails.ListItems.Item(I).ListSubItems(1).Default)
    
    If NFLEN = 0 Then
       Exit Sub
    End If
    
    beginpos = Val(lstDetails.ListItems.Item(I).ListSubItems(2).Default)

     Dim txtfile As String
     txtfile = UCase(Right(fname, 4)) '‘新增代码
     

    'If (Right(fname, 4) = ".FPW") Or (Right(fname, 2) = ".H") Or (Right(fname, 2) = ".C") Then
      '  If txtfile = ".PRG" Or txtfile = ".BAS" Or txtfile = ".INI" Or txtfile = ".TXT" Or txtfile = ".HTM" Or txtfile = ".CPP" Or txtfile = ".FPW" Or txtfile = ".MPR" Or txtfile = ".QPR" Or txtfile = ".SPR" Or txtfile = ".BAT" Or txtfile = ".LOG" Or txtfile = ".PRG" Or txtfile = ".ERR" Or txtfile = ".ASM" Or txtfile = ".URL" Or (Right(fname, 2) = ".H") Or (Right(fname, 2) = ".C") Then 'new code
      ' fname = apppath + "~ft_tmp.txt"
    'End If

    If (Right(fname, 4) = ".FXP") Or _
        (Right(fname, 4) = ".FOX") Or _
        (Right(fname, 4) = ".MPX") Or _
        (Right(fname, 4) = ".QPX") Then
        
        fname = apppath + "~ft_tmp" + Right(fname, 4)
        
        ReDim tmpfile(0 To NFLEN) As Byte
        CopyMemory tmpfile(0), ddata(beginpos), NFLEN
        Open fname For Binary As #2
        Put #2, , tmpfile()
        Close #2

        inpfile = fname
        SplitFxp = True
        Main "*", 0
        SplitFxp = False
        
        Select Case Right(fname, 4)
        Case ".FXP"
             fname = apppath + "~ft_tmp.prg"
        Case ".MPX"
             fname = apppath + "~ft_tmp.mpr"
        Case ".QPX"
             fname = apppath + "~ft_tmp.qpr"
        End Select
        EditFileName = fname
        frmNoteEdit.Show 1
        ReDim ddata(0 To UBound(origdata)) As Byte
        CopyMemory ddata(0), origdata(0), UBound(origdata) + 1
        Exit Sub
    ElseIf (Right(fname, 4) = ".VCX") Or _
        (Right(fname, 4) = ".SCX") Or _
        (Right(fname, 4) = ".DBF") Or _
        (Right(fname, 4) = ".FRX") And _
        (Right(fname, 1) <> "\") Then
        
         ReDim tmpfile(0 To NFLEN) As Byte
         CopyMemory tmpfile(0), ddata(beginpos), NFLEN
         Open "DBF" For Binary As #2
         Put #2, , tmpfile()
         Close #2
        
         form2.Show 1
         Exit Sub
    Else
        If (Right(fname, 4) <> ".VCX") And _
            (Right(fname, 4) <> ".VCT") And _
            (Right(fname, 4) <> ".SCX") And _
            (Right(fname, 4) <> ".SCT") And _
            (Right(fname, 4) <> ".DBF") And _
            (Right(fname, 4) <> ".FPT") And _
            (Right(fname, 4) <> ".CDX") And _
            (Right(fname, 4) <> ".FRX") And _
            (Right(fname, 1) <> "\") And _
            (Right(fname, 4) <> ".FRT") Then
            
                fname = apppath + "~ft_tmp" + Right(fname, 4)
                ReDim tmpfile(0 To NFLEN - 1) As Byte
                CopyMemory tmpfile(0), ddata(beginpos), NFLEN
                Open fname For Binary As #2
                Put #2, , tmpfile()
                Close #2
        Else
            Exit Sub
        End If

    End If
     If txtfile = ".INF" Or txtfile = ".PRG" Or txtfile = ".BAS" Or txtfile = ".INI" Or txtfile = ".TXT" Or txtfile = ".HTM" Or txtfile = ".CPP" Or txtfile = ".FPW" Or txtfile = ".MPR" Or txtfile = ".QPR" Or txtfile = ".SPR" Or txtfile = ".BAT" Or txtfile = ".LOG" Or txtfile = ".PRG" Or txtfile = ".ERR" Or txtfile = ".ASM" Or txtfile = ".URL" Or (Right(fname, 2) = ".H") Or (Right(fname, 2) = ".C") Then 'new code
  
    'If (Right(fname, 4) = ".TXT") Then
        EditFileName = fname
        frmNoteEdit.Show 1
        ReDim ddata(0 To UBound(origdata)) As Byte
        CopyMemory ddata(0), origdata(0), UBound(origdata) + 1
        Exit Sub
    End If

   ' Case ".BMP", ".JPG", ".GIF", ".ICO", ".CUR", ".EMF", ".WMF", ".DIB"
      If txtfile = ".BMP" Or txtfile = ".JPG" Or txtfile = ".GIF" Or txtfile = ".ICO" Or txtfile = ".CUR" Or txtfile = ".EMF" Or txtfile = ".WMF" Or txtfile = ".DIB" Then 'new code
  
    'If (Right(fname, 4) = ".TXT") Then
        EditFileName = fname
        Form3.Show 1
        ReDim ddata(0 To UBound(origdata)) As Byte
        CopyMemory ddata(0), origdata(0), UBound(origdata) + 1
        Exit Sub
    End If
    
    
    
    Dim r As Long, msg As String
    
    r = StartDoc(fname)

    If r <= 32 Then
        Select Case r
            Case SE_ERR_FNF
                msg = "文件未找到"
            Case SE_ERR_PNF
                msg = "路径未找到"
            Case SE_ERR_ACCESSDENIED
                msg = "访问拒绝"
            Case SE_ERR_OOM
                msg = "内存不足"
            Case SE_ERR_DLLNOTFOUND
                msg = "DLL 未找到"
            Case SE_ERR_SHARE
                msg = "发生共享冲突"
            Case SE_ERR_ASSOCINCOMPLETE
                msg = "不完整的或无效的文件扩展名"
            Case SE_ERR_DDETIMEOUT
                msg = "DDE 超时"
            Case SE_ERR_DDEFAIL
                msg = "DDE 传输失败"
            Case SE_ERR_DDEBUSY
                msg = "DDE 忙"
            Case SE_ERR_NOASSOC
                msg = "没有找到查看此类文件的程序"
            Case ERROR_BAD_FORMAT
                msg = "无效的 EXE 文件或 EXE 映象文件错误"
            Case Else
                msg = "未知的错误"
        End Select
        MsgBox msg
    End If
    ReDim ddata(0 To UBound(origdata)) As Byte
    CopyMemory ddata(0), origdata(0), UBound(origdata) + 1
End If
End Sub
Private Sub lstDetails_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    Set ItemClicked = Item
    If ItemClicked.Checked = False Then
        getfoxfile.aChecked(ItemClicked.Index - 1) = True
    Else
        getfoxfile.aChecked(Ite