http://dieseyer.de • all rights reserved • © 2011 v11.4
'v2.5*****************************************************
' File: cd-menu.vbs
' Autor: dieseyer@gmx.de
' dieseyer.de
'*********************************************************
Option Explicit
Dim Modus, DriveList, i, RegKey, objAdr, ZielSys, OpSys, Info
Dim ShellLink, LNK, aktCD, CDLw, WSHver, VBver, InfoDatei, LwFrei, LwHDD, LwSum
Dim Titel, Anzeige, Eingabe, aktAusw, Quelle, Ziel, DateiName, DateiNamen, InstDir
Dim Text, TextX, Text1, Text2, Text3, NT_9x, StopStelle, SysLw, FTP, TmpDir
Dim objNet, WSHShell, fso, Param, WSHEnv
InfoDatei = "\auswahl.txt"
Set objNet = WScript.CreateObject("WScript.Network")
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WSHEnv = WSHShell.Environment("Process")
Set Param = Wscript.Arguments
If Param.Count >= 1 Then Modus = UCase(Param(0))
' ----------------------------------------------
' . . . ein paar Variablen holen
' ----------------------------------------------
' Installationsverzeichnis festlegen: InstDir
' Festplatte mit dem meisten freien Platz ermitteln: LwHDD
' Testen lokalen Eigenschaften: SysLw, TmpDir, VBver, aktCD
' Testen der Windows-Version: ZielSys, OpSys, NT_9x
' nächste Zeile freigeben
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CDTest
If Modus = "TEST" Then
Titel = "WSH" & WSHver & " unter " & NT_9x & "/" & OpSys & " (" & aktCD & ")"
Else
Titel = "Auswahlmenü (c) service.cd@gmx.de"
End if
Info = NT_9x & " - OS-Version: " & vbTab & OpSys & vbCRLF
Info = Info & "System Laufwerk: " & vbTab & SysLw & vbCRLF
Info = Info & "CD-Laufwerk: " & vbTab & CDLw & vbCRLF
Info = Info & "Eingelegte CD: " & vbTab & aktCD & vbCRLF
Info = Info & "TMP-Verzeichnis: " & vbTab & TmpDir & vbCRLF
Info = Info & "WSH Version: " & vbTab & WSHver & " / " & VBver & vbCRLF
Info = Info & "Install-Verz.: " & vbTab & InstDir & vbTab & vbTab & LwFrei & " MB frei" & vbCRLF
If Modus = "TEST" Then MsgBox Info, vbOKOnly, Titel
' nächste Zeile nicht freigeben
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' WScript.Quit
' ----------------------------------------------
' WSH-Version testen und ggf. aktualisieren
' ----------------------------------------------
' scriptde.exe für Windows 2000 / XP
' scr56de.exe für Windows 98 / ME / NT4
If WSHver < "2" Then
TextX = ""
Text = CDLw & "\TOOL\WScript.56\scriptde.exe"
If (fso.FileExists(Text)) AND OpSys = "Windows 2000" Then TextX = Text
Text = CDLw & "\TOOL\WScript.56\scr56de.exe"
If (fso.FileExists(Text)) AND not OpSys = "Windows 2000" Then TextX = Text
If not TextX = "" Then
Text = "Auf diesem PC ist z.Z. WindowsScriptHost Version 1.0 (WSH1) installiert" & vbCRLF
Text = Text & "Dieses Programm läuft besser, einfacher, schneller, höher, weiter, breiter . . ." & vbCRLF
Text = Text & "wenn eine neuere Version installiert ist. " & vbCRLF & vbCRLF
Text = Text & "(" & TextX & ")" & vbCRLF & vbCRLF
Text = Text & "Jetzt installieren? (Ist ein Neustart erforderlich?)"
'nächsten VIER Zeilen freigeben
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
aktAusw = MsgBox(Text, vbYesNo + vbDefaultButton1 + vbQuestion, Titel)
if aktAusw <> vbNo Then
WSHShell.Run (TextX),,True
End If
End If
End If
' ----------------------------------------------
' Das Hauptmenü:
' ----------------------------------------------
Do
If Modus = "TEST" Then
Titel = "WSH" & WSHver & " unter " & NT_9x & "/" & OpSys & " (" & aktCD & ")"
Else
Titel = "Auswahlmenü (c) service.cd@gmx.de"
End if
Anzeige = " 2 " & vbTAB & "Windows 2000 SP2 installieren." & vbCRLF
Anzeige = Anzeige & " 4 " & vbTAB & "Windows NT4 SP6a installieren." & vbCRLF
Anzeige = Anzeige & " a " & vbTAB & "Acrobat Reader v5 installieren." & vbCRLF
Anzeige = Anzeige & " f " & vbTAB & "F-PROT Virus-Scanner starten." & vbCRLF
Anzeige = Anzeige & " i6" & vbTAB & "InternetExplorer v6 installiern." & vbCRLF
Anzeige = Anzeige & " j " & vbTAB & "JVM für MS IE v6 installiern." & vbCRLF
Anzeige = Anzeige & " m " & vbTAB & "McAfee VirusScan starten." & vbCRLF
Anzeige = Anzeige & " mc" & vbTAB & "McAfee VirusScan Kopieren & starten." & vbCRLF
Anzeige = Anzeige & " o1" & vbTAB & "Office 2000 SR1 installieren." & vbCRLF
Anzeige = Anzeige & " o2" & vbTAB & "Office 2000 SR1 SP2 installieren." & vbCRLF
Anzeige = Anzeige & " v " & vbTAB & "VC, WinRAR ... kopieren." & vbCRLF
Anzeige = Anzeige & " w " & vbTAB & "Windows Commander starten." & vbCRLF
Anzeige = Anzeige & " wc" & vbTAB & "Windows Commander kopieren & starten." & vbCRLF
If (fso.FileExists(CDLw & InfoDatei)) Then Anzeige = Anzeige & " . . . was soll's denn sein? (h => Hilfe/Info's)"
If not (fso.FileExists(CDLw & InfoDatei)) Then Anzeige = Anzeige & " . . . was soll's denn sein?"
Eingabe = InputBox(Anzeige,Titel,,500,1)
If Eingabe = "" Then ' Abbruch vom Benutzer
' aktAusw = MsgBox(". . . wirklich beenden?", vbYesNo + vbDefaultButton1 + vbQuestion, Titel)
aktAusw = MsgBox(". . . wirklich beenden?", vbYesNo + vbDefaultButton2 + vbQuestion, Titel)
if aktAusw <> vbNo Then WScript.Quit
End If
If UCase(Eingabe) = "TEST" AND Modus = "" Then Modus = "TEST"
If UCase(Eingabe) = "NOTEST" AND Modus = "TEST" Then Modus = ""
If UCase(Eingabe) = "-TEST" AND Modus = "TEST" Then Modus = ""
If Eingabe = "?" Then MsgBox Info, vbOKOnly, Titel
If Eingabe = "ß" Then MsgBox Info, vbOKOnly, Titel
If Eingabe = "2" Then
TextX = CDLw & "\W2kSp2\W2KSP2.exe"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX),,TRUE
End If
If Eingabe = "4" Then
TextX = CDLw & "\NT4_SP6A\SP6I386.EXE"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX),,TRUE
End If
If UCase(Eingabe) = "A" Then
TextX = CDLw & "\TOOL\AcroRead\ar500deu.exe"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX),,TRUE
End If
If UCase(Eingabe) = "F" Then FProtCopy
If UCase(Eingabe) = "H" Then
TextX = CDLw & InfoDatei
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX)
End If
If UCase(Eingabe) = "I6" Then
TextX = CDLw & "\TOOL\ie6\ie6setup.exe"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX),,TRUE
End If
If UCase(Eingabe) = "J" Then
TextX = CDLw & "\TOOL\WinXX\JVM\msjavx86.exe"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX),,TRUE
End If
If UCase(Eingabe) = "M" Then
If NT_9x = "NT" Then TextX = CDLw & "\MCAFEE_4.DOS\ScanNT.BAT"
If NT_9x = "9x" Then TextX = CDLw & "\MCAFEE_4.DOS\Scan9x.BAT"
ExeRun
End If
If UCase(Eingabe) = "MC" Then McAfeeCopy
If UCase(Eingabe) = "MI" Then McAfeeCopy
If UCase(Eingabe) = "O1" Then
TextX = CDLw & "\TOOL\O2kSR1\o2ksr1adl.exe"
If (fso.FileExists(TextX)) Then
Ziel = TmpDir & "\o2ksr1"
If (fso.FolderExists(Ziel)) Then fso.DeleteFolder(Ziel), True
WSHShell.Run (TextX & " /T:" & Ziel),,TRUE
TextX = Ziel & "\setup.exe"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX),,TRUE
End If
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
End If
If UCase(Eingabe) = "O2" Then
TextX = CDLw & "\TOOL\Office.2k\O2kSR1Sp2\sp2upd.exe"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX),,TRUE
End If
If UCase(Eingabe) = "V" Then VCcopy
If UCase(Eingabe) = "W" Then
TextX = CDLw & "\WinCMD\WINCMD32.EXE"
If not (fso.FileExists(TextX)) Then MsgBox "Fehler!" & vbCRLF & vbCRLF & "Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
If (fso.FileExists(TextX)) Then WSHShell.Run (TextX)
End If
If UCase(Eingabe) = "WC" Then WinCMDcopy
If UCase(Eingabe) = "WI" Then WinCMDcopy
If UCase(Eingabe) = "X" Then WScript.Quit
Loop
Sub VCcopy
' ----------------------------------------------
' DateienListe holen und löschen
' ----------------------------------------------
' Zuerst wird die Liste der zu kopierenden Dateien (Quelle) geholt,
' um dann im Zielverzeichnis genau diese Dateien zu löschen.
' Dadurch gibt es keine Probleme beim überschreiben beim Kopiervorgang.
Quelle = CDLw & "\DISKS\win_pc\win_pc"
If not (fso.FolderExists(Quelle)) Then
MsgBox "Fehler!" & vbCRLF & vbCRLF & "SubVCcopy: Das erforderliche Verzeichnis " & Quelle & " nicht gefunden!", vbOKOnly, Titel
Exit Sub
End If
Set Quelle = fso.GetFolder(WSHShell.ExpandEnvironmentStrings(Quelle))
Set DateiNamen = Quelle.Files
For Each i In DateiNamen
DateiName = ZielSys & "\" & i.Name
On Error Resume Next
fso.DeleteFile(DateiName), True
On Error GoTo 0
Next
' ----------------------------------------------
' Dateien kopieren
' ----------------------------------------------
fso.CopyFolder Quelle, ZielSys
Anzeige = "VC, WinRAR, WinCMD . . . in's lokale System (" & ZielSys & ") kopieren . . ." & vbCRLF & vbCRLF
Anzeige = Anzeige & ". . . ist erledigt! "
MsgBox Anzeige,, Titel
End Sub ' VCcopy
Sub McAfeeCopy
Quelle = CDLw & "\MCAFEE_4.DOS"
If not (fso.FolderExists(Quelle)) Then ' Quelle vorhanden?
MsgBox "SubMcAfeeCopy: " & "Fehler!" & vbCRLF & vbCRLF & "Das erforderliche Verzeichnis " & Quelle & " nicht gefunden!", vbOKOnly, Titel
Exit Sub
End If
Ziel = InstDir & "\MCAFEE_4.DOS"
Ziel = WSHShell.ExpandEnvironmentStrings(Ziel)
If (fso.FolderExists(Ziel)) Then ' Zielverzeichnis löschen, fals vorhanden
If Modus = "TEST" Then MsgBox Ziel & " wird gelöscht",, Titel
fso.DeleteFolder(Ziel), True
End If
fso.CopyFolder Quelle, Ziel ' Quelle ins Zielverzeichnis kopieren
If Modus = "TEST" Then MsgBox Quelle & " wurde nach " & Ziel & " kopiert!",, Titel
' fso.DeleteFile(Ziel & "\clean.dat"), True ' clean.dat löschen - damit kann man Geld verdienen
If NT_9x = "NT" Then TextX = Ziel & "\ScanNT.BAT"
If NT_9x = "9x" Then TextX = Ziel & "\Scan9x.BAT"
' ----------------------------------------------
' Verknüpfung anlegen - erreichbar wegen PATH
' ----------------------------------------------
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\ma.lnk")
Text1 = "LNK: " & vbTab & WSHShell.CreateShortcut(ZielSys & "\ma.lnk") & vbCRLF
ShellLink.TargetPath = TextX
Text1 = Text1 & "Target: " & vbTab & TextX & vbCRLF
ShellLink.WorkingDirectory = Ziel
Text1 = Text1 & "WorkDir: " & vbTab & Ziel & vbCRLF
ShellLink.Save
If Modus = "TEST" Then MsgBox "Folgende Verknüpfung wurde erstellt: " & vbCRLF & Text1,,Titel
Anzeige = Quelle & " wurde nach " & Ziel & " kopiert!" & vbCRLF & vbCRLF
Anzeige = Anzeige & "McAfee - Scan kann per <Start> <Ausführen> "" ma "" aufgerufen werden."
MsgBox Anzeige,, Titel
WSHShell.Run ("ma")
End Sub ' McAfeeCopy
Sub SuperScanCopy
Quelle = CDLw & "\Tool\SuperScan"
If not (fso.FolderExists(Quelle)) Then ' Quelle vorhanden?
MsgBox "SuperScanCopy: " & "Fehler!" & vbCRLF & vbCRLF & "Das erforderliche Verzeichnis " & Quelle & " nicht gefunden!", vbOKOnly, Titel
Exit Sub
End If
Set Quelle = fso.GetFolder(WSHShell.ExpandEnvironmentStrings(Quelle))
Set DateiNamen = Quelle.Files
For Each i In DateiNamen ' Quell-Dateien-Liste
DateiName = ZielSys & "\" & i.Name ' ist Liste der zu löschenden
On Error Resume Next ' Dateien im Zielverzeichnis
' MsgBox Dateiname,,Titel
fso.DeleteFile(DateiName), True
On Error GoTo 0
Next
Ziel = InstDir & "\SuperSc"
Ziel = WSHShell.ExpandEnvironmentStrings(Ziel)
' Zielverzeichnis löschen, fals vorhanden
If (fso.FolderExists(Ziel)) Then fso.DeleteFolder(Ziel), True
' ----------------------------------------------
' Dateien kopieren
' ----------------------------------------------
fso.CopyFolder Quelle, Ziel
If Modus = "TEST" Then MsgBox Quelle & " wurde nach " & Ziel & " kopiert!",, Titel
' ----------------------------------------------
' Verknüpfung anlegen - erreichbar wegen PATH
' ----------------------------------------------
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\scanner.lnk")
ShellLink.TargetPath = Ziel & "\scanner.exe"
ShellLink.WorkingDirectory = Left(Ziel, InstrRev(Ziel, "\"))
ShellLink.Save
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\SS.lnk")
ShellLink.TargetPath = Ziel & "\scanner.exe"
ShellLink.WorkingDirectory = Left(Ziel, InstrRev(Ziel, "\"))
ShellLink.Save
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\SScan.lnk")
ShellLink.TargetPath = Ziel & "\scanner.exe"
ShellLink.WorkingDirectory = Left(Ziel, InstrRev(Ziel, "\"))
ShellLink.Save
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\SuperScan.lnk")
ShellLink.TargetPath = Ziel & "\scanner.exe"
ShellLink.WorkingDirectory = Left(Ziel, InstrRev(Ziel, "\"))
ShellLink.Save
Anzeige = Quelle & " wurde nach " & Ziel & " kopiert!" & vbCRLF & vbCRLF
Anzeige = Anzeige & "SuperScan kann per <Start> <Ausführen> "" SScan "" aufgerufen werden."
MsgBox Anzeige,, Titel
WSHShell.Run ("ss")
End Sub ' SuperScanCopy
Sub WinCMDcopy
' ----------------------------------------------
' DateienListe holen und löschen
' ----------------------------------------------
' Zuerst wird die Liste der zu kopierenden Dateien (Quelle) geholt,
' um dann im Zielverzeichnis genau diese Dateien zu löschen.
' Dadurch gibt es keine Probleme beim überschreiben beim Kopiervorgang.
Quelle = CDLw & "\WinCMD"
Ziel = InstDir & "\WinCMD"
If not (fso.FolderExists(Quelle)) Then
MsgBox "SubWinCMDcopy: " & "Fehler!" & vbCRLF & vbCRLF & "Das erforderliche Verzeichnis " & Quelle & " nicht gefunden!", vbOKOnly, Titel
Exit Sub
End If
' ----------------------------------------------
' Dateien kopieren
' ----------------------------------------------
If Modus = "TEST" Then MsgBox Ziel & " wird gelöscht . . . ",, Titel
If (fso.FolderExists(Ziel)) Then fso.DeleteFolder(Ziel), True
If Modus = "TEST" Then MsgBox Ziel & " ist gelöscht . . . ",, Titel
If Modus = "TEST" Then MsgBox Quelle & " wird jetzt nach " & Ziel & " kopiert!",, Titel
fso.CopyFolder Quelle, Ziel
If Modus = "TEST" Then MsgBox Quelle & " wurde nach " & Ziel & " kopiert!",, Titel
' ----------------------------------------------
' Verknüpfung anlegen - erreichbar wegen PATH
' ----------------------------------------------
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\wc.lnk")
ShellLink.TargetPath = Ziel & "\Wincmd32.exe"
ShellLink.WorkingDirectory = Left(Ziel, InstrRev(Ziel, "\"))
ShellLink.Save
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\wincmd.lnk")
ShellLink.TargetPath = Ziel & "\Wincmd32.exe"
ShellLink.WorkingDirectory = Left(Ziel, InstrRev(Ziel, "\"))
ShellLink.Save
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\wincmd32.lnk")
ShellLink.TargetPath = Ziel & "\Wincmd32.exe"
ShellLink.WorkingDirectory = Left(Ziel, InstrRev(Ziel, "\"))
ShellLink.Save
Anzeige = Quelle & " wurde nach " & Ziel & " kopiert!" & vbCRLF & vbCRLF
Anzeige = Anzeige & "WinCommander kann per <Start> <Ausführen> "" wc "" aufgerufen werden."
MsgBox Anzeige,, Titel
WSHShell.Run ("wc")
End Sub ' WinCMDcopy
Sub FProtCopy
' ----------------------------------------------
' DateienListe holen und löschen
' ----------------------------------------------
' Zuerst wird die Liste der zu kopierenden Dateien (Quelle) geholt,
' um dann im Zielverzeichnis genau diese Dateien zu löschen.
' Dadurch gibt es keine Probleme beim überschreiben beim Kopiervorgang.
Quelle = CDLw & "\F-Prot"
Ziel = InstDir & "\F-Prot"
If not (fso.FolderExists(Quelle)) Then
MsgBox "SubFProtCopy: " & "Fehler!" & vbCRLF & vbCRLF & "Das erforderliche Verzeichnis " & Quelle & " nicht gefunden!", vbOKOnly, Titel
Exit Sub
End If
Set Quelle = fso.GetFolder(WSHShell.ExpandEnvironmentStrings(Quelle))
Set DateiNamen = Quelle.Files
For Each i In DateiNamen
DateiName = Ziel & "\" & i.Name
On Error Resume Next
' MsgBox Dateiname,,Titel
fso.DeleteFile(DateiName), True
On Error GoTo 0
Next
' ----------------------------------------------
' Dateien kopieren
' ----------------------------------------------
If Modus = "TEST" Then MsgBox Quelle & " wurde nach " & Ziel & " kopiert!",, Titel
fso.CopyFolder Quelle, Ziel
' ----------------------------------------------
' Verknüpfung anlegen - erreichbar wegen PATH
' ----------------------------------------------
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\fp.lnk")
ShellLink.TargetPath = Ziel & "\fp.bat"
ShellLink.WorkingDirectory = Ziel
ShellLink.Save
Set ShellLink = WSHShell.CreateShortcut(ZielSys & "\f-prot.lnk")
ShellLink.TargetPath = Ziel & "\fp.bat"
ShellLink.WorkingDirectory = Ziel
ShellLink.Save
If Modus = "TEST" Then MsgBox "Folgende Verknüpfung wurde erstellt: " & vbCRLF & ZielSys & "\f-p.lnk",,Titel
Anzeige = "F-PROT . . . nach " & Ziel & " kopieren . . ." & vbCRLF
Anzeige = Anzeige & ". . . ist erledigt! " & vbCRLF & vbCRLF
Anzeige = Anzeige & "F-PROT wird jetzt gestartet! "
MsgBox Anzeige,, Titel
WSHShell.Run ("fp")
End Sub ' FProtCopy
Sub ExeRun
' ----------------------------------------------
' *.exe - Datei ausführen
' ----------------------------------------------
' Es wird ein Verknüpfung %TMP%\?????.lnk erstellt, die zusätzlich
' das Arbeitsverzeichnis enthält - manche Programme laufen sonst nicht
If not (fso.FileExists(TextX)) Then
MsgBox "Fehler!" & vbCRLF & vbCRLF & "SubExeRun: Die erforderliche Datei " & TextX & " existiert nicht!", vbOKOnly, Titel
Exit Sub
End If
LNK = Mid(TextX, (InstrRev(TextX, "\")+1))
LNK = Left( LNK, (Instr(LNK, ".")-1))
If Modus = "TEST" Then MsgBox "SubExeRUN erstellt folgenden Link und ruft ihn auf: " & vbCRLF & LNK,,Titel
Text = TmpDir & "\" & LNK
If (fso.FileExists(Text & ".pif")) Then
fso.DeleteFile(Text & ".pif"), True
If Modus = "TEST" Then MsgBox Text & ".pif . . . gelöscht!" ,,Titel
End If
If (fso.FileExists(Text & ".lnk")) Then
fso.DeleteFile(Text & ".lnk"), True
If Modus = "TEST" Then MsgBox Text & ".lnk . . . gelöscht!",,Titel
End If
If (fso.FileExists(Text & ".")) Then
fso.DeleteFile(Text & "."), True
If Modus = "TEST" Then MsgBox Text & ". . . . gelöscht!" ,,Titel
End If
If (fso.FileExists(Text)) Then
fso.DeleteFile(Text), True
If Modus = "TEST" Then MsgBox Text & " . . . gelöscht!" ,,Titel
End If
Set ShellLink = WSHShell.CreateShortcut(Text & ".lnk")
Text1 = "LNK: " & vbTab & WSHShell.CreateShortcut(Text & ".lnk") & vbCRLF
ShellLink.WorkingDirectory = Left(TextX, InstrRev(TextX, "\"))
Text1 = Text1 & "WorkDir: " & vbTab & Left(TextX, InstrRev(TextX, "\")) & vbCRLF
ShellLink.TargetPath = TextX
Text1 = Text1 & "Target: " & vbTab & Left(TextX, InstrRev(TextX, "\")) & vbCRLF
ShellLink.Save
If Modus = "TEST" Then MsgBox "Folgende Verknüpfung wurde erstellt: " & vbCRLF & Text1,,Titel
' Text = Text & ".lnk"
If Modus = "TEST" Then MsgBox Text & vbCRLF & "wird aufgerufen . . .",,Titel
WSHShell.Run Text
' WSHShell.Run (Text),,True ' auf Anwendungsende warten geht nicht immer
' WScript.Sleep 7500 ' geht erst ab WSH2
End Sub ' ExeRun
Sub CDTest
' ---------------------------------------------------------
' Testen der Windows-Version: ZielSys, OpSys, NT_9x
' ---------------------------------------------------------
On Error Resume Next
RegKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\Productname"
TextX = WSHShell.RegRead(RegKey)
If not err.number <> 0 Then
ZielSys = "Command"
OpSys = WSHShell.RegRead(RegKey)
NT_9x = "9x"
End if
On Error GoTo 0
On Error Resume Next
RegKey = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\CurrentVersion"
TextX = "Windows NT " & WSHShell.RegRead(RegKey)
If not err.number <> 0 Then
ZielSys = "System32"
OpSys = "Windows NT " & WSHShell.RegRead(RegKey)
NT_9x = "NT"
End if
On Error GoTo 0
On Error Resume Next
RegKey = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Productname"
TextX = WSHShell.RegRead(RegKey)
If not err.number <> 0 Then
ZielSys = "System32"
OpSys = WSHShell.RegRead(RegKey)
NT_9x = "NT"
End if
On Error GoTo 0
Zielsys = WSHShell.ExpandEnvironmentStrings(WSHShell.Environment.Item("WINDIR")) & "\" & ZielSys
' ---------------------------------------------------------
' Lokalen Eigenschaften: SysLw, TmpDir, VBver, aktCD
' ---------------------------------------------------------
CDLw = Left (fso.GetFolder("."), 2) ' CD-Lw.-Buchstabe
aktCD = fso.GetDrive(fso.GetDriveName(CDLw)).VolumeName ' CD-Label
SysLw = Left (WSHEnv ("WINDIR"), 3)
TmpDir = WSHEnv("TEMP")
If TmpDir = "" Then TmpDir = WSHEnv("TMP")
' Unter Win2k ist das Temp-Verz. ?:\Dokumente und Einstellungen\UserName\TEMP
' Wenn TmpDir das ..\UserName\TEMP-Verzeichnis ist und ein ?:\Winnt\TEMP existiert,
' wird TmpDir auf ?:\Winnt\TEMP geändert
if 0 <> InstrRev(TmpDir, objNet.UserName) AND (fso.FolderExists(WSHEnv("SystemRoot") & "\TEMP")) Then TmpDir = WSHEnv("SystemRoot") & "\TEMP"
VBver = WScript.Version
if VBver < "5.1" Then WSHver = "1"
if VBver = "5.1" Then WSHver = "2"
if VBver = "5.6" Then WSHver = "5.6"
if VBver > "5.6" Then WSHver = ">5.6"
' ---------------------------------------------------------
' Festplatte mit dem meisten freien Platz ermitteln: LwHDD
' ---------------------------------------------------------
Set DriveList = fso.Drives
LwFrei = CInt(0)
For Each i in DriveList
if 2 = i.DriveType Then
If i.IsReady Then
If LwFrei < CInt(FormatNumber(i.FreeSpace/1024/1024, 0)) Then
LwFrei = CInt(FormatNumber(i.FreeSpace/1024/1024, 0))
LwHDD = i.DriveLetter & ":"
LwSum = CInt(FormatNumber(i.TotalSize/1024/1024, 0))
End If
End If
End If
Next
' ---------------------------------------------------------
' Installationsverzeichnis festlegen: InstDir
' ---------------------------------------------------------
' Hier werden Dateien abelegt, die für spätere oder wiederholte Installationen
' bzw. Updates erforderlich sind. Nachdem das %TEMP% Verzeichnis als InstDir festgelegt
' wurde, wird zunächst versucht auf dem SystemLaufwerk (meist C:) und anschließend auf
' LwHDD (Festplatte/Partition auf dem System mit dem meisten freien Platz; z.B. D:) ein
' vorhandenes Verzeichnis (setups, setup oder install) zu finden. Existiert ein solches
' Verzeichnis, wird InstDir überschrieben.
If (fso.FolderExists(TmpDir)) Then InstDir = WSHShell.ExpandEnvironmentStrings(TmpDir)
If (fso.FolderExists(SysLw & "setups" )) Then InstDir = WSHShell.ExpandEnvironmentStrings(SysLw & "\setups")
If (fso.FolderExists(SysLw & "setup" )) Then InstDir = WSHShell.ExpandEnvironmentStrings(SysLw & "\setup")
If (fso.FolderExists(SysLw & "install")) Then InstDir = WSHShell.ExpandEnvironmentStrings(SysLw & "\install")
If (fso.FolderExists(SysLw & "driver" )) Then InstDir = WSHShell.ExpandEnvironmentStrings(SysLw & "\install")
If (fso.FolderExists(SysLw & "treiber")) Then InstDir = WSHShell.ExpandEnvironmentStrings(SysLw & "\install")
If (fso.FolderExists(LwHDD & "\setups" )) Then InstDir = WSHShell.ExpandEnvironmentStrings(LwHDD & "\setups")
If (fso.FolderExists(LwHDD & "\setup" )) Then InstDir = WSHShell.ExpandEnvironmentStrings(LwHDD & "\setup")
If (fso.FolderExists(LwHDD & "\install")) Then InstDir = WSHShell.ExpandEnvironmentStrings(LwHDD & "\install")
If (fso.FolderExists(LwHDD & "\driver" )) Then InstDir = WSHShell.ExpandEnvironmentStrings(LwHDD & "\install")
If (fso.FolderExists(LwHDD & "\treiber")) Then InstDir = WSHShell.ExpandEnvironmentStrings(LwHDD & "\install")
If Modus = "TEST" Then MsgBox LwHDD & " ist das Laufwerk mit dem meisten freien Platz: " & LwFrei & " MB von " & LwSum & " MB frei. ", vbOKOnly, Titel
End Sub ' CDTest
http://dieseyer.de • all rights reserved • © 2011 v11.4