defoxpro.bas

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

Attribute VB_Name = "Module1"
Option Explicit

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const LVS_EX_FULLROWSELECT = &H20
Const LVM_FIRST = &H1000
Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + &H37
Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + &H36
Public In240 As Boolean
Public In241 As Boolean
Public ExprLen As Integer
Public ExprEndLen As Integer
Public IsC4C5 As Long
Public Noffs As Long
Public FirstBlock As Long
Public LastBlock As Long
Public RecNo As Long
Public BlockSize As Integer
Public NextFreeBlockNum As Long
Public NextFreeBlockOffset As Long
Public ErrNum As Integer
Public filename1 As String
Public filename2 As String
Public filelen1 As String
Public filelen2 As String
Public ListViewHasInit As Boolean
Public linenum As Long
Public commstr As String
Public fxpno As Integer
Public scxno As Integer
Public IsInSerchMode As Boolean
Public IsDirSelected As Boolean
Public pdscx As Boolean '判断是不是表文件
Public nextfile As String  '表文件的备注
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Public FileName As String
Public Directory As String
Public FullFileName As String
Public StrucVer As String
Public FileVer As String
Public ProdVer As String
Public FileFlags As String
Public FileOS As String
Public FILETYPE As String
Public FileSubType As String
Public filepath1 As String
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Boolean

Type VS_FIXEDFILEINFO
   dwSignature As Long
   dwStrucVersionl As Integer
   dwStrucVersionh As Integer
   dwFileVersionMSl As Integer
   dwFileVersionMSh As Integer
   dwFileVersionLSl As Integer
   dwFileVersionLSh As Integer
   dwProductVersionMSl As Integer
   dwProductVersionMSh As Integer
   dwProductVersionLSl As Integer
   dwProductVersionLSh As Integer
   dwFileFlagsMask As Long
   dwFileFlags As Long
   dwFileOS As Long
   dwFileType As Long
   dwFileSubtype As Long
   dwFileDateMS As Long
   dwFileDateLS As Long
End Type

Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal dir As String) As Boolean

Global InSql As Boolean
Global modnum As Long
Global classnum As Long
Global aclass() As String
Global aclassadress() As Long
Global abaseclass() As String
Global cbaseclass As String
Global FileData() As Byte
Global FileDataScx() As Byte
Global FileDataSct() As Byte
Global datapointer As Double
Global stackptr As Integer
Global stack() As String
Global stackptr2 As Integer
Global stack2() As String
Global typ As Integer
Global Line1() As Byte
Global linpos As Integer
Global procstab As Long
Global namvars
Global dfoxfile
Global sysmemvar(255)
Global sysfce() As String
Global sysfce2() As String
Global sysmenus() As String
Global sqlfcess(10)
Global setnamess(1 To 255, 1 To 2) As String
Global sysobject(255)
Global CMD(255)
Global outfilep
Global inpfile As String
Global leninp
Global typinp
Global oldfox
Global startofs
Global newformat
Global mainloop
Global indadd As Integer
Global indent As Integer
Global procind As Boolean
Global isapp As Boolean
Global appv As Integer
Global is25 As Integer
Global is20 As Integer
Global procname() As String
Global procaddr() As Long
Global procedure_type() As Long
Global class_order() As Long
Global f As Boolean
Global txtfield As String
Global intpo As Integer
Global refoxed As Integer
Global filelens As Long
Global Const d1900_01_01 As Long = &H426CD680
Global Const t00_00_01   As Long = &H6117
Global SplitFxp As Boolean
Global repall As Boolean
Global fl As Long
Global methodtext As String
Global codelenchanged As Boolean
Global retvall() As Byte
Global apppos As Long
Global FirstRecPos As Integer
Global reclen As Integer
Global RecNum As Long
Global FirstRecOffset As Integer
Global ddata() As Byte
Global tmpfile() As Byte
Global Prepaired As Boolean
Global fname As String
Global selfile As String
Global apppath As String
Global List1Content() As String
Global EditFileName As String
Global DeCompFilePath As String
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Public Const FS_CASE_IS_PRESERVED = &H2
Public Const FS_CASE_SENSITIVE = &H1
Public Const FS_UNICODE_STORED_ON_DISK = &H4
Public Const FS_PERSISTENT_ACLS = &H8
Public Const FS_FILE_COMPRESSION = &H10
Public Const FS_VOLUME_IS_COMPRESSED = &H8000
Public Const FILE_NAMED_STREAMS = &H40000
Public Const FILE_SUPPORTS_ENCRYPTION = &H20000
Public Const FILE_SUPPORTS_OBJECT_IDS = &H10000
Public Const FILE_SUPPORTS_REPARSE_POINTS = &H80
Public Const FILE_SUPPORTS_SPARSE_FILES = &H40
Public Const FILE_VOLUME_QUOTAS = &H20

Public Const HH_DISPLAY_TOPIC = &H0
Public Const HH_SET_WIN_TYPE = &H4
Public Const HH_GET_WIN_TYPE = &H5
Public Const HH_GET_WIN_HANDLE = &H6
Public Const HH_DISPLAY_TEXT_POPUP = &HE
Public Const HH_HELP_CONTEXT = &HF
Public Const HH_TP_HELP_CONTEXTMENU = &H10
Public Const HH_TP_HELP_WM_HELP = &H11

Public Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long

Public Const fo_delete As Long = &H3
Public Const fof_noconfirmation As Long = &H10
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200

Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Long
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long

Public Const SW_SHOWNORMAL = 1
Public Const SE_ERR_FNF = 2&
Public Const SE_ERR_PNF = 3&
Public Const SE_ERR_ACCESSDENIED = 5&
Public Const SE_ERR_OOM = 8&
Public Const SE_ERR_DLLNOTFOUND = 32&
Public Const SE_ERR_SHARE = 26&
Public Const SE_ERR_ASSOCINCOMPLETE = 27&
Public Const SE_ERR_DDETIMEOUT = 28&
Public Const SE_ERR_DDEFAIL = 29&
Public Const SE_ERR_DDEBUSY = 30&
Public Const SE_ERR_NOASSOC = 31&
Public Const ERROR_BAD_FORMAT = 11&

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDst As Any, ByRef pSrc As Any, ByVal ByteLen As Long)
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Type BrowseInfo
    hwndOwner As Long
    pidlRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Global DelFileOp As SHFILEOPSTRUCT

Public Type vfpstructure
    aappfilename As String
    aisapp As Boolean
    aappsize As Long
    afoxversion As String
    aencrypt As String
    afilenumbers As Long
    afileliststartpos As Long
    afilelistendpos As Long
    afilelistsize As Long
    amainfileinfilelist As Long
    amainfilename As String
    afoxchksum As String
    afilenamepos() As Long
    afilestype() As Byte
    afilesname() As String
    afilesstartpos() As Long
    afilesendpos() As Long
    afilessize() As Long
    afilesname1() As String
    afilesstartpos1() As Double
    afilesendpos1() As Long
    afilessize1() As Long
    aChecked() As Boolean
End Type

Global getfoxfile As vfpstructure

Public Type fxpstructure
    procnumbers As Long
    classnumber As Long
    aprocname() As String
    aprocadress() As Long
    aproctype() As String
    aproctype2() As String
End Type

Global fxpfileinfo As fxpstructure

Public Type DBF_HEADER
    FILETYPE As Byte
    UPDATEYEAR As Byte
    UPDATEMONTH As Byte
    UPDATEDAY As Byte
    RecNum As Long
    FirstRecOffset As Integer
    RECLENGTH  As Integer
    RESERVED(0 To 15) As Byte
    TABLEFLAG As Byte
    CODEPAGE As Byte
    RESERVED2(0 To 1) As Byte
End Type

Global dbfheader As DBF_HEADER

Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Global openfiles As OPENFILENAME
Function GetJustdir(ByVal fullname As String) As String
' 从带盘符和路径的文件名中反回路径
If Len(fullname) = 0 Then
    GetJustdir = ""
    Exit Function
End If
Dim filelen1 As Integer
filelen1 = Len(fullname)
Dim I As Integer

For I = filelen1 To 1 Step -1
    If Mid(fullname, I, 1) = "\" Then
        filepath1 = Left(fullname, filelen1 - I)
        Exit For
    End If
Next

GetJustdir = filepath1

End Function

Sub Main(FileName As String, method As Integer)
typinp = -1
leninp = 0
startofs = 0
newformat = 0
oldfox = False
datapointer = 0
isapp = False

'打开文件
If (FileName = "") And (FileName <> "*") Then
    inpfile = OpenFile(form1.hWnd, "要反编译的文件:", "exe;app;dll;fox;fxp;spx;mpx;qpx;prx" & chr(0) & "*.exe;*.app;*.dll;*.fox;*.fxp;*.mpx;*.spx;*.mpx;*.qpx;*.prx" & chr(0), "")
Else