Hope This Helps - VBS / WSH

Robocopy - LOG Funktion - Umlaute Problem - XP010 und XP027

nospam@example.com (Christopher Pope) — Wed, 13 Mar 2013 11:40:58 +0100

Problem :
Wenn man ein Logfile von Robocopy erstellen lässt sind Umlaute nicht richtig kodiert, eine richtige Kodierung ist jedoch erforderlich wenn man das Logfile weiter verarbeiten möchte.
EDIT : Das selbe Problem ist mir jetzt auch bei DIR und TREE aufgefallen

Lösung :
Bestimmt gibt es hier viele Wege um dieses Problem zu lösen ich habe micht mit dieser Funktion beholfen :

Function ReplaceSonder(Line)

Line = Replace(Line,Chr(142),"Ä")
Line = Replace(Line,Chr(132),"ä")
Line = Replace(Line,Chr(154),"Ü")
Line = Replace(Line,Chr(129),"ü")
Line = Replace(Line,Chr(153),"Ö")
Line = Replace(Line,Chr(148),"ö")
Line = Replace(Line,Chr(225),"ß")

ReplaceSonder = Line
End Function

Sollten dennoch noch Zeichen in dem Logfile stehen die nicht richtig dargestellt werden kann der CharacterSet mit z.B. ASC("@") ermittelt und die Function nach belieben erweitert werden.

Bilder auf Fileserver über VBS mit ImageMagick automatisch verkleinern

nospam@example.com (Christopher Pope) — Thu, 22 Nov 2012 16:20:41 +0100

Problem :

Welcher Admin kennst das nicht , die Benutzer machen Bilder mit einer 12 MP Kamera und legen die Bilder auch in dieser Auflösung auf dem Fileserver ab. Sicherlich ist das in dem einen oder anderen Fall sinnvoll , jedoch nicht immer. In meinem Fall ist es nicht nötig die Bilder in der höchsten Auflösung zu speichern da diese weder ausgedruckt noch weiterverarbeitet werden. Um die Dateigröße von Anfang an auf ein erträgliches Maß zu reduzieren habe ich dieses Skript erstellt. Es verwendet Imagemagick und benötigt eine Installation auf dem Rechner auf dem das Skript laufen soll.
Dieses Skript läuft bei mir einmal in der Woche um alle Bilder im Ordner und allen Unterordnern zu verkleinern. Es wird ein rekursiver Dateidurchlauf auf die definierte Erweiterung ausgeführt

Dieses Skript stellt folgende Parameter bereit

------------------------------------------------------------------------------------------
-q: = Quelle zum Startordner
-e: = Welche Datei Typen sollen konvertiert werden
-s: = Auflösung der Konvertierten Bilder
-j: = Qualität für die Output Bilder (JPG 1-100 , PNG 1-9)
-l: = Schreibt ein Logfile mit an den angegeben Ort
wenn kein Wert übergeben wird , wird kein Logfile erzeugt
------------------------------------------------------------------------------------------

Download :

ImageMagick
konvPic.vbs

Erklärung :

Um über ImageMagick zu konvertieren muss folgendes Object instanziert werden.

Dim ObjImg : Set ObjImg = CreateObject("ImageMagickObject.MagickImage.1")

Dies kann dann so angesprochen werden.

ObjImg.Convert QUELLDATEI , "-resize" , AUFLÖSUNG , "-format" , "jpg" , "-quality" , QUALITÄT , ZIELDATEI

man kann auch anstelle von ObjImg.Convert die Funktion ObjImg.Mogrify verwenden. Der Unterschied zwischen .Convert und .Mogrify liegt darin das .Convert eine neue Datei anlegt und .Mogrify die vorhandene überschreibt.

Sollte ein Fehler auftreten das das ActiveX Element nicht erstellt werden kann liegt das daran das entweder die falsche Imagemagick Version installiert ist oder das Skript über den Pfad C:\Windows\SysWOW64\cscript.exe gestartet werden muss.

VBS / WSH Funktion um Array zu füllen

nospam@example.com (Christopher Pope) — Wed, 17 Oct 2012 17:43:09 +0200

Problem :
Man möchte ein Array erstellen und das mehrmals im Skript mit einer ReDim Anweisung

Lösung :
Um den ganzen Code nicht immer in die Länge zu ziehen hier eine Funktion

Aufruf :
Davor muss ein Array definiert sein dann kann man die Funktion mit einer Textdatei als Parameter starten.
Die Textdatei wird dann zeilenweise eingelesen und das Array wird erstellt.

Dim TestArray : TestArray = Array()
TestArray = FillArray(Beispieldatei)

Funktion :

Function FillArray(CFG)
   Dim ARRCnt : ARRCnt = 0
   Dim ARR : ARR = Array()
     If ObjFso.FileExists(CFG) Then
      Set Dummy = ObjFso.OpenTextFile(CFG)
       Do Until Dummy.AtEndOfStream
        Zeile = Trim(Dummy.ReadLine)
        If Not Left(Zeile,1) = "#" Then
         ReDim Preserve ARR(UBound(ARR)+1)
         ARR(ARRCnt) = Zeile
         ARRCnt = ARRCnt + 1
        End If
       Loop
     End If
    FillArray = ARR
    Set Dummy = Nothing
    Erase ARR
   End Function

Windows XP / 7 - VpnApp

nospam@example.com (Christopher Pope) — Thu, 09 Feb 2012 10:05:52 +0100

Es gibt immer wieder Benutzer die nicht verstehen das Sie erst in VPN eingewählt sein müssen um Anwendungen aus dem Firmennetz zu starten. Um dieses Problem etwas zu mildern hab ich ein kleines Programm geschrieben das es den Benutzer noch einfacher machen soll.

Zur Benutzung des Programmes gibts nicht viel zu sagen , es wird überprüft ob eine IP oder ein Hostname erreichbar ist , ist dies nicht der Fall wird der VPN Client gestartet. Nach dem erfolgreichen Einwählen wird die Anwendung aus dem internen Netz gestartet.

Die Konfigurationsdatei enthällt folgende Parameter :

Server="IP ODER HOSTNAME"
VpnClient="PFAD ZUM VPN CLIENT"
AppToStart="ANWENDUNG DIE GESTARTET WERDEN SOLL"
CntPi=1
MaxTry=3

CntPi=1

Count Ping wie oft soll der Server gepingt werden um eine Verbindung zu diesem zu überprüfen , default ist hier 1 bei schlechten Verbindungen kann dieser Wert erhöht werden. Allerdings wird dann auch mehr Zeit benötigt

MaxTry=3
Wie oft soll die Schleife durchlaufen werden bevor die Meldung ausgegeben wird das keine Verbindung aufgebaut werden kann.

Download VpnApp.exe
Source Code VpnApp.exe

Das Icon wurde von Sergio Sánchez López entwickelt

Windows-Firewall: WMI für Firewall

nospam@example.com (Ralf Entner) — Mon, 12 Dec 2011 09:40:21 +0100

Problem
Man möchte mittels WMI auf einen PC zugreifen wir jedoch von der Firewall blockiert.
Die Firewall-Konfiguration stellt den WMI-Dienst nicht zur Verfügung um diesen freizugeben.

Lösung
Die einfachste Möglichkeit die Freigabe zu aktivieren stellt der netsh-Befehl zur Verfügung.
Einfach in der Shell des Remote-Computers folgenden Befehl ausführen:

netsh firewall set service RemoteAdmin enable

Quelle: poweradmin.com: Enable WMI (Windows Management Instrumentation)

CreateBackup.exe erstellt ein Backup eines Ordner

nospam@example.com (Christopher Pope) — Wed, 24 Aug 2011 10:56:53 +0200

CreateBackup.exe erstellt ein Backup eines Ordner und zippt die Zieldatei nach einem eingestellten Muster

Hilfe zu CreateBackup.exe

/H Zeigt diese Hilfe an
/Q: Definiert die Quelle der Dateien
/Z: Definiert das Ziel des Backups
/N: Definiert das Muster des Dateinamens

/N:DT DT steht für DateTime (Standard)
/N:D D steht für Datum

Beispiele :

Erstellt eine Backupdatei mit dem Namen TagMonatJahr_StundeMinuteSekunde.zip

CreateBackup.exe /Q:"C:\Quelle Test" /Z:C:\test /N:DT

Erstellt eine Backupdatei mit dem Namen TagMonatJahr.zip

CreateBackup.exe /Q:C:\Quelle /Z:C:\test /N:D

Erstellt von Christopher Pope | NO WARRANTY !! | Freeware

Download : CreateBackup.exe

Source Code : nur für registrierte Mitglieder

Windows XP - WMI Abfrage auf Win32_Product ( Error 80041001 ) funktioniert nicht

nospam@example.com (Christopher Pope) — Wed, 24 Aug 2011 08:53:05 +0200

Problem :

Sie möchten über WMI die installierte Software ermitteln , die hierzu gehörige Klasse Win32_Product läuft allerdings in den Fehler ( 80041001 ) , die Lösung hierzu ist ein Patch von Microsoft den man allerdings direkt anfordern muss. Das Problem selbst ist bei Windows XP und Windows Server 2003 bekannt.

Lösung :

Installieren des von Microsoft bereitgestellten Patches für das jeweilige System.

Download des Patches für Windows Server 2003 : http://support.microsoft.com/kb/972189
Download des Patches für Windows XP : http://support.microsoft.com/kb/970553
WMI Win32_Product Hotfix für Windows XP

VBS / WSH Funktion um Meldungen auszugeben je nach Interpreter

nospam@example.com (Christopher Pope) — Wed, 20 Jul 2011 15:37:45 +0200

Problem :

Wenn man ein VBS Skript schreibt und Meldungen ausgeben möchte stehen einem mehrere Wege zur Verfügung die gängigsten sind eine MsgBox und WScript.Echo das Echo wird meistens verwendet wenn das Skript über cscript.exe gestartet wird , startet man es dann mit wscript.exe bekommt man für jede Zeile die ein Echo enthällt eine gesonderte Messagebox (MsgBox)

Lösung :

Ich hab hier eine kleine Funktion geschrieben die ermittelt über welchen Interpreter wscript / cscript das Skript gestartet wurde und die Meldung anpasst.

Function ShowMessage(MSG,Titel)
Dim StrScriptInt : StrScriptInt = LCase(WScript.FullName)
' --- Check Interpreter
If Right(StrScriptInt,11) = "wscript.exe" Then
MsgBox MSG,vbOKOnly + vbInformation,Titel
Else
WScript.Echo Titel & "--------------" & vbCrLf & MSG & vbCrLf
End If
End Function

Neues Tool zum umziehen von Druckern

nospam@example.com (Christopher Pope) — Wed, 20 Jul 2011 15:25:49 +0200

Problem :

Der Name des Druckservers hat sich verändert und soll jetzt automatisch beim anmelden der user in den verbundenen Drucker korrigiert werden.
Getestet mit Win 2000 / XP / 7

Lösung :

Ich hab mich ran gesetzt und eine neue Version ohne speichern auf File System Ebene geschrieben.

Hier die möglichen Parameter :

-o:[Servername] or /o:[Servername] = old print server
-n:[Servername] or /n:[Servername] = new print server
-l:[Logfile] or /l:[Logfile] = create an Logfile (path:filename)
-? or /? = shows this help

replace [Servername] with the hostname / ip-adress without [ and ]

Beispielaufruf sieht dann so aus :

Move_Printer.exe -o:ALTSERVER -n:NEUSERVER -l:C:\Logfile.txt

Download Tool : Move_Printer.exe (freier Download)

Hier der download des Source Codes : Source Code (nur für registrierte Mitglieder)

VBS Progress Bar

nospam@example.com (Christopher Pope) — Mon, 11 Jul 2011 12:12:05 +0200

Problem:

Man möchte den einen Fortschrittsbalken in VBS anzeigen , leider bringt VBS diese Funktion nicht mit dadurch muss man den Internet Explorer verwenden

Lösung :

North Atlanta Web Design hat eine Super Klasse dafür geschrieben, so umgeht man den Weg über HTA

hier gehts zum Code : VBS Class ProgressBar

VBS Funktion: ungelesene Mails im Posteingang von Outlook ermitteln

nospam@example.com (Ralf Entner) — Mon, 11 Jul 2011 11:20:26 +0200

Funktion zur Ermittlung der ungelesenen Nachrichten im Posteingang von Outlook.
Outlook muß installiert sein!
Läuft auch unter Outlook 2010.

Function unread_mails()
'Funktion zum überprüfen auf neue Mails im Ordner "Posteingang"
'In Variable "u" wird die Anzahl der ungelesenen Nachrichten übergeben

Dim unread_items, mapi, inbox, mail

Set outObj = CreateObject("Outlook.Application")

u = 0 'Zähler ungelesene Nachrichten zurücksetzen

Set mapi = outObj.GetNamespace("MAPI")
Set inbox = mapi.GetDefaultFolder(6) 'Zeiger auf Posteingang setzten - Posteingang = Folder(6)

For Each mail In inbox.Items 'überprüfen auf ungelesene Mails
If mail.unread Then unread_items = unread_items + 1
Next

'Ausgabe als Msgbox
MsgBox "Sie haben " & unread_items & " ungelesene Mails in Ihrem Posteingang", vbOKOnly, "Posteingang überprüft"

End Function

Überprüfen ob Prozess läuft mit VBS/WSH

nospam@example.com (Christopher Pope) — Wed, 06 Jul 2011 11:24:31 +0200

Hier eine kleine Funktion die überprüft ob ein Prozess läuft oder nicht , sie baut auf VBS / WSH und WMI auf und liefert TRUE oder FALSE zurück.

Funktion :

Function CheckProcess(name)
'------------------ check for running process
Dim ObjProcess
Set ObjProcess = OBJWMI.ExecQuery("select * from win32_process where name='" & name & "' ")
If ObjProcess.Count <> 0 Then
CheckProcess = True
Else
CheckProcess = False
End If
Set ObjProcess = Nothing
End Function

diese Funktion kann z.B. so eingebunden werden

Beispiel :

Do
BoolCkProc = CheckProcess("notepad.exe")
WScript.Sleep 5000
Loop Until BoolCkProc = False

Benötigt wird natürlich das WMI interface

Dim StrComputer : StrComputer = "." '-- lokaler Rechner
Dim OBJWMI : Set OBJWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & StrComputer & "\root\cimv2")

VBS Logfile schreiben | Funktion

nospam@example.com (Christopher Pope) — Wed, 08 Jun 2011 14:15:15 +0200

Funktion um ein Logfile in VBS zu schreiben , der neue Eintrag wird immer angehängt.

Benötigt einen Verweis auf

Dim ObjFso : Set ObjFso = CreateObject("Scripting.FileSystemObject")

Und die Variable FIL_LOG muss deklariert sein !

Dim FIL_LOG : FIL_LOG = "C:\" & Replace(WScript.ScriptName,".vbs",".log")

Funktion :

Function WriteLog(Inhalt)
'------------------ Schreibt ein Logfile
Dim FileOut
Set FileOut = ObjFso.OpenTextFile(FIL_LOG,8,true)
FileOut.WriteLine (Inhalt)
FileOut.Close
Set FileOut = Nothing
End Function

VBS: Blinkende Tastatur

nospam@example.com (Ralf Entner) — Tue, 12 Apr 2011 16:58:52 +0200

Problem:
Um Aufmerksamkeit zu erregen, soll eine LED an der Tastatur blinken.

Lösung:
Die ScrollLock-LED blinkt, und auf dem Bildschirm erscheint ein PopUp, mit dem das Blinken abgestellt werden kann.

set WshShell = WScript.CreateObject("WScript.Shell")
do
WshShell.SendKeys "{SCROLLLOCK}"
Abbruch = WshShell.PopUp("Blinker stop",1,"Mail",0)
if Abbruch<>-1 then exit do
loop

VBS: ZIP-Datei überprüfen

nospam@example.com (Ralf Entner) — Tue, 12 Apr 2011 12:48:09 +0200

Problem:
Man möchte den Inhalt einer ZIP-Datei bzw. die Anzahl der Dateien in der ZIP-Datei überprüfen.

Lösung:
Mit folgendem VB-Skript kann man die Anzahl der Dateien innerhalb der ZIP-Datei überprüfen.
Sollte die Anzahl (filesinzip.Count) 0 sein, dann ist die ZIP-Datei entweder beschädigt oder leer.

Set objApp = CreateObject("Shell.Application")
set filesInzip=objApp.NameSpace("C:\test.zip").Items
Msgbox filesinzip.Count

VBS zum automatischen umziehen der lokalen Druckerverbindungen

nospam@example.com (Christopher Pope) — Thu, 24 Feb 2011 10:40:06 +0100

Problem :

Der Name des Printservers hat sich geändert , jetzt kann man zu Fuß an alle Clients gehen und die Drucker umstellen oder man nimmt dieses Skript ins Loginskript auf und das erledigt einem diese Aufgabe ....

Skript :

Option Explicit

Dim ObjWsh : Set ObjWsh = CreateObject("WScript.Shell")
Dim ObjNet : Set ObjNet = CreateObject("WScript.Network")
Dim ObjFso : Set ObjFso = CreateObject("Scripting.FileSystemObject")
Dim objEnv : Set objEnv = ObjWsh.Environment("Process")
Dim Logfile : Logfile = objEnv("USERPROFILE") & "\PrtUmzug.txt"
Dim objNetPr,NPR,DUMMY,ToDo,Zeile,Inhalt,Entry,Printer_New,OLDSERVER,NEWSERVER

OLDSERVER = "SERVERALT" ' ----------------------------> Hier den Namen des alten Printservers eintragen
NEWSERVER = "SERVERNEU" ' ----------------------------> Hier den Namen des neuen Printservers eintragen

' ------------------ routine
WScript.Echo ""
WScript.Echo "-----------------------------------------------------"
If Not ObjFso.FileExists(Logfile) then
WScript.Echo "|-> Ihre Druckerverbindungen werden überprüft & korrigiert"
Inhalt = GetPrinterNames()
WriteLog Logfile,Inhalt
ReadLog Logfile
Else
WScript.Echo "|-> Druckerverbindungen wurden bereits überprüft"
End If
WScript.Echo "-----------------------------------------------------"
WScript.Quit (1)
' ------------------ funktionen
Function GetPrinterNames() '--- liest die verbundenen Netzwerkdrucker aus
Set objNetPr = ObjNet.EnumPrinterConnections
For NPR = 0 to objNetPr.Count - 1 Step 2
If Left(objNetPr.Item(NPR + 1),2) = "\\" then
If DUMMY = "" then
DUMMY = "NPR|" & objNetPr.Item(NPR) & "|" & objNetPr.Item(NPR + 1)
Else
DUMMY = DUMMY & vbCrLf & "NPR|" & objNetPr.Item(NPR) & "|" & objNetPr.Item(NPR + 1)
End If
End If
Next
GetPrinterNames = DUMMY
DUMMY = ""
Set objNetPr = nothing
End Function
Function SetPrinterNames(Line) '--- verbindet einen Netzwerkdrucker
On Error Resume Next
Entry = split(Line,"|")
If UBound(Entry) = 2 Then
Printer_New = Replace(lcase(Entry(2)),OLDSERVER,NEWSERVER)
ObjNet.RemovePrinterConnection Entry(2)
ObjNet.AddWindowsPrinterConnection Printer_New
End If
End Function
Function ReadLog(File) '--- überprüft ob Logfile existiert wenn ja liet Datei aus und spielt gesicherte Einträge zurück
If ObjFso.FileExists(File) Then
Set Dummy = ObjFso.OpenTextFile(File)
Do Until Dummy.AtEndOfStream
Zeile = trim(Dummy.Readline)
SetPrinterNames(Zeile)
Loop
End If
End Function
Function WriteLog(File,Content) '--- löscht die Datei wenn vorhanden und erstellt eine aktualisierte
If ObjFso.FileExists(File) Then
ObjFso.DeleteFile(File)
End If
Dim ObjLogFile : Set ObjLogFile = ObjFso.OpenTextFile(File,8,true)
ObjLogFile.WriteLine (Content)
Set ObjLogFile = Nothing
End Function

VBS zum Löschen von Dateien mit bestimmter Extension nach x Tagen

nospam@example.com (Ralf Entner) — Wed, 22 Dec 2010 22:17:10 +0100

'DEL_X_DAYS_EXT_FILES.VBS
'
'Skript zum löschen von Dateien mit der Extension sExt im Pfad sDirectoryPath,
'die älter als iDaysOld Tage sind
'
'
'sDirectoryPath = Pfad zum Verzeichnis, in dem die zu löschenden Dateien liegen (ohne abschließnden Backslash)
'sExt = Extension, der Dateien, die gelöscht werden können/sollen
'iDaysOld = Angabe des Dateialters in ganzen Tagen

Option Explicit
On Error Resume Next
Dim oFSO, oFolder, sDirectoryPath
Dim oFileCollection, oFile, sDir
Dim iDaysOld, sExt

'Variablen definieren

sDirectoryPath = "D:\BACKUP"
sExt = "bak"
iDaysOld = 1

'Zugriff auf Ordner und Dateien

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.Files

'Durchsuchen des Zielordners nach allen Dateien mit der Endung sExt
For each oFile in oFileCollection

If LCase(Right(Cstr(oFile.Name), 3)) = sExt Then

If oFile.DateLastModified < (Date() - iDaysOld) Then 'lösche Datei, wenn diese älter als iDaysOld Tage ist
'oFile.Delete(True) '----> Zeile ist nicht aktiv, bitte noch Dokemtarzeiehn davor herausnhemen!!!
msgbox oFile.Name '----> Es wird nur der Name der zu löschenden Datei angezeigt!!
End If

End If

Next

'Variablen zurücksetzen

Set oFSO = Nothing
Set oFolder = Nothing
Set oFileCollection = Nothing
Set oFile = Nothing

VBS zum Ermitteln der neuesten Datei an einem Verzeichnis abhängig von der Extension

nospam@example.com (Ralf Entner) — Wed, 22 Dec 2010 22:13:52 +0100

'Ermittlung der neuesten Datei mit Extension sExt im Pfad sPfath
'
'
'Das Skript durchsucht den gewünschten Pfad "sPath" nach Dateien mit der Extension "sExt"
'und gibt dann den kompletten Pfad mit Dateinamen von der neuesten Dateu aus sNewestFile

'Variablen für Pfad und Extension
'sPfad ohne abschließenden Backslash angeben
'sExt ohne Punkt davor angeben

sPath = "C:\Windows\System32"
sExt = "dll"

'Filesystemobject genereieren
Set oFSO = CreateObject("Scripting.FileSystemObject")

'Funtkion GetNewestFile ausführen
sNewestFile = GetNewestFile(sPath)

'Ausgabe der neuesten Datei
'Wenn keine Datei ermittelt werden konnte, dann auch melden

If sNewestFile <> "" Then
WScript.Echo "Die neuste Datei mit der Extension " & sExt & " ist " & sNewestFile
Else
WScript.Echo "Verzeichnis ist leer"
End If

'Funktion NewestFile

Function GetNewestFile(ByVal sPath)

sNewestFile = Null ' initialisiere Wert

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files

' Finde die neueste Datei unter allen anderen Dateien
For Each oFile In oFiles

if lcase(oFSO.GetExtensionName(ofile)) = sExt then 'selektiere Dateien mit der gewünschten Endung aus
On Error Resume Next

If IsNull(sNewestFile) Then
sNewestFile = oFile.Path
dPrevDate = oFile.DateLastModified
Elseif dPrevDate < oFile.DateLastModified Then
sNewestFile = oFile.Path
End If

end if

On Error Goto 0
Next

If IsNull(sNewestFile) Then sNewestFile = ""

GetNewestFile = sNewestFile
End Function

Konvertierung VBE zu VBS

nospam@example.com (Ralf Entner) — Mon, 18 Oct 2010 10:31:17 +0200

Problem
Wer kennt das nicht. Da hat sich ein gutes VB-Skript ausgedacht und um das ganze abzusichern, hat man das in eine VBE umgewandelt um das Ganze zu verschlüsseln. Irgendwie ist einem dann die originale Datei abhanden gekommen und man hat nur noch die kryptische VBE-Datei...wie jetzt an die Daten herankommen?

Lösung
Es gibt tatsächlich ein Skript, dass eine VBE-Datei wieder in eine VBS-Datei umwandelt. Das Originalskript gibt den unverschlüsselten Inhalt als MsgBox zurück. Ich habe mir erlaubt das Ganze etwas zu erweitern und lasse die entschlüsselte Datei als xxx_encrypted.txt im gleichen Verzeichnis wie die VBE-Datei abspeichern, wobei xxx für den originalen Dateinamen steht (z.B. test.vbe -> test.vbe_decrypted.txt). Hier nun das Skript...dieses einfach als decrypt_vbs.vbs speichern und die gewünschte VBE-Datei entweder per Drag&Drop fallen lassen oder per integrierter Browse-Funktion suchen.

option explicit
Dim oArgs, NomFichier
'Optional argument : the encoded filename
NomFichier=""
Set oArgs = WScript.Arguments
Select Case oArgs.Count
Case 0 'No Arg, popup a dialog box to choose the file
NomFichier=BrowseForFolder("Choose an encoded file", &H4031, &H0011)
Case 1
If Instr(oArgs(0),"?")=0 Then '-? ou /? => aide
NomFichier=oArgs(0)
End If
Case Else
WScript.Echo "Too many parameters"
End Select
Set oArgs = Nothing

If NomFichier<>"" Then
Dim fso
Set fso=WScript.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(NomFichier) Then
Dim fic,contenu,ofile
Set fic = fso.OpenTextFile(NomFichier, 1)
Contenu=fic.readAll
fic.close
Set fic=Nothing

Const TagInit="#@~^" '#@~^awQAAA==
Const TagFin="==^#~@" '& chr(0)
Dim DebutCode, FinCode
Do
FinCode=0
DebutCode=Instr(Contenu,TagInit)
If DebutCode>0 Then
If (Instr(DebutCode,Contenu,"==")-DebutCode)=10 Then 'If "==" follows the tag
FinCode=Instr(DebutCode,Contenu,TagFin)
If FinCode>0 Then
Contenu=Left(Contenu,DebutCode-1) & _
Decode(Mid(Contenu,DebutCode+12,FinCode-DebutCode-12-6)) & _
Mid(Contenu,FinCode+6)
End If
End If
End If
Loop Until FinCode=0
WScript.Echo contenu
Set oFile = fso.OpenTextFile(NomFichier & "_decrypted.txt",2,True)
oFile.WriteLine contenu
oFile.close
Else
WScript.Echo Nomfichier & " not found"
End If
Set fso=Nothing
Else
WScript.Echo "Please give a filename"
WScript.Echo "Usage : " & wscript.fullname & " " & WScript.ScriptFullName & " "
End If

Function Decode(Chaine)
Dim se,i,c,j,index,ChaineTemp
Dim tDecode(127)
Const Combinaison="1231232332321323132311233213233211323231311231321323112331123132"

Set se=WSCript.CreateObject("Scripting.Encoder")
For i=9 to 127
tDecode(i)="JLA"
Next
For i=9 to 127
ChaineTemp=Mid(se.EncodeScriptFile(".vbs",string(3,i),0,""),13,3)
For j=1 to 3
c=Asc(Mid(ChaineTemp,j,1))
tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)
Next
Next
'Next line we correct a bug, otherwise a ")" could be decoded to a ">"
tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)
Set se=Nothing

Chaine=Replace(Replace(Chaine,"@&",chr(10)),"@#",chr(13))
Chaine=Replace(Replace(Chaine,"@*",">"),"@!","<")
Chaine=Replace(Chaine,"@$","@")
index=-1
For i=1 to Len(Chaine)
c=asc(Mid(Chaine,i,1))
If c<128 Then index=index+1
If (c=9) or ((c>31) and (c<128)) Then
If (c<>60) and (c<>62) and (c<>64) Then
Chaine=Left(Chaine,i-1) & Mid(tDecode(c),Mid(Combinaison,(index mod 64)+1,1),1) & Mid(Chaine,i+1)
End If
End If
Next
Decode=Chaine
End Function

Function BrowseForFolder(ByVal pstrPrompt, ByVal pintBrowseType, ByVal pintLocation)
Dim ShellObject, pstrTempFolder, x
Set ShellObject=WScript.CreateObject("Shell.Application")
On Error Resume Next
Set pstrTempFolder=ShellObject.BrowseForFolder(&H0,pstrPrompt,pintBrowseType,pintLocation)
BrowseForFolder=pstrTempFolder.ParentFolder.ParseName(pstrTempFolder.Title).Path
If Err.Number<>0 Then BrowseForFolder=""
Set pstrTempFolder=Nothing
Set ShellObject=Nothing
End Function

Quelle: Decode all files encoded (original version)

VBS / WSH Pseudo Timestamp erstellen

nospam@example.com (Christopher Pope) — Thu, 29 Jul 2010 10:25:06 +0200

Diese Funktion erstellt einen Pseudotimestamp , ist ganz gut wenn man Logfiles oder ähnliches schreiben möchte

Function PTimestamp()
Dim JAH,MON,SEK,STU,TAG,MIN
JAH = Year(Now)
If Month(Now) < 10 then
mon = "0" & Month(Now)
Else
mon = Month(Now)
End If
If Day(Now) < 10 then
TAG = "0" & Day(Now)
Else
TAG = Day(Now)
End If
If Hour(Now) < 10 then
STU = "0" & Hour(Now)
Else
STU = Hour(Now)
End If
If Minute(now) < 10 then
MIN = "0" & Minute(now)
Else
MIN = Minute(now)
End If
If Second(Now) < 10 then
SEK = "0" & Second(Now)
Else
SEK = Second(Now)
End If
PTimestamp = TAG & MON & JAH & STU & MIN & SEK
End Function

Die Funktion kann dann z.B. so aufgerufen werden.

MsgBox "TEST_" & PTimestamp()

Inputbox an bestimmter Position anzeigen

nospam@example.com (Ralf Entner) — Thu, 25 Mar 2010 16:19:38 +0100

Problem
Man möchte eine Inputbox an eine bestimmte Position am Bildschirm anzeigen lassen um z.B. eine andere Anwendung nicht zu verdecken.

Lösung

InputBox ( "title", "Prompt" [, "Default" [, "password char" [, Width, Height [, Left, Top [, TimeOut]]]]] )

Parameter

title = Der Titel der InputBox
prompt = Ein Beschreibungstext für den Nutzer, damit er weiß, was er eingeben soll.
password char [optional] = Das Zeichen, mit dem alle eingegebenen Zeichen maskiert werden. Wenn du willst, dass das echte Zeichen angezeigt werden soll, dann übergebe einen leeren String ("") (Standardwert) oder ein Leerzeichen als erstes Zeichen. Wenn du einen mehrere Zeichen langen String angibst, wird nur das erste Zeichen zum Maskieren genutzt. Die weiteren Zeichen haben eine besondere Bedutung. Siehe dazu die Bemerkungen.
width [optional] = Die Breite des Fensters. Wenn die Breite definiert wird, muss auch die Höhe angegeben werden. Gib -1 an, um die Standardbreite zu verwenden.
height [optional] =Die Höhe des Fensters. Wenn die Höhe definiert wird, muss auch die Breite angegeben werden. Gib -1 an, um die Standardhöhe zu verwenden
left [optional] = Horizontale Position der InputBox. Standardmäßig wird die Box zentriert. Wenn angegeben, muss auch die vertikale Position bestimmt werden.
top [optional] = Vertikale Position der InputBox. Standardmäßig wird die Box zentriert. Wenn angegeben, muss auch die horizontale Position bestimmt werden.
timeout [optional] = Wie viele Sekunden soll gewartet werden, bis die InputBox automatisch über den Cancel-Button verlassen wird.

Quelle autoit.de: InputBox - Referenz

Fehlerbehandlung in VBS/WSH

nospam@example.com (Christopher Pope) — Fri, 19 Mar 2010 13:03:56 +0100

Problem :

Es soll überprüft werden ob eine Aufgabe eines VBS/WSH Skriptes erfolgreich durchgeführt wurde.
Normalerweise stopt die Ausführen an jedem Fehler , ohne das dieser auswertbar bist.
In einigen Fälle wird aber ein Rückgabewert erforderlich diesen erreicht man indem man am Anfang
des Skriptes die Zeile

On Error Resume Next

einfügt. Der Status des Vorgangs kann dann mit

if err.number<>0 then
wscript.echo err.number, err.description
err.Clear
end if

überprüft werden. Wenn die Fehlerbehandlung wieder von VBS/WSH erledigt werden soll kann man das mit der Zeile

On Error Goto 0

erreichen

Sprache des Installierten Betriebssystem ermitteln

nospam@example.com (Christopher Pope) — Fri, 19 Mar 2010 10:01:54 +0100

Problem :

Man muss herausfinden auf welcher Sprache das Betriebssystem läuft

Lösung :

Diese Funktion ermittelt die gewünschte Information über WMI

Benötigte Deklarationen :

Dim ObjWMI : Set ObjWMI = GetObject("winmgmts:\\.\root\CIMV2")
PUBLIC LANGID
PUBLIC LANGLE

Funktion :

Function GetLanguageID()
DIM colItems : Set colItems = ObjWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each objItem in colitems
LANGID = objItem.Locale
Next
Select Case LANGID
Case "0409" : LANGLE = "EN" : MsgBox "Language : English (American)"'
Case "0407" : LANGLE = "DE" : MsgBox "Language : Deutsch (Germany)"
Case "040c" : LANGLE = "FR" : MsgBox "Language : French (Standard)"
Case "0c0a" : LANGLE = "ES" : MsgBox "Language : Spain (Modern Sort)"
Case "040a" : LANGLE = "ES" : MsgBox "Language : Spain (Traditional Sort)"
Case "0410" : LANGLE = "IT" : MsgBox "Language : Italian (Standard)"
End Select
End Function

Kann beliebig mit den Codes von MS erweitert werden : Language IDs Microsoft

BIOS mittels WMI per Skript auslesen

nospam@example.com (Ralf Entner) — Wed, 03 Mar 2010 09:31:06 +0100

Problem
Man möchte gerne BIOS-Version, Hersteller, Seriennummer und Physikalische Speicherbelegung aus dem BIOS auslesen ohne den Server neu zu starten.

Lösung
Folgendes VBS-Skript ließt die wichtigsten Informationen aus dem BIOS aus:

bios_settings.vbs

strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colBIOS = objWMIService.ExecQuery ("Select from Win32_BIOS")
For each objBIOS in colBIOS
msg = "BIOS-Informationen" & vbcrlf
msg = msg & "Manufacturer: " & objBIOS.Manufacturer & vbcrlf
msg = msg & "Name: " & objBIOS.Name & vbCRLF
msg = msg & "Serial Number: " & objBIOS.SerialNumber & vbCRLF
msg = msg & "SMBIOS Version: " & objBIOS.SMBIOSBIOSVersion & vbCRLF
msg = msg & "Status: " & objBIOS.Status & vbCRLF & vbcrlf
Next

msg = msg & "physikalische Speicherplätze" & vbCRLF
anzahl = 0

Set colItems = objWMIService.ExecQuery("Select from Win32_PhysicalMemory",,48)
For Each objItem in colItems
anzahl = anzahl + 1
msg = msg & "Bank " & anzahl & " = Größe: " & objItem.Capacity/1024/1024 & " MB" & vbcrlf
Next
msgbox msg

Aktuelles Datum , zweistellig ermitteln / ausgeben

nospam@example.com (Christopher Pope) — Fri, 26 Feb 2010 10:22:48 +0100

Ist zwar eine einfach Funktion aber dennoch wenn man sie hat muß man sie nicht immer selber Tippen

Function GetDate()
'------------------ Ermittelt das aktuelle Datum
Dim Monat : Monat = Month(now)
Dim Tag : Tag = Day(Now)
Dim Jahr : Jahr = Year(now)
If Monat < 10 then
Monat = "0" & Monat
End If
If Tag < 10 Then
Tag = "0" & Tag
End If
GetDate = Tag & "." & Monat & "." & Jahr
End Function