Sirius Forza1063: Z10Main/stblib2.vbs


'stblib2.vbs

'-----------------------------------------------
'　1.3.2　(E-1)　サブ tmcm：ファイル候補リスト作成(メイン)　
'-----------------------------------------------
Sub TmcmProcLst(curTmcmFile,patternchr)

 Dim fsoObj
 Dim objTextSrc

 Set fsoObj = CreateObject("Scripting.FileSystemObject")

 '　候補リストがあれば削除する
 If fsoObj.FileExists(LIST_FILE_TM) Then
  Call fsoObj.DeleteFile(LIST_FILE_TM)
 End If

 '　候補リスト準備
 Set objTextSrc = fsoObj.OpenTextFile(LIST_FILE_TM, 8, True, 0)

 '　候補リストを作成する
 '
 '　フォルダがであるかをチェック
 If fsoObj.FolderExists(ZIP_BASEPATH) Then
  'リスト作成メイン実行
  Call CreTmcmFList(fsoObj,ZIP_BASEPATH,objTextSrc,curTmcmFile,patternchr)
 Else
  WScript.Echo now & MSGLEVEL_S & _
  "TmcmProcLst デイレクトリなしのためリスト処理を停止" & _
  vbCrLf & ZIP_BASEPATH
  WScript.Quit (10)
 End If

 '　ログファイルクローズ
 objTextSrc.Close

 '　オブジェクト開放
 Set objTextSrc = Nothing
 Set fsoObj = Nothing

End Sub


'-----------------------------------------------
'　1.3.3　(E-1-1)サブ　tmcmファイル候補リスト作成(サブ)　
'-----------------------------------------------
Sub CreTmcmFList(fsoObj,inFolderName,objText,curTmcmFile,patternchr)

 Dim fsoFolder
 Dim fsoSubFolder
 Dim fsoFile
 Dim itmcm 
 
 WScript.Echo now & MSGLEVEL_I & "確認フォルダ　　:" & inFolderName
 WScript.Echo now & MSGLEVEL_I & "除外ファイル　　:" & curTmcmFile
 WScript.Echo now & MSGLEVEL_I & "削除候補リスト　:" & LIST_FILE_TM
 
 itmcm = 0
 '　フォルダオブジェクト取得
 Set fsoFolder = fsoObj.GetFolder(inFolderName)
 For Each fsoFile In fsoFolder.Files
  '　削除候補ファイルリストを出力
  IF not trim(fsoFile.name) = curTmcmFile THEN
   '以下のファイル名で始まるファイルリストを対象とする
   IF left(fsoFile.name,len(patternchr)) = patternchr THEN
    objText.WriteLine fsoFile.name
    itmcm = itmcm + 1 
   END IF
  END IF

 Next

 WScript.Echo now & MSGLEVEL_I & "削除候補対象　　: " & itmcm & "　件　"

End Sub

'-----------------------------------------------
'　1.3.4 (E-2)　候補リストを元にして削除処理実行　
'-----------------------------------------------
Sub TmcmProcDel()

 Dim fsoObj
 Dim objTextSrc
 Dim objTextTgt
 Dim objFSO    '　ファイルシステムオブジェクト
 Dim objTextStream  '　テキストストリームオブジェクト
 Dim strText   '　テキスト内容
 Dim delfile
 Dim itmcm

 WScript.Echo now & MSGLEVEL_I & "削除処理実行　　:" & ZIP_BASEPATH

 '
 '　候補リストによる削除

 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
 Set objTextStream = objFSO.OpenTextFile(LIST_FILE_TM, 1)

 IF Not objFSO.FolderExists(ZIP_BASEPATH) THEN
  WScript.Echo now & MSGLEVEL_S & "TmcmProcDel デイレクトリなしでファイル削除停止" & _
  vbCrLf & ZIP_BASEPATH
  WScript.Quit (10)
 END IF

 itmcm = 0
 Do Until objTextStream.AtEndOfLine = True
  strText = objTextStream.ReadLine

  delfile = ZIP_BASEPATH & "\" & trim(strText)

  objFSO.DeleteFile delfile, true
  itmcm = itmcm + 1
  
  WScript.Echo now & MSGLEVEL_I & "FILE DELETE 　　: " & trim(strText)
 Loop

 objTextStream.Close
 
 WScript.Echo now & MSGLEVEL_I & "削除処理結果　　: " & itmcm & "　件　"

 Set objTextStream = Nothing
 Set objFSO = Nothing

End Sub
2013年9月21日土曜日

Z10Main/stblib2.vbs
