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