VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassFileHead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim HeadChar(1 To 128) As Byte
Dim c(1 To 4) As Byte

Public Property Get FileHeadByteNum()
  FileHeadByteNum = UBound(HeadChar)
End Property



Private Function CodeCheck(CodeStr As String) As Boolean
Dim CodeOk As Boolean
Dim i As Integer
    For i = 1 To 4
      c(i) = Asc(Mid$(CodeStr, i, 1))
    Next i
    CodeOk = True
    If c(1) < 65 Or c(1) > 122 Then CodeOk = False
    If c(2) < 65 Or c(2) > 122 Then CodeOk = False
    If c(3) < 48 Or c(3) > 57 Then CodeOk = False
    If c(4) < 48 Or c(4) > 57 Then CodeOk = False
    CodeCheck = CodeOk
End Function

Public Property Get Summary() As String
Dim FCode As String
Dim i As Integer
    FCode = ""
    For i = 11 To 124
      FCode = FCode + Chr$(HeadChar(i))
    Next i
    Summary = FCode
End Property

Public Property Let Summary(Max114 As String)
Dim i As Integer
Dim Fs As String
Dim L As Integer

  Fs = Mid$(Max114, 1, 114)
  L = Len(Fs)
  For i = 1 To L
    HeadChar(i + 10) = Asc(Mid$(Fs, i, 1))
  Next i
End Property
 
Public Property Get DATAFormatCode() As String
Dim FCode As String
Dim i As Integer
    FCode = ""
    For i = 1 To 4
      FCode = FCode + Chr$(HeadChar(i))
    Next i
    DATAFormatCode = FCode

End Property

Public Property Let DATAFormatCode(ByVal FormatCode As String)
Dim FCode As String
Dim i As Integer
    FCode = Mid$(FormatCode, 1, 4)
    If CodeCheck(FCode) = True Then
       For i = 1 To 4
         HeadChar(i) = c(i)
       Next i
    Else
       MsgBox "數據格式代碼由4個字符組成，前兩個為英文字母，后兩個為數字。", vbCritical, "代碼形式錯誤"
    End If
End Property

Public Property Get DeviceCode() As String
Dim FCode As String
Dim i As Integer
    FCode = ""
    For i = 1 To 4
      FCode = FCode + Chr$(HeadChar(i + 4))
    Next i
    DeviceCode = FCode

End Property

Public Property Let DeviceCode(ByVal DeviceCode As String)
Dim FCode As String
Dim i As Integer
    FCode = Mid$(DeviceCode, 1, 4)
    If CodeCheck(FCode) = True Then
       For i = 1 To 4
         HeadChar(i + 4) = c(i)
       Next i
    Else
       MsgBox "設備代碼由4個字符組成，前兩個為英文字母，后兩個為數字。", vbCritical, "代碼形式錯誤"
    End If
End Property

Public Function ReadFileHead(DATAFileName As String) As String
Dim FNo As Integer
Dim CodeOk As Boolean
Dim ErrCode As Integer
Dim i As Integer
Dim FCode As String

    FNo = FreeFile
    Open DATAFileName For Binary As #FNo
      Get #FNo, 1, HeadChar
    Close #FNo
    '查尾代碼
    CodeOk = True
       If HeadChar(125) <> 13 Then CodeOk = False
       If HeadChar(126) <> 10 Then CodeOk = False
       If HeadChar(127) <> 0 Then CodeOk = False
       If HeadChar(128) <> 26 Then CodeOk = False
    If CodeOk = False Then
       ErrCode = 1
       GoTo WrongHead
    End If
    '查定界碼
       If HeadChar(9) <> Asc("/") Then CodeOk = False
       If HeadChar(10) <> Asc("/") Then CodeOk = False
    If CodeOk = False Then
       ErrCode = 2
       GoTo WrongHead
    End If
    '查數據格式代碼
      FCode = ""
      For i = 1 To 4
        FCode = FCode + Chr$(HeadChar(i))
      Next i
      If CodeCheck(FCode) = False Then
         ErrCode = 3
      End If
    '查設備格式代碼
      FCode = ""
      For i = 1 To 4
        FCode = FCode + Chr$(HeadChar(i + 4))
      Next i
      If CodeCheck(FCode) = False Then
         ErrCode = 4
      End If
    
    ReadFileHead = ""
    Exit Function
    
WrongHead:
    Select Case ErrCode
      Case 1:
         ReadFileHead = "文件頭結束符錯誤"
      Case 2:
         ReadFileHead = "文件頭分界符錯誤"
      Case 3:
         ReadFileHead = "數據格式代碼錯誤"
      Case 4:
         ReadFileHead = "設備代碼錯誤"
    End Select
End Function




Public Sub WriteFileHead(DATAFileName As String)
Dim FNo As Integer
    FNo = FreeFile
    Open DATAFileName For Binary As #FNo
      Put #FNo, 1, HeadChar
    Close #FNo
End Sub




Private Sub Class_Initialize()
Const Default As String = "Undefined DATA Format // Unknow Device"
Dim i As Integer
Dim L As Integer
  '1-4字符為數據類型定義代碼，其中前兩個應為英文，后兩個為數字。在數據庫中對應唯一一組數據格式定義與讀寫類
  '5-8字符為設備類型定義代碼，其中前兩個應為英文，后兩個為數字。在數據庫中對應唯一一組設備參數與使用手冊。
  '9，10永遠取 “//”
  '11-124為開發者對數據類型及設備的兩個描述區，區之間建議用//分開。
  '建議文件頭用英文書寫，不要寫中文。

  For i = 1 To 8
    HeadChar(i) = Asc("0")
  Next i
  HeadChar(9) = Asc("/")
  HeadChar(10) = Asc("/")
  L = Len(Default)
  For i = 11 To 11 + L - 1
      HeadChar(i) = Asc(Mid$(Default, i - 10, 1))
  Next i
  For i = 11 + L To 124
    HeadChar(i) = 32
  Next i
  HeadChar(125) = 13
  HeadChar(126) = 10
  HeadChar(127) = 0
  HeadChar(128) = 26
  
  
  
  
End Sub