frmscxbrow.frm

来自「一款反编译VFP程序的代码的工具」· FRM 代码 · 共 327 行

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form form2 
   BackColor       =   &H00FFFFFF&
   Caption         =   "FoxTools 表单/类库/表结构文件 查看器"
   ClientHeight    =   4650
   ClientLeft      =   2715
   ClientTop       =   3675
   ClientWidth     =   9780
   ClipControls    =   0   'False
   Icon            =   "frmScxBrow.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   ScaleHeight     =   4650
   ScaleWidth      =   9780
   Begin MSComctlLib.ListView ListView1 
      Height          =   4620
      Left            =   15
      TabIndex        =   0
      Top             =   30
      Width           =   9720
      _ExtentX        =   17145
      _ExtentY        =   8149
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   16777215
      Appearance      =   1
      NumItems        =   0
   End
End
Attribute VB_Name = "form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const LVS_EX_FULLROWSELECT = &H20
Const LVM_FIRST = &H1000
Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + &H37
Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + &H36

Private Sub Command1_Click()

End Sub

Private Sub Command2_Click()
    Unload Me
End Sub
Private Sub Form_Load()
   form2.ListView1.ColumnHeaders.Clear
   OpenAndLoad2
End Sub
Sub OpenAndLoad2()

Dim filelen1 As Long
filelen1 = FileLen("DBF")
If filelen1 = 0 Then
   Exit Sub
End If

ReDim FileDataScx(1 To filelen1) As Byte

Open "DBF" 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
   Close #1
   MsgBox "无备注字段错误!", , "错误"
   Exit Sub
End If

Dim slong(0 To 3) As Byte
Dim I 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 j As Integer
Dim re As Integer
Dim fieldsnum As Integer
Dim fieldname As String
Dim fieldvalue As String
fieldsnum = (FirstRecPos - 296) / 32
Dim Item As ListItem
Dim clmAdd As ColumnHeader
Dim itmAdd As ListItem

form2.ListView1.View = lvwReport
Dim lStyle As Long
lStyle = SendMessage(form2.ListView1.hWnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
lStyle = lStyle Or LVS_EX_FULLROWSELECT
Call SendMessage(form2.ListView1.hWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal lStyle)

Dim Fieldtype As String

form2.ListView1.ColumnHeaders.Clear

For j = 1 To fieldsnum
   fieldname = ""
   fieldname = GetFieldName(j)
   Set clmAdd = form2.ListView1.ColumnHeaders.Add(Text:=fieldname)
Next

For re = 1 To RecNum
   For j = 1 To fieldsnum
      fieldvalue = ""
      Fieldtype = GetFieldType(j)
      
      If Fieldtype <> "M" Then
         fieldvalue = GetFieldValue(re, j)
      End If
      
      If j = 1 Then
         Set itmAdd = form2.ListView1.ListItems.Add(Text:=fieldvalue)
      Else
        If Fieldtype = "M" Then
           If GetMemoOffset(re, j) = 0 Then
              itmAdd.SubItems(j - 1) = "memo"
           Else
              itmAdd.SubItems(j - 1) = "MEMO"
           End If
        Else
           itmAdd.SubItems(j - 1) = fieldvalue
        End If
      End If
   Next
Next

Error:
On Error GoTo 0
Close #1
End Sub
Sub ScanScx2(filename1 As String, filename2 As String)

filelen1 = FileLen(filename1)
If filelen1 = 0 Then
   Exit Sub
End If

filelen2 = FileLen(filename2)
If filelen2 = 0 Then
   Exit Sub
End If

ReDim FileDataScx(1 To filelen1) As Byte

Open filename1 For Binary As #1
Open filename2 For Binary As #2

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

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

' 检查备注字段标志
If FileDataScx(29) <> 2 Then
   Close #1
   Close #2
   MsgBox "无备注字段错误!", , "错误"
   Exit Sub
End If

ReDim FileDataSct(1 To filelen2) As Byte
Get #2, , FileDataSct()

Dim slong(0 To 3) As Byte
Dim I As Long

ErrNum = 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

'备注块大小
CopyMemory slong(0), FileDataSct(5), 4
ReserveByte slong
CopyMemory BlockSize, slong(0), 4

If BlockSize = 0 Or BlockSize >= filelen1 Then
    Exit Sub
End If

Dim j As Integer
Dim re As Integer
Dim fieldsnum As Integer
Dim fieldname As String
Dim fieldvalue As String
Dim Fieldtype As String
Dim MemoOffset As Long
Dim mLength As Long
Dim HasObjcode As Boolean
Dim fxpflag As Long
Dim fxplen As Long

fieldsnum = (FirstRecPos - 296) / 32

Open "error.txt" For Output As #3
Print #3, "文件 " + filename1 + ", " + filename2 + " 扫描结果:"
Print #3, "================================================================================"

Dim IsComment As String

For re = 1 To RecNum
   IsComment = GetFieldValue(re, 1)
   For j = 1 To fieldsnum
      fieldname = ""
      fieldvalue = ""
      fieldname = GetFieldName(j)
      Fieldtype = GetFieldType(j)
      
      If Fieldtype <> "M" Then
         fieldvalue = GetFieldValue(re, j)
      End If
      
      If Fieldtype = "M" Then
         mLength = GetMemoLength(re, j)
         If mLength <> 0 Then
         MemoOffset = GetMemoOffset(re, j)
         If (MemoOffset < 512 And MemoOffset <> 0) Or MemoOffset > filelen2 Then
            Print #3, "记录" + str$(re) + "," + "字段 " + fieldname + " 指向不正确位置:" + str(MemoOffset)
            ErrNum = ErrNum + 1
         End If
         If (mLength < 0 Or mLength > (filelen2 - MemoOffset)) Then
            Print #3, "记录" + str$(re) + "," + "字段 " + fieldname + " 备注块长度错误:" + Hex(mLength)
            ErrNum = ErrNum + 1
         End If
         If LCase(fieldname) <> "reserved1" And re = 1 And mLength <> 0 Then
            Print #3, "记录" + str$(re) + "," + "字段 " + fieldname + " 出现在不正确的位置"
            ErrNum = ErrNum + 1
         End If
         
         If Trim(LCase(IsComment)) = "comment" And LCase(fieldname) = "objcode" And re <> 1 Then
            Print #3, "记录" + str$(re) + "," + "字段 " + fieldname + " 出现在不正确的位置"
            ErrNum = ErrNum + 1
         End If
         
         If LCase(fieldname) = "methods" And mLength <> 0 And GetMemoLength(re, 12) = 0 Then
            Print #3, "记录" + str$(re) + "," + "字段 " + fieldname + " 中有垃圾内容"
            ErrNum = ErrNum + 1
         End If
         
         If LCase(fieldname) = "objcode" Then
            fxpflag = GetMemoLong(re, j)
            If Hex(fxpflag) <> "FEF2FF20" Then
               Print #3, "记录" + str$(re) + "," + "字段 " + fieldname + " Fxp 标志被修改:" + Hex(fxpflag)
               ErrNum = ErrNum + 1
            End If
            
            fxplen = GetFxpLen(re, j)
            If mLength <> fxplen Then
               Print #3, "记录" + str$(re) + "," + "字段 " + fieldname + " Fxp 长度被修改:" + Hex(mLength) + "," + Hex(fxplen)
               ErrNum = ErrNum + 1
            End If
         End If
         End If
      End If
   Next
Next
Print #3, "================================================================================"
Print #3, "共找到 " + str(ErrNum) + " 处错误"
Close #1
Close #2
Close #3

If ErrNum <> 0 Then
   MsgBox "搜索完成,共找到 " + str(ErrNum) + " 个错误,详细情况请查看 error.txt."
Else
  DeleteFile "error.txt"
  MsgBox "搜索完成,未找到错误"
End If
End Sub

Private Sub Form_Resize()
ListView1.Width = Abs(Me.Width - 335)
ListView1.Height = Abs(Me.Height - 600)
End Sub