| >>は、桐9までのファイルだけで、桐10 のファイルに
>>関しては、対応していないと思います。
すげぇ～雑に、桐10 に対応させてみた。
桐10 になって、64文字まで標題は設定できるけど
それまでの桁数にあわせたまま。
ざっとしか確認していないので、全部が桐10 に
対応できるかは確認していない。
これは、テーブルだけでなく、昔のバージョンの
桐も含め、Windows 環境なら、桐なしでも、表は
当然として、フォームやレポートや .cmx .kex の
標題も取得できるのが特徴。
昔、松についていた BTYPE.COM は、松の表だけで
なく、桐のファイルの標題も取り出せていたので、
その機能の跡継ぎが欲しかったので、造ったもの
です。本当は、もっとまともに桐10 に対応させた
方が良いのですが…
'-----------------------------------------------------------------------
Function KiriTitle(KiriFile)
Dim KTitle, Ver, TimeC, TimeM, _
c1, c2, i ,j, _
Stream, _
Data(84), Bin(2), T0(7), T1(7)
Set Stream = WScript.CreateObject("Adodb.Stream")
Stream.Type = 1
Stream.Open
Stream.LoadFromFile KiriFile
' 対象ファイルの先頭「0x00」を読み込む
Stream.Position = &H00
Bin(0) = Stream.Read(1)
' 対象ファイルのバージョン「0x30」を読み込む
Stream.Position = &H30
Bin(1) = Stream.Read(1)
If UCase(Right(File,4)) = ".WFM" And UCase(Right(File,4)) = ".WFX" And AscB(Bin(1)) = 7 Then
Stream.Position = &H33
Bin(1) = Stream.Read(1)
End If
' 対象ファイルの表題「0x34～0x5B」を読み込む
If (AscB(Bin(0)) = 0 And AscB(Bin(1)) = 10) Then
Stream.Position = &H5C8
For i=1 To 40
Data(i) = Stream.Read(1)
If (i mod 2) = 0 Then
Stream.Position = Stream.Position + 2
End If
Next
Else
Stream.Position = &H34
For i=1 To 40
Data(i) = Stream.Read(1)
Next
End If
' 対象ファイルの作成日「0x9C～0xA1」を読み込む
Stream.Position = &H9C
For i=1 To 6
T0(i) = Stream.Read(1)
Next
' 対象ファイルの更新日「0xA2～0xA7」を読み込む
Stream.Position = &HA2
For i=1 To 6
T1(i) = Stream.Read(1)
Next
Stream.Close
Set Stream = Nothing
' 桐のファイルか否かを 0x00h とバージョン情報でチェックする
If (AscB(Bin(0)) = 0 And AscB(Bin(1)) >= 1 And AscB(Bin(1)) <= 10) Then
' バージョン情報を文字列に変換する
'Ver = "[" & Chr(AscB(Bin(1)) + &H30) & "]"
If (AscB(Bin(0)) = 0 And AscB(Bin(1)) >= 1 And AscB(Bin(1)) <= 9) Then
Ver = "[" & Chr(AscB(Bin(1)) + &H30) & "]"
ElseIf (AscB(Bin(0)) = 0 And AscB(Bin(1)) = 10) Then
Ver = "[A]"
End if
' 表題を JIS から SJIS にコード変換する
i = 0 : j = 0 : KTitle = ""
For i = 1 To 40
If (i mod 2) = 0 Then
c1 = AscB(Data(i))
c2 = AscB(Data(i-1))
If (c1 <> 0) Then
If (c1 mod 2) = 1 Then
c1 = ((c1 + 1) / 2) + &H70
c2 = c2 + &H1F
Else
c1 = (c1 / 2) + &H70
c2 = c2 + &H7D
End If
If (c1 >= &HA0) Then c1 = c1 + &H40
If (c2 >= &H7F) Then c2 = c2 + 1
ElseIf (c1 = 0 And c2 = 0) Then
c2 = AscB(" ")
j = j + 1
Else
j = j + 1
End If
KTitle = KTitle & Chr(c1 * &H100 + c2)
End If
Next
KTitle = KTitle & Space(j)
' 作成日を文字列に変換する
For i=1 To 6
TimeC = TimeC & Chr(AscB(T0(i)))
Next
' 更新日を文字列に変換する
For i=1 To 6
TimeM = TimeM & Chr(AscB(T1(i)))
Next
' 桐のファイルで無い場合の処理
Else
Ver = Space(3)
TimeC = Space(6)
TimeM = Space(6)
KTitle = Space(40)
End If
KiriTitle = Ver & _
" " & _
TimeC & _
" " & _
TimeM & _
" " & _
KTitle
End Function
'-----------------------------------------------------------------------
|
