hallo zusammen! ich habe ein kleines Problem, und zwar komme ich nicht zu den Infos heran, wie man eine reg. Datei mit vbscript im Hintergrund ausführen kann, so dass der Benutzer nichts davon merkt... kann mir da vielleicht jemand helfen??
Programmieren - alles kontrollieren 4.941 Themen, 20.708 Beiträge
Hier ein Beispiel, wie man mit VBS Registryeinträge ändert.
Da Du aber was heimlich machen willst, musst Du Dir die Sache schon selbst anpassen !
repi
'
' RegKey.VBS
'
' WSH ab Version 2.0 (5.1)
' Menüsteuerung für ausgewählte Registrymanipulationen
'
' Hinweis: Die Datei RegObj.dll muß im System vorhanden und registriert sein
' z.B. RegSvr32.exe C:\Windows\RegObj.dll
'
' Variablen
'
Option Explicit
' Bei Problemem abschalten.
On Error Resume Next
Dim WSHFile, WSHShell, Command, ErrorCode
Dim MakroName, Version, LogProg, LogText
Dim Name, FName, Flag
Dim Text, Titel, Stil, Ergebnis
Dim CRLF, TAB
Dim ObjEnv, SearchVerz(), SearchFile()
Dim ObjReg, RegKey(), RegText(), RegOut, RegProg
Dim IniFileName(), IniFileString(), FilePathName()
Dim FilePath, FoundLines
Dim ObjArgs, Argument(), Arg, i
Dim RootKey, SubKey
Dim x, y, z
' Carriage Return + Linefeed setzen.
CRLF = vbCrLf
TAB = vbTab
' WSHFile Object.
Set WSHFile = CreateObject("Scripting.FileSystemObject")
' WSHShell Object.
Set WSHShell = WScript.CreateObject("WScript.Shell")
' Erzeuge Verweis auf Environment.
Set ObjEnv = WSHShell.Environment("Process")
' Variablen vorbelegen.
Name = WScript.ScriptName
FName = WScript.ScriptFullName
LogProg = Left(FName, InstrRev(FName, "\")) & "Log.vbs"
MakroName = "'" & Left(Name, InstrRev(Name, ".") - 1) & "'"
Version = "V1.4"
' Registrierungsprogramm für Registry.
RegProg = "RegSvr32.exe"
' Dimensionen hier anpassen.
ReDim Preserve SearchFile(0)
' Nur Files zum Registrieren eintragen.
SearchFile(0) = "RegObj.dll"
' Dimensionen hier anpassen.
ReDim Preserve SearchVerz(2)
SearchVerz(0) = ObjEnv("windir")
SearchVerz(1) = WSHFile.BuildPath(ObjEnv("windir"), "system")
SearchVerz(2) = WSHFile.BuildPath(ObjEnv("windir"), "system32")
' Dimensionen hier anpassen.
ReDim Preserve RegKey(6) : ReDim Preserve RegText(6)
RegKey(0) = "\HKEY_Local_Machine\Software\Microsoft\Windows\CurrentVersion\Run"
RegText(0) = "Start Programme (Run)"
RegKey(1) = "\HKEY_Local_Machine\Software\Microsoft\Windows\CurrentVersion\RunOnce"
RegText(1) = "Start Programme (RunOnce)"
RegKey(2) = "\HKEY_Local_Machine\Software\Microsoft\Windows\CurrentVersion\RunOnceEx"
RegText(2) = "Start Programme (RunOnceEx)"
RegKey(3) = "\HKEY_Local_Machine\Software\Microsoft\Windows\CurrentVersion\RunServices"
RegText(3) = "Start Programme (RunServices)"
RegKey(4) = "\HKEY_Local_Machine\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce"
RegText(4) = "Start Programme (RunServicesOnce)"
RegKey(5) = "\HKEY_CLASSES_ROOT\exefile\shell\open\command"
RegText(5) = "Start Programme (exefile)"
RegKey(6) = "\HKEY_Local_Machine\Software\Microsoft\Windows\CurrentVersion\ProfileList"
RegText(6) = "Rechner Benutzerprofile"
' Dimensionen hier anpassen.
ReDim Preserve IniFileName(1) : ReDim Preserve IniFileString(1, 1)
IniFileName(0) = "System.ini"
IniFileString(0, 0) = "shell="
IniFileName(1) = "Win.ini"
IniFileString(1, 0) = "load="
IniFileString(1, 1) = "run="
For z = 0 To UBound(IniFileName, 1)
Check IniFileName(z)
ReDim Preserve FilePathName(z)
FilePathName(z) = FilePath
' MsgBox LCase(FilePathName(z))
Next
If (WSHFile.FileExists(LogProg)) Then
' Information protokollieren.
LogText = "4" & Space(1) & Chr(34) & MakroName & " - Start (" & FName & ")" & Chr(34)
Command = LogProg & Space(1) & LogText
ErrorCode = WSHShell.Run(Command, 1, True)
End If
' Definieren der Sub zum Überprüfen der notwendigen System-DLL.
Sub Check(FileName)
Dim Flag
' Flag vorbelegen.
Flag = 1
For y = 0 To UBound(SearchVerz, 1)
FilePath = WSHFile.BuildPath(SearchVerz(y), FileName)
If (WSHFile.FileExists(FilePath)) Then
Flag = 0
Exit For
End If
Next
' Fehlerausschrift.
If Flag Then
Text = "Achtung:" & CRLF
Text = Text & "Die Datei '" & LCase(FileName) & "' ist nicht vorhanden !!!" & CRLF & CRLF
Text = Text & "Auf folgenden Verzeichnissen wurde gesucht:" & CRLF
For y = 0 To UBound(SearchVerz, 1)
Text = Text & "'" & LCase(SearchVerz(y)) & "'" & CRLF
Next
Text = Text & CRLF
Text = Text & "Bitte überprüfen und erstellen"
Titel = "Abbruch - Makro"
Stil = vbCritical + vbOkOnly
MsgBox Text, Stil, Titel
EndeBox
End If
End Sub
' Definieren der Sub zum Registrieren der Objecte.
Sub ObjectRegistrierung(ObjectName)
' Run Kommando absetzen.
Command = RegProg & Space(1) & ObjectName
ErrorCode = WSHShell.Run(Command, 1, True)
If ErrorCode Then
Text = "Das Programm oder der Makro" & CRLF
Text = Text & "'" & RegProg & "'" & CRLF
Text = Text & "konnte nicht gestartet werden !" & CRLF & CRLF
Text = Text & "Evtl. auch die übergebenen Argumente anschauen !!!" & CRLF
Text = Text & "Argument(e): " & ObjectName
Titel = "Abbruch - Fehler beim Starten"
Stil = vbCritical + vbOkOnly
MsgBox Text, Stil, Titel
If (WSHFile.FileExists(LogProg)) Then
' Fehler protokollieren.
LogText = "1" & Space(1) & Chr(34) & MakroName & " - Registrierung: " & RegProg & Space(1) & ObjectName & Chr(34)
Command = LogProg & Space(1) & LogText
ErrorCode = WSHShell.Run(Command, 1, True)
End If
EndeBox
Else
If (WSHFile.FileExists(LogProg)) Then
' Erfolgreich protokollieren.
LogText = "0" & Space(1) & Chr(34) & MakroName & " - Registrierung: " & RegProg & Space(1) & ObjectName & Chr(34)
Command = LogProg & Space(1) & LogText
ErrorCode = WSHShell.Run(Command, 1, True)
End If
End If
End Sub
Sub ReadFileName(FileName, FileString)
Const ForReading = 1
Dim Line, ObjFile
Set ObjFile = WSHFile.OpenTextFile(FileName, ForReading, False)
Do While ObjFile.AtEndOfStream True
Line = ObjFile.ReadLine
If (instr(1, Line, FileString, vbBinaryCompare) 0) Then
FoundLines = FoundLines & Space(5) & Line & CRLF
End If
Loop
' File schliessen.
ObjFile.Close
End Sub
' Definieren der Sub zur Fehlerbehandlung.
Sub ErrorRoutine(ErrorFlag)
' Startflag setzen.
Flag = 1
' Fehlerbehandlung aktivieren.
If (Err.Number 0) Then
If ErrorFlag Then ' ErrorFlag = 1
Text = "Achtung !!! Achtung !!! Achtung !!!" & CRLF & CRLF
Text = Text & "In dem Script : " & Name & " ist ein Fehler aufgetreten..." & CRLF & CRLF
Text = Text & "Fehler Nr. " & CStr(Err.Number)
Text = Text & Space(5) & "(" & cStr(Date) & " - " & cStr(Time) & ")" & CRLF & CRLF
Text = Text & Err.Description & CRLF & CRLF
Text = Text & "Scriptfehler : " & Err.Source
Titel = "Fehlermeldung"
Stil = vbCritical + vbOkOnly
MsgBox Text, Stil, Titel
' Fehler löschen.
Err.Clear
' Fehlerflag setzen.
Flag = 0
' Hilfe aufrufen
HelpBox
' Makro beenden
EndeBox
Else
' Fehler löschen.
Err.Clear
' Fehlerflag setzen.
Flag = 0
End If
End If
End Sub
' Definieren der Sub zum Darstellen der Hilfe.
Sub HelpBox()
Text = "Info zum Makro: " & Name & CRLF & CRLF
Text = Text & "Bei evtl. auftretenden Fehlern bitte den Makro mit der Option '-reg' starten." & CRLF & CRLF
Text = Text & "Hier werden dann die notwendigen Einträge in der" & CRLF
Text = Text & "Registry erzeugt !" & CRLF & CRLF
Text = Text & "Beispiel: '" & LCase(FName) & Space(1) & "-reg'"
Titel = "Hilfe"
Stil = vbInformation + vbOkOnly
MsgBox Text, Stil, Titel
End Sub
' Definieren der Sub zum Darstellen der Endemeldung im Makro.
Sub EndeBox()
Text = "Ende ausgew. Registryauflistungen"
Titel = MakroName & " Routine " & Version
Stil = vbInformation + vbOkOnly
WSHShell.Popup Text, 2, Titel, Stil
If (WSHFile.FileExists(LogProg)) Then
' Information protokollieren.
LogText = "4" & Space(1) & Chr(34) & MakroName & " - Ende (" & FName & ")" & Chr(34)
Command = LogProg & Space(1) & LogText
ErrorCode = WSHShell.Run(Command, 1, True)
End If
' Object trennen.
WScript.DisconnectObject WSHShell
Set WSHShell = Nothing
WScript.DisconnectObject WSHFile
Set WSHFile = Nothing
WScript.DisconnectObject ObjArgs
Set ObjArgs = Nothing
WScript.Quit
End Sub
' Main.
' Argument(e) auslesen.
Set ObjArgs = Wscript.Arguments
For i = 0 To ObjArgs.Count - 1
ReDim Preserve Argument(i)
Argument(i) = ObjArgs(i)
Next
' Erstes Argument herausfiltern, wenn gesetzt.
If (i > 0) Then Arg = LCase(Argument(0)) End If
If IsEmpty(Arg) Then Arg = "" End If
Select Case Arg
Case "-reg"
' Registrierungsprogramm suchen.
Check(RegProg)
' Pfad zusammensetzen.
RegProg = LCase(FilePath)
Case "-help"
' Hilfe anlisten.
HelpBox
' Makro danach beenden.
EndeBox
Case Else
End Select
' Notwendige Files überprüfen.
For x = 0 To UBound(SearchFile, 1)
Check(SearchFile(x))
If (Arg = "-reg") Then
ObjectRegistrierung(SearchFile(x))
End If
Next
' Erzeuge Objektreferenz auf Datei RegObj.dll.
Set ObjReg = WScript.CreateObject("RegObj.Registry")
ErrorRoutine 1 ' mit Fehlermeldung.
' Schleife starten.
For x = 0 To UBound(RegKey, 1)
Set RootKey = ObjReg.RegKeyFromString(RegKey(x))
ErrorRoutine 0 ' ohne Fehlermeldung.
SubKey = RegKey(x) & CRLF & CRLF
' Auflistung bearbeiten (Unterschlüssel).
For Each RegOut In RootKey.SubKeys
SubKey = SubKey & CStr(LCase(RegOut.Name)) & CRLF
Next
' Auflistung bearbeiten (Werte).
For Each RegOut In RootKey.Values
SubKey = SubKey & CStr(LCase(RegOut.Name)) & CRLF
If Flag Then ' Flag = 1
SubKey = SubKey & CStr(LCase(RegOut.Value)) & CRLF & CRLF
End If
Next
' Ausgabebox definieren.
Text = SubKey
Titel = RegText(x)
Stil = vbInformation + vbOkCancel
Ergebnis = WSHShell.Popup(Text, 30, Titel, Stil)
' Ergebnis = MsgBox(Text, Stil, Titel)
If (Ergebnis = vbCancel) Then Exit For End If
Next
WScript.DisconnectObject RootKey
Set RootKey = Nothing
WScript.DisconnectObject ObjReg
Set ObjReg = Nothing
If (Ergebnis vbCancel) Then
' Inhalt von Dateien auslesen.
For x = 0 To UBound(FilePathName, 1)
FoundLines = FoundLines & CRLF & LCase(FilePathName(x)) & CRLF
For y = 0 To UBound(IniFileString, 2)
If (IniFileString(x, y) "") Then
ReadFileName FilePathName(x), IniFileString(x, y)
End If
Next
Next
Text = FoundLines
Titel = "File load and run points"
Stil = vbInformation + vbOkOnly
Ergebnis = MsgBox(Text, Stil, Titel)
End If
EndeBox
ich habe eben Reg Dateien gespeichert und möchte sie im Hintergrund ausführen, aber es kommt eben die Meldung ob ich sie wirklich regestrieren möchte oder nicht. Deswegen weiss ich nicht wie ich es am besten anstellen soll, dass es wirklich im Hintergrund läuft ohne dass diese Frage auftaucht...