foxtools.frm

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

           Text2.Text = selfile
           txtVersion.Text = Trim(str(appv))
           txtFileNum.Text = Trim(str(getfoxfile.afilenumbers))
           txtMainFile.Text = getfoxfile.afilesname(getfoxfile.amainfileinfilelist)
           txtEncrypt.Text = getfoxfile.aencrypt
           txtftb.Text = getfoxfile.afileliststartpos
           For I = 0 To UBound(getfoxfile.afilesstartpos) - 1
               If getfoxfile.afilesstartpos(I) <> 0 Then
                  txtffo.Text = Trim(str(getfoxfile.afilesstartpos(I)))
                  Exit For
               End If
           Next
           Frame7.Visible = True
           ChkAddDebug.Enabled = True
           ChkBuild.Enabled = True
           ChkAddDebug.Value = 0
        End If
        Me.StatusBar1.Panels(1).Text = "OK"
        
    Else
        Frame7.Visible = False
        Label11.Visible = False
        Text2.Text = selfile
        Reset
        Me.MousePointer = 11
        Me.Refresh
        ChkAddDebug.Enabled = False
        ChkBuild.Enabled = False
        ChkAddDebug.Value = 0
        ChkBuild.Value = 0
        Dim h(0 To 1) As Byte
        Open selfile For Binary As #1
        Get #1, , h()
        Close #1
        
        If (h(0) = &HFE And h(1) = &HF2) Or (h(0) = &HFB And h(1) = &H2A) Or (h(0) = &HFB And h(1) = &H2B) Then
            Main Text2.Text, 0
        Else
            SplitFxp = True
            Main selfile, 0
            SplitFxp = False
        End If
        
        ReDim FileData(0) As Byte
        Me.ProgressBar1.Value = 0
        Me.MousePointer = 0
        Dim fname As String
        Dim r As Long, msg As String
        Select Case UCase(Right(selfile, 4))
        Case ".FXP", ".FOX"
             fname = strleft(selfile, strlen(selfile) - 4) + ".prg"
        Case ".MPX"
             fname = strleft(selfile, strlen(selfile) - 4) + ".mpr"
        Case ".QPX"
             fname = strleft(selfile, strlen(selfile) - 4) + ".qpr"
        Case ".SPX"
             fname = strleft(selfile, strlen(selfile) - 4) + ".spr"
        End Select
    
        EditFileName = fname
        frmNoteEdit.Show 1
    End If
Me.MousePointer = 0
End If
Me.ProgressBar1.Value = 0

End Sub
Private Sub Command1_Click()
If Command1.Caption = "打开单个文件" Then
DeCompFilePath = ""
filename1 = ""
filename2 = ""

filename1 = OpenFile(Me.hWnd, "要处理的文件:", "scx;vcx" & chr(0) & "*.scx;*.vcx" & chr(0), "")
If filename1 = "" Then
    Exit Sub
Else
    filename2 = strleft(filename1, strlen(filename1) - 1) + "t"
   ' Me.Caption = GetJustFileName(filename1) + " / " + GetJustFileName(filename2)
End If

Reset

form1.ListView1.ListItems.Clear
OpenAndLoad filename1, filename2
Check2.Value = 0
Check2.Enabled = False
Check3.Value = 0
Check3.Enabled = False
Check4.Value = 0
Check4.Enabled = False
IsDirSelected = False
Command2.Enabled = True
repall = False
Command1.Caption = "错误扫描"
form1.ListView1.Visible = True
form1.List1.Visible = False
Else
    Command1.Caption = "打开单个文件"
    ScanScx filename1, filename2
End If
End Sub

Private Sub Command10_Click()

End Sub

Private Sub Command11_Click()
selfile = OpenFile(Me.hWnd, "要解密的文件:", "exe;app;dll" & chr(0) & "*.exe;*.app;*.dll" & chr(0), "")
If selfile <> "" Then
   Text1.Text = selfile
End If
End Sub
Private Sub Command12_Click()

Dim rii() As Byte
 Dim riiexe As Long
 Dim riiapp As Long
 ''''''''''''''''''''''''以下用于获取c4c5的app
Dim exesize  As Long, pd As Integer, I As Long
Dim appsize As Long
Dim rifile As String, rapp As String

pd = 0
If Text1.Text <> "" Then
rifile = Text1.Text
'rapp = Right(rifile, Len(rifile) - 4) + ".app"
exesize = FileLen(rifile)
ReDim ddata(0 To exesize - 1) As Byte
Open rifile For Binary As #8
Get #8, , ddata()
Close #8
    For I = 1 To exesize - 5
      If ddata(I) = &HC4 And ddata(I + 1) = &HC5 Then 'And ddata(i + 2) = &HEE) Or (ddata(i) = &HFE And ddata(i + 1) = &HF2 And ddata(i + 2) = &HEE) Then
       ReDim ddata(0 To exesize - I) As Byte
         Open rifile For Binary As #8
         Seek #8, I + 1
         Get #8, , ddata()
         Close #8
        pd = 1
          Exit For
        End If
    Next



 
If pd = 1 Then
 ddata(0) = &HFE 'c4c5不改成fef2无法解密
 ddata(1) = &HF2
 Decrypt3 ddata

'Open "FoxTools.app" For Binary As #5
' Put #5, , ddata()
' Close #5
MsgBox "解密成功同目录下生成FoxTools.app", , "提示"
form1.ProgressBar1.Value = 0
        form1.StatusBar1.Panels(1).Text = "完成"
        form1.Refresh
        Else
        MsgBox "不是ftII型加密", , "提示"
End If
End If

End Sub


Private Sub Command13_Click()
Reset
         Dim lpIDList As Long
         Dim sBuffer As String
         Dim szTitle As String
         Dim tBrowseInfo As BrowseInfo

         szTitle = "请选择文件所在目录"
         With tBrowseInfo
            .hwndOwner = Me.hWnd
            .lpszTitle = lstrcat(szTitle, "")
            .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
         End With

         lpIDList = SHBrowseForFolder(tBrowseInfo)

         If (lpIDList) Then
            sBuffer = Space(MAX_PATH)
            SHGetPathFromIDList lpIDList, sBuffer
            sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
            DeCompFilePath = sBuffer
            If strright(DeCompFilePath, 1) <> "\" Then
               DeCompFilePath = DeCompFilePath + "\"
            End If
             Text4.Text = DeCompFilePath
            Me.StatusBar1.Panels(1).Text = "OK: 当前目录  " + DeCompFilePath
         End If

   If DeCompFilePath = "" Then
    Exit Sub
   End If
   Dim SearchPath As String, FindStr As String
   Dim FileSize As Long
   Dim NumFiles As Integer, NumDirs As Integer
    IsInSerchMode = True
   Screen.MousePointer = vbHourglass
   List1.Clear
   Dim fn As Integer
   fn = 0
   fxpno = 0
   scxno = 0
   
   form1.ListView1.Visible = False
   form1.List1.Visible = True
   Command1.Caption = "打开单个文件"
   
   SearchPath = DeCompFilePath
   FileSize = FindFilesAPI(SearchPath, "*.scx", NumFiles, NumDirs)
   scxno = scxno + FileSize
   FileSize = FindFilesAPI(SearchPath, "*.vcx", NumFiles, NumDirs)
   scxno = scxno + FileSize
   FileSize = FindFilesAPI(SearchPath, "*.fxp", NumFiles, NumDirs)
   fxpno = fxpno + FileSize
   FileSize = FindFilesAPI(SearchPath, "*.fox", NumFiles, NumDirs)
   fxpno = fxpno + FileSize
   FileSize = FindFilesAPI(SearchPath, "*.mpx", NumFiles, NumDirs)
   fxpno = fxpno + FileSize
   FileSize = FindFilesAPI(SearchPath, "*.spx", NumFiles, NumDirs)
   fxpno = fxpno + FileSize
   FileSize = FindFilesAPI(SearchPath, "*.prx", NumFiles, NumDirs)
   fxpno = fxpno + FileSize
   FileSize = FindFilesAPI(SearchPath, "*.qpx", NumFiles, NumDirs)
   fxpno = fxpno + FileSize
   Screen.MousePointer = vbDefault

   If scxno <> 0 Or fxpno <> 0 Then
        repall = True
        Command1.Enabled = True
        Command2.Enabled = True
        If scxno <> 0 Then
            Check2.Enabled = True
            Check2.Value = 1
        End If
        If fxpno <> 0 Then
            Check4.Enabled = True
            Check4.Value = 1
        End If
        If scxno <> 0 And fxpno <> 0 Then
           Check2.Value = 0
           Check4.Value = 0
           Check3.Value = 1
           Check2.Enabled = True
           Check3.Enabled = True
           Check4.Enabled = True
        End If
        IsDirSelected = True
   Else
        Command1.Enabled = True
        Command2.Enabled = False
        MsgBox "没有要处理的文件"
   End If

End Sub
Private Sub decomp_click()

Reset

DeCompFilePath = BrowseForFolder(, , ROOTDIR_ALL, , GetFilePath(CurrentFile), True, , "确定")

If strright(DeCompFilePath, 1) <> "\" Then
   DeCompFilePath = DeCompFilePath + "\"
End If
If Len(DeCompFilePath) < 2 Then Exit Sub

Me.MousePointer = 11
Me.Refresh
Main Text2.Text, 0
ReDim FileData(0) As Byte
Me.ProgressBar1.Value = 0
Me.MousePointer = 0

End Sub
Private Sub exit_Click()
Reset
If apppath <> "" Then
    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 If
End
End Sub
Private Sub Dir1_Change()
File1.path = Dir1.path
End Sub

Private Sub Drive1_Change()
On Error GoTo Error
Dir1.path = Drive1.Drive
On Error GoTo Error
Exit Sub
Error:
MsgBox "请正确插入活动磁盘", , "错误"
Drive1.Drive = "c:"
Exit Sub
End Sub

Private Sub File1_Click()
'ListView2.ColumnHeaders.Clear
'ListView2.Visible = False
'List2.Clear
RichTextBox1.Text = ""
Dim filenamea As String, lx As String, tt As String, efile As String, selfile As String
tt = File1.path
If Len(tt) = 0 Then
tt = Drive1.Drive
End If
If Right(tt, 1) <> "\" Then
tt = tt + "\"
End If
filenamea = tt + File1.FileName
lx = Right(filenamea, 4)
Dim LX2 As String
LX2 = UCase(Right(filenamea, 2))
   
  If LX2 = ".H" Or LX2 = ".C" Then
   RichTextBox1.Visible = True
'           Image3.Visible = False
            On Error GoTo Error
        RichTextBox1.LoadFile filenamea, rtfText
        Exit Sub
        End If
   Select Case UCase(lx)
            Case ".BMP", ".JPG", ".GIF", ".ICO", ".CUR", ".EMF", ".WMF", ".DIB"
           On Error GoTo Error
           RichTextBox1.Text = ""
           RichTextBox1.Visible = False
'           Image3.Visible = True
'           Image3.Picture = LoadPicture(filenamea)
           On Error GoTo Error
         
        Case ".INF", ".PRG", ".BAS", ".INI", ".TXT", ".HTM", ".CPP", ".FPW", ".MPR", ".QPR", ".SPR", ".LOG", ".BAT", ".ERR", ".ASM", ".ASP", ".URL", ".LNG"
         RichTextBox1.Visible = True
'           Image3.Visible = False
            On Error GoTo Error
        RichTextBox1.LoadFile filenamea, rtfText
         On Error GoTo Error
           '''''''''''''新代码处理'fox,mpx,
         

             ''''''''''''
             '去掉这节因为占用太大内存
        '     Case ".FRX", ".LBX", ".MNX", ".PJX", ".SCX", ".VCX", ".DBF" ''''数据表格式
           
           'RichTextBox1.Visible = False
           'Image3.Visible = False
           ''ListView2.Visible = True
           
        
      
      
      
      'Dim filelenjg As Long
'filelenjg = FileLen(filenamea)
'If filelenjg = 0 Then
 '  Exit Sub
'End If

'ReDim FileDataScx(1 To filelenjg) As Byte

'Open filenamea For Binary As #1

' 读入 scx
'Get #1, , FileDataScx()

' 检查文件类型
'If FileDataScx(1) <> 48 Then
 '  Close #1
  ' MsgBox "文件类型错误", , "错误"
   'Exit Sub
'End If

' 检查备注字段标志

'If FileDataScx(29) <> 2 Then
 ' If UCase(lx) <> ".DBF" Then
  ' Close #1
   'MsgBox "无备注字段错误!", , "错误"
   'Exit Sub
   'End If
'End If


'Dim slong(0 To 3) As Byte
'Dim il As Long

'filelen2 = 0
' 记录长度
'FirstRecPos = FileDataScx(10)
'FirstRecPos = FileDataScx(9) + FirstRecPos * 256
'reclen = FileDataScx(12)
'reclen = reclen * 256 + FileDataScx(11)

' 记录数
'CopyMemory RecNum, FileDataScx(5), 4
'CopyMemory FirstRecOffset, FileDataScx(9), 2


'If RecNum = 0 Then
 '  Close #2
  ' Close #1
   'MsgBox "无记录供处理", , "错误"
   'Exit Sub
'End If

'备注块大小
'Dim jl As Integer
'Dim rel As Integer
'Dim fieldsnuml As Integer