Option Explicit
On Error Resume Next

Dim Arg, WS, FS, SH, File, Path, 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
  Path = Arg(0)
  If FS.FolderExists(Path) Then
    call FileList(Path)
  Else
    Ret = WS.Popup( "オプション指定に間違いがあります！" _
                   , 3 _
                   , "確認" _
                   , 0)
  End If
Else
  Ret = WS.Popup( "フォルダを指定して下さい！" _
                 , 3 _
                 , "確認" _
                 , 0)
End If

Set SH  = Nothing
Set FS  = Nothing
Set WS  = Nothing
Set Arg = Nothing
WScript.Quit

'-----------------------------------------------------------------------
Function FileList(Path)
  Dim f, f1, subf
  Path = FS.GetAbsolutePathName(Path)
  Set f = FS.GetFolder(Path)
  'すべてのファイルを表示
  WScript.Echo Path
  For Each f1 In f.Files
      call GetKTitle(f1.Path)
  Next
  WScript.Echo
  'すべてのサブフォルダを表示
  For Each subf In f.SubFolders
      call FileList(subf.Path)
  Next
End Function
'-----------------------------------------------------------------------
Function GetKTitle(File)
  Dim SubPath, Name, ShortName, Size, Last, _
      ShortExt, ShortBaseName, TrueName, _
      Title, NS
  SubPath  = FS.GetParentFolderName(File)
  Name     = FS.GetFile(File).Name
  ShortName= FS.GetFile(File).ShortName
  Size     = FS.GetFile(File).Size
  Last     = FS.GetFile(File).DateLastModified
  ShortExt = FS.GetExtensionName(ShortName)
  ShortBaseName = FS.GetBaseName(ShortName)
  If IsNull(SubPath) Or SubPath = "" Then SubPath = FS.GetAbsolutePathName(".\")
  Set NS   = SH.NameSpace(SubPath)
  TrueName = NS.ParseName(Name)
  Set NS   = Nothing

  If     InStr(".JPEG,.JPG", "." & UCase(FS.GetExtensionName(File))) Then
    Title = Space(18) & JpegSize(File)

  ElseIf UCase(FS.GetExtensionName(File)) = "GIF" Then
    Title = Space(18) & GifSize(File)

  ElseIf UCase(FS.GetExtensionName(File)) = "PNG" Then
    Title = Space(18) & PngSize(File)

  ElseIf UCase(FS.GetExtensionName(File)) = "BMP" Then
    Title = Space(18) & BmpSize(File)

  ElseIf InStr(".TBL,.WFM,.FRM,.RPT,.VIW,.XVW,.CMD,.KEV", UCase(Right(File, 4))) = 0 Then
    Title = Space(18) & Space(40)

  Else
    Title = KiriTitle(File)

  End If

  If (Name = ShortName) Then
    ShortName = Space(12)
  Else
    ShortName = ShortBaseName & _
                Space(8 - (Len(ShortBaseName) + DblCnt(ShortBaseName))) & _
                "." & _
                ShortExt & _
                Space(3 - (Len(ShortExt) + DblCnt(ShortExt)))
  End If

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

End Function
'-----------------------------------------------------------------------
Function DblCnt(String)
  Dim objRE, Matches, ank
  Set objRE = New RegExp
  objRE.IgnoreCase = True
  objRE.Global = True
  objRE.Pattern = "([\ -~]|[｡-ﾟ])"
  Set Matches = objRE.Execute(String)
  ank = Matches.Count
  DblCnt = Len(String) - ank
  Set objRE = Nothing
End Function
'-----------------------------------------------------------------------
Function KiriTitle(KiriFile)

  Dim KTitle, Ver, TimeC, TimeM, _
      c1, c2, i ,j, _
      Stream, _
      Data(41), 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 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

' 対象ファイルの作成日「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)) <= 9) Then
    ' バージョン情報を文字列に変換する
    Ver = "[" & Chr(AscB(Bin(1)) + &H30) & "]"

    ' 表題を 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
'-----------------------------------------------------------------------
Function JpegSize(JpegFile)

  Dim Stream, _
      Size, _
      Data1, Data2, Data3, Data4, Data5, _
      DataX, DataX1, DataX2, _
      DataY, DataY1, DataY2
  Set Stream = WScript.CreateObject("Adodb.Stream")
  Stream.Type = 1
  Stream.Open
  Stream.LoadFromFile JpegFile
  Data5 = Stream.Read(2)
  Do while not Stream.EOS
    Data1 = Stream.Read(1)
    Data2 = Stream.Read(1)
    Data3 = Stream.Read(1)
    Data4 = Stream.Read(1)
    If (AscB(Data1) = &HFF) Then
      If ((AscB(Data2) >= &HC0) And (AscB(Data2) =< &HC3)) Then
        Data5  = Stream.Read(1)
        DataY1 = Stream.Read(1)
        DataY2 = Stream.Read(1)
        DataX1 = Stream.Read(1)
        DataX2 = Stream.Read(1)
        DataX = AscB(DataX1) * &H100 + AscB(DataX2)
        DataY = AscB(DataY1) * &H100 + AscB(DataY2)
        Exit Do
      Else
        Data5 = Stream.Read(AscB(Data3) * &H100 + AscB(Data4) - 2)
      End If
    End If
  Loop
  Stream.Close
  Set Stream = Nothing

  If (DataX + DataY) Then
    Size = "画像サイズ：" & _
           Right(Space(6) & FormatNumber(DataX,0,-1,0,-1),6) & _
           " × " & _
           Right(Space(6) & FormatNumber(DataY,0,-1,0,-1),6)
  Else
    Size = "This is not Jpeg File."
  End If

  JpegSize = Size & Space(40 - (Len(Size) + DblCnt(Size)))

End Function
'-----------------------------------------------------------------------
Function GifSize(GifFile)

  Dim Stream, _
      Size, _
      Data, Data1, Data2, Data3, Data4, _
      DataX, DataX1, DataX2, _
      DataY, DataY1, DataY2
  Set Stream = WScript.CreateObject("Adodb.Stream")
  Stream.Type = 1
  Stream.Open
  Stream.LoadFromFile GifFile
  Data1 = Stream.Read(1)
  Data2 = Stream.Read(1)
  Data3 = Stream.Read(1)
  Data  = Chr(AscB(Data1)) & Chr(AscB(Data2)) & Chr(AscB(Data3))
  If Data = "GIF" Then
    Data3  = Stream.Read(3)
    DataX1 = Stream.Read(1)
    DataX2 = Stream.Read(1)
    DataY1 = Stream.Read(1)
    DataY2 = Stream.Read(1)
    DataX  = AscB(DataX2) * &H100 + AscB(DataX1)
    DataY  = AscB(DataY2) * &H100 + AscB(DataY1)
  End If
  Stream.Close
  Set Stream = Nothing

  If (DataX + DataY) Then
    Size = "画像サイズ：" & _
           Right(Space(6) & FormatNumber(DataX,0,-1,0,-1),6) & _
           " × " & _
           Right(Space(6) & FormatNumber(DataY,0,-1,0,-1),6)
  Else
    Size = "This is not GIF File."
  End If

  GifSize = Size & Space(40 - (Len(Size) + DblCnt(Size)))

End Function
'-----------------------------------------------------------------------
Function PngSize(PngFile)
  Dim Stream, _
      Size, _
      Data, Data0, _
      Data1, Data2, Data3, Data4, _
      DataX, DataY
  Set Stream = WScript.CreateObject("Adodb.Stream")
  Stream.Type = 1
  Stream.Open
  Stream.LoadFromFile PngFile
  Data0 = Stream.Read(1)
  Data1 = Stream.Read(1)
  Data2 = Stream.Read(1)
  Data3 = Stream.Read(1)
  Data  = Chr(AscB(Data1)) & Chr(AscB(Data2)) & Chr(AscB(Data3))
  If (AscB(Data0) = &H89) And (Data = "PNG") Then
    Data0 = Stream.Read(8)
    Data1 = Stream.Read(1)
    Data2 = Stream.Read(1)
    Data3 = Stream.Read(1)
    Data4 = Stream.Read(1)
    Data  = Chr(AscB(Data1)) & _
            Chr(AscB(Data2)) & _
            Chr(AscB(Data3)) & _
            Chr(AscB(Data4))
    If (Data = "IHDR") Then
      Data1 = Stream.Read(1)
      Data2 = Stream.Read(1)
      Data3 = Stream.Read(1)
      Data4 = Stream.Read(1)
      DataX  =   AscB(Data1) * &H01000000 _
               + AscB(Data2) * &H00010000 _
               + AscB(Data3) * &H00000100 _
               + AscB(Data4)
      Data1 = Stream.Read(1)
      Data2 = Stream.Read(1)
      Data3 = Stream.Read(1)
      Data4 = Stream.Read(1)
      DataY  =   AscB(Data1) * &H01000000 _
               + AscB(Data2) * &H00010000 _
               + AscB(Data3) * &H00000100 _
               + AscB(Data4)
    End If
  End If
  Stream.Close
  Set Stream = Nothing

  If (DataX + DataY) Then
    Size = "画像サイズ：" & _
           Right(Space(6) & FormatNumber(DataX,0,-1,0,-1),6) & _
           " × " & _
           Right(Space(6) & FormatNumber(DataY,0,-1,0,-1),6)
  Else
    Size = "This is not PNG File."
  End If

  PngSize = Size & Space(40 - (Len(Size) + DblCnt(Size)))

End Function
'-----------------------------------------------------------------------
Function BmpSize(BmpFile)
  Dim Stream, _
      Size, _
      Data, Data0, _
      Data1, Data2, Data3, Data4, _
      DataX, DataY
  Set Stream = WScript.CreateObject("Adodb.Stream")
  Stream.Type = 1
  Stream.Open
  Stream.LoadFromFile BmpFile
  Data1 = Stream.Read(1)
  Data2 = Stream.Read(1)
  Data0 = Stream.Read(16)
  Data  = Chr(AscB(Data1)) & Chr(AscB(Data2))
  If Data = "BM" Then
    Data1 = Stream.Read(1)
    Data2 = Stream.Read(1)
    Data3 = Stream.Read(1)
    Data4 = Stream.Read(1)
    DataX  =   AscB(Data4) * &H01000000 _
             + AscB(Data3) * &H00010000 _
             + AscB(Data2) * &H00000100 _
             + AscB(Data1)
    Data1 = Stream.Read(1)
    Data2 = Stream.Read(1)
    Data3 = Stream.Read(1)
    Data4 = Stream.Read(1)
    DataY  =   AscB(Data4) * &H01000000 _
             + AscB(Data3) * &H00010000 _
             + AscB(Data2) * &H00000100 _
             + AscB(Data1)
  End If
  Stream.Close
  Set Stream = Nothing

  If (DataX + DataY) Then
    Size = "画像サイズ：" & _
           Right(Space(6) & FormatNumber(DataX,0,-1,0,-1),6) & _
           " × " & _
           Right(Space(6) & FormatNumber(DataY,0,-1,0,-1),6)
  Else
    Size = "This is not BMP File."
  End If

  BmpSize = Size & Space(40 - (Len(Size) + DblCnt(Size)))

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