'***********************************************************
' お助けWSH dehualt.tonyuprjが壊れた無くなったどうしよう
' <default.tonyuprjファイル捏造 vbs>
' （豆乳 Ver. 1.24用 他は知らん。テストプロジェクト作って試すが吉）
'
' 好きに改変・改造・配布していいよん
'                                          2011 (C) リセッタ
'***********************************************************
'
' 最初にすること設計中のフォルダに、このファイルをぶち込む
' このファイルの拡張子をvbsにする
' なに〜 拡張子が表示されない？ググレ
' ヒント：エクスプローラ フォルダオプション 検索キー：拡張子 表示
'
' 設計中ディレクトリに、壊れたdefault.tonyuprjがあれば消す
' また、不要なクラスのソース(クラス名.tonyuファイル)が消しておく
'
' 元ネタを作る。豆乳を起動する。新規ディレクトリを作ってプロジェクトを作成。
' 豆乳は終了。新規ディレクトリからdefault.tonyuprjファイルを
' 設計中ディレクトリにこぴれ〜。新規ディレクトリは消してOK。
' まぁ、失敗した時に備えて作業終了前に消せばいいけどさ。
'
' いよいよdefault.tonyuprjを捏造します。
' このファイルを実行します。
' やり方？エクスプローラでこのファイルをダブルクリックｗ 何時もやってるっしょ？
'
' 動いてなさげ？ WSHでぐぐるとなにやら呪文が出るらしい
' 後、拡張子変ええたか？
'
' 豆乳を起動して設計中のプロジェクトを開いて動作確認してちょ
' だめならもう一度。それでだめなら 諦めて
'
'***********************************************************
'
' やっている事
' 元になるdefault.tonyuuprjを読みdefault.wrkに書き出します
' その時
' １．<resourcelist name="pages">〜</resourcelist>間のタグを削除
'   （豆乳で開くと勝手に再作成されるので大丈夫）
' ２．<resourcelist name="classes">〜</resourcelist>間のタグを削除
'     新たに拡張子tonyuのファイル（クラスファイル：クラス名.tonyu）を探し
'     <class name="クラス名" src="クラス名.tonyu" category=""/>タグを
'     <resourcelist name="classes">〜</resourcelist>間に挿入
' ３．default.tonyuuprjを消して、default.wrkをdefault.tonyuuprjに名前換え
'
' やる内容事態は、手動でもできるけどクラス多いと死ねるからね
'
'***********************************************************


Pf = 0                  ' pages  編集中フラグ -1:編集開始 0:未編集 1:編集中
Cf = 0                  ' classes編集中フラグ -1:編集開始 0:未編集 1:編集中

Set FS = CreateObject("Scripting.FileSystemObject")        ' ファイル操作オブジェクト
Set Fi = FS.OpenTextFile("default.tonyuprj", 1, False)     ' 入力ファイル オープン
If Err.Number > 0 Then                                     ' エラーチェック
  MsgBox "default.tonyupjが開けない＞＜かっぱっらてこいｗ" ' エラー表示
Else                                                       ' 入力ファイル開けた
  Set Fo = FS.OpenTextFile("default.wrk", 2, True)         ' 出力ファイル作るじょ
  If Err.Number > 0 Then                                   ' エラーなの？
    MsgBox "default.wrkが作れない＞＜ＨＤがいっぱいか？"   ' エラーだ
  Else                                                     ' OK!OK!
    Do Until Fi.AtEndOfStream                              ' どんどん 読み込むぞ
      line = Fi.ReadLine                                   ' まて まず１行づつ嫁
      str  = Replace(LCase(line), vbTab, " ")              ' TABをSPACEに変える
      ary  = Split(str)                                    ' SPACEでちょん切る

      Pf=PfEdit(Pf, ary)                                   ' pages  編集チェック
      Cf=CfEdit(Cf, ary)                                   ' classes編集チェック
      If (Pf+Cf)<1 Then                                    ' 編集中？だったら削除
        Fo.WriteLine line                                  ' ちゃう、そのまま出す
      End If
      If Cf<0 Then Call CfWrite(FS, Fo)                    ' classes編集開始でclassを掻き集めろ
    Loop                                                   ' 終わるまで夜目
  End If
  Fo.Close                                                 ' 開けたら閉める
End If

Fi.Close                                                   ' 明けたら〆る
                                                           ' 編集は終わり
If Err.Number = 0 Then
  FS.DeleteFile "default.tonyuprj"                         ' 元ネタはさよなら
  FS.MoveFile "default.wrk","default.tonyuprj"             ' 名前を変えて
End If

'                                                          ' ここで処理終了
'***************************************

' pages編集チェック a:分割文字列配列 f:編集フラグ 戻り:編集フラグ値
Function PfEdit(f, a)
  If f=0 Then                                              ' 未編集
' <resourcelist name="pages">なら編集開始、違うなら未編集を返す
    If sTagCheck(a, "name=""pages"">") = 2 Then PfEdit=-1 Else PfEdit=0
  Else                                                     ' 編集開始/編集中
' </resourcelist>なら未編集、違うなら編集中を返す
    If eTagCheck(a) = 1 Then PfEdit=0 Else PfEdit=1
  End If
End Function

' classes編集チェック a:分割文字列配列 f:編集フラグ 戻り:編集フラグ値
Function CfEdit(f, a)
  If f=0 Then                                              ' 未編集
' <resourcelist name="classes">なら編集開始、違うなら未編集を返す
    If sTagCheck(a, "name=""classes"">") = 2 Then CfEdit=-1 Else CfEdit=0
  Else                                                     ' 編集開始/編集中
' </resourcelist>なら未編集、違うなら編集中を返す
    If eTagCheck(a) = 1 Then CfEdit=0 Else CfEdit=1
  End If
End Function

' 開始タグ<resourcelist>チェック a:分割文字列配列 s:要素分文字列
'                                戻り; 0=タグ不一致 1:要素不一致 2:一致
Function sTagCheck(a, s)
  f=0                                                      ' タグ未検出セット
  For Each w In a
    Select Case f
    Case 0
      If StrComp(w, "<resourcelist")=0 Then f=1             ' タグ ヒット 要素検出へ
    Case 1
      If StrComp(w, s)=0 Then f=2                           ' 要素検出
    End Select
  Next
  sTagCheck=f
End Function

' 終了タグ</resourcelist>チェック a:分割文字列配列 戻り; 0=タグ不一致 1:一致
Function eTagCheck(a)
  f=0
  For Each w In a
    If StrComp(w, "</resourcelist>")=0 Then f=1
  Next
  eTagCheck=f
End Function

' <class>タグを作成 Fx:ファイル操作オブジェクト Fy：出力ファイルオブジェクト
Function CfWrite(Fx, Fy)
  Set Fl = Fx.GetFolder(".")                               ' フォルダオブジェクト作成
  For Each Obj In Fl.Files                                 ' ファイル情報を順番に取って
    Set F = FS.GetFile(obj)                                ' ファイルオブジェクト作って
    fname = F.name                                         ' ファイルパス貰って
    fbase = Fx.GetBaseName(fname)                          ' クラス名にして
    fexp  = LCase(Fx.GetExtensionName(fname))              ' 拡張子取り出して
    If StrComp(fexp, "tonyu")=0 Then                       ' 拡張子がtonyuなら
      line  = "<class name="""                             ' <class>タグ作って
      line  = line & fbase & """ src="""
      line  = line & fbase & "." & fexp & """ category=""""/>"
      Fy.WriteLine line                                    ' 書き出し
    End if
  Next                                                     ' 全部のファイルをチェック
End Function                                               ' お疲れ〜