vbs复制文件的脚本_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,放入两个文件,运行程序结果如下

时间: 2024-08-02 03:34:50

vbs复制文件的脚本_vbs的相关文章

vbs复制文件夹的实现代码_vbs

需要实现一个复制文件夹的功能,网上找到相关代码,并做了改进,vbs脚本如下 复制代码 代码如下: Dim fso, CopyCountSet fso = CreateObject("Scripting.FileSystemObject") CopyCount = CopyCount + XCopy(fso, ".\1", ".\2", True)MsgBox "拷贝了" & CopyCount & "

用vbs判断系统补丁的脚本_vbs

  Set objSession = CreateObject("Microsoft.Update.Session") Set objSearcher = objSession.CreateUpdateSearcher Set objResults = objSearcher.Search("Type='Software'") Set colUpdates = objResults.Updates For i = 0 to colUpdates.Count - 1

自动复制U盘文件的VBS脚本_vbs

以下为演示: 一.设置 右键单击,选择编辑 oStr = "txt|jpg|doc" '你要窃取的文件类型,可以自行添加,用"|"隔开 oDistPath = "C:\\windows\\system\\" '保存路径 oFolderName = "Task" '保存文件夹名称 oType = 0 '将保存的文件夹进行伪装 1为task文件夹,2为recycler文件夹,0为不伪装 oOut = 1 '1复制完毕后退出,0复制

利用wscript执行文件[包括可执行exe文件]vbs脚本_vbs

昨天下载并且安装了Updater Application Block后,需要执行一个Deploy.vbs的文件,鄙人才疏学浅,这个小问题竟然也花费了我不少心机. 现在把结论共享一下. 首先,我的vbs文件关联已经被"豪杰"夺取了.我双击Deploy.vbs就会打开豪杰,比较郁闷.但是我用了打开方式,试了浏览器.cmd,都无济于事. 今天,我想到这个问题后,就有想法去Microsoft的News Group上去问一问.然后又去了CSDN的全文检索.果然很争气,我的关键字只是vbs,执行,

EXE2BAT(EXE转BAT)的vbs脚本_vbs

exe2bat的脚本 复制代码 代码如下: fp=wscript.arguments(0) fn=right(fp,len(fp)-instrrev(fp,"")) with createobject("adodb.stream") .type=1:.open:.loadfromfile fp:str=.read:sl=lenb(str) end with sll=sl mod 65536:slh=sl65536 with createobject("sc

使用vbs下载文件的代码加强版_vbs

说到使用vbs下载文件是不是想到了XMLHTTP呢,呵呵,以下是比较经典的代码: iLocal=LCase(Wscript.Arguments(1)) iRemote=LCase(Wscript.Arguments(0)) Set xPost=createObject("Microsoft.XMLHTTP") xPost.Open "GET",iRemote,0 xPost.Send() set sGet=createObject("ADODB.Strea

Shell脚本实现复制文件到多台服务器的代码分享_linux shell

在多机集群环境中,经常面临修改配置文件后拷贝到多台服务器的情况,传统的执行scp比较麻烦,所以写了以下shell脚本,可以将指定文件拷贝到多台机器. 使用方法请参见HELP部分代码. #!/bin/bash help() { cat << HELP --------------HELP------------------------ This shell script can copy file to many computers. Useage: copytoall filename(ful

用vbs 取得收藏夹里的所有链接名称和URL的脚本_vbs

另外,可以考虑在输出的时候将链接输出成超链接形式,输出文件改为html文件.GetFavorites.vbs: 复制代码 代码如下: '=================================================================== Const FAVORITES = &H6& Const ForWriting = 2 Set objShell = CreateObject("shell.application") Set objF

ASP.NET Core MVC压缩样式、脚本及总是复制文件到输出目录

前言 在.NET Core之前对于压缩样式文件和脚本我们可能需要借助第三方工具来进行压缩,但在ASP.NET MVC Core中则无需借助第三方工具来完成,本节我们来看看ASP.NET Core MVC为我们提供了哪些方便. 自动压缩样式和脚本 当我们在测试环境中肯定不需要压缩脚本的,如果一旦压缩脚本的话,若在控制台出现错误不利于我们调试,但是在生产环境中我们通过压缩脚本或者样式一来可以减少传输流量,二来可以加速页面加载时间,换句话说,此时我们需要测试环境和生产环境对应的原生版本和压缩版本,那么