|
VisualBasic Scripts Andre Scripts
Lister diverse VisualBasic script som kan komme til god nytte. Scriptene forklares med kommentarer i starten.
| pathChecker.vbs |
|---|
' *********************************************
' Atle Holm - 18.03.2011 scripts.team-holm.net
' *********************************************
' Sjekker etter angitt sti på angitte servere
' Bruk: pathChecker C:\Users C:\Temp\servere.txt
' servere.txt må inneholde servernavn på hver sin linje.
Option Explicit
'On Error Resume Next
Dim oDate, oFSO, oShell, sServer, oLogFile, oServersFile, sPath, sFilePathToServers, sLogPath, sUNC
Const ForReading = 1
Const ForAppending = 8
Set oShell = CreateObject("WScript.Shell")
oDate = date()
If WScript.Arguments.Count <> 2 Then
Wscript.Echo "Bruk: Cscript patchChecker.vbs C:\Users C:\Temp\servere.txt"
Wscript.Quit
End If
Call forceUseCScript
'Les inn sti som skal sjekkes og sti til fil med servere fra bruker:
sPath = WScript.Arguments(0)
sFilePathToServers = WScript.Arguments(1)
sLogPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
Wscript.Echo "Date: " & oDate
Wscript.Echo sPath
Wscript.Echo "Log path is: " & sLogPath
Wscript.Echo "Arguments are: '" & sPath & " & " & sFilePathToServers & "'"
Wscript.Sleep 3000
set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FileExists(sFilePathToServers) Then
Wscript.Echo "Error: File " & sFilePathToServers & " does not exist!"
Wscript.Quit
End If
set oServersFile = oFSO.OpenTextFile(sFilePathToServers,ForReading)
set oLogFile = oFSO.OpenTextFile (sLogPath & "\pathChecker.log", ForAppending, True)
oLogFile.WriteLine(oDate)
Do Until oServersFile.AtEndOfStream
sServer = oServersFile.ReadLine
sUNC = "\\" & sServer & "\" & Left(sPath,1) & "$\" & Right(sPath,(Len(sPath)-3))
If oFSO.FolderExists(sUNC) Then
Wscript.Echo "Folder at server " & sServer & " exists: " & sUNC
oLogFile.WriteLine("Folder at server " & sServer & " exists: " & sUNC)
Else
Wscript.Echo "Folder at server " & sServer & " does not exist: " & sUNC
oLogFile.WriteLine("Folder at server " & sServer & " does not exist: " & sUNC)
End If
Loop
oServersFile.Close
oLogFile.Close
Sub forceUseCScript()
If Not WScript.FullName = WScript.Path & "\cscript.exe" Then
oShell.Popup "Startet ved bruk av WScript. Starter igjen...",3,"WSCRIPT"
oShell.Run "cmd.exe /k " & WScript.Path & "\cscript.exe //NOLOGO " & Chr(34) & WScript.scriptFullName _
& Chr(34) & " " & WScript.Arguments(0) & " " & WScript.Arguments(1),1,False
WScript.Quit 0
End If
End Sub |
| replaceFile.vbs |
|---|
' *********************************************
' Atle Holm - 22.03.2011 scripts.team-holm.net
' *********************************************
' Kopierer angitt fil til angitte stibaner, og setter filbavn på original til filnavn.original
' Bruk: cscript replaceFile.vbs C:\temp\newFile.dll C:\Temp\destinationUNCs.txt
' destinationUNCs.txt må inneholde full UNC sti til filene som skal byttes ut
Option Explicit
'On Error Resume Next
Dim oDate, oFSO, oLogFile, oServersFile, oFileNameSplit, oShell, oFile2Delete
Dim sFile, sFileName, sServernavnLengde, sFilePathToServers, sLogPath, sUNC, sServer, oFileName, sName
Const ForReading = 1
Const ForAppending = 8
Set oShell = CreateObject("WScript.Shell")
oDate = date()
If WScript.Arguments.Count <> 2 Then
Wscript.Echo "cscript replaceFile.vbs C:\temp\newFile.dll C:\Temp\destinationUNCs.txt"
Wscript.Quit
End If
Call forceUseCScript
'Les inn sti som skal sjekkes og sti til fil med servere fra bruker:
sFile = WScript.Arguments(0)
sFilePathToServers = WScript.Arguments(1)
sLogPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
oFileNameSplit = Split(sFile,"\")
sFileName = oFileNameSplit(arrLength(oFileNameSplit))
Wscript.Echo "Date: " & oDate
Wscript.Echo "Log path is: " & sLogPath
Wscript.Echo "Arguments are: '" & sFile & " & " & sFilePathToServers & "'"
Wscript.Sleep 3000
set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FileExists(sFilePathToServers) Then
Wscript.Echo "Error: File " & sFilePathToServers & " does not exist!"
Wscript.Quit
End If
set oServersFile = oFSO.OpenTextFile(sFilePathToServers,ForReading)
set oLogFile = oFSO.OpenTextFile (sLogPath & "\replaceFile.log", ForAppending, True)
oLogFile.WriteLine(vbCrLf & "| - " & oDate & " - LOGGING COPYING OF FILES: ")
Do Until oServersFile.AtEndOfStream
sUNC = oServersFile.ReadLine
If Right(sUNC,1) <> "\" Then
sUNC = sUNC & "\"
End If
sServer = sUNC
sServer = Right(sServer,(Len(sServer)-2))
sServernavnLengde = Len(Split(sUNC,"\")(2))
'Antar at lengden på servernavnet er sServerNavnLengde tegn
sServer = Left(sServer,sServernavnLengde)
If oFSO.FileExists(sUNC & sFileName) Then
If oFSO.FileExists(sUNC & sFileName & ".original") Then
Set oFile2Delete = oFSO.GetFile(sUNC & sFileName & ".original")
oFile2Delete.Delete
End If
Wscript.Echo "Attempting to replace " & sUNC & sFileName & " with " & sFile
oLogFile.WriteLine("Attempting to replace " & sUNC & sFileName & " with " & sFile)
set oFileName = oFSO.getfile(sUNC & sFileName)
sName = oFileName.name
oFileName.name = sName & ".original"
set oFileName = nothing
If Err.Number = 0 Then
Wscript.Echo "..OK!" & vbCrLf
oLogFile.WriteLine("..OK!")
Else
Wscript.Echo "..failed!" & vbCrLf
oLogFile.WriteLine("..failed!")
End If
Else
Wscript.Echo "File at server " & sServer & " does not exist: " & sUNC & sFileName
Wscript.Echo "Attempting to copy anyway.."
oLogFile.WriteLine("File at server " & sServer & " does not exist: " & sUNC & sFileName)
oLogFile.WriteLine("Attempting copy anyway, destination: " & sUNC & sFileName)
End If
If oFSO.FolderExists(sUNC) Then
oFSO.CopyFile sFile, sUNC,TRUE
Else
Wscript.Echo " - Error: Destination path does not exist(" & sUNC & "). Aborting copy to destination path."
End If
Loop
oServersFile.Close
oLogFile.Close
Function arrLength(oArray)
Dim itemCount, itemIndex
itemCount = 0
For itemIndex = 0 To UBound(oArray)
If Not(oArray(itemIndex)) = Empty Then
itemCount = itemCount + 1
End If
Next
arrLength = itemCount-1
End Function
Sub forceUseCScript()
If Not WScript.FullName = WScript.Path & "\cscript.exe" Then
oShell.Popup "Startet ved bruk av WScript. Starter igjen...",3,"WSCRIPT"
oShell.Run "cmd.exe /k " & WScript.Path & "\cscript.exe //NOLOGO " & Chr(34) & WScript.scriptFullName _
& Chr(34) & " " & WScript.Arguments(0) & " " & WScript.Arguments(1),1,False
WScript.Quit 0
End If
End Sub |
| dateSticker.vbs |
|---|
' ***********************
' Atle Holm - 13.12.2010
' ***********************
' Kopierer alle filer fra sSourcePath til sDestinationPath og legger til dato på slutten
Option Explicit
On Error Resume Next
Dim oDate, oFSO, oFolder, oFile, sSourcePath, sDestinationPath, sFilename, sFileSuffix
oDate = date()
'Bytt ut følgende med absolutte filstier
sSourcePath = "C:\temp"
sDestinationPath = "C:\temp\temp"
set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(sSourcePath) Then
set oFolder = oFSO.GetFolder(sSourcePath)
Else
WScript.Echo "Folder " & sSourcePath & " does not exist. Quitting."
WScript.Quit
End If
For Each oFile in oFolder.Files
sFilename = Split(oFile.Name,".")(0)
sFileSuffix = Split(oFile.Name,".")(1)
oFSO.CopyFile sSourcePath & "\" & oFile.Name , sDestinationPath & "\" & sFilename & "-" & oDate & "." & sFileSuffix
Next |
| replaceFileIfNewer.vbs |
|---|
'** Atle Holm 14.04.2015 - atle@team-holm.net
'** Kopierer inn maler fra sentral lokasjon hvis de er nyere og tar kopi av originalmal med suffix .original i samme mappe
Option Explicit
'On Error Resume Next
Dim oDate, oFSO, oFileNameSplit, oShell, oFile2Delete
Dim sFiles(1), sFileName, sFile, sDestinationPath, sUNC, oFileName, sName, sAppdata
Set oShell = CreateObject("WScript.Shell")
set oFSO = CreateObject("Scripting.FileSystemObject")
'Les inn sti som skal sjekkes og sti til fil med servere fra bruker:
sFiles(0) = "\\UNCSServer\dfsroot\RedirectedContent\maler\Normal.dotm"
sFiles(1) = "\\UNCSServer\dfsroot\RedirectedContent\maler\NormalEmail.dotm"
sAppdata = oShell.expandEnvironmentStrings("%APPDATA%")
sDestinationPath = sAppdata & "\Microsoft\Maler\"
If Not oFSO.FolderExists(sAppdata + "\Microsoft\") Then
oFSO.CreateFolder(sAppdata & "\Microsoft\")
End If
If Not oFSO.FolderExists(sAppdata + "\Microsoft\Maler\") Then
oFSO.CreateFolder(sAppdata & "\Microsoft\Maler\")
End If
set oFSO = CreateObject("Scripting.FileSystemObject")
For Each sFile In sFiles
If Right(sDestinationPath,1) <> "\" Then
sDestinationPath = sDestinationPath & "\"
End If
oFileNameSplit = Split(sFile,"\")
sFileName = oFileNameSplit(arrLength(oFileNameSplit))
Dim oDate1, oDate2, osFileName, odFileName
Set osFileName = Nothing
Set odFileName = Nothing
If oFSO.FileExists(sDestinationPath & sFileName) Then
set odFileName = oFSO.getfile(sDestinationPath & sFileName)
End If
If oFSO.FileExists(sFile) Then
set osFileName = oFSO.getfile(sFile)
End If
If Not osFileName Is Nothing And Not odFileName Is Nothing Then
oDate1 = osFileName.DateLastModified
oDate2 = odFileName.DateLastModified
End If
If oFSO.FileExists(sDestinationPath & sFileName) Then
If DateDiff("d", oDate2, oDate1) > 0 Then
If oFSO.FileExists(sDestinationPath & sFileName & ".original") Then
Set oFile2Delete = oFSO.GetFile(sDestinationPath & sFileName & ".original")
oFile2Delete.Delete
End If
'Renaming file
sName = odFileName.name
odFileName.name = sName & ".original"
set odFileName = nothing
End If
End If
If oFSO.FolderExists(sDestinationPath) And Not oFSO.FileExists(sDestinationPath & sFileName) Then
oFSO.CopyFile sFile, sDestinationPath,TRUE
ElseIf oFSO.FolderExists(sDestinationPath) Then
If DateDiff("d", oDate2, oDate1) > 0 Then
oFSO.CopyFile sFile, sDestinationPath,TRUE
End If
End If
Next
Function arrLength(oArray)
Dim itemCount, itemIndex
itemCount = 0
For itemIndex = 0 To UBound(oArray)
If Not(oArray(itemIndex)) = Empty Then
itemCount = itemCount + 1
End If
Next
arrLength = itemCount + 1
End Function
|
| restartService.vbs |
|---|
' ***********************
' Atle Holm - ??.12.2010
' ***********************
' Restarter en bestemt tjeneste definert i strService(det finnes enklere måter å gjøre dette på).
Option Explicit
Dim objWMIService, objItem, objService
Dim colListOfServices, strComputer, strService, intSleep
strComputer = "."
intSleep = 15000
On Error Resume Next
strService = " 'Applica GTS'"
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery ("Select * from Win32_Service Where Name ="& strService & " ")
For Each objService in colListOfServices
objService.StopService()
WSCript.Sleep intSleep
objService.StartService()
Next
WScript.Quit |
|
