Copy Code code as follows:
ParentFolder = "C:\"
SourceFile = "C:\windows\log.log"
TargetFolder = parentfolder & date & "\"
Set Objshell = CreateObject ("Shell.Application")
Set objfolder = Objshell.namespace (ParentFolder)
Objfolder.newfolder Date
Set So=createobject ("Scripting.FileSystemObject")
So.getfile (sourcefile). Copy (TargetFolder)
After the recent need to write the following code to determine whether the file is updated and the file size is larger
Copy Code code as follows:
Dim FSO
Set fso = CreateObject ("Scripting.FileSystemObject")
Set FN2=FSO. GetFile ("c:\index2.htm")
Flsize2=fn2.size
Fldate2=fn2.datelastmodified
Set FN=FSO. GetFile ("c:\index.htm")
Flsize1=fn.size
Fldate1=fn.datelastmodified
If FSO. FileExists ("c:\index2.htm") and flsize2>50000 and Fldate2>fldate1 Then
Fso.getfile ("c:\index2.htm"). Copy ("C:\index.htm")
If Err.number=0 then WriteHistory "Success" &now (), "Log.txt"
End If
Sub writehistory (hischars, Path)
Const ForReading = 1, ForAppending = 8
Dim FSO, F
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso. OpenTextFile (Path, ForAppending, True)
F.writeline Hischars
F.close
End Sub
Here's a more functional code:
Copy Code code as follows:
Wscript.Sleep 65000
Dim Strauditpath,fsog,findex,strlocalfolders,strreadfolders,indexpath,flmdate,crtdate,strlocalpath,i, Computername,cell,pathformat,clect,aleart1,alearb
Main ()
"" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "
Sub Main ()
Aleart=formatdatetime (Now (), 4)
Alearb=false
Flmdate=cdate ("01, 31, 1980")
Clect=false
Computername=getcomputername ()
Set fsog=createobject ("Scripting.FileSystemObject")
GetSetting
' Pathformat=left (Strlocalpath,len (Strlocalpath) -8) & "Labels"
Indexpath=strauditpath & "Index.txt"
Set F=FSOG. OpenTextFile (Getabpath (Strauditpath) & "logo history.txt", 8,true)
F.writeline FormatDateTime (Now (), 4) & "\" & Cell & "\" & ComputerName
F.close
' *************** compute local format****************************************************************************
' GetFormat
'**************************************************************************************************************
' Here's a loop compare log update date
Do while (1)
If (Fsog.fileexists (indexpath)) Then
' Indicates the latest update time
Set Findex=fsog.getfile (Indexpath)
Crtdate=findex.datelastmodified
If Flmdate < Crtdate Then
Strreadfolders=readlinetextfile (Indexpath)
Strlocalfolders=showfolderlist (Strlocalpath)
Dowithchange
Flmdate = Crtdate
End If
End If
"' **********update vbs*****
' If (fsog.fileexists getabpath (strauditpath) & "Pe.vbs") Then
' Fsog. CopyFile Getabpath (Strauditpath) & "Pe.vbs", Getabpath (Getcpath) & "Pe.vbs"
' End If
'***************************
' End If
'***************************************
If Hour (FormatDateTime (Now (), 4)) >=hour (TimeValue ("11:00:00")) and Hour (The FormatDateTime (now (), 4)) <=hour ( TimeValue ("12:00:00")) Then
Alearb=true
End If
If Hour (FormatDateTime (Now (), 4)) >=hour (TimeValue ("15:00:00")) and Hour (The FormatDateTime (now (), 4)) <=hour ( TimeValue ("14:00:00")) Then
Alearb=true
End If
If Hour (FormatDateTime (Now (), 4)) >=hour (TimeValue ("7:00:00")) and Hour (The FormatDateTime (now (), 4)) <=hour ( TimeValue ("8:00:00")) Then
Alearb=true
End If
' Test
If Hour (FormatDateTime (Now (), 4)) >=hour (TimeValue ("11:00:00")) and Hour (The FormatDateTime (now (), 4)) <=hour ( TimeValue ("12:00:00")) Then
Alearb=true
End If
If Alearb=true Then
If hour (FormatDateTime (now (), 4))-hour (Aleart) >1 Then
MsgBox "Pls Compress the NLPV and restart the computer"
Else
Alearb=false
End If
End If
Wscript.Sleep 10000
Loop
End Sub
Sub GetFormat ()
Strformats=showfileslist (Pathformat)
Const ForReading = 1, ForWriting = 2
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso. OpenTextFile (Getabpath (strauditpath) & CELL & "" & ComputerName & ". txt", ForWriting, True)
For i=0 to UBound (strformats)
F.writeline Left (Strformats (i), Len (Strformats (i))-4)
Next
F.writeline cell
F.writeline ComputerName
'
F.close
Clect =true
End Sub
Function showfileslist (FOLDERSPEC)
Dim FSO, F, F1, S (), sf,i
I=0
ReDim S (i)
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso. GetFolder (FOLDERSPEC)
Set FC = F.files
For each F1 in FC
ReDim Preserve S (i)
S (i) = F1.name
I=i+1
Next
Showfileslist=s
End Function
Function showfolderlist (FOLDERSPEC)
Dim FSO, F, F1, S (), sf,i
I=0
ReDim S (i)
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso. GetFolder (FOLDERSPEC)
Set SF = f.subfolders
For each F1 in SF
ReDim Preserve S (i)
S (i) = F1.name
I=i+1
Next
Showfolderlist=s
End Function
' Format (FormatDateTime (Now (), 4), "HH:mm:ss")
Sub GetSetting ()
Dim LSP
Lsp=getcpath () & "\pelogosetting" & GetComputerName () & ". txt"
If (not fsog.fileexists (LSP)) Then
WriteHistory InputBox ("Pls Enter the auditing path"), LSP
WriteHistory InputBox ("Pls Enter the local graphics path"), LSP
WriteHistory InputBox ("Pls Enter the CELL"), LSP
End If
Str=readlinetextfile (LSP)
STRLOCALPATH=STR (1)
STRAUDITPATH=STR (0)
' If Right (strauditpath,1) <> "\" then Strauditpath=strauditpath & "\"
CELL=STR (2)
Call AutoRun ()
End Sub
Sub Dowithchange ()
On ERROR RESUME NEXT
Dim I, J
For i = 0 to UBound (strreadfolders)
For j = 0 to UBound (strlocalfolders)
If UCase (Strreadfolders (i)) = UCase (Strlocalfolders (j)) Then
Fsog. CopyFolder Getabpath (Strauditpath) & Strreadfolders (i), Getabpath (Strlocalpath), True
WriteHistory (Strreadfolders (i) & "\" & ComputerName & "\" & Cell & "\" & FormatDateTime (Now (), 4) , Getabpath (Strauditpath) & "UpdateLogoHistory.txt"
End If
Next
Next
End Sub
Sub writehistory (hischars, Path)
Const ForReading = 1, ForAppending = 8
Dim FSO, F
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso. OpenTextFile (Path, ForAppending, True)
F.writeline Hischars
F.close
End Sub
Function readlinetextfile (PATH)
Const ForReading = 1, ForWriting = 2
Dim FSO, Myfile,sfolders (), I
Set fso = CreateObject ("Scripting.FileSystemObject")
I=0
ReDim Sfolders (i)
Set MyFile = fso. OpenTextFile (Path, ForReading)
Do While Myfile.atendofline <> True
ReDim Preserve Sfolders (i)
Sfolders (i) = Myfile.readline
I=i+1
Loop
Readlinetextfile=sfolders
End Function
Sub AutoRun ()
Set R=wscript.createobject ("Wscript.Shell")
Yuan = Wscript.scriptfullname
R.regwrite "Hkey_current_user\software\microsoft\windows\currentversion\runonce\pelogoupdate", Yuan
End Sub
Function Getabpath (PATH)
If Right (path, 1) <> "\" Then
Getabpath = path & "\"
Exit Function
End If
Getabpath = Path
End Function
Function GetComputerName ()
Dim A
Set A = CreateObject ("Wscript.Network")
Getcomputername= A.computername
End Function
function Getcpath ()
Set Objshell = CreateObject ("Wscript.Shell")
strpath = Wscript.scriptfullname
Set objFSO = CreateObject ("Scripting.FileSystemObject")
Set objfile = Objfso.getfile (strpath)
Getcpath = Objfso.getparentfoldername (objfile)
End Function
VBS Replication Folder
Need to implement a copy folder function, the Internet to find the relevant code, and made improvements, the VBS script is as follows
Copy Code code as follows:
Dim FSO, Copycount
Set fso = CreateObject ("Scripting.FileSystemObject")
Copycount = Copycount + XCopy (FSO, ". \1", ". \2", True)
MsgBox "Copy" & Copycount & "Files!"
'********************************************************************
' * function:xcopy
'*
' * Purpose: Copy files and directory trees.
'*
' * Input:fso FileSystemObject object instance
' * source Specifies the file to copy.
' * destination Specifies the location and/or name of the new file.
' * Overwrite whether to overwrite existing files. Ture Overwrite, False skip
'*
' * Output: Returns the number of copied files
'*
'********************************************************************
Function XCopy (FSO, source, destination, overwrite)
Dim S, D, F, L, Copycount
Set s = fso. GetFolder (source)
If not FSO. FolderExists (destination) Then
Fso. CreateFolder destination
End If
Set d = fso. GetFolder (destination)
Copycount = 0
For each F in s.files
L = d.path & "\" & F.name
If not FSO. FileExists (l) Or overwrite Then
If FSO. FileExists (L) Then
Fso. DeleteFile L, True
End If
F.copy L, True
Copycount = Copycount + 1
End If
Next
For each F in s.subfolders
Copycount = Copycount + XCopy (FSO, F.path, D.path & "\" & F.name, Overwrite)
Next
XCopy = Copycount
End Function
In the script file path to create a folder, named 1, put two files, run the program results are as follows
