| |
yrh4401
Posts: 4
Score: 0
Joined: 11/24/2005
Status: offline
|
'***********************************************************
'Subject : Copy file from source folder to destination folder
'Writtren by Ray Yen 2004/09/21
'Version : 1.0
'Note :
' Usuage : cscript CopyFile.vbs /src:c:\temp /dest:c:\backup\Back /stime:22:30 /etime:23:20 /CrossMidnight:Y
'***********************************************************
'On Error Resume Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Some handy global variables
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TabStop
Dim NewLine
Dim srcFolder
Dim destFolder
Dim strOS
Dim strLanguage
Dim strIEVersion
Dim strServicePack
Dim strEnvOSName
Dim strEnvOSPatchVersion
Dim CurrentVersion,CSDVersion,ProductLanguage
Dim strFolderNamingType
'Please specific the folder naming method
'strFolderNamingType = "HOUR"
'strFolderNamingType = "MINUTE"
'strFolderNamingType = "SECOND"
strFolderNamingType = "DAY"
' Set up global data.
TabStop = Chr(9)
NewLine = Chr(10)
'Checking OSVersion
Call CheckOS()
'Wscript.Echo strEnvOSName
'Print "OS = " & strEnvOSName
'Decide to run ....
Select Case Ucase(strEnvOSName)
Case "W2K"
Case "WXP","W3K"
Case Else
'Do Nothing
End Select
'*****************************
'Get User Input Arguments
'Path & Drive
'*****************************
ReDim strArgumentArray(0)
Dim strFlag,objArgs
Dim strType,strInputType
Dim strComputer
Dim strMessage
'Start Time & End Time for checking file to delete
Dim dteStartTimeSet, dteEndTimeSet
'If specific the parameter the the Ending time need add one day
Dim blnCrossMidnight
Set objArgs = WScript.Arguments
'Get the command line arguments
For i = 0 to objArgs.count - 1
ReDim Preserve strArgumentArray(i)
strArgumentArray(i) = objArgs.item(i)
Next
strFlag = strArgumentArray(0)
If strFlag = "" then 'No arguments have been received
Print "Please specific parameters : cscript CopyFile.vbs /src:{Source Folder}" _
& "/dest:{Destination Foder}" _
& "/stime:{Start Checking Time}" _
& "/etime:{Ending Checking Time}" _
& "/CrossMidnight:{The Ending Checking Time is Cross Midnight or Not:Y/N}"
Wscript.Quit
End If
For i = 0 to UBound(strArgumentArray)
strFlag = Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1)
'Prevent parameter error : An error occurs if there is no : in the string
If Err.Number Then
Err.Clear
Print strArgumentArray(i) & " is NOT recognized as a valid input."
Wscript.Quit
Else
Select Case LCase(strFlag)
Case "/src"
srcFolder = Right(strArgumentArray(i), Len(strArgumentArray(i))-5)
Case "/dest"
destFolder = Right(strArgumentArray(i), Len(strArgumentArray(i))-6)
Case "/stime"
dteStartTimeSet = Right(strArgumentArray(i), Len(strArgumentArray(i))-7)
Case "/etime"
dteEndTimeSet = Right(strArgumentArray(i), Len(strArgumentArray(i))-7)
Case "/crossmidnight"
blnCrossMidnight = Right(strArgumentArray(i), Len(strArgumentArray(i))-15)
Case else
Print strArgumentArray(i) & " is not recognized as a valid input."
End Select
End If
Next
'Need to checking the time is correct
Print "===== Input Parameters ====="
Print "Source Folder = " & srcFolder
Print "Destination Foder = " & destFolder
Print "Start Checking Time = " & dteStartTimeSet
Print "Ending Checking Time = " & dteEndTimeSet
Print "CrossMidnight = " & blnCrossMidnight
Print "."
'Check the script run at specific time range
If ChkSpecificTimeRange(dteStartTimeSet,dteEndTimeSet) = True Then
'Deleting source folder file
Print "Meet the time range! Deleting source folder files!"
'Call Main Function : Copy source folder file to naming folder
'==>Please decide to copy file first the delete or not
Call CopySrcToDest()
'Call Delet File function
Call DeleteSrcFolder()
Else
Print "Keeping copy source file to destination !"
'Call Main Function : Copy source folder file to naming folder
Call CopySrcToDest()
'Call Delet File function
Call DeleteSrcFolder()
End If
'End this script
Wscript.Quit
'==============================
' Check the specific time range
'==============================
Function ChkSpecificTimeRange(dteStartTime,dteEndTime)
'On Error Resume Next
Dim dteCheckDateTimeNow
Dim strDate
Dim dteChkStartTime,dteChkEndTime
Dim bltResult
bltResult = False
strDate = Year(Now()) & "/" & Month(Now()) & "/" & Day(Now())
dteCheckDateTimeNow = Now()
dteChkStartTime = strDate & " " & dteStartTime
dteChkEndTime = strDate & " " & dteEndTime
If ChkSysSEDateTime(dteCheckDateTimeNow,dteChkStartTime,dteChkEndTime,blnCrossMidnight) Then
bltResult = True
Else
bltResult = False
End If
'Print "bltResult = " & bltResult
ChkSpecificTimeRange = bltResult
End Function
'==============================
' Delete Source Folder all Files
'==============================
Sub DeleteSrcFolder()
Dim objSrcFolder
Dim objSrcDeleteFile
Dim objSrcFolderFiles
Dim objFolder
Set FSO = CreateObject("Scripting.FileSystemObject")
'If Not FSO.DriveExists(strDrive) Then Exit Sub
If Not FSO.FolderExists(srcFolder) Then
Print "Error! Not exist Source Folder : " & srcFolder & " folder! "
Exit Sub
End If
'Get All Files
ArrayFolderFiles = Split(ShowFolderList(srcFolder),",")
If IsArray(ArrayFolderFiles) Then
'Check Every Sub Folder's Files LastAccessed Date
Print "................. Delete Source Folder Files Now ................. "
For Each objSrcDeleteFile in ArrayFolderFiles
Print TabStop & srcFolder & "\" & objSrcDeleteFile
FSO.DeleteFile(srcFolder & "\" & objSrcDeleteFile)
Next
Print "................. Files Delete Done! ................."
Else
Print "The Source Folder no file can be delete!"
End If
Set objSrcFolder = Nothing
Set objSrcFolderFiles = Nothing
Set FSO = Nothing
End Sub
'==============================
' Copy Source Folder all Files to Destionation Folder
'==============================
Sub CopySrcToDest()
Dim objSrcFolder, objobjDestFolder
Dim objSrcCopyFile
Dim objFolder
Dim objSrcFolderFiles
Set FSO = CreateObject("Scripting.FileSystemObject")
'If Not FSO.DriveExists(strDrive) Then Exit Sub
If Not FSO.FolderExists(srcFolder) Then
Print "Error! Not exist Source Folder : " & srcFolder & " folder! "
Exit Sub
End If
'Destination Folder need add Date & Time as Folder name
destFolder = destFolder & GenDateTimeString
'srcFolder = srcFolder & "\*"
'Print "srcFolder= " & srcFolder
Print "Naming New Destination Folder = " & destFolder
If Not FSO.FolderExists(destFolder) Then
Print "Creating Destionation " & destFolder & " folder! "
If strEnvOSName = "W2K" Then
'If folder not exist the create it! ==> If use CopyFolder method, don't create folder
Set objSrcFolder = FSO.CreateFolder(destFolder)
'Get All Files
ArrayFolderFiles = Split(ShowFolderList(srcFolder),",")
'Check Every Sub Folder's Files LastAccessed Date
Print "................. Start Copy Files Now ................. "
For Each objSrcCopyFile in ArrayFolderFiles
Print TabStop & srcFolder & "\" & objSrcCopyFile
FSO.CopyFile srcFolder & "\" & objSrcCopyFile, destFolder & "\" & objSrcCopyFile ,True
Next
Print "................. Files Copy Done! ................."
ElseIf strEnvOSName = "WXP" or strEnvOSName = "W3K" Then
'Start Copy Folder
Print "................. Start Copy Folder Now ................. "
FSO.CopyFolder srcFolder,destFolder,True
Print "................. Folder Copy Done! ................."
End If
Else
'Need Copy file .
Print "The Destination Folder : " & destFolder & " folder already exist! "
'Get All Files
ArrayFolderFiles = Split(ShowFolderList(srcFolder),",")
'Check Every Sub Folder's Files LastAccessed Date
Print "................. Start Copy Folder Now ................. "
For Each objSrcCopyFile in ArrayFolderFiles
Print TabStop & srcFolder & "\" & objSrcCopyFile
FSO.CopyFile srcFolder & "\" & objSrcCopyFile, destFolder & "\" & objSrcCopyFile ,True
Next
Print "................. Folder Copy Done! ................."
End If
Set objSrcFolder = Nothing
Set objSrcFolderFiles = Nothing
Set FSO = Nothing
End Sub
'******************************
'Generate UID
'******************************
Function GenDateTimeString()
Dim strDateTime
Dim strYear,strMonth,strDay
Dim strHour,strMinute,strSecond
strYear = Year(Now())
strMonth = Month(Now())
strDay = Day(Now())
strHour = Hour(Now())
strMinute = Minute(Now())
strSecond = Second(Now())
If Len(strMonth) < 2 Then
strMonth = "0" & strMonth
End If
If Len(strDay) < 2 Then
strDay = "0" & strDay
End If
If Len(strHour) < 2 Then
strHour = "0" & strHour
End If
If Len(strMinute) < 2 Then
strMinute = "0" & strMinute
End If
If Len(strSecond) < 2 Then
strSecond = "0" & strSecond
End If
Select Case strFolderNamingType
Case "DAY"
strDateTime = strYear & strMonth & strDay
Case "HOUR"
strDateTime = strYear & strMonth & strDay & strHour
Case "MINUTE"
strDateTime = strYear & strMonth & strDay & strHour & strMinute
Case "SECOND"
strDateTime = strYear & strMonth & strDay & strHour & strMinute & strSecond
End Select
GenDateTimeString = strDateTime
End Function
'******************************
' Split File Extension
'******************************
Function GetFileExtension(strFileName)
Dim intLoc
Dim strResult
intLoc = Instr(strFileName,".")
If intLoc <> 0 Then
strResult = Mid(strFileName,intLoc+1,Len(strFileName))
Else
strResult = ""
End If
GetFileExtension = strResult
End Function
'******************************
'List all subfolder name in a folder
'******************************
Function ShowFolderList(folderspec)
Dim fso, f, f1, fc, s,intCount,intFolderCount
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
intFileCount=fc.Count
intCount=0
For Each f1 in fc
intCount=intCount+1
s = s & f1.name
If intCount<intFileCount Then
s = s & ","
End If
Next
'Print "Files List : " & s
ShowFolderList = s
End Function
'******************************
' Print Message
'******************************
Sub Print(x)
WScript.Echo x
End Sub
'******************************
' Show all file name in a folder
' dteNumber : check date number
'******************************
Function ShowFolderListByLastAccessed(folderspec,dteNumber)
Dim fso, f, f1, fc, s,intCount,intFileCount
Dim dteCheckDate
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
dteCheckDate=DateAdd("d",dteNumber,Now)
'Print "dteCheckDate = " & dteCheckDate & NewLine
intFileCount=fc.Count
intCount=0
For Each f1 in fc
intCount=intCount+1
'Print f1.Name & " " & f1.DateLastAccessed
If CDate(f1.DateLastAccessed) <= dteCheckDate Then
'Print f1.DateLastAccessed & " <= " & dteCheckDate
s = s & f1.name
If intCount<intFileCount Then
s = s & ","
End If
Else
'Print f1.DateLastAccessed & " > " & dteCheckDate
End If
Next
ShowFolderListByLastAccessed = s
End Function
'******************************
' Show all file name in a folder
' dteNumber : check date number
'******************************
Function ShowFolderListByCreated(folderspec,dteNumber)
Dim fso, f, f1, fc, s,intCount,intFileCount
Dim dteCheckDate
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
dteCheckDate=DateAdd("d",dteNumber,Now)
'Print "dteCheckDate = " & dteCheckDate & NewLine
intFileCount=fc.Count
intCount=0
For Each f1 in fc
intCount=intCount+1
'Print f1.Name & " DateCreated : " & f1.DateCreated & NewLine
If CDate(f1.DateCreated) <= dteCheckDate Then
'Print f1.DateLastAccessed & " <= " & dteCheckDate
s = s & f1.name
If intCount<intFileCount Then
s = s & ","
End If
Else
'Print f1.DateCreated & " > " & dteCheckDate
End If
Next
ShowFolderListByCreated = s
End Function
'******************************
'List all subfolder name in a folder
'******************************
Function ShowSubFolderList(folderspec)
Dim fso, f, f1, fc, s,intCount,intFolderCount
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
Set SubFolders = f.SubFolders
intFolderCount=SubFolders.Count
intCount=0
For Each f1 in SubFolders
intCount=intCount+1
s = s & f1.name
If intCount<intFolderCount Then
s = s & ","
End If
Next
ShowSubFolderList = S
End Function
'*****************************************
'Delete File
'*****************************************
Function blnDeleteTmpFile(strFileName)
Dim blnFlag
On Error Resume Next
Print strFileName
If strFileName = "" Then
blnDeleteTmpFile = False
Exit Function
End If
blnFlag = False
Err.Clear
'刪除檔案
Set fs = CreateObject("Scripting.FileSystemObject")
'先判斷刪除的檔案是否存在，才執行刪除
If fs.FileExists(strFileName) Then
fs.DeleteFile strFileName,True
If Err.Number <> 0 Then
Print "File Deleted Fail !"
Else
Print "File Deleted !"
End If
End If
'判斷刪除的檔案是否存在，如以存在則『刪除失敗』
If fs.FileExists(strFileName) Then
blnFlag = False
Else
blnFlag = True
End If
Set fs=nothing
If blnFlag = True Then
blnDeleteTmpFile = True
ElseIf blnFlag = False Then
blnDeleteTmpFile = False
End If
End Function
'*****************************************
'檢查檔案是否存在Function，
'NOTE：Backup
'*****************************************
Function blnCheckFile(strFileName)
Dim blnFlag
If strFileName = "" Then
blnCheckFile= False
Exit Function
End If
blnFlag = False
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(strFileName) Then
blnFlag = True
Else
blnFlag = False
End If
Set fs=nothing
If blnFlag = True Then
blnCheckFile = True
ElseIf blnFlag = False Then
blnCheckFile = False
End If
End Function
'==============================
' Main function
'==============================
Sub DeleteOldFiles()
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.DriveExists(strDrive) Then Exit Sub
If Not FSO.FolderExists(strPath) Then Exit Sub
Set LogFolder = FSO.GetFolder(strPath)
Set LogFiles=LogFolder.Files
'Get All SubFolders
ArraySubFolders=Split(ShowSubFolderList(strPath),",")
Dim intCount,IntArrayMax
intCount=0
'Check Every Sub Folder's Files LastAccessed Date
For Each objSubFolder in ArraySubFolders
Print " =========== " & strPath & "\" & objSubFolder & " =========== " & NewLine
'Get SubFolder Files Name by Checking the LastAccessed Date
'Method 1 : Check Last Access Date
'ArrayDeleteFiles=Split(ShowFolderListByLastAccessed(strPath & "\" & objSubFolder,dteDelLogDate),",")
'Method 1 : Check Last Created Date
ArrayDeleteFiles=Split(ShowFolderListByCreated(strPath & "\" & objSubFolder,dteDelLogDate),",")
'Do Delete Files Actions:
For Each objDeleteFiles in ArrayDeleteFiles
Print strPath & "\" & objSubFolder & "\" & objDeleteFiles & NewLine
Result=blnDeleteTmpFile(strPath & "\" & objSubFolder & "\" & objDeleteFiles)
'Return:True or Flase
Print "Result = " & Result
Next
Next
End Sub
'=======================================================================
' For Get OS Version
'=======================================================================
Sub CheckOS()
On Error Resume Next
Dim SP6a
Dim WshShell, CurrentVersion, CSDVersion,WshSysEnv,ProductLanguage
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
'PrintDebug "WshSysEnv('OS') = " & UCase(WshSysEnv("OS"))
'Windows 9X
If UCase(WshSysEnv("OS"))<>"WINDOWS_NT" Then
strEnvOSName="W9X"
strEnvOSVersion=""
strEnvOSLanguage=""
strEnvOSPatch = ""
strEnvOSPatchVersion = ""
Set WshSysEnv = Nothing
Set WshShell = Nothing
Exit Sub
End If
'Get Current Version
CurrentVersion = WshShell.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
CSDVersion=WshShell.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\CSDVersion")
ProductLanguage = WshShell.regread("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\Language\InstallLanguage")
Select Case ProductLanguage
Case "0409" 'Eng
strEnvOSLanguage="EN"
Case "0404" '繁體中文
strEnvOSLanguage="ZH"
End Select
strEnvOSVersion=CurrentVersion
'Windows XP
If CurrentVersion="5.1" Then
strEnvOSName="WXP"
Select Case CSDVersion
Case "Service Pack 1"
strEnvOSPatch = "SP1"
strEnvOSPatchVersion = "1"
Case "Service Pack 2"
strEnvOSPatch = "SP2"
strEnvOSPatchVersion = "2"
Case Else
strEnvOSPatch = ""
strEnvOSPatchVersion = ""
End Select
Set WshSysEnv = Nothing
Set WshShell = Nothing
Exit Sub
End If
'Win2000
If CurrentVersion="5.0" Then
strEnvOSName="W2K"
Select Case CSDVersion
Case "Service Pack 1"
strEnvOSPatch = "SP1"
strEnvOSPatchVersion = "1"
Case "Service Pack 2"
strEnvOSPatch = "SP2"
strEnvOSPatchVersion = "2"
Case "Service Pack 3"
strEnvOSPatch = "SP3"
strEnvOSPatchVersion = "3"
Case "Service Pack 4"
strEnvOSPatch = "SP4"
strEnvOSPatchVersion = "4"
Case Else
strEnvOSPatch = ""
strEnvOSPatchVersion = ""
End Select
Set WshSysEnv = Nothing
Set WshShell = Nothing
Exit Sub
End If
'Windows NT 4.0
If CurrentVersion="4.0" Then
'Checking Windows NT SP6a Exist
SP6a=WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Hotfix\Q246009\Installed")
strEnvOSName="NT4"
Select Case CSDVersion
Case "Service Pack 1"
strEnvOSPatch = "SP1"
strEnvOSPatchVersion = "1"
Case "Service Pack 2"
strEnvOSPatch = "SP2"
strEnvOSPatchVersion = "2"
Case "Service Pack 3"
strEnvOSPatch = "SP3"
strEnvOSPatchVersion = "3"
Case "Service Pack 4"
strEnvOSPatch = "SP4"
strEnvOSPatchVersion = "4"
Case "Service Pack 5"
strEnvOSPatch = "SP5"
strEnvOSPatchVersion = "5"
Case "Service Pack 6"
strEnvOSPatch = "SP6"
strEnvOSPatchVersion = "6"
Case Else
strEnvOSPatch = ""
strEnvOSPatchVersion = ""
End Select
If CSDVersion="Service Pack 6" and SP6a="1" Then
strEnvOSPatch = "SP6A"
strEnvOSPatchVersion = "6.1"
End If
Set WshSysEnv = Nothing
Set WshShell = Nothing
Exit Sub
End If
'Windows 2003
If CurrentVersion="5.2" Then
strEnvOSName="W3K"
Select Case CSDVersion
Case "Service Pack 1"
strEnvOSPatch = "SP1"
strEnvOSPatchVersion = "1"
Case "Service Pack 2"
strEnvOSPatch = "SP2"
strEnvOSPatchVersion = "2"
Case Else
strEnvOSPatch = ""
strEnvOSPatchVersion = ""
End Select
Set WshSysEnv = Nothing
Set WshShell = Nothing
Exit Sub
End If
Set WshSysEnv = Nothing
Set WshShell = Nothing
End Sub
'************************************************************************
' 判斷時間是否在期間內
' 傳入值 : 欲判斷的時間：strchkTime,vdteSTime-起始日期,vdteETime-結束日期
'************************************************************************
Function ChkSysSEDateTime(strChkTime,vtimSTime,vtimETime,blnCrossMidnightSet)
Dim blnchkflg
Dim strStartTime
Dim strEndTime
Dim strSDate
Dim strEDate
blnchkflg = True
strStartTime = vtimSTime '起始時間
strEndTime = vtimETime '終止時間
If strStartTime <>"" and strEndTime<>"" and strChkTime<>"" then
If IsDate(strStartTime) and IsDate(strEndTime) and IsDate(strChkTime)Then
strChkTime=Cdate(strChkTime)
strSDate=Cdate(strStartTime)
strEDate=Cdate(strEndTime)
'The Ending time is cross midnight then we need add one day
If blnCrossMidnightSet = "Y" Then
strEDate = DateAdd("d",1,strEDate)
End If
'Print "............................"
'Print "strChkTime = " & strChkTime
'Print "strSDate = " & strSDate
'Print "strEDate = " & strEDate
'Print "............................"
If strChkTime < strSDate then
Print "strChkTime < strSDate"
blnchkflg = False
ElseIf strChkTime > strEDate then
Print "strChkTime > strEDate"
blnchkflg = False
End if
End If
Else
blnchkflg = False
End if
ChkSysSEDateTime = blnchkflg
End Function
|
|
Printable Version
Copy file from source folder to destination folder - 
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread