Option Explicit
'
' -- target: set in each wsf ------------------------------------------
'
'Const BK_SRC = "d:\work"
'Const BK_DST = "C:\Documents and Settings\user\My Documents\work\backup"
'
' -- param: set in each wsf -------------------------------------------
'
'Const NO_EXEC = False ' True | False
'Const MODE_PDUMPFS = True ' True | False
'Const SKIP_HIDDEN = True ' True | False
'Const SKIP_SYSTEM = True ' True | False
'Const SKIP_COPY_ERROR = False ' True | False
'Const SKIP_LARGE_SIZE = "1G" ' 0 | "1.2G" | bytes
Dim SkipBySize, SKIP_BY_NAME, SKIP_BY_EXP
'SKIP_BY_NAME = Array( _
' "a", "b", "c" _
' )
'SKIP_BY_EXP = Array( _
' "*.bak", "*.o", "ABC??.tmp" _
' )
'
' -- const ------------------------------------------------------------
'
Const Hidden = 2 ' 隠しファイル
Const System = 4 ' システム ファイル
Const COMMAND_MAKE_LINK = "fsutil hardlink create" ' ハードリンク作成コマンド
'
' -- procedures -------------------------------------------------------
'
' is target ?
Function isTarget( src, file )
Dim fso, f, s, re, p, ret
ret = True
Set fso = CreateObject( "Scripting.FileSystemObject" )
Set f = fso.GetFile( fso.BuildPath( src, file ) )
If SKIP_HIDDEN And (0 <> (f.Attributes And Hidden)) Then
ret = False
ElseIf SKIP_SYSTEM And (0 <> (f.Attributes And System)) Then
ret = False
ElseIf (0 <> SkipBySize) And (SkipBySize < f.Size) Then
ret = False
End If
If ret Then
For Each s In SKIP_BY_NAME
If s = f.Name Then
ret = False
Exit For
End If
Next
End If
If ret Then
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
For Each s In SKIP_BY_EXP
p = 1
Do
p = Instr( p, s, "?" )
If 0 = p Then
Exit Do
End If
s = Left( s, p - 1 ) & "." & Mid( s, p + 1 )
p = p + 1
Loop
p = 1
Do
p = Instr( p, s, "*" )
If 0 = p Then
Exit Do
End If
s = Left( s, p - 1 ) & "." & Mid( s, p )
p = p + 2
Loop
s = s & "$"
re.Pattern = s
If re.Test( f.Name ) Then
ret = False
Exit For
End If
Next
Set re = Nothing
End If
'
' todo: any check
' time regexp or else
'
Set f = Nothing
Set fso = Nothing
isTarget = ret
End Function
' check if same
Function isSameFile( src, dst, file )
Dim fso, sf, df, s, d, ret
If NO_EXEC Then
isSameFile = False
Exit Function
End If
ret = True
Set fso = CreateObject( "Scripting.FileSystemObject" )
sf = fso.BuildPath( src, file )
df = fso.BuildPath( dst, file )
If Not fso.FileExists( df ) Then
ret = False
Else
Set s = fso.GetFile( sf )
Set d = fso.GetFile( df )
If s.Size <> d.Size Then
ret = False
ElseIf s.DateLastModified <> d.DateLastModified Then
ret = False
End If
Set d = Nothing
Set s = Nothing
End If
'
' todo: any check
' hash(md5/sha1) or else
Set fso = Nothing
isSameFile = ret
End Function
' search in dst directory
Function searchSamefile( src, file, top )
' todo: search in 'top' directory
' return: fullname if found, or Empty
searchSamefile = Empty
End Function
' log: todo: write to logfile or else
Sub log( msg )
WScript.Echo( msg )
End Sub
' date/time
Function getYear
getYear = Right( "" & Year( Now ), 4 )
End Function
Function getMonthr
getMonthr = Right( "0" & Month( Now ), 2 )
End Function
Function getDay
getDay = Right( "0" & Day( Now ), 2 )
End Function
Function getHour
getHour = Right( "0" & Hour( Now ), 2 )
End Function
Function getMinute
getMinute = Right( "0" & Minute( Now ), 2 )
End Function
' directory/file name
Function quotePath( path )
If 0 < InStr( path, " " ) Then
quotePath = """" & path & """"
Else
quotePath = path
End If
End Function
Function getDstDir( dst )
Dim fso, s
Set fso = CreateObject( "Scripting.FileSystemObject" )
s = fso.BuildPath( dst, getYear )
s = fso.BuildPath( s, getMonthr )
s = fso.BuildPath( s, getDay )
If Not MODE_PDUMPFS Then
s = fso.BuildPath( s, getHour )
s = fso.BuildPath( s, getMinute )
End If
Set fso = Nothing
getDstDir = s
End Function
'
Function searchLastDir( dst, level )
Dim fso, folders, folder, d
Dim max, maxname, i
Const MAX_TAG = Empty
max = MAX_TAG
Set fso = CreateObject( "Scripting.FileSystemObject" )
Set folder = fso.GetFolder( dst )
Set folders = folder.SubFolders
For Each d In folders
If IsNumeric( d.Name ) Then
i = 1 + CInt( d.Name ) ' 0 < Empty < 1
If max < i Then
max = i
maxname = d.Name
End If
End If
Next
Set folders = Nothing
If MAX_TAG = max Then
searchLastDir = Empty
Set fso = Nothing
Exit Function
End If
d = fso.BuildPath( dst, maxname )
Set fso = Nothing
If 0 = level Then
searchLastDir = d
Else
searchLastDir = searchLastDir( d, level - 1 )
End If
End Function
Function getLastDir( dst )
Dim level
If Not MODE_PDUMPFS Then
level = 4
Else
level = 2
End If
getLastDir = searchLastDir( dst, level )
End Function
' check existing file/directory
Function isExist( file )
Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )
If fso.FileExists( file ) Then
isExist = True
ElseIf fso.FolderExists( file ) Then
isExist = True
Else
isExist = False
End If
Set fso = Nothing
End Function
' make directory
Function mkdir( dir )
Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )
On Error Resume Next
fso.CreateFolder( dir )
mkdir = (0 = Err.Number)
On Error Goto 0
Set fso = Nothing
End Function
Function createParentsDir( dir )
Dim fso, path, names, i
Set fso = CreateObject( "Scripting.FileSystemObject" )
names = Split( fso.GetAbsolutePathName( dir ) , "\" )
path = names( LBound( names ) ) & "\"
For i = (LBound( names ) + 1) To UBound( names )
path = fso.BuildPath( path, names( i ) )
If Not isExist( path ) Then
If Not mkdir( path ) Then
log( "ERR: make directory: " & path )
createParentsDir = False
Set fso = Nothing
Exit Function
End If
End If
Next
Set fso = Nothing
createParentsDir = True
End Function
' file/path name
Function getPath( fullname )
Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )
getPath = fso.GetParentFolderName( fullname )
Set fso = Nothing
End Function
Function getFile( fullname )
Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )
getFile = fso.GetFileName( fullname )
Set fso = Nothing
End Function
' copy or link
Function copyFile( src, dst, file )
Dim fso, s, d
Set fso = CreateObject( "Scripting.FileSystemObject" )
s = fso.BuildPath( src, file )
d = fso.BuildPath( dst, file )
If NO_EXEC Then
copyFile = True
log( "TEST: copy: " & s & vbCrLf & " --> " & d )
Else
On Error Resume Next
fso.CopyFile s, d
copyFile = (0 = Err.Number)
On Error Goto 0
End If
Set fso = Nothing
End Function
Function makeLink( sf, df )
Dim fso, wso, cmd, ret
If NO_EXEC Then
log( "TEST: link: " & sf & vbCrLf & " --> " & df )
Exit Function
End If
cmd = COMMAND_MAKE_LINK & " " & quotePath( df ) & " " & quotePath( sf )
Set wso = WScript.CreateObject( "WScript.Shell" )
ret = wso.Run( cmd, 0, True )
Set wso = Nothing
makeLink = (0 = ret)
End Function
Function linkFile( src, dst, file )
Dim fso, s, d
Set fso = CreateObject( "Scripting.FileSystemObject" )
s = fso.BuildPath( src, file )
d = fso.BuildPath( dst, file )
Set fso = Nothing
linkFile = makeLink( s, d )
End Function
Function backupFile( src, dst, last, top, file )
Dim fso, f, d
If isTarget( src, file ) Then
If Empty = last Then
backupFile = copyFile( src, dst, file )
Else
If isSameFile( src, last, file ) Then
backupFile = linkFile( last, dst, file )
Else
f = searchSamefile( src, file, top )
If Empty = f Then
backupFile = copyFile( src, dst, file )
Else
Set fso = CreateObject( "Scripting.FileSystemObject" )
d = fso.BuildPath( dst, file )
Set fso = Nothing
backupFile = makeLink( f, d )
End If
End If
End If
Else
backupFile = True
End If
End Function
Function backupDir( src, dst, last, top )
Dim fso, folder, files, folders
Dim f,d, sd, dd, ld, ret
ret = True
Set fso = CreateObject( "Scripting.FileSystemObject" )
Set folder = fso.GetFolder( src )
Set files = folder.Files
For Each f In files
ret = backupFile( src, dst, last, top, f.Name )
If Not ret Then
log( "ERR: backup file : " & src & " / " & f.Name )
If Not SKIP_COPY_ERROR Then
Exit For
End If
End If
Next
Set files = Nothing
If (Not SKIP_COPY_ERROR) And (Not ret) Then
log( "ERR: backup file" )
backupDir = ret
Set folder = Nothing
Set fso = Nothing
Exit Function
End If
Set folders = folder.SubFolders
For Each d In folders
If ((Not SKIP_HIDDEN) Or (0 = (d.Attributes And Hidden))) _
And ((Not SKIP_SYSTEM) Or (0 = (d.Attributes And System))) Then
sd = fso.BuildPath( src, d.Name )
dd = fso.BuildPath( dst, d.Name )
If (Not NO_EXEC) And (Not mkdir( dd )) Then
log( "ERR: make directory: " & dd )
ret = False
Exit For
End If
If Empty = last Then
ld = Empty
Else
ld = fso.BuildPath( last, d.Name )
End If
ret = backupDir( sd, dd, ld, top )
If Not ret Then
log( "ERR: backup directory: " & sd )
If Not SKIP_COPY_ERROR Then
Exit For
End If
End If
End If
Next
Set folders = Nothing
Set folder = Nothing
Set fso = Nothing
backupDir = ret
End Function
'
Function backup( src, dst, last )
Dim fso, f
Set fso = CreateObject( "Scripting.FileSystemObject" )
f = fso.FileExists( src )
Set fso = Nothing
If f Then
backup = backupFile( getPath( src ), dst, last, dst, getFile( src ) )
Else
backup = backupDir( src, dst, last, dst )
End If
End Function
'
Function checkArg
Dim f, m
' SKIP_LARGE_SIZE --> SkipBySize
If Not IsNumeric( SKIP_LARGE_SIZE ) Then
m = Right( SKIP_LARGE_SIZE, 1 )
On Error Resume Next
f = CDbl( Left( SKIP_LARGE_SIZE, Len( SKIP_LARGE_SIZE ) - 1 ) )
If 0 <> Err.Number Then
f = Empty
End If
On Error Goto 0
If Empty = f Then
checkArg = False
Exit Function
End If
Select Case UCase( m )
Case "K" SkipBySize = f * 1000
Case "M" SkipBySize = f * 1000 * 1000
Case "G" SkipBySize = f * 1000 * 1000 * 1000
Case "T" SkipBySize = f * 1000 * 1000 * 1000 * 1000
Case Else checkArg = False: Exit Function
End Select
Else
SkipBySize = SKIP_LARGE_SIZE
End If
checkArg = True
End Function
'
' -- main -------------------------------------------------------------
'
Sub main()
Dim fso, src, dst
Dim this, last
If Not checkArg Then
log( "ERR: check Argumets: " )
Exit Sub
End If
Set fso = CreateObject( "Scripting.FileSystemObject" )
src = fso.GetAbsolutePathName( BK_SRC )
dst = fso.GetAbsolutePathName( BK_DST )
Set fso = Nothing
If Not isExist( src ) Then
log( "ERR: source not found: " & src )
Exit Sub
End If
If Not isExist( dst ) Then
If Not NO_EXEC Then
log( "WARN: destination not found: " & dst )
If Not mkdir( dst ) Then
log( "ERR: make directory: " & dst )
Exit Sub
End If
End If
End If
last = getLastDir( dst )
this = getDstDir( dst )
If isExist( this ) Then
log( "ERR: write directory is exist. Prev work not finished ?" )
Exit Sub
End If
If Not NO_EXEC Then
If Not createParentsDir( this ) Then
log( "ERR: create directorys: " & this )
Exit Sub
End If
End If
If Not backup( src, this, last ) Then
log( "error" )
Exit Sub
End If
WScript.Echo( "done" )
End Sub