« about:home アドレスバーからホームページに移動する。 | トップページ | Webページが「完全」や「アーカイブ」で保存できないとき(その2) »

2010年8月22日 (日)

VistaやWindows7で、XPの頃にNTFS代替streamに格納された「概要」を表示する。

cscript SummaryInfo.vbs ファイル...

Option Explicit
Dim Item
Dim oSum
Set oSum=New SummaryInfo
For Each Item In WScript.Arguments
  WScript.StdOut.WriteLine Item
  Call oSum.GetSummaryInfo(Item)
  WScript.Echo "Title:",oSum.GetProperty("Title")
  WScript.Echo "Author:",oSum.GetProperty("Author")
  WScript.Echo "Subject:",oSum.GetProperty("Subject")
  WScript.Echo "Keywords:",oSum.GetProperty("Keywords")
  WScript.Echo "Comments:",oSum.GetProperty("Comments")
  WScript.Echo "Revision Number:",oSum.GetProperty("Revision Number")
Next
Set oSum=Nothing

Class SummaryInfo
Private Buf, Stream, Props

Public Property Get GetProperty(Name)
Select Case LCase(Name)
Case "title" GetProperty=Props.Item(2)
Case "subject" GetProperty=Props.Item(3)
Case "author" GetProperty=Props.Item(4)
Case "keywords" GetProperty=Props.Item(5)
Case "comments" GetProperty=Props.Item(6)
Case "revision number" GetProperty=Props.Item(9)
Case Else GetProperty=Props.Item(Name)
End Select
End Property

Public Default Property Get Properties
Set Properties=Props
End Property

Public Function GetSummaryInfo(sPath)
Dim pPropSet, pPropId, pPropType
Dim PropCnt, PropId, PropType
Set Props=CreateObject("Scripting.Dictionary")
Set GetSummaryInfo=Props
Set Stream=CreateObject("ADODB.Stream")
Stream.Open
Stream.Type=1
Stream.LoadFromFile sPath & ":" & Chr(5) & "SummaryInformation"
If Stream.Size=0 Then Exit Function
Buf=Stream.Read(-1)
pPropSet=LongAt(44)
PropCnt=LongAt(pPropSet+4)
For pPropId=pPropSet+8 To pPropSet+8*PropCnt Step 8
  PropId=LongAt(pPropId)
  pPropType=pPropSet+LongAt(pPropId+4)
  PropType=LongAt(pPropType)
'  wscript.echo PropId,PropType
  Select Case PropType
  Case 30
    Props.Add PropId,StringAt(pPropType+8,LongAt(pPropType+4)-1)
  Case 2,3,19
    Props.Add PropId,LongAt(pPropType+4)
  Case Else
  End Select
Next
End Function

Private Function LongAt(Offset)
LongAt=AscB(MidB(Buf,Offset+1,1))+AscB(MidB(Buf,Offset+2,1))*256+AscB(MidB(Buf,Offset+3,1))*256*256+AscB(MidB(Buf,Offset+4,1))*256*256*256
End Function

Private Function StringAt(Offset,Length)
Dim dst
Set dst=CreateObject("ADODB.Stream")
dst.Open
dst.Type=1
Stream.Position=Offset
Stream.CopyTo dst,Length
dst.Position=0
dst.Type=2
dst.Charset="shift_jis"
StringAt=dst.ReadText(-1)
End Function

End Class

« about:home アドレスバーからホームページに移動する。 | トップページ | Webページが「完全」や「アーカイブ」で保存できないとき(その2) »