vbsサンプル
http://tuka.s12.xrea.com/index.xcg?p=VBS#p16
Option Explicit
'############################################################
'## ファイル一覧作成処理 2008/02/19
'## （サブフォルダも処理する）
'############################################################
'###
'### 実行情報定義（デバッグ情報）
'### true ならデバッグモード
'### ログにデバッグ情報が出力されます
'### 削除はおこなわれません
'### 起動パラメータ/debug:でデバッグ指定をおこないます
Public CNS_DEBUG
CNS_DEBUG = False 'パラメータでも指定可能
'###
'###
Const CNS_LOGDIR = ".\"
Const CNS_LOGFILE = "FILEList.log"
'############################################################
'### プログラム
'############################################################
Dim m_oFs
Dim m_INCNT, m_MATCHCNT
Dim m_SubFlg
Dim m_SizeFlg
Dim m_DateFlg
'
'主処理の実行( 検索対象パス 対象拡張子 間隔 経過月数 ）
'
'起動パラメータのチェック
Dim strDir, strSub, strDebug, strDate, strSize
strDir = Wscript.Arguments.Named("DIR")
strDate = Wscript.Arguments.Named("DATE")
strSize = Wscript.Arguments.Named("SIZE")
strSub = Wscript.Arguments.Named("SUB")
strDebug = Wscript.Arguments.Named("DEBUG")
If Ucase(Trim(strDebug)) = "ON" Then
CNS_DEBUG = True
End if
If strDir = "" Then
Wscript.Echo "Dir Error"
Wscript.Quit
End if
m_SubFlg = True
If Ucase(Trim(strSub)) = "OFF" Then
m_SubFlg = False
End if
m_DateFlg = True
If Ucase(Trim(strDate)) = "OFF" Then
m_DateFlg = False
End if
m_SizeFlg = True
If Ucase(Trim(strSize)) = "OFF" Then
m_SizeFlg = False
End if
'
'
'処理実行
Call Main(strDir )
'
'
'
'############################################################
'==========================================================
'主処理
'引数：対象ディレクトリ
'==========================================================
function MAIN( DIRNAME )
Dim OFLD
Dim inCnt
Dim outCnt
Dim dtComp
Dim lngLevel
set m_oFs = createobject("Scripting.FileSystemObject")
SET OFLD = M_OFS.GETFOLDER(DIRNAME)
CALL LOGWRITE("----start " & NOW )
if CNS_DEBUG = true then
CALL LOGWRITE("--Debug=On")
Else
CALL LOGWRITE("--Debug=Off")
end if
CALL LOGWRITE("--SubDir=" & m_SubFlg )
m_INCNT = 0
m_MATCHCNT = 0
lngLevel = 1
CALL ReMain( OFLD, DIRNAME, lngLevel)
CALL LOGWRITE("--InCnt=" & m_INCNT )
CALL LOGWRITE("--MatchCnt=" & m_MATCHCNT )
CALL LOGWRITE("----end " & NOW )
set m_oFs = Nothing
end function
'
'==========================================================
'フォルダは再帰処理でファイル検索
'引数：検索フォルダ、
'==========================================================
function ReMain(oFolders, dirname, lngLevel)
dim oFile
dim oSubFolder
Dim sw1
'----------------------------------------
'ファイル名を列挙し、処理を行なう。
'----------------------------------------
sw1 = 0
for each oFile in oFolders.files
m_INCNT = m_INCNT + 1
sw1 = sw1 + 1
m_MATCHCNT = m_MATCHCNT + 1
Call ProcFile(oFile)
next
'----------------------------------------
'サブフォルダーは再帰呼び出しおこなう
'----------------------------------------
if m_SubFlg = True Then
for each oSubFolder in oFolders.subfolders
lngLevel = lngLevel + 1
Call ReMain(oSubFolder,addsep(dirname) & oSubFolder.name, lngLevel)
lngLevel = lngLevel - 1
next
End If
end function
'
'==========================================================
'見つかったファイルはここの記述で処理される。
'引数：Fileオブジェクト
'==========================================================
sub ProcFile(objFile)
'ログファイル出力
Dim strWk
Dim strWk1
strWk1 = left(objFile.Path, len(objFile.Path) - len(objFile.Name) )
strWk = ""
strWk = strWk & UCASE( objFile.Name )
If m_SizeFlg <> False Then
strWk = strWk & vbTab
strWk = strWk & objFile.Size
End If
IF m_DateFlg <> False Then
strWk = strWk & vbTab
strWk = strWk & objFile.Datelastmodified
End If
strWk = strWk & vbTab
strWk = strWk & UCASE( strWk1 )
Call LogWrite( strWk )
end sub
'
'==========================================================
'拡張子の取得
'引数：
'==========================================================
function GetExtention(strFname)
dim Cnt
Cnt = ubound(Split(strFname, "."))
if Cnt => 1 then
' . でスプリットした最後の要素が拡張子
GetExtention = Split(strFname, ".")(Cnt)
else
'.が無い場合は拡張子なし
GetExtention = ""
end if
end function
'
'==========================================================
'パスセパレータの追加
'==========================================================
function addsep(dirname)
if right(dirname,1) <> "\" then
addsep = dirname & "\"
end if
end function
'
'==========================================================
'ログファイルの出力
'==========================================================
sub LogWrite( MSG )
dim OOUTF
dim strFname
On Error Resume Next
strFname = CNS_LOGDIR & GetSysDate() & CNS_LOGFILE
SET OOUTF = M_OFS.OpenTextFile(strFname ,8,true)
OOUTF.WRITELINE( Now & vbTab & MSG )
OOUTF.close
end sub
'
'==========================================================
'デバッグログファイルの出力(CNS_DEBUG<>0のときのみ出力
'==========================================================
sub DebugLogWrite( MSG )
dim OOUTF
dim strFname
If CNS_DEBUG = False then
Exit Sub
End if
Call LogWrite( "<Debug>" & vbTab & MSG )
end sub
'
Function GetSysDate()
GetSysDate = GetDateFormat( Now() )
End Function
'
Function GetDateFormat( dtDate )
Dim strWk
strWk = Year( dtDate )
strWk = strWk & Right("00" & Month( dtDate ),2)
strWk = strWk & Right("00" & Day( dtDate ),2)
GetDateFormat = strWk
End Function
'
'======================================================================
'Read a profile from .ini file
'======================================================================
Private Function GetProfile(strSection, strKey, varDefault, strPathIni)
GetProfile = varDefault ' Initialize by default
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim f : Set f = fso.OpenTextFile(strPathIni)
Dim strLine
Dim fSectionFound
Dim strKeyFound
fSectionFound = False
Do While f.AtEndOfStream <> True
strLine = Trim(f.ReadLine)
If (strLine <> "") And (Left(strLine, 1) <> ";") Then ' Skip Blank/Comment Line
' When Key was found
If fSectionFound = True Then
If strKey = Left(strLine, InStr(strLine, "=") - 1) Then
GetProfile = Mid(strLine, InStr(strLine, "=") + 1)
f.Close()
Set fso = Nothing
Exit Function ' Success
End If
End If
' Control inside target section or not.
If (Left(strLine, 1) = "[") And (Right(strLine, 1) = "]") Then
If strLine = ("[" + strSection + "]") Then
fSectionFound = True
Else
fSectionFound = False
End If
End If
End If
Loop
f.Close()
Set fso = Nothing
End Function
vbsサンプル.txt · 最終更新: 2019/06/30 12:22 by 127.0.0.1