Option Explicit
On Error Resume Next

Dim Arg, WS, FS, SH, NS, File, Name, Ext, Path, Size, TrueName, Last, _
    Stream, Data(41), Bin(2), Title, c1, c2, i, j, Ret
Set Arg = WScript.Arguments
Set WS  = WScript.CreateObject("WScript.Shell")
Set FS  = WScript.CreateObject("Scripting.FileSystemObject")
Set SH  = WScript.CreateObject("Shell.Application")
If Arg.Count = 1 Then
  File = Arg(0)
  If FS.FileExists(File) Then
    Name = FS.GetFileName(File)
    Ext  = FS.GetExtensionName(File)
    Path = FS.GetParentFolderName(File)
    Size = FS.GetFile(File).Size
    Last = FS.GetFile(File).DateLastModified
    If IsNull(Path) Or Path = "" Then Path = FS.GetAbsolutePathName(".\")
    Set NS = SH.NameSpace(Path)
    Set TrueName = NS.ParseName(Name)
    Set NS  = Nothing
    Set FS  = Nothing
    Set Arg = Nothing
  Else
    Ret = WS.Popup( "ファイルがありません！" _
                   , 3 _
                   , "確認" _
                   , 0)
    Set SH  = Nothing
    Set FS  = Nothing
    Set WS  = Nothing
    Set Arg = Nothing
    WScript.Quit
  End If
Else
  Ret = WS.Popup( "ファイルを指定して下さい！" _
                 , 3 _
                 , "確認" _
                 , 0)
  Set SH  = Nothing
  Set FS  = Nothing
  Set WS  = Nothing
  Set Arg = Nothing
  WScript.Quit
End If

If Size < 4096 Then
' Ret = WS.Popup( "桐のファイルでは無いようです！" _
'                , 3 _
'                , "確認" _
'                , 0)
' Set WS  = Nothing
' WScript.Quit
  Title = Space(40)

ElseIf InStr(".TBL,.WFM,.FRM,.RPT,.VIW,.XVW,.CMD,.KEV",UCase(Right(Name,4)))=0 Then
' Ret = WS.Popup( "桐のファイルでは無いようです！" _
'                , 3 _
'                , "確認" _
'                , 0)
' Set WS  = Nothing
' WScript.Quit
  Title = Space(40)

ElseIf Not IsNull(File) Then
  call GetKtitle(File)

End If

call  DispKtitle()

Set WS = Nothing
WScript.Quit

'-----------------------------------------------------------------------
Function DispKTitle()

' 表題を出力する
  WScript.Echo FormatDateTime(Last,2) & _
               " " & _
               FormatDateTime(Last,3) & _
               " " & _
               Right(Space(11) & FormatNumber(Size,0,-1,0,-1),11) & _
               " " & _
               Title & _
               " " & _
               TrueName

End Function
'-----------------------------------------------------------------------
Function GetKTitle(File)

  Const adTypeBinary = 1
  Const adTypeText = 2
  Const adModeUnknown = 0 'Default
  Const adModeRead = 1
  Const adModeWrite = 2
  Const adModeReadWrite = 3
  Const adModeShareDenyRead = 4
  Const adModeShareDenyWrite = 8
  Const adModeShareExclusive = 12
  Const adModeRecursive = &H400000
  Const adSaveCreateNotExist = 1
  Const adSaveCreateOverWrite = 2
  Const adReadAll = -1

  Set Stream = WScript.CreateObject("Adodb.Stream")
  Stream.Type = adTypeBinary
  Stream.Mode = adModeReadWrite
  Stream.Open
  Stream.LoadFromFile File

' 対象ファイルの先頭「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 AscB(Bin(1)) = 7 Then
    Stream.Position = &H33
    Bin(1) = Stream.Read(1)
  End If

' 対象ファイルの表題「0x34〜0x5B」を読み込む
  Stream.Position = &H34
  For i=1 To 40
    Data(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)) <= 9) Then
    ' 表題を JIS から SJIS にコード変換する
    i = 0 : j = 0
    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
        Title = Title & Chr(c1 * &H100 + c2)
      End If
    Next
    Title = Title & Space(j)

' 桐のファイルで無い場合の処理
  Else
    Title = Space(40)

  End If

End Function
'-----------------------------------------------------------------------