
'Dieses Installationsskript dient auch Lernzwecken. Es ist deshalb einfach gehalten. Für professionelle Zwecke
'existieren Autorensysteme, zum Beispiel die Produkte von InstallShield

'Option Explicit ...
'  (1) prüft ob alle Objekte so vereinbart sind (Orthographieprüfung)
'  (2) verbessert die Codeeffizienz
'  Datentypen werden allerdings - anders als in VBA - nicht geprüft. Oft wird deshalb der Datentyp durch 
'  ein Präfix (z.B. int, str) angegeben. Wir verzichten darauf, weil hier der Kontext den Datentyp klar macht.

'Ich danke Martin Fischer für die Hilfe bei der Erstellung dieses Installationsskripts

Option Explicit

'Hauptprogramm
'**********************************************************************************************************************
Const cNormal = 0
Const cDriveTypeCDROM = 4     'Ergebnis von <Drive>.DriveType

Private Titel
Private Information
Private Skriptumgebung
Private Dateisystem
Private Anwendungspfad
Private Laufwerkname
Private Laufwerk
Private Accesspfad
Private Prompt
Private Vollinstallation
Private Befehlszeilenrest
Private Iconpfad
Private CDLaufwerkbuchstabe
Private InstallationspfadOk
Private Speicherplatz
Private CrLfCrLf              'doppelter Zeilensprung
Private Windowspfad

'-- keine benutzerdefinierte Fehlerbehandlung

'-- Initialisierungen
Set Skriptumgebung = WScript.CreateObject("WScript.Shell")  'eine von mehreren Shells (Skriptumgebungen)
Set Dateisystem = WScript.CreateObject("Scripting.FileSystemObject")

'1 CdEUS eingelegt?
'------------------
Do Until CDROMBereit(CDLaufwerkbuchstabe) = True
	If MsgBox("Legen Sie die richtige CD ROM ins Laufwerk (Abbrechen verlässt die Installation)", vbOkCancel+vbExclamation, " CD ROM nicht gefunden") = vbCancel Then
	  WScript.Quit  '==================================================>
	End If
Loop

'2 Information über CdEUS
'------------------------
CrLfCrLf = vbCrLf & vbCrLf
Information = _
  "Ein Teil der CD wird auf Ihre Festplatte kopiert. Das nicht kopierte Verzeichnis Demonstrationssoftware" & vbCrLf & _
  "und das kopierte Verzeichnis EUS sind für den Leser von " & Chr(34) & "Data Warehousing und Data Mining" & Chr(34) & vbCrLf & _
  "bestimmt (ReadmeDataWarehousing.pdf)." & CrLfCrLf & _
  "Wenn Sie alle Dokumente und Programme der CD ROM nutzen wollen, dann benötigen Sie mindestens:" & CrLfCrLf & _
  "a)  Windows 95/NT 4.0" & vbCrLf & _
  "b)  MS Excel 97 für einen Teil der Beispiele" & vbCrLf & _
  "c)  MS Access 2000 für TESTS und weitere Datenbankbeispiele" & vbCrLf & _
  "d)  MS Internet Explorer 4.0 für Hilfedateien und Web Quizzes." & vbCrLf & _
  "e)  Acrobat Reader 3.0 für pdf-Dokumente (Verzeichnis Demonstrationssoftware/AcroReader)." & CrLfCrLf & _
  "Testverwaltung.mdb lässt sich mit Access 2000 nur starten, falls Sie nach der Installation einen" & vbCrLf & _
  "Objektverweis ändern (Hilfethema Installation/Access-Version)."
Titel = _
  " CD ROM zu " & Chr(34) & "Dateien und Datenbanken" & Chr(34) & " und " & Chr(34) & "Data Warehousing und Data Mining" & Chr(34) & " (Springer Verlag)"
If MsgBox(Information, vbOkCancel+vbInformation, Titel) = vbCancel Then WScript.Quit  '===================>

'3 Vollinstallation oder Start ab CD ROM? (vbCrLf für Carriage Return/Line Feed das heisst Zeilensprung)
'----------------------------------------
Prompt = _
  "JA       kopiert 220 Mb auf die Festplatte  (empfohlen)" & vbCrLf & _
	"NEIN   installiert nur die Startsymbole  (Bearbeitung der kopierten Dateien nicht möglich)"
Vollinstallation = MsgBox(Prompt, vbYesNoCancel+vbDefaultButton1, "Vollinstallation?")
If Vollinstallation = vbCancel Then WScript.Quit  '==================================================>

'4 Installationspfad?
'--------------------
If Vollinstallation = vbYes Then
  Prompt = "Wo wollen Sie die Beispiele und Aufgaben auf der Festplatte installieren?"
  InstallationspfadOk = False
  Do Until InstallationspfadOk = True
    'Antwort = InputBox(<Prompt>, <Titel>, <Voreinstellung>) mit Ok- und Cancel-Schaltflächen 
    Anwendungspfad = InputBox(Prompt, "Installationsverzeichnis? ", "C:\Programme\CdEUS")
    If Anwendungspfad = "" Then WScript.Quit  'nach Cancel ===========================================>
    Befehlszeilenrest = _
      Chr(34) & Anwendungspfad & "\GrundlagenExcel\BeispieleAufgaben\Fallbeispiel " & _ 
	    "TESTS\Testverwaltung.mdb" & Chr(34) & " /cmd " & Chr(34) & Anwendungspfad &  _
	    "\GrundlagenExcel\BeispieleAufgaben\Fallbeispiel TESTS" & Chr(34)
    'Überflüssigen Backslash entfernen
	  If Right(Anwendungspfad, 1) = "\" Then Anwendungspfad = Left(Anwendungspfad, Len(Anwendungspfad)-1)
	  '-- Anwendungspfad prüfen
	  If Len(Anwendungspfad & Befehlszeilenrest) > 255 Then
	    Prompt = _
	      "Der Pfad und die Befehlszeile eines Startsymbols dürfen zusammen höchstens 255 Zeichen lang sein." & CrLfCrLf & _
	      "Bitte neuen Pfad eingeben oder manuell (und ohne Startsymbole) installieren"
	    InstallationspfadOk = False
	  Else
      If Dateisystem.FolderExists(Anwendungspfad) = True Then
        Prompt = "Verzeichnis bereits vorhanden. Bitte neuen Pfad eingeben"
        InstallationspfadOk = False
      Else
        Laufwerkname = Dateisystem.GetDriveName(Anwendungspfad)
        If Laufwerkname <> "" Then
	        Set Laufwerk = Dateisystem.GetDrive(Laufwerkname)
		      InstallationspfadOk = True
		    Else
		      Prompt = "Unerlaubter Verzeichnispfad. Bitte neuen Pfad eingeben"
		      InstallationspfadOk = False
		    End if
      End If
	  End If
  Loop
  
'5 Von CD ROM kopieren
'---------------------
  '-- Genügend Speicherplatz?
	'   formatierter Ausdruck = FormatNumber(<arithmetischer Ausdruck>, <Zahl der Dezimalstellen>)
	'   FreeSpace-Eigenschaft ergibt freien Speicher in Bytes. Argument von FormatNumber rechnet Bytes in Mb um
  Speicherplatz = FormatNumber(Laufwerk.FreeSpace/1048576, 0)
	If Speicherplatz >= 200 Then  '200 Mb
		'-- CD kopieren
		If MsgBox("Der Kopiervorgang dauert eine Weile, warten Sie bis zur Endemeldung.", vbOkCancel+vbDefaultButton1+vbInformation, " Von CD ROM auf die Festplatte kopieren") = vbCancel Then WScript.Quit  '==================================================>
    erstelleInstallationspfad(Anwendungspfad)
    '-- Copy...(<Quelle>, <Ziel>)
    '   (Verzeichnis Demonstrationssoftware wird nicht kopiert) 
	  Dateisystem.CopyFolder CDLaufwerkbuchstabe & ":\EUS", Anwendungspfad & "\EUS"
	  Dateisystem.CopyFolder CDLaufwerkbuchstabe & ":\GrundlagenExcel", Anwendungspfad & "\GrundlagenExcel"
	  Dateisystem.CopyFile CDLaufwerkbuchstabe & ":\*.*" , Anwendungspfad
	  entferneSchreibschutz Anwendungspfad
	Else
		If MsgBox("Die Vollinstallation benötigt 200 Mb. Auf " & Anwendungspfad & _
		  " sind aber nur noch " & Speicherplatz & " Mb frei." & CrLfCrLf & _
		  "Ok lässt Sie ab CD ROM starten (Abbrechen verlässt Installation)" , vbOkCancel+vbExclamation) = vbCancel Then
			WScript.Quit '=======================================================>
		End If
	End If	
'-- b) Nur Startsymbole
Else  'Vollinstallation <> vbYes
	Anwendungspfad = CDLaufwerkbuchstabe & ":"
End If

'Dialogsteuerelement kopieren, falls nicht vorhanden
'---------------------------------------------------
'Dateidialoge von TESTS erfordern das ActiveX-Steuerelement COMDLG32.OCX (Microsoft Common Dialog Control)
Windowspfad =Skriptumgebung.ExpandEnvironmentStrings("%WinDir%") & "\system32"
If Dateisystem.FileExists(Windowspfad & "\COMDLG32.OCX") = False Then
  Dateisystem.CopyFile CDLaufwerkbuchstabe & ":\COMDLG32.OCX", Windowspfad & "\COMDLG32.OCX"
End If

'6 Startsymbole im Startmenü errichten
'-------------------------------------
Accesspfad = Skriptumgebung.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Extensions\mdb")
If Len(Accesspfad) > 0 Then  '(1) MS Access installiert
	'-- a) Testverwaltung.mdb (s. "Startsymbol" und "Befehlszeile" im Index der Hilfedatei TESTS.CHM)
	'   Befehlszeile = Accesspfad + Anwendungspfad + Befehlszeilenoption (hier /cmd) + Aufgabenbankpfad (Chr(34) für ") 
  Iconpfad = _
	  Anwendungspfad & "\GrundlagenExcel\BeispieleAufgaben\Fallbeispiel TESTS\Testverwaltung.ico"
	setzeStartmenuesymbol "Autorenkomponente von TESTS", Accesspfad, Befehlszeilenrest, Iconpfad
	
	'-- b) Access_Quiz.mdb
  Befehlszeilenrest = _
		Chr(34) & Anwendungspfad & "\GrundlagenExcel\BeispieleAufgaben\Fallbeispiel " & _ 
			"TESTS\Access_Quiz.mdb" & Chr(34) & " /cmd " & Chr(34) & Anwendungspfad & _
			"\GrundlagenExcel\BeispieleAufgaben\Fallbeispiel TESTS" & Chr(34)
	Iconpfad = _
		Anwendungspfad & "\GrundlagenExcel\BeispieleAufgaben\Fallbeispiel TESTS\Access_Quiz.ico"
	setzeStartmenuesymbol "Darbietungskomponente Access Quiz", Accesspfad, Befehlszeilenrest, Iconpfad
Else  '(2) MS Access nicht installiert
	MsgBox "Startsymbole für Testverwaltung.mdb und Access_Quiz.mdb nicht installiert", vbOkOnly+vbExclamation, " MS Access nicht gefunden"
End If

'-- c) Hilfe TESTS.mdb
setzeStartmenuesymbol "Hilfe zu TESTS", Anwendungspfad & "\GrundlagenExcel\BeispieleAufgaben\Fallbeispiel TESTS\TESTS.chm", "", ""
'-- d) Wurzelverzeichnis der CD EUS
setzeStartmenuesymbol "CD EUS", Anwendungspfad, "", ""
'-- e) Literaturverwaltung.mdb
Iconpfad = Anwendungspfad & "\GrundlagenExcel\BeispieleAufgaben\Literaturverwaltung.ico"
setzeStartmenuesymbol "Fallbeispiel Literaturverwaltung (Kap. 7)", Anwendungspfad & "\GrundlagenExcel\BeispieleAufgaben\Literaturverwaltung.mdb", "", Iconpfad

Information = _
  "Im Startmenü finden Sie ..." & CrLfCrLf & _
  "1  das Wurzelverzeichnis der kopierten CD ROM-Software" & vbCrLf & _
  "2  die HILFE mit den Curricula " & Chr(34) & "Datenbanken" & Chr(34) & ", " & Chr(34) & "Programmieren" & Chr(34) & " und " & Chr(34) & "Tabellenkalkulation" & Chr(34) & ")" & vbCrLf & _
  "3  die Autorenkomponente TESTVERWALTUNG" & vbCrLf & _
  "4  die Darbietungskomponente ACCESS QUIZ" & vbCrLf & _
  "5  das Beispiel LITERATURVERWALTUNG  (Kapitel 7 von " & Chr(34) & "Dateien und Datenbanken" & Chr(34) & ")"
MsgBox Information, vbOkOnly+vbInformation, " Installation erfolgreich"
WScript.Quit  '=====================================================================>


'Unterprogramme
'**********************************************************************************************************************
Function CDROMBereit(CDLaufwerkbuchstabe)
  Dim Laufwerk
  Dim Laufwerke

	CDLaufwerkbuchstabe = ""
	CDROMBereit = False
	Set Laufwerke = Dateisystem.Drives
	For Each Laufwerk in Laufwerke
	  With Laufwerk
		  If .DriveType = cDriveTypeCDROM Then
		    CDLaufwerkbuchstabe = .DriveLetter
		    If .IsReady Then
		      If .VolumeName = "CdEUS" Then
		        CDROMBereit = True
		        Exit For  '------------------------------------------>
		      End If
		    End If
		  End If
		End With
	Next
End Function

Sub erstelleInstallationspfad(Anwendungspfad)
  Dim Teilverzeichnisse
  Dim Teilverzeichnis
  Dim i
  
	Teilverzeichnisse = Split(Anwendungspfad, "\")  'Datenfeld aus den durch \ getrennten Teilverzeichnissen von Pfad
	Teilverzeichnis = Teilverzeichnisse(0)          'Laufwerkname (z.B. c:)
	For i = 1 to UBound(Teilverzeichnisse)
		Teilverzeichnis = Teilverzeichnis & "\" & Teilverzeichnisse(i)
		'CreateFolder erzeugt nur ein Verzeichnis und nicht alle Verzeichnis von Pfad
		Dateisystem.CreateFolder(Teilverzeichnis)
	Next
End Sub

Sub setzeStartmenuesymbol(Startsymbolname, Programmpfad, Befehlszeilenrest, Iconpfad)
	Dim Startsymbol
	Dim Startmenue
	
	Startmenue = Skriptumgebung.SpecialFolders("Programs")
	'Startmenü-Unterverzeichnis CdEUS einrichten, falls nicht bereits vorhanden
	If Not Dateisystem.FolderExists(Startmenue & "\CdEUS") Then Dateisystem.CreateFolder(Startmenue & "\CdEUS")
	'Startsymbol setzen
	Set Startsymbol = Skriptumgebung.CreateShortcut(Startmenue & "\CdEUS\" & Startsymbolname & ".lnk")
	With Startsymbol
	  .TargetPath = Programmpfad
	  .Arguments = Befehlszeilenrest
	  .IconLocation = Iconpfad
	  .Save
	End With
End Sub

'~~~ Anwendungsbeispiel für Rekursion
Sub entferneSchreibschutz(Pfad)
	Dim Verzeichnis
	Dim Unterverzeichnis
	Dim Datei

	Set Verzeichnis = Dateisystem.GetFolder(Pfad)
	'-- Setze alle Dateiattribute des Verzeichnisses Pfad auf cNormal
	For Each Datei in Verzeichnis.Files
		Datei.Attributes = cNormal
	Next
	'-- Setze alle Dateiattribute der Unterverzeichnisse von Pfad auf cNormal
	For Each Unterverzeichnis in Verzeichnis.SubFolders
		entferneSchreibschutz(Pfad & "\" & Unterverzeichnis.Name)  'rekursiv
	Next
End Sub
