VBS Logfile schreiben | Funktion

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

Konvertierung VBE zu VBS

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

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()

Signatur abschalten per Skript

Problem:

Outlook Signatur mittels Skript (Anmeldeskript) abschalten/verändern!

Lösung:

Folgendes Skript einfach ins Notepad kopieren und als signatur.vbs speichern. Danach kann das Skript mittels Aufruf: "wscript signatur.vbs" als Task oder im Loginskript gestartet werden!

'Word-Objekt generieren
Set objWord = CreateObject("Word.Application")

'auf Emailoptionen innerhalb des Wordobjekts zugreifen
Set objEmailOptions = objWord.EmailOptions

'Sigantur als Objekt der Emailoptionen auswählen
Set objSignatureObject = objEmailOptions.EmailSignature

'keine Signatur für neue Email aktivieren
objSignatureObject.NewMessageSignature = ""

'keine Signatur für antworten aktivieren
objSignatureObject.ReplyMessageSignature = ""



Anstatt "" kann auch ein "Signaturname" eingesetzt werden. Hiermit wird die Sigantur aktiviert!

Signatur abschalten per Skript - Outlook

Problem:

Outlook Signatur mittels Skript (Anmeldeskript) abschalten/verändern!

Lösung:

Folgendes Skript einfach ins Notepad kopieren und als signatur.vbs speichern. Danach kann das Skript mittels Aufruf: "wscript signatur.vbs" als Task oder im Loginskript gestartet werden!



'Word-Objekt generieren
Set objWord = CreateObject("Word.Application")

'auf Emailoptionen innerhalb des Wordobjekts zugreifen
Set objEmailOptions = objWord.EmailOptions

'Sigantur als Objekt der Emailoptionen auswählen
Set objSignatureObject = objEmailOptions.EmailSignature

'keine Signatur für neue Email aktivieren
objSignatureObject.NewMessageSignature = ""

'keine Signatur für antworten aktivieren
objSignatureObject.ReplyMessageSignature = ""



Anstatt "" kann auch ein "Signaturname" eingesetzt werden. Hiermit wird die Sigantur aktiviert!
“Das Alzheimer-Gesetz der Programmierung: Wenn du einen von dir vor zwei Wochen geschriebenen Code ansiehst, kommt es dir vor als hättest du ihn noch nie gesehen.”
Dan Hurvitz – Software-Entwickler