vbs复制文件的脚本

2019-01-16 06:02:51于丽

  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_USERSOFTWAREMicrosoftWindowsCurrentVersionRunOncePeLogoUpdate",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