vbs复制文件的脚本

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)

经过最近的需要写出了如下代码，可以判断文件是否更新并且文件大小更大

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 "成功"&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

下面来个功能更多的代码：

wscript.sleep 65000
dim strauditpath,fsog,findex,strlocalfolders,strreadfolders,indexpath,flmdate,crtdate,strlocalpath,i,computername,cell,pathformat,clect,aleart1,alearb
main()
'""""""""""""""""""""sub""""""""""""
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
'***************计算本地format****************************************************************************
' getformat
'**************************************************************************************************************
'在这里一个循环比较日志更新日期
do while(1)
   if (fsog.fileexists(indexpath)) then
    '指出最近更新时间
   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(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(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(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(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复制文件夹

需要实现一个复制文件夹的功能，网上找到相关代码，并做了改进，vbs脚本如下

dim fso, copycount
set fso = createobject("scripting.filesystemobject")

copycount = copycount + xcopy(fso, ".\1", ".\2", true)
msgbox "拷贝了" & copycount & "个文件!"

'********************************************************************
'* function :     xcopy
'*
'* purpose:  复制文件和目录树。
'*
'* input:    fso            filesystemobject 对象实例
'*           source         指定要复制的文件。
'*           destination    指定新文件的位置和/或名称。
'*           overwrite      是否覆盖已存在文件。 ture 覆盖， false 跳过
'*
'* output:   返回复制的文件个数
'*
'********************************************************************
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

在脚本文件路径建立一个文件夹，取名1，放入两个文件，运行程序结果如下