かちゅ〜しゃのkakikomi.txtをdat化した上、自分が書き込んだスレを
まとめてスレ倉庫化するスクリプトを書いてみたので、試して
みてください。(まだ動作が若干怪しい)
このスクリプトを拡張子をvbsにして、かちゅと同じフォルダに入れてね。
kage入れること。
かちゅが動いてないときに実行してください。
実行すると、以下のフォルダが作られます。
log\local
log\local\mine
以下のファイルが作られます。
書き込んだスレ.idx …ログ倉庫ファイル
log\local\mine\1000000000.dat …kakikomi.txtをコンバートしたもの
log\local\mine\1000000000.idx …そのインデックスファイル
実行したらかちゅを起動し、「マイフォルダ」の中にある「書き込んだスレ」を
開いてみてください。
まず、【自分の書き込み】というスレがありますが、これがkakikomi.txtを
コンバートしたもの、つまりあなたのこれまでの書き込みです。
他のスレは、あなたがこれまでに書き込んだことのあるスレです。
Dim iRes
Set Fs = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set dicIdx = WScript.CreateObject("Scripting.Dictionary")
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
If Not Fs.FileExists("kage.exe") Then
MsgBox "かちゅ〜しゃのあるフォルダにおいてください。それとkage導入して。"
WScript.Quit
End If
If Not Fs.FileExists("kakikomi.txt") THen
MsgBox "ROMはお断りだゴルァ"
WScript.Quit
End If
If Not Fs.FolderExists("log") THen
MsgBox "ログがない。"
WScript.Quit
End If
Set tsKakikomi=Fs.OpenTextFile("kakikomi.txt")
sKakikomi=tsKakikomi.ReadAll
tsKakikomi.Close
If Not Fs.FolderExists("log\local") Then
Fs.CreateFolder "log\local"
End If
If Not Fs.FolderExists("log\local\mine") Then
Fs.CreateFolder "log\local\mine"
End If
Set tsDat=Fs.CreateTextFile("log\local\mine\1000000000.dat")
regEx.Pattern="Date : (\d{4})/(\d{2})/(\d{2}) (\d{2}):(\d{2}):(\d{2})\r\n" & _
"Subject: ([^\r\n]+)\r\n" & _
"URL :
http://(.*)/test/read.cgi\?bbs=([^&]*)&key=(\d+)\r\n" & _
"From : ([^\r\n]*)\r\n" & _
"Mail : ([^\r\n]*)\r\n" & _
"\r\n" & _
"([^\v]*)"
'0=year 1=month 2=day 3=hour 4=minitue 5=second 6=subject 7=server
'8=bbs 9=surenumber 10=from 11=mail 12=body
For Each sMessage In Split(sKakikomi,vbCrLf & String(44,"-") & vbCrLf)
Set Matches=regEx.Execute(sMessage)
For Each Match In Matches
Set SubMatch=Match.SubMatches
sBody=Replace(StrEscape(SubMatch(12)),vbCrLf,"<br>")
sBody = sBody & "<a href=""
http://" & SubMatch(7) & "/test/read.cgi?bbs=" & _
SubMatch(8) & "&key=" & SubMatch(9) & """ target=""_blank"">" & _
StrEscape(SubMatch(6)) & "</a>"
tsDat.WriteLine "<b>" & SubMatch(10) & "</b>," & SubMatch(11) & "," & _
SubMatch(0) & "/" & SubMatch(1) & "/" & SubMatch(2) & " " & _
SubMatch(3) & ":" & SubMatch(4) & ":" & SubMatch(5) & "," & sBody
sIdx=Replace(SubMatch(7),"/","_") & "\" & SubMatch(8) & "\" & SubMatch(9) & ".idx"
If Not dicIdx.Exists(sIdx) Then
dicIdx.Add sIdx,""
End If
Next
iRes=iRes+1
Next
tsDat.CLose
Set tsIdx=Fs.CreateTextFile("log\local\mine\1000000000.idx")
tsIdx.Write Replace("3,32,5,【自分の書き込み】,local,mine,1000000000," & iRes & "," & _
iRes & ",-1," & Now & ",,書き込んだスレ,0,,,,,,",",",vbTab)
tsIdx.Close
Set tsSouko=Fs.CreateTextFile("書き込んだスレ.idx")
For Each key In dicIdx.Keys
tsSouko.WriteLine key
Next
tsSouko.WriteLine "local\mine\1000000000.idx"
tsSouko.Close
WshShell.Popup "あなたの書き込みと、あなたが書き込んだスレ一覧をまとめました。" & _
vbCrLf & "「マイフォルダ」-「書き込んだスレ」をご覧ください。",10
Function StrEscape(str)
StrEscape = str
StrEscape = Replace(StrEscape,Chr(38),"&")
StrEscape = Replace(StrEscape,Chr(34),""")
StrEscape = Replace(StrEscape,Chr(60),"<")
StrEscape = Replace(StrEscape,Chr(62),">")
StrEscape = Replace(StrEscape,",","@`")
End Function
うーん。最後の行なんだが、
StrEscape = Replace(StrEscape,",",",")
これ、かちゅでは、カンマをエスケープさせるのに
全角アットマーク@と全角アクセント符合っていうのかな、`との
組み合わせを使ってるんだわ。
で、その文字をつなげて書くと、かちゅではカンマ , に置換されちゃう。
だからこのコードをそのままコピペしてもちゃんと動かない。
…ええい、説明するのが面倒だ。わからん人はブラウザで見るべし。