Distrib2Folder.vbs

Das Skript Distrib2Folder.vbs habe ich für eine spezielle Aufgabe entwickelt.

Per Scheduler erstelle ich regelmäßig für jeden Server eine HTML-Datei mit umfangreichen Informationen, die aus WMI- und anderen Abfragen gewonnen werden. Diese Servername.html Dateien sollen nun in einer Ordnerstruktur unterbracht werden, aus der eine Oracle Datenbank wiederem Daten zu jedem Server bezieht. Für jeden Server gibt es irgendwo in der Ordnerstruktur einen Ordner mit dem Namen Servername.
Die Aufgabe bestand für mich nun darin, dass die von meinem Skript erzeugten HTMl-Dateien in die passenden Ordner verteilt werden müssen. Und diese Aufgabe erledigt das Skript Distrib2Folder.vbs.

Obwohl für eine spezielle Aufgabe entwickelt, lässt sich das Skript leicht an ähnliche Anforderungen anpassen.

'********************************************************************
'* File: Distrib2Folder.VBS
'* Created: 05/2007 by Manfred.Paleit
'* Version: 1.0
'*
'* Main Function: Die Servername.html Dateien, die mit SrvWatch.vbs
'* erzeugt werden, sollen im (Base) Verzeichnis \\...\
'* in die entsprechenden Server Folder kopiert werden.
'*
'*******************************************************************
Option Explicit
On ERROR RESUME Next

' Const
CONST CONST_FOR_APPENDING    = 8
CONST CONST_FOR_WRITING        = 2
CONST CONST_FOR_READING        = 1
CONST CONST_ERROR             = 0
CONST CONST_WSCRIPT             = 1
CONST CONST_CSCRIPT             = 2


Dim WshShell,WshFso, strBaseF, strMap, strPathToScript, strLogfile, strServerLogF, SrvFile, SrvName
Dim oLogFile, oBaseF, oServerLogF, oFilesInServerLogF
Dim i, erg, cmd, ret, aSrvDict, aSrvDictKeys, aSrvDictValues, aFolderDict, aFldrDictKeys, aFldrDictValues

strBaseF = "\\YourServer\BaseFolder\Folder"
strPathToScript = Left(WScript.ScriptFullName,(Len(WScript.ScriptFullName) - (Len(WScript.ScriptName) + 1))) & "\"
strLogfile = strPathToScript & Mid(WScript.ScriptName,1, InStr(1,WScript.ScriptName,".")-1) & ".log"
strServerLogF = strPathToScript & "ServerHTM" 'Hier liegen die Servername.html Files"
strMap = "z:" 'ggfls. anpassen

' preset variables
Set WshShell = CreateObject("Wscript.Shell")
Set WshFso = CreateObject("Scripting.FileSystemObject")
Set aSrvDict = CreateObject("Scripting.Dictionary")
Set aFolderDict = CreateObject("Scripting.Dictionary")


'********************************
'* Main
'********************************
err.clear
CheckHostScript()
Set oLogFile = WshFso.OpenTextFile(strLogfile, 2, True)
If Err.Number Then
    PrintLog() -1, "ERROR Fileobject at Set oLogFile = WshFso.OpenTextFile(" & strLogfile & ")"
    wscript.quit
End If

PrintLog 0, "Start: " & Now()

Set oServerLogF = WshFso.GetFolder(strServerLogF)
If Err.Number Then
    PrintLog Err.Number, vbTAB & "ERROR Set oServerLogF = WshFso.GetFolder(" & strServerLogF & ")"
    wscript.quit
End If

cmd = "cmd /c net use " & strMap & " " & strBaseF
erg = WshShell.Run(cmd,0,true)
If Err.Number or erg Then
    PrintLog Err.Number, vbTAB & erg & " - ERROR WshShell.Run(" & cmd & ",0,true)"
    wscript.quit
End If

Set oBaseF = WshFso.GetFolder(strMap)
If Err.Number Then
    PrintLog Err.Number, vbTAB & "ERROR Set oBaseF = WshFso.GetFolder(" & strBaseF & ")"
    wscript.quit
End If

Set oFilesInServerLogF = oServerLogF.Files
If Err.Number Then
    PrintLog Err.Number, vbTAB & "ERROR Set oFilesInServerLogF = oServerLogF.Files"
    wscript.quit
End If

If oFilesInServerLogF.Count <> 0 Then
    PrintLog -1, "Generating Server Dictionary - please wait ..."
    Call CreateServerDict()
Else
    PrintLog 0, "Keine Dateien in " & strServerLogF
    wscript.quit
End If

PrintLog -1, vbCRLF & "Generating Folder Dictionary for " & strBaseF & " - please wait ..."
Call RecurseFolder(oBaseF)

aSrvDictKeys = aSrvDict.Keys
aFldrDictKeys = aFolderDict.Keys
aSrvDictValues = aSrvDict.Items
aFldrDictValues = aFolderDict.Items

Dim copyDest
PrintLog -1, vbCRLF & "Compare Server and Folder Dictionary - please wait ..."
err.clear
For i = 0 To aSrvDict.Count -1
    SrvName = aSrvDictKeys(i)
    SrvFile = aSrvDictValues(i)
    copyDest= EnumFolderDict(SrvName)
    If copyDest = "" Then
        PrintLog 0, SrvName & ": No Destination Folder found to copy "
    Else
        PrintLog -1, "Try to copy: " & SrvFile & " -to- " & copyDest
        cmd = "cmd /c copy " & SrvFile & " " & copyDest & " /y"
        erg = WshShell.Run(cmd,0,true)
        If not Err.Number Then
            PrintLog 0, SrvName & ": " & SrvFile & " - " & copyDest
        Else
            PrintLog Err.Number, SrvName & ": " & erg & " - ERROR WshShell.Run(" & cmd & ",0,true)"
            err.clear
        End If
    End If
Next
Printlog 0, "End: " & Now()
cmd = "cmd /c net use " & strMap & " /d"
erg = WshShell.Run(cmd,0,true)
wscript.quit
'********************************
'* End Main
'********************************


'********************************
'* Sub CreateServerDict()
'* Purpose:    generate Array for Serverfiles
'********************************
Private Sub CreateServerDict()
    On ERROR Resume Next
    Dim pos, aTemp, strTemp

    For Each SrvFile In oFilesInServerLogF
        pos = InStrRev(SrvFile, "\") 'Position letzter Backslash
        strTemp = Mid(SrvFile,pos+1) 'Servername.html
        aTemp=Split(strTemp,".") 'Split in Servername und html
        If LCase(aTemp(1)) = "html" Then
            Printlog -1, aTemp(0) & ": " & SrvFile
            aSrvDict.Add UCase(aTemp(0)), SrvFile 'Servername und Filepath
        End If
    Next
End Sub


'********************************
'* Sub RecurseFolder()
'* Purpose:    generate Array for Serverfiles
'********************************
Private Sub RecurseFolder(BaseFolder)
    On ERROR Resume Next
    Dim Folder, Folders
    Dim pos, strFldrName

    Set Folders = BaseFolder.SubFolders
    If Folders.Count <> 0 Then
        For Each Folder In Folders
            PrintLog -1, vbCRLF & Folder
            pos = InStrRev(Folder, "\") 'Position letzter Backslash
            strFldrName = Mid(Folder,pos+1)
            PrintLog -1, vbTab & strFldrName & ": " & Folder & "\"
            aFolderDict.Add UCase(strFldrName), Folder & "\" 'Servername und Folderpath
            Call RecurseFolder(Folder)
        Next
    End If
End Sub


'********************************
'* Function EnumFolderDict()
'* Purpose:    Enum Folder Dictionary
'* Input:    Servername
'* Output:    Destinationfolder if found in Dictionary or "" if not
'********************************
Function EnumFolderDict(ByVal strServer)
    On ERROR Resume Next
    Dim cmd, i, strFolderPath, strFolderName
    
    EnumFolderDict = ""

    For i = 0 To aFolderDict.Count -1
        strFolderName = aFldrDictKeys(i)
        strFolderPath = aFldrDictValues(i)
        PrintLog -1, vbTAB & "Compare: " & strServer & " - " & strFolderName
        If strFolderName = strServer Then
            EnumFolderDict = strFolderPath
            Exit For
        End If
    Next
End Function


Hinweis zum Skript:

Im Skript werden mit Set aSrvDict = CreateObject("Scripting.Dictionary") und Set aFolderDict = CreateObject("Scripting.Dictionary") zwei Dictionaries erzeugt. Ein Dictionary ist vergleichbar einem Perl Hash oder assoziativen Array, mit einem Key / Value Paar.

Das Skript prüft zuerst über VerifyHostScript(), ob als Scripting Host cscript.exe eingestellt ist und erzeugt dann ein Handle für die Ausgabe über PrintLog().
Die folgenden Zeilen will ich nicht weiter kommentieren, sondern gleich mit einer Beschreibung der Funktion CreateServerDict() fortfahren. In dieser Funktion wird das Verzeichnis, in dem die Servername.html Dateien liegen, durchlaufen und für jede gefundene Datei wird ein Eintrag im Server Dictionary aSrvDict gemacht.
Mit aSrvDict.Add UCase(aTemp(0)), SrvFile wird ein Key / Value Paar ins Server Dictionary geschrieben, wobei der Servername den Key und der Pfad zur Servername.html Datei den Value darstellt.

In der Funktion RecurseFolder() wird ausgehend vom fest definierten BaseFolder, jeder Subfolder rekursiv durchlaufen. Für jeden Folder wird ein Eintrag im Folder Dictionary aFolderDict gemacht.
Mit aFolderDict.Add UCase(strFldrName), Folder & "\" wird ein Key / Value Paar ins Folder Dictionary geschrieben, wobei der Foldername den Key und der komplette Pfad zum Folder den Value darstellt. Da nicht bekannt ist, wieviele Ordner und Unterordner vorhanden sind, werden alle Verzeichnisse ab dem BaseFolder mit Call RecurseFolder(Folder) rekursiv durchlaufen.

Wir haben jetzt zwei assoziative Arrays, einmal für die Servername.html Dateien und einmal für die Folderstrukturen. Diese beiden Arrays können wir jetzt in der Funktion EnumFolderDict() vergleichen.
In einer Loop wird dazu jeder Servername aus dem Server Dictionary gelesen und an die Funktion EnumFolderDict(ByVal strServer) als Parameter übergeben. Diese Funktion liefert entweder einen Leerstring oder den kompletten Pfad zum Serverfolder zurück.
Jetzt wissen wir wohin unser Servername.html File kopiert werden soll.

Ohne dieses assoziative Arrays, müsste für jede Servername.html Datei jeder Folder unterhalb vom BaseFolder durchsucht werden, ob ein Verzeichnis "Servername" vorhanden ist. Das dauert bei vielen Dateien und vielen Ordner sehr lange.


Download Distrib2Folder.vbs

Scripting Basics