home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_4_94 / vbwin / vbsetup / setup2.bas < prev    next >
BASIC Source File  |  1994-09-23  |  74KB  |  2,108 lines
  1. '============================================================
  2. ' Projekt        : Setup-Steuerung mit Hilfe von Makros
  3. ' Modulname      : SETUP2.BAS
  4. ' Aufgabe        : Globale Deklarationen und Routinen
  5. ' Copyright      : Arthur Burda
  6. ' Compiler       : Visual Basic 3.0 fⁿr Windows
  7. '============================================================
  8. ' l. ─nderung am : 26.07.1994
  9. ' Version        : 1.00
  10. ' Bemerkungen    : Erste Implementierung
  11. '------------------------------------------------------------
  12. ' l. ─nderung am : 24.09.1994
  13. ' Version        : 1.01
  14. ' Bemerkungen    : Neue Befehle: Kopiere_Datei_in_Win_Pfad
  15. '                  und Entpacke_LHARC_EXE_in_Win_Pfad
  16. '                  Balkenposition wird bei jedem Anzeigen des
  17. '                  Statusfensters (Kopieren von Dateien) auf 0
  18. '                  gesetzt.
  19. '------------------------------------------------------------
  20.  
  21. Option Explicit
  22.  
  23. DefInt A-Z
  24.  
  25. '------------------------------------------------------------
  26. ' globale Konstanten
  27. '------------------------------------------------------------
  28.  
  29. Global Const SRCCOPY = &HCC0020
  30.  
  31. '------------------------------------------------------------
  32. ' Typen
  33. '------------------------------------------------------------
  34.  
  35. Type OFStruct
  36.     cBytes As String * 1
  37.     fFixedDisk As String * 1
  38.     nErrCode As Integer
  39.     reserved As String * 4
  40.     szPathName As String * 128
  41. End Type
  42.  
  43. Type ParamType
  44.     i(10) As String
  45. End Type
  46.  
  47. '------------------------------------------------------------
  48. ' globale Variablen
  49. '------------------------------------------------------------
  50.  
  51. Global WinSysDir$ ' Windows-System-Verzeichnis
  52. Global WinDir$ ' Windows-Verzeichnis
  53. Global WinDrive$ ' Windows-Laufwerk
  54. Global gfWin31%
  55. Global gGroupName$ ' Name der Programmgruppe fⁿr die Applikation
  56.  
  57. Global SetupIniName$ ' Name der Setup-INI-Datei inkl. Pfad (Standard: SETUP2.INI)
  58.  
  59. ' Bereich [Global] (globale Parameter)
  60.  
  61. Global AppName$ ' Programmname (Standard: kein Name)
  62. Global SetupName$ ' Name des Setup-Programms (Standard: SETUP)
  63. Global WinSysNeeded& ' Anzahl Bytes fⁿr Windows-Verzeichnisse (unkomprimiert)
  64. Global OtherNeeded& ' Anzahl Bytes fⁿr sonstige Dateien (unkomprimiert)
  65. Global Compressed& ' Anzahl Bytes gesamt (komprimiert)
  66. Global fOLE2% ' Gibt an, ob OLE 2.0 benutzt wird (Standard: N)
  67.  
  68. ' Bereich [Setup-Fenster] (Hauptfenster des Setup-Programms)
  69.  
  70. Global SetupDlgTitle$ ' Setup-▄berschrift (Standard: keine ▄berschrift)
  71. Global TitleForeColor& ' Vordergrundfarbe der Setup-▄berschrift (Standard: &H80000005)
  72. Global TitleFontBold% ' True, wenn die Setup-▄berschrift fett erscheinen soll (Standard: N)
  73. Global TitleFontItalic% ' True, wenn die Setup-▄berschrift kursiv erscheinen soll (Standard: N)
  74. Global TitleFontUnderline% 'True, wenn die Setup-▄berschrift unterstrichen erscheinen soll (Standard: N)
  75. Global TitleFontName$ ' Name des Fonts fⁿr Setup-▄berschrift (Standard: MS Sans Serif)
  76. Global TitleFontSize# ' Gr÷▀e des Fonts fⁿr Setup-▄berschrift (Standard: 24)
  77. Global SetupDlgBackColor& ' Hintergrundfarbe des Setup-Fensters (Standard: &H808000)
  78. Global SetupDlgIntro$ ' Setup-Intro (Standard: kein Intro)
  79. Global SetupIntroPosX% ' X-Position des Setup-Intro (Standard: 12)
  80. Global SetupIntroPosY% ' Y-Position des Setup-Intro (Standard: 80)
  81. Global SetupIntroWidth% ' Breite des Setup-Intro (Standard: 609)
  82. Global SetupIntroHeight% ' H÷he des Setup-Intro (Standard: 353)
  83.  
  84. ' Bereich [Message-Boxen] (Parameter fⁿr Message-Boxen)
  85.  
  86. Global ErrorBoxCaption$ ' Kopfzeile fⁿr Fehler-Box (Standard: Fehler)
  87. Global CrErrorBoxCaption$ ' Kopfzeile fⁿr Kritischer-Fehler-Box (Standard: Kritischer Fehler)
  88. Global InfoBoxCaption$ ' Kopfzeile fⁿr Info-Box (Standard: Hinweis)
  89. Global QuestionBoxCaption$ ' Kopfzeile fⁿr Frage-Box (Standard: Frage)
  90. Global WarningBoxCaption$ ' Kopfzeile fⁿr Warnung-Box (Standard: Warnung)
  91.  
  92. ' Bereich [Status-Fenster] (Parameter fⁿr das Status-Dialogfenster)
  93.  
  94. Global StatusTitle$ ' Kopfzeile fⁿr das Status-Fenster (Standard: Status)
  95.  
  96. ' Bereich [Installation von] (Angabe des Quellpfades und anderer fⁿr die Installation wichtiger Parameter)
  97.  
  98. Global SrcDialogTitle$ ' Dialog-Kopfzeile (Standard: Installation von ...)
  99. Global SrcDialogInfo$ ' Info (Standard: Bitte geben Sie Laufwerk und Pfad ein, in dem sich das zu installierende Programm befindet.)
  100. Global SrcPathLabel$ ' Beschriftung fⁿr das Textfeld (Standard: Quellpfad:)
  101. Global SrcDrive$ ' Quell-Laufwerksbezeichnung (Standard: A:)
  102. Global SrcPath$ ' Quellpfad (ohne Laufwerksangabe, z.B. \TEST)
  103.  
  104. ' Bereich [Installation nach] (Angabe des Zielpfades und anderer fⁿr die Installation wichtiger Parameter)
  105.  
  106. Global DestDialogTitle$ ' Dialog-Kopfzeile (Standard: Installation nach ...)
  107. Global DestDialogInfo$ ' Info (Standard: Bitte geben Sie Laufwerk und Pfad ein, wonach das Programm installiert werden soll.)
  108. Global DestPathLabel$ ' Beschriftung fⁿr das Textfeld (Standard: Zielpfad:)
  109. Global DestDrive$ ' Ziel-Laufwerksbezeichnung (Standard: C:)
  110. Global DestPath$ ' Zielpfad (ohne Laufwerksangabe, z.B. \TEST)
  111.  
  112. Global position ' Position des Statusbalkens beim Kopieren von Dateien (in %)
  113.  
  114. '------------------------------------------------------------
  115. ' Deklaration der API-Funktionen
  116. '------------------------------------------------------------
  117.  
  118. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  119. Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  120. Declare Function BitBlt Lib "Gdi" (ByVal destHdc, ByVal x, ByVal y, ByVal w, ByVal h, ByVal srcHdc, ByVal srcX, ByVal srcY, ByVal Rop As Long)
  121. Declare Function GetVersion Lib "Kernel" () As Long
  122.  
  123. Declare Function DiskSpaceFree Lib "SETUPKIT.DLL" () As Long
  124. Declare Function AllocUnit Lib "SETUPKIT.DLL" () As Long
  125. Declare Function SetTime Lib "SETUPKIT.DLL" (ByVal A$, ByVal B$) As Integer
  126.  
  127. Declare Function VerInstallFile& Lib "ver.dll" (ByVal Flags%, ByVal SrcFile$, ByVal DestFile$, ByVal SrcPath$, ByVal DestPath$, ByVal CurrDir$, ByVal TmpFile$, lpwTmpFileLen%)
  128. Declare Function GetFileVersionInfoSize Lib "ver.dll" (ByVal lpszFileName As String, lpdwHandle As Long) As Long
  129. Declare Function GetFileVersionInfo Lib "ver.dll" (ByVal lpszFileName As String, ByVal lpdwHandle As Long, ByVal cbbuf As Long, ByVal lpvdata As String) As Integer
  130. Declare Function VerQueryValue Lib "ver.dll" (ByVal lpvBlock As String, ByVal lpszSubBlock As String, lplpBuffer As Long, lpcb As Integer) As Integer
  131. Declare Function lstrcpyn Lib "Kernel" (ByVal lpszString1 As Any, ByVal lpszString2 As Long, ByVal cChars As Integer) As Long
  132.  
  133. Declare Function WritePrivateProfileString% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpString$, ByVal lpFileName$)
  134. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, ByVal lpRetString$, ByVal nSize%, ByVal lpFileName$) As Integer
  135.  
  136. Declare Function OpenFile Lib "Kernel" (ByVal lpFileName As String, lpReOpenBuff As OFStruct, ByVal wStyle As Integer) As Integer
  137.  
  138. Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
  139.  
  140. Declare Function GetModuleHandle Lib "KERNEL" (ByVal ModuleName As String) As Integer
  141. Declare Function Ctl3DAutoSubclass Lib "CTL3D.DLL" (ByVal hInst As Integer) As Integer
  142. Declare Function Ctl3DRegister Lib "CTL3D.DLL" (ByVal hInst As Integer) As Integer
  143. Declare Function Ctl3DUnregister Lib "CTL3D.DLL" (ByVal hInst As Integer) As Integer
  144.  
  145. '============================================================
  146. ' Routine : AddShare
  147. '============================================================
  148. ' Aufgabe : Fⁿgt den SHARE-Befehl in die Datei AUTOEXEC.BAT ein
  149. '           (falls nicht vorhanden) und liefert True bzw. False
  150. '           zurⁿck.
  151. ' Eingabe : DosPath = DOS-Pfad
  152. '           Param   = SHARE-Parameter
  153. ' Ausgabe : keine
  154. ' Return  : True bzw. False (True wird auch bei Vorhandensein
  155. '           des SHARE-Befehls zurⁿckgeliefert)
  156. '------------------------------------------------------------
  157. '
  158. Function AddShare (DosPath$, Param$) As Integer
  159.  
  160.     Dim f1, f2
  161.     Dim found
  162.     Dim ln$
  163.  
  164.     On Error GoTo ERR_AddShare
  165.  
  166.     AddShare = False
  167.  
  168.     found = False
  169.  
  170.     f1 = FreeFile
  171.     Open "C:\AUTOEXEC.BAT" For Input As f1
  172.     While Not EOF(f1)
  173.     Line Input #f1, ln$
  174.     If InStr(1, UCase$(ln$), "REM") = 0 And InStr(1, ln$, ";") = 0 And InStr(1, UCase$(ln$), "SHARE") > 0 Then
  175.         found = True
  176.     End If
  177.     Wend
  178.     Close #f1
  179.  
  180.     If Not found Then
  181.     FileCopy "C:\AUTOEXEC.BAT", "C:\AUTOEXEC.$$$"
  182.     f1 = FreeFile
  183.     Open "C:\AUTOEXEC.BAT" For Output As f1
  184.     f2 = FreeFile
  185.     Open "C:\AUTOEXEC.$$$" For Input As f2
  186.     If DosPath$ = "" Then
  187.         If Param$ = "" Then
  188.         Print #f1, "SHARE.EXE"
  189.         Else
  190.         Print #f1, "SHARE.EXE " & Param$
  191.         End If
  192.     Else
  193.         If Param$ = "" Then
  194.         Print #f1, DosPath$ & "\SHARE.EXE"
  195.         Else
  196.         Print #f1, DosPath$ & "\SHARE.EXE " & Param$
  197.         End If
  198.     End If
  199.     While Not EOF(f2)
  200.         Line Input #f2, ln$
  201.         Print #f1, ln$
  202.     Wend
  203.     Close #f1
  204.     Close #f2
  205.     If Err = 0 Then
  206.         Kill "C:\AUTOEXEC.$$$"
  207.         AddShare = True
  208.     End If
  209.     Else
  210.     AddShare = True
  211.     End If
  212.  
  213. EXIT_AddShare:
  214.  
  215.     Exit Function
  216.  
  217. ERR_AddShare:
  218.  
  219.     Close #f1
  220.     Close #f2
  221.     If FileExists("C:\AUTOEXEC.$$$") Then
  222.     Kill "C:\AUTOEXEC.BAT"
  223.     Name "C:\AUTOEXEC.$$$" As "AUTOEXEC.BAT"
  224.     End If
  225.     AddShare = False
  226.     GoTo EXIT_AddShare
  227.  
  228. End Function
  229.  
  230. '============================================================
  231. ' Routine : CenterForm
  232. '============================================================
  233. ' Aufgabe : Zentriert eine Form auf dem Bildschirm.
  234. ' Eingabe : f = Form
  235. ' Ausgabe : keine
  236. '------------------------------------------------------------
  237. '
  238. Sub CenterForm (f As Form)
  239.  
  240.     Screen.MousePointer = 11
  241.     f.Top = (Screen.Height * .95) / 2 - f.Height / 2
  242.     f.Left = Screen.Width / 2 - f.Width / 2
  243.     Screen.MousePointer = 0
  244.  
  245. End Sub
  246.  
  247. '============================================================
  248. ' Routine : ConcatSplitFiles
  249. '============================================================
  250. ' Aufgabe : Fⁿgt Split-Dateien zu einer Datei zusammen.
  251. ' Eingabe : firstfile = Name der ersten Split-Datei
  252. '           cSplit    = Anzahl der Split-Dateien
  253. ' Ausgabe : keine
  254. '------------------------------------------------------------
  255. '
  256. Sub ConcatSplitFiles (firstfile$, cSplit%)
  257.  
  258.     Dim x%, fh1%, fh2%, outfile$, outfileLen&, CopyLeftOver&, CopyChunk#, filevar$
  259.     Dim iFileMax%, iFile%, y%
  260.  
  261.     For x% = 2 To cSplit%
  262.  
  263.     fh1% = FreeFile
  264.     Open Left$(firstfile$, Len(firstfile$) - 1) + Format$(1) For Binary As fh1%
  265.     
  266.     fh2% = FreeFile
  267.     outfile$ = Left$(firstfile$, Len(firstfile$) - 1) + Format$(x%)
  268.     Open outfile$ For Binary As fh2%
  269.     
  270.     Seek #fh1%, LOF(fh1%) + 1
  271.  
  272.     outfileLen& = LOF(fh2%)
  273.     CopyLeftOver& = outfileLen& Mod 10
  274.     CopyChunk# = (outfileLen& - CopyLeftOver&) / 10
  275.     filevar$ = String$(CopyLeftOver&, 32)
  276.     Get #fh2%, , filevar$
  277.     Put #fh1%, , filevar$
  278.     filevar$ = String$(CopyChunk#, 32)
  279.     iFileMax% = 10
  280.  
  281.     For iFile% = 1 To iFileMax%
  282.         Get #fh2%, , filevar$
  283.         Put #fh1%, , filevar$
  284.     Next iFile%
  285.  
  286.     Close fh1%, fh2%
  287.     y% = SetTime(outfile$, firstfile$)
  288.     Kill outfile$
  289.  
  290.     Next x%
  291.  
  292.     FileCopy Left$(firstfile$, Len(firstfile$) - 1) + Format$(1), firstfile$
  293.     Kill Left$(firstfile$, Len(firstfile$) - 1) + Format$(1)
  294.  
  295. End Sub
  296.  
  297. '============================================================
  298. ' Routine : CopyFile
  299. '============================================================
  300. ' Aufgabe : Kopiert die Datei SrcFileName (Pfad SourcePath)
  301. '           nach DestFileName (Pfad DestPath) und liefert True
  302. '           bzw. False zurⁿck, je nachdem, ob der Kopiervor-
  303. '           gang erfolgreich war oder nicht.
  304. ' Eingabe : SourcePath      = Quellpfad
  305. '           DestinationPath = Zielpfad
  306. '           SrcFileName     = Name der Quelldatei
  307. '           DestFileName    = Name der Zieldatei
  308. ' Ausgabe : keine
  309. ' Return  : True (Kopiervorgang erfolgreich) oder False (Ko-
  310. '           piervorgang mi▀lungen)
  311. '------------------------------------------------------------
  312. '
  313. Function CopyFile (ByVal SourcePath As String, ByVal DestinationPath As String, ByVal SrcFilename As String, ByVal DestFileName As String) As Integer
  314.  
  315.     Const VIFF_FORCEINSTALL% = &H1, VIFF_DONTDELETEOLD% = &H2
  316.     Const OF_DELETE% = &H200
  317.     Const VIF_TEMPFILE& = &H1
  318.     Const VIF_MISMATCH& = &H2
  319.     Const VIF_SRCOLD& = &H4
  320.  
  321.     Const VIF_DIFFLANG& = &H8
  322.     Const VIF_DIFFCODEPG& = &H10
  323.     Const VIF_DIFFTYPE& = &H20
  324.     Const VIF_WRITEPROT& = &H40
  325.     Const VIF_FILEINUSE& = &H80
  326.     Const VIF_OUTOFSPACE& = &H100
  327.     Const VIF_ACCESSVIOLATION& = &H200
  328.     Const VIF_SHARINGVIOLATION = &H400
  329.     Const VIF_CANNOTCREATE = &H800
  330.     Const VIF_CANNOTDELETE = &H1000
  331.     Const VIF_CANNOTRENAME = &H2000
  332.     Const VIF_CANNOTDELETECUR = &H4000
  333.     Const VIF_OUTOFMEMORY = &H8000
  334.  
  335.     Const VIF_CANNOTREADSRC = &H10000
  336.     Const VIF_CANNOTREADDST = &H20000
  337.  
  338.     Const VIF_BUFFTOOSMALL = &H40000
  339.  
  340.     Dim TmpOFStruct As OFStruct
  341.     Dim x%
  342.     Dim CurrDir$
  343.     Dim TmpFile$
  344.     Dim lpwTempFileLen%
  345.     Dim InFileVer$
  346.     Dim OutFileVer$
  347.     Dim Result&
  348.     Dim s$
  349.     Dim TryAgain%
  350.     Dim copyresult%
  351.  
  352.     On Error GoTo ERR_CopyFile
  353.  
  354.     Screen.MousePointer = 11
  355.  
  356.     If Right$(SourcePath$, 1) <> "\" Then
  357.     SourcePath$ = SourcePath$ + "\"
  358.     End If
  359.  
  360.     If Right$(DestinationPath$, 1) <> "\" Then
  361.     DestinationPath$ = DestinationPath$ + "\"
  362.     End If
  363.  
  364.     If FileExists(DestinationPath$ & DestFileName$) Then
  365.     If ShowYesNoBox(QuestionBoxCaption$, "Datei " & DestinationPath$ & DestFileName$ & " exitiert bereits." & Chr$(13) & "▄berschreiben?", 1) = IDNO Then
  366.         UpdateStatus GetFileSize(SourcePath$ + SrcFilename$)
  367.         CopyFile = True
  368.         GoTo EXIT_CopyFile
  369.     End If
  370.     End If
  371.  
  372.     frm_StatusDlg.lab_SourceFile.Caption = UCase$(SourcePath$ + SrcFilename$)
  373.     frm_StatusDlg.lab_SourceFile.Refresh
  374.     frm_StatusDlg.lab_DestFile.Caption = UCase$(DestinationPath$ + DestFileName$)
  375.     frm_StatusDlg.lab_DestFile.Refresh
  376.  
  377. CheckForExist:
  378.  
  379.     If Not FileExists(SourcePath$ + SrcFilename$) Then
  380.     
  381.     Screen.MousePointer = 0
  382.     x% = ShowErrorBox("Folgende Datei konnte nicht gefunden werden: " + SourcePath$ + SrcFilename$, 1)
  383.     Screen.MousePointer = 11
  384.  
  385.     If x% = 3 Then
  386.         CopyFile = False
  387.     ElseIf x% = 4 Then
  388.         GoTo CheckForExist
  389.     ElseIf x% = 5 Then
  390.         GoTo EXIT_CopyFile
  391.     End If
  392.  
  393.     Else
  394.  
  395. TryToCopyAgain:
  396.     
  397.     CurrDir$ = String$(255, 0)
  398.     TmpFile$ = String$(255, 0)
  399.     lpwTempFileLen% = 255
  400.     InFileVer$ = GetFileVersion(SourcePath$ + SrcFilename$)
  401.     OutFileVer$ = GetFileVersion(DestinationPath$ + DestFileName$)
  402.  
  403.     If Len(InFileVer$) <> 0 And Len(OutFileVer$) <> 0 Then
  404.         If InFileVer$ <= OutFileVer$ And SourcePath <> DestinationPath Then
  405.         UpdateStatus GetFileSize(SourcePath$ + SrcFilename$)
  406.         CopyFile = True
  407.         GoTo EXIT_CopyFile
  408.         End If
  409.     End If
  410.  
  411.     Result& = VerInstallFile&(0, SrcFilename$, DestFileName$, SourcePath$, DestinationPath$, CurrDir$, TmpFile$, lpwTempFileLen%)
  412.  
  413.     s$ = DestinationPath$
  414.     If Right$(s$, 1) <> "\" Then s$ = s$ + "\"
  415.     s$ = s$ + DestFileName$
  416.     If Not TryAgain% Then UpdateStatus GetFileSize(s$)
  417.  
  418.     If Result& = 0 Or (Result& And VIF_SRCOLD&) = VIF_SRCOLD& Then
  419.         CopyFile = True
  420.     ElseIf (Result& And VIF_DIFFLANG&) = VIF_DIFFLANG& Then
  421.         Result& = VerInstallFile&(VIFF_FORCEINSTALL%, SrcFilename$, DestFileName$, SourcePath$, DestinationPath$, CurrDir$, TmpFile$, lpwTempFileLen%)
  422.         CopyFile = True
  423.     ElseIf (Result& And VIF_DIFFTYPE&) = VIF_DIFFTYPE& Then
  424.         Result& = VerInstallFile&(VIFF_FORCEINSTALL%, SrcFilename$, DestFileName$, SourcePath$, DestinationPath$, CurrDir$, TmpFile$, lpwTempFileLen%)
  425.         CopyFile = True
  426.     ElseIf (Result& And VIF_WRITEPROT&) = VIF_WRITEPROT& Then
  427.         Result& = VerInstallFile&(VIFF_FORCEINSTALL%, SrcFilename$, DestFileName$, SourcePath$, WinSysDir$ + "\", CurrDir$, TmpFile$, lpwTempFileLen%)
  428.         CopyFile = True
  429.     ElseIf (Result& And VIF_CANNOTREADSRC) = VIF_CANNOTREADSRC Then
  430.         FileCopy SourcePath$ + SrcFilename$, DestinationPath$ + DestFileName$
  431.         CopyFile = True
  432.     Else
  433.         Screen.MousePointer = 0
  434.         If (Result& And VIF_FILEINUSE&) = VIF_FILEINUSE& Then
  435.         x% = ShowErrorBox(DestFileName$ & " wird schon benutzt. Bitte beenden Sie alle Programme und fⁿhren Setup nochmal aus.", 1)
  436.         If x% = 3 Then
  437.             CopyFile = False
  438.         ElseIf x% = 4 Then
  439.             TryAgain% = True
  440.             GoTo TryToCopyAgain
  441.         ElseIf x% = 5 Then
  442.             CopyFile = True
  443.             GoTo EXIT_CopyFile
  444.         End If
  445.         Else
  446.         ShowErrorBox2 DestFileName$ & " kann nicht installiert werden."
  447.         CopyFile = False
  448.         End If
  449.         Screen.MousePointer = 11
  450.     End If
  451.  
  452.     If (Result& And VIF_TEMPFILE&) = VIF_TEMPFILE& Then copyresult% = OpenFile(TmpFile$, TmpOFStruct, OF_DELETE%)
  453.     Screen.MousePointer = 0
  454.     GoTo EXIT_CopyFile
  455.  
  456.     End If
  457.  
  458. EXIT_CopyFile:
  459.  
  460.     Exit Function
  461.  
  462. ERR_CopyFile:
  463.  
  464.     CopyFile = False
  465.     Screen.MousePointer = 0
  466.     Exit Function
  467.  
  468. End Function
  469.  
  470. '============================================================
  471. ' Routine : CreatePath
  472. '============================================================
  473. ' Aufgabe : Erstellt ein neues Verzeichnis und liefert True
  474. '           bzw. False zurⁿck, je nachdem, ob die Operation
  475. '           erfolgreich war oder nicht.
  476. ' Eingabe : DestinationPath = Verzeichnisname
  477. ' Ausgabe : keine
  478. ' Return  : True bzw. False
  479. '------------------------------------------------------------
  480. '
  481. Function CreatePath (DestinationPath$) As Integer
  482.  
  483.     Dim BackPos, ForePos
  484.     Dim temp$
  485.  
  486.     Screen.MousePointer = 11
  487.  
  488.     If Right$(DestinationPath$, 1) <> "\" Then
  489.     DestinationPath$ = DestinationPath$ + "\"
  490.     End If
  491.     
  492.     On Error Resume Next
  493.  
  494.     ChDrive DestinationPath$
  495.     If Err <> 0 Then GoTo ERR_CreatePath
  496.     ChDir "\"
  497.  
  498.     BackPos = 3
  499.     ForePos = InStr(4, DestinationPath$, "\")
  500.     Do While ForePos <> 0
  501.     temp$ = Mid$(DestinationPath$, BackPos + 1, ForePos - BackPos - 1)
  502.     Err = 0
  503.     MkDir temp$
  504.     If Err <> 0 And Err <> 75 Then GoTo ERR_CreatePath
  505.     Err = 0
  506.     ChDir temp$
  507.     If Err <> 0 Then GoTo ERR_CreatePath
  508.     BackPos = ForePos
  509.     ForePos = InStr(BackPos + 1, DestinationPath$, "\")
  510.     Loop
  511.     
  512.     CreatePath = True
  513.     Screen.MousePointer = 0
  514.     
  515. EXIT_CreatePath:
  516.  
  517.     Exit Function
  518.     
  519. ERR_CreatePath:
  520.  
  521.     ShowErrorBox2 "Pfad " & Left$(DestinationPath$, Len(DestinationPath$) - 1) & " konnte nicht erstellt werden."
  522.     CreatePath = False
  523.     Screen.MousePointer = 0
  524.  
  525. End Function
  526.  
  527. '============================================================
  528. ' Routine : CreateProgManGroup
  529. '============================================================
  530. ' Aufgabe : Erzeugt eine neue Programmgruppe.
  531. ' Eingabe : f         = Form, in der das Steuerelement lab_1
  532. '                       enthalten ist
  533. '           GroupName = Name der Programmgruppe
  534. '           GroupPath = String, der den Namen der Gruppendatei
  535. '                       enthΣlt
  536. ' Ausgabe : keine
  537. '------------------------------------------------------------
  538. '
  539. Sub CreateProgManGroup (f As Form, groupname$, GroupPath$)
  540.  
  541.     Dim i%
  542.     Dim z%
  543.  
  544.     Screen.MousePointer = 11
  545.  
  546.     On Error Resume Next
  547.     
  548.     f.lab_1.LinkTopic = "ProgMan|Progman"
  549.     f.lab_1.LinkMode = 2
  550.  
  551.     For i% = 1 To 10
  552.     z% = DoEvents()
  553.     Next
  554.  
  555.     f.lab_1.LinkTimeout = 100
  556.     f.lab_1.LinkExecute "[CreateGroup(" + groupname$ + Chr$(44) + GroupPath$ + ")]"
  557.     gGroupName = groupname
  558.     f.lab_1.LinkTimeout = 50
  559.     f.lab_1.LinkMode = 0
  560.  
  561.     Screen.MousePointer = 0
  562.  
  563. End Sub
  564.  
  565. '============================================================
  566. ' Routine : CreateProgManItem
  567. '============================================================
  568. ' Aufgabe : Erzeugt einen neuen Eintrag in der aktuellen Prog-
  569. '           rammgruppe.
  570. ' Eingabe : f         = Form, in der das Steuerelement lab_1
  571. '                       enthalten ist
  572. '           CmdLine   = String, der die Kommandozeile fⁿr den
  573. '                       Eintrag/Icon enthΣlt
  574. '           IconTitle = Text unter dem Icon
  575. ' Ausgabe : keine
  576. '------------------------------------------------------------
  577. '
  578. Sub CreateProgManItem (f As Form, CmdLine$, IconTitle$)
  579.  
  580.     Dim i%
  581.     Dim z%
  582.  
  583.     Screen.MousePointer = 11
  584.  
  585.     On Error Resume Next
  586.     
  587.     f.lab_1.LinkTopic = "ProgMan|Progman"
  588.     f.lab_1.LinkMode = 2
  589.  
  590.     For i% = 1 To 10
  591.     z% = DoEvents()
  592.     Next
  593.     
  594.     f.lab_1.LinkTimeout = 100
  595.     If gfWin31% Then
  596.     f.lab_1.LinkExecute "[ReplaceItem(" + IconTitle$ + ")]"
  597.     End If
  598.     f.lab_1.LinkExecute "[AddItem(" + CmdLine$ + Chr$(44) + IconTitle$ + Chr$(44) + ",,)]"
  599.     f.lab_1.LinkExecute "[ShowGroup(" + gGroupName + ", 1)]"
  600.     f.lab_1.LinkTimeout = 50
  601.     f.lab_1.LinkMode = 0
  602.  
  603.     Screen.MousePointer = 0
  604.  
  605. End Sub
  606.  
  607. '============================================================
  608. ' Routine : DoneCtl3D
  609. '============================================================
  610. ' Aufgabe : Deinstalliert die Windows-Klasse zur 3D-Darstellung
  611. '           von Message-Boxen und liefert True oder False zu-
  612. '           rⁿck, je nachdem, ob die Operation erfolgreich war
  613. '           oder nicht.
  614. ' Eingabe : ProgName = Name des Programms
  615. ' Ausgabe : keine
  616. ' Return  : True oder False
  617. '------------------------------------------------------------
  618. '
  619. Function DoneCtl3D (ProgName$) As Integer
  620.  
  621.     Dim Inst%, Result%
  622.  
  623.     On Error Resume Next
  624.  
  625.     DoneCtl3D = False
  626.     Inst% = GetModuleHandle(ProgName)
  627.     Result% = Ctl3DUnregister(Inst%)
  628.     DoneCtl3D = Result%
  629.  
  630. End Function
  631.  
  632. '============================================================
  633. ' Routine : EndProgram
  634. '============================================================
  635. ' Aufgabe : Beendet das Setup-Programm.
  636. ' Eingabe : Info = Info-Text anzeigen (True oder False)
  637. ' Ausgabe : keine
  638. '------------------------------------------------------------
  639. '
  640. Sub EndProgram (Info%)
  641.  
  642.     If Info Then
  643.     If AppName$ = "" Then
  644.         ShowInfoBox "Die Anwendung wurde nicht richtig installiert. Rufen Sie das Setup-Programm erneut auf."
  645.     Else
  646.         ShowInfoBox AppName$ & " wurde nicht richtig installiert. Rufen Sie das Setup-Programm erneut auf."
  647.     End If
  648.     End If
  649.     ChDrive WinDrive$
  650.     ChDir Left$(WinDir$, Len(WinDir$) - 1)
  651.     End
  652.  
  653. End Sub
  654.  
  655. '============================================================
  656. ' Routine : ExecCmd
  657. '============================================================
  658. ' Aufgabe : Fⁿhrt einen Installationsbefehl mit Parametern aus
  659. '           und liefert True oder False, je nachdem, ob die
  660. '           Operation erfolgreich war oder nicht.
  661. ' Eingabe : Cmd   = Befehl
  662. '           Param = Parameter (max. 10)
  663. '           Count = Lfd-Nr.
  664. '           Item  = Eintrag (Kommando mit Parametern)
  665. ' Ausgabe : keine
  666. ' Return  : True oder False
  667. '------------------------------------------------------------
  668. '
  669. Function ExecCmd (Cmd$, Param As ParamType, Count%, Item$) As Integer
  670.  
  671.     Dim OutButton$
  672.     Dim temp1$, temp2$
  673.     Dim v1 As Variant, v2 As Variant
  674.     Dim WinSpaceFree&, DestSpaceFree&
  675.     Dim TotalNeeded&
  676.     Dim Result%
  677.     Dim CurrDir$
  678.  
  679.     ExecCmd = False
  680.  
  681.     Select Case Cmd$
  682.  
  683.     ' Syntax: [Lfd-Nr]=Eingabe_Quellpfad
  684.  
  685.     Case UCase$("Eingabe_Quellpfad")
  686.  
  687.         ShowPathDialog SrcDialogTitle$, SrcDialogInfo$, SrcPathLabel$, SrcDrive$, SrcPath$, SrcPath$, OutButton$
  688.         If OutButton$ = "Exit" Then
  689.         EndProgram False
  690.         Else
  691.         If Left$(SrcPath$, 1) = "\" Then
  692.             SrcPath$ = SrcDrive$ + SrcPath$
  693.         ElseIf Len(SrcPath$) > 2 Then
  694.             If InStr(1, SrcPath$, ":") And InStr(2, SrcPath$, "\") Then
  695.             SrcDrive$ = UCase$(Left$(SrcPath$, 2))
  696.             End If
  697.         End If
  698.         SrcPath$ = UCase$(SrcPath$)
  699.         End If
  700.  
  701.     ' Syntax: [Lfd-Nr]=Eingabe_Zielpfad
  702.  
  703.     Case UCase$("Eingabe_Zielpfad")
  704.  
  705.         ShowPathDialog DestDialogTitle$, DestDialogInfo$, DestPathLabel$, DestDrive$, DestPath$, DestPath$, OutButton$
  706.         If OutButton$ = "Exit" Then
  707.         EndProgram False
  708.         Else
  709.         If Left$(DestPath$, 1) = "\" Then
  710.             DestPath$ = DestDrive$ + DestPath$
  711.         ElseIf Len(DestPath$) > 2 Then
  712.             If InStr(1, DestPath$, ":") And InStr(2, DestPath$, "\") Then
  713.             DestDrive$ = UCase$(Left$(DestPath$, 2))
  714.             End If
  715.         End If
  716.         DestPath$ = UCase$(DestPath$)
  717.         End If
  718.  
  719.     ' Syntax: [Lfd-Nr]=Zeige_Info [Kopfzeile]; [Message]; [Warte-Sekunden]
  720.  
  721.     Case UCase$("Zeige_Info")
  722.  
  723.         If Param.i(3) = "" Then Param.i(3) = "5"
  724.         ShowMessageDialog Param.i(1), Param.i(2)
  725.         v1 = 0
  726.         v2 = CVar(Param.i(3))
  727.         temp1$ = Time$
  728.         While CInt(v1) < CInt(v2)
  729.         temp2$ = Time$
  730.         If temp1$ <> temp2$ Then
  731.             temp1$ = temp2$
  732.             v1 = v1 + 1
  733.         End If
  734.         Wend
  735.         Unload frm_MessageDlg
  736.  
  737.     ' Syntax: [Lfd-Nr]=Prⁿfe_Speicherplatz
  738.  
  739.     Case UCase$("Prⁿfe_Speicherplatz")
  740.  
  741.         WinSpaceFree& = GetDiskSpaceFree(WinDrive$)
  742.         DestSpaceFree& = GetDiskSpaceFree(DestDrive$)
  743.  
  744.         TotalNeeded& = WinSysNeeded& + OtherNeeded&
  745.  
  746.         If DestSpaceFree& < TotalNeeded& Then
  747.         ShowErrorBox2 "Nicht genug Speicherplatz auf Laufwerk " & DestDrive$ & Chr$(13) & Chr$(13) & "Es fehlen " & LTrim$(RTrim$(Str$(TotalNeeded& - DestSpaceFree&))) & " Bytes." & Chr$(13) & Chr$(13) & "Verschaffen Sie sich den erforderlichen Speicherplatz und rufen Sie das Setup-Programm erneut auf."
  748.         GoTo ERR_ExecCmd_1
  749.         End If
  750.         If WinSpaceFree& < WinSysNeeded& Then
  751.         ShowErrorBox2 "Nicht genug Speicherplatz auf Laufwerk " & WinDrive$ & Chr$(13) & Chr$(13) & "Es fehlen " & LTrim$(RTrim$(Str$(WinSysNeeded& - WinSpaceFree&))) & " Bytes." & Chr$(13) & Chr$(13) & "Verschaffen Sie sich den erforderlichen Speicherplatz und rufen Sie das Setup-Programm erneut auf."
  752.         GoTo ERR_ExecCmd_1
  753.         End If
  754.         If DestSpaceFree& < OtherNeeded& Then
  755.         ShowErrorBox2 "Nicht genug Speicherplatz auf Laufwerk " & DestDrive$ & Chr$(13) & Chr$(13) & "Es fehlen " & LTrim$(RTrim$(Str$(OtherNeeded& - DestSpaceFree&))) & " Bytes." & Chr$(13) & Chr$(13) & "Verschaffen Sie sich den erforderlichen Speicherplatz und rufen Sie das Setup-Programm erneut auf."
  756.         GoTo ERR_ExecCmd_1
  757.         End If
  758.  
  759.     ' Syntax: [Lfd-Nr]=Disk_Anforderung [Disk-Nr]; [Identifikations-Dateiname]
  760.  
  761.     Case UCase$("Disk_Anforderung")
  762.  
  763.         If Param.i(1) = "" Then
  764.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Disk_Anforderung [Disk-Nr]; [Identifikations-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Disk-Nr] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  765.         GoTo ERR_ExecCmd_1
  766.         End If
  767.  
  768.         If Param.i(2) = "" Then
  769.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Disk_Anforderung [Disk-Nr]; [Identifikations-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Identifikations-Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  770.         GoTo ERR_ExecCmd_1
  771.         End If
  772.  
  773. LABEL_ExecCmd_1:
  774.  
  775.         If Not PromptForNextDisk(CInt(Param.i(1)), Param.i(2)) Then
  776.         If ShowYesNoBox(QuestionBoxCaption$, "Wollen Sie die Installation wirklich abbrechen?", 2) = IDYES Then
  777.             GoTo ERR_ExecCmd_1
  778.         Else
  779.             GoTo LABEL_ExecCmd_1
  780.         End If
  781.         End If
  782.  
  783.     ' Syntax: [Lfd-Nr]=Erzeuge_Pfad [Pfadname]
  784.  
  785.     Case UCase$("Erzeuge_Pfad")
  786.  
  787.         If Param.i(1) = "" Then
  788.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Erzeuge_Pfad [Pfadname]" & Chr$(13) & Chr$(13) & "Parameter [Pfadname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  789.         GoTo ERR_ExecCmd_1
  790.         End If
  791.  
  792.         If Not CreatePath(Param.i(1)) Then
  793.         If ShowYesNoBox(QuestionBoxCaption$, "Soll das Setup-Programm beendet werden?", 2) = IDYES Then
  794.             GoTo ERR_ExecCmd_1
  795.         End If
  796.         End If
  797.  
  798.     ' Syntax: [Lfd-Nr]=Erzeuge_Zielpfad
  799.  
  800.     Case UCase$("Erzeuge_Zielpfad")
  801.  
  802.         If Not CreatePath(DestPath$) Then
  803.         If ShowYesNoBox(QuestionBoxCaption$, "Soll das Setup-Programm beendet werden?", 2) = IDYES Then
  804.             GoTo ERR_ExecCmd_1
  805.         End If
  806.         End If
  807.  
  808.     ' Syntax: [Lfd-Nr]=Erzeuge_Pfad_in_Zielpfad [Pfadname]
  809.  
  810.     ' Anmerkung: Pfadname darf nicht mit "\" beginnen
  811.  
  812.     Case UCase$("Erzeuge_Pfad_in_Zielpfad")
  813.  
  814.         If Param.i(1) = "" Then
  815.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Erzeuge_Pfad_in_Zielpfad [Pfadname]" & Chr$(13) & Chr$(13) & "Parameter [Pfadname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  816.         GoTo ERR_ExecCmd_1
  817.         End If
  818.  
  819.         If Not CreatePath(DestPath$ & Param.i(1)) Then
  820.         If ShowYesNoBox(QuestionBoxCaption$, "Soll das Setup-Programm beendet werden?", 2) = IDYES Then
  821.             GoTo ERR_ExecCmd_1
  822.         End If
  823.         End If
  824.  
  825.     ' Syntax: [Lfd-Nr]=Zeige_Status_Fenster_an [Kopfzeile]; [Gesamt Bytes]
  826.  
  827.     Case UCase$("Zeige_Status_Fenster_an")
  828.  
  829.         ShowStatusDialog Param.i(1), CLng(Param.i(2))
  830.  
  831.     ' Syntax: [Lfd-Nr]=Blende_Status_Fenster_aus
  832.  
  833.     Case UCase$("Blende_Status_Fenster_aus")
  834.  
  835.         HideStatusDialog
  836.  
  837.     ' Syntax: [Lfd-Nr]=Kopiere_Datei [Quellpfad]; [Quell-Dateiname]; [Zielpfad]; [Ziel-Dateiname]
  838.  
  839.     Case UCase$("Kopiere_Datei")
  840.  
  841.         If Param.i(1) = "" Then
  842.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei [Quellpfad]; [Quell-Dateiname]; [Zielpfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Quellpfad] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  843.         GoTo ERR_ExecCmd_1
  844.         End If
  845.  
  846.         If Param.i(2) = "" Then
  847.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei [Quellpfad]; [Quell-Dateiname]; [Zielpfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Quell-Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  848.         GoTo ERR_ExecCmd_1
  849.         End If
  850.  
  851.         If Param.i(3) = "" Then
  852.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei [Quellpfad]; [Quell-Dateiname]; [Zielpfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Zielpfad] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  853.         GoTo ERR_ExecCmd_1
  854.         End If
  855.  
  856.         If Param.i(4) = "" Then
  857.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei [Quellpfad]; [Quell-Dateiname]; [Zielpfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Ziel-Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  858.         GoTo ERR_ExecCmd_1
  859.         End If
  860.  
  861. LABEL_ExecCmd_2:
  862.  
  863.         If Not CopyFile(Param.i(1), Param.i(3), Param.i(2), Param.i(4)) Then
  864.  
  865. LABEL_ExecCmd_3:
  866.  
  867.         Result% = ShowYesNoCancelBox(QuestionBoxCaption$, "Datei " & UCase$(Param.i(1)) & "\" & UCase$(Param.i(2)) & " konnte nicht kopiert werden." & Chr$(13) & Chr$(13) & "Nochmal versuchen?", 1)
  868.         Select Case Result%
  869.             Case IDYES
  870.             GoTo LABEL_ExecCmd_2
  871.             Case IDCANCEL
  872.             If ShowYesNoBox(QuestionBoxCaption$, "Wollen Sie die Installation wirklich abbrechen?", 2) = IDYES Then
  873.                 GoTo ERR_ExecCmd_1
  874.             Else
  875.                 GoTo LABEL_ExecCmd_3
  876.             End If
  877.         End Select
  878.         End If
  879.  
  880.     ' Syntax: [Lfd-Nr]=Kopiere_Datei_in_Zielpfad [Quell-Dateiname]; [Unterverzeichnis in Zielpfad]; [Ziel-Dateiname]
  881.  
  882.     ' Anmerkung: Name des Unterverzeichnisses im Zielpfad darf nicht mit "\" beginnen
  883.  
  884.     Case UCase$("Kopiere_Datei_in_Zielpfad")
  885.  
  886.         If Param.i(1) = "" Then
  887.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei_in_Zielpfad [Quell-Dateiname]; [Unterverzeichnis in Zielpfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Quell-Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  888.         GoTo ERR_ExecCmd_1
  889.         End If
  890.  
  891.         If Param.i(3) = "" Then
  892.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei_in_Zielpfad [Quell-Dateiname]; [Unterverzeichnis in Zielpfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Ziel-Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  893.         GoTo ERR_ExecCmd_1
  894.         End If
  895.  
  896. LABEL_ExecCmd_4:
  897.  
  898.         If Not CopyFile(SrcPath$, DestPath$ & Param.i(2), Param.i(1), Param.i(3)) Then
  899.  
  900. LABEL_ExecCmd_5:
  901.  
  902.         Result% = ShowYesNoCancelBox(QuestionBoxCaption$, "Datei " & SrcPath$ & UCase$(Param.i(1)) & " konnte nicht kopiert werden." & Chr$(13) & Chr$(13) & "Nochmal versuchen?", 1)
  903.         Select Case Result%
  904.             Case IDYES
  905.             GoTo LABEL_ExecCmd_4
  906.             Case IDCANCEL
  907.             If ShowYesNoBox(QuestionBoxCaption$, "Wollen Sie die Installation wirklich abbrechen?", 2) = IDYES Then
  908.                 GoTo ERR_ExecCmd_1
  909.             Else
  910.                 GoTo LABEL_ExecCmd_5
  911.             End If
  912.         End Select
  913.         End If
  914.  
  915.     ' Syntax: [Lfd-Nr]=Zeige_Program_Manager
  916.  
  917.     Case UCase$("Zeige_Program_Manager")
  918.  
  919.         RestoreProgMan
  920.  
  921.     ' Syntax: [Lfd-Nr]=Erzeuge_Programmgruppe [Name]; [Dateiname]
  922.  
  923.     Case UCase$("Erzeuge_Programmgruppe")
  924.  
  925.         If Param.i(1) = "" Then
  926.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Erzeuge_Programmgruppe [Name]; [Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Name] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  927.         GoTo ERR_ExecCmd_1
  928.         End If
  929.  
  930.         If Param.i(2) = "" Then
  931.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Erzeuge_Programmgruppe [Name]; [Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  932.         GoTo ERR_ExecCmd_1
  933.         End If
  934.  
  935.         CreateProgManGroup frm_Setup2, Param.i(1), Param.i(2)
  936.  
  937.     ' Syntax: [Lfd-Nr]=Erzeuge_Programm_Icon [Kommando-String]; [Icon-Name]; [Kommando-String auf Zielpfad bezogen=J|N]
  938.  
  939.     ' Anmerkung: Parameter "Kommando-String" bezieht sich auf den Zielpfad, wenn der Parameter "Kommando-String auf Zielpfad bezogen" auf "J" eingestellt ist
  940.     '            Beispiel: Zielpfad        = C:\TEST\
  941.     '                      Kommando-String = DATEN\TEST.DAT
  942.     '                      Aufruf-Kommando = C:\TEST\DATEN\TEST.DAT
  943.  
  944.     Case UCase$("Erzeuge_Programm_Icon")
  945.  
  946.         If Param.i(1) = "" Then
  947.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Erzeuge_Programm_Icon [Kommando-String]; [Icon-Name]; [Kommando-String auf Zielpfad bezogen=J|N]" & Chr$(13) & Chr$(13) & "Parameter [Kommando-String] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  948.         GoTo ERR_ExecCmd_1
  949.         End If
  950.  
  951.         If Param.i(2) = "" Then
  952.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Erzeuge_Programm_Icon [Kommando-String]; [Icon-Name]; [Kommando-String auf Zielpfad bezogen=J|N]" & Chr$(13) & Chr$(13) & "Parameter [Icon-Name] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  953.         GoTo ERR_ExecCmd_1
  954.         End If
  955.  
  956.         If UCase$(Param.i(3)) = "J" Then
  957.         CreateProgManItem frm_Setup2, DestPath$ & Param.i(1), Param.i(2)
  958.         Else
  959.         CreateProgManItem frm_Setup2, Param.i(1), Param.i(2)
  960.         End If
  961.  
  962.     ' Syntax: [Lfd-Nr]=Rufe_Shell_auf [Kommando-String]
  963.  
  964.     Case UCase$("Rufe_Shell_auf")
  965.  
  966.         If Param.i(1) = "" Then
  967.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Rufe_Shell_auf [Kommando-String]" & Chr$(13) & Chr$(13) & "Parameter [Kommando-String] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  968.         GoTo ERR_ExecCmd_1
  969.         End If
  970.  
  971.         If Not RunShell(Param.i(1)) Then
  972.         ShowErrorBox2 "Kommandozeile " & Param.i(1) & " konnte nicht ausgefⁿhrt werden (Shell-Aufruf)."
  973.         End If
  974.  
  975.     ' Syntax: [Lfd-Nr]=Entpacke_LHARC_EXE [Dateiname]; [Unterverzeichnis in Zielpfad]; [L÷schen=J|N]
  976.  
  977.     ' Anmerkung: Die zu enkomprimierende Datei mu▀ sich im Zielpfad (Hauptverzeichnis) oder in einem Unterverzeichnis befinden.
  978.     '            Die Datei UNPACK.PIF mu▀ sich im Windows-Hauptverzeichnis befinden.
  979.     '            Name des Unterverzeichnisses im Zielpfad darf nicht mit "\" beginnen.
  980.  
  981.     Case UCase$("Entpacke_LHARC_EXE")
  982.  
  983.         If Param.i(1) = "" Then
  984.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Entpacke_LHARC_EXE [Dateiname]; [Unterverzeichnis in Zielpfad]; [L÷schen=J|N]" & Chr$(13) & Chr$(13) & "Parameter [Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  985.         GoTo ERR_ExecCmd_1
  986.         End If
  987.  
  988.         CurrDir$ = CurDir$
  989.  
  990. LABEL_ExecCmd_6:
  991.  
  992.         If Param.i(2) = "" Then
  993.         ChDir Left$(DestPath$, Len(DestPath$) - 1)
  994.         Result% = RunShell(WinDir$ & "\UNPACK.PIF " & DestPath$ & Param.i(1))
  995.         Else
  996.         ChDir DestPath$ & Param.i(2)
  997.         Result% = RunShell(WinDir$ & "\UNPACK.PIF " & DestPath$ & Param.i(2) & "\" & Param.i(1))
  998.         End If
  999.  
  1000.         If Not Result% Then
  1001.  
  1002. LABEL_ExecCmd_7:
  1003.  
  1004.         Result% = ShowYesNoCancelBox(QuestionBoxCaption$, "Datei " & DestPath$ & Param.i(2) & "\" & Param.i(1) & " konnte nicht entpackt werden." & Chr$(13) & Chr$(13) & "Nochmal versuchen?", 1)
  1005.         Select Case Result%
  1006.             Case IDYES
  1007.             GoTo LABEL_ExecCmd_6
  1008.             Case IDCANCEL
  1009.             If ShowYesNoBox(QuestionBoxCaption$, "Wollen Sie die Installation wirklich abbrechen?", 2) = IDYES Then
  1010.                 ChDir CurrDir$
  1011.                 GoTo ERR_ExecCmd_1
  1012.             Else
  1013.                 GoTo LABEL_ExecCmd_7
  1014.             End If
  1015.         End Select
  1016.         Else
  1017.         If UCase$(Param.i(3)) = "J" Then
  1018.             Kill DestPath$ & Param.i(2) & "\" & Param.i(1)
  1019.         End If
  1020.         ChDir CurrDir$
  1021.         End If
  1022.  
  1023.     ' Syntax: [Lfd-Nr]=Fⁿge_SHARE_ein [DOS-Pfad]; [Parameter]
  1024.  
  1025.     Case UCase$("Fⁿge_SHARE_ein")
  1026.  
  1027.         If Not AddShare(Param.i(1), Param.i(2)) Then
  1028.         ShowErrorBox2 "SHARE-Befehl konnte nicht in die AUTOEXEC.BAT-Datei eingefⁿgt werden."
  1029.         End If
  1030.  
  1031.     ' Syntax: [Lfd_Nr]=Kopiere_Datei_in_Win_Pfad [Quell-Dateiname]; [Unterverzeichnis im Windows-Pfad]; [Ziel-Dateiname]
  1032.     '
  1033.     ' Anmerkung: Name des Unterverzeichnisses im Windows-Pfad darf nicht mit "\" beginnen
  1034.  
  1035.     Case UCase$("Kopiere_Datei_in_Win_Pfad")
  1036.  
  1037.         If Param.i(1) = "" Then
  1038.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei_in_Win_Pfad [Quell-Dateiname]; [Unterverzeichnis im Windows-Pfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Quell-Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  1039.         GoTo ERR_ExecCmd_1
  1040.         End If
  1041.  
  1042.         If Param.i(3) = "" Then
  1043.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Kopiere_Datei_in_Win_Pfad [Quell-Dateiname]; [Unterverzeichnis im Windows-Pfad]; [Ziel-Dateiname]" & Chr$(13) & Chr$(13) & "Parameter [Ziel-Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  1044.         GoTo ERR_ExecCmd_1
  1045.         End If
  1046.  
  1047. LABEL_ExecCmd_8:
  1048.  
  1049.         If Not CopyFile(SrcPath$, WinDir$ & Param.i(2), Param.i(1), Param.i(3)) Then
  1050.  
  1051. LABEL_ExecCmd_9:
  1052.  
  1053.         Result% = ShowYesNoCancelBox(QuestionBoxCaption$, "Datei " & SrcPath$ & UCase$(Param.i(1)) & " konnte nicht kopiert werden." & Chr$(13) & Chr$(13) & "Nochmal versuchen?", 1)
  1054.         Select Case Result%
  1055.             Case IDYES
  1056.             GoTo LABEL_ExecCmd_8
  1057.             Case IDCANCEL
  1058.             If ShowYesNoBox(QuestionBoxCaption$, "Wollen Sie die Installation wirklich abbrechen?", 2) = IDYES Then
  1059.                 GoTo ERR_ExecCmd_1
  1060.             Else
  1061.                 GoTo LABEL_ExecCmd_9
  1062.             End If
  1063.         End Select
  1064.         End If
  1065.  
  1066.     ' Syntax: [Lfd-Nr]=Entpacke_LHARC_EXE_in_Win_Pfad [Dateiname]; [Unterverzeichnis im Windows-Pfad]; [L÷schen=J|N]
  1067.  
  1068.     ' Anmerkung: Die Datei UNPACK.PIF mu▀ sich im Windows-Hauptverzeichnis befinden.
  1069.     '            Name des Unterverzeichnisses im Windows-Pfad darf nicht mit "\" beginnen.
  1070.  
  1071.     Case UCase$("Entpacke_LHARC_EXE_in_Win_Pfad")
  1072.  
  1073.         If Param.i(1) = "" Then
  1074.         ShowErrorBox2 "Fehler in der Setup-INI-Datei " & SetupIniName$ & Chr$(13) & Chr$(13) & "Bereich: [Ablauf]" & Chr$(13) & "Eintrag: " & LTrim$(RTrim$(Str$(Count%))) & "=" & Item$ & Chr$(13) & Chr$(13) & "Syntax: [Lfd-Nr]=Entpacke_LHARC_EXE_in_Win_Pfad [Dateiname]; [Unterverzeichnis im Windows-Pfad]; [L÷schen=J|N]" & Chr$(13) & Chr$(13) & "Parameter [Dateiname] fehlt." & Chr$(13) & Chr$(13) & "Setup kann nicht fortgesetzt werden."
  1075.         GoTo ERR_ExecCmd_1
  1076.         End If
  1077.  
  1078.         CurrDir$ = CurDir$
  1079.  
  1080. LABEL_ExecCmd_10:
  1081.  
  1082.         If Param.i(2) = "" Then
  1083.         ChDir Left$(WinDir$, Len(WinDir$) - 1)
  1084.         Result% = RunShell(WinDir$ & "\UNPACK.PIF " & WinDir$ & Param.i(1))
  1085.         Else
  1086.         ChDir WinDir$ & Param.i(2)
  1087.         Result% = RunShell(WinDir$ & "\UNPACK.PIF " & WinDir$ & Param.i(2) & "\" & Param.i(1))
  1088.         End If
  1089.  
  1090.         If Not Result% Then
  1091.  
  1092. LABEL_ExecCmd_11:
  1093.  
  1094.         Result% = ShowYesNoCancelBox(QuestionBoxCaption$, "Datei " & WinDir$ & Param.i(2) & "\" & Param.i(1) & " konnte nicht entpackt werden." & Chr$(13) & Chr$(13) & "Nochmal versuchen?", 1)
  1095.         Select Case Result%
  1096.             Case IDYES
  1097.             GoTo LABEL_ExecCmd_10
  1098.             Case IDCANCEL
  1099.             If ShowYesNoBox(QuestionBoxCaption$, "Wollen Sie die Installation wirklich abbrechen?", 2) = IDYES Then
  1100.                 ChDir CurrDir$
  1101.                 GoTo ERR_ExecCmd_1
  1102.             Else
  1103.                 GoTo LABEL_ExecCmd_11
  1104.             End If
  1105.         End Select
  1106.         Else
  1107.         If UCase$(Param.i(3)) = "J" Then
  1108.             Kill WinDir$ & Param.i(2) & "\" & Param.i(1)
  1109.         End If
  1110.         ChDir CurrDir$
  1111.         End If
  1112.  
  1113.     End Select
  1114.  
  1115.     If Err = 0 Then ExecCmd = True
  1116.  
  1117. EXIT_ExecCmd:
  1118.  
  1119.     Exit Function
  1120.  
  1121. ERR_ExecCmd_1:
  1122.  
  1123.     ChDrive WinDrive$
  1124.     ChDir Left$(WinDir$, Len(WinDir$) - 1)
  1125.     End
  1126.     GoTo EXIT_ExecCmd
  1127.  
  1128. End Function
  1129.  
  1130. '============================================================
  1131. ' Routine : FileExists
  1132. '============================================================
  1133. ' Aufgabe : Liefert True zurⁿck, wenn die angegebene Datei
  1134. '           existiert, sonst False.
  1135. ' Eingabe : FileName = Dateiname inkl. Pfadangabe
  1136. ' Ausgabe : keine
  1137. ' Return  : True bzw. False
  1138. '------------------------------------------------------------
  1139. '
  1140. Function FileExists (FileName$) As Integer
  1141.  
  1142.     Dim x
  1143.  
  1144.     x = FreeFile
  1145.  
  1146.     On Error Resume Next
  1147.  
  1148.     Open FileName$ For Input As x
  1149.  
  1150.     If Err = 0 Then
  1151.     FileExists = True
  1152.     Else
  1153.     FileExists = False
  1154.     End If
  1155.  
  1156.     Close x
  1157.  
  1158. End Function
  1159.  
  1160. '============================================================
  1161. ' Routine : GetDiskSpaceFree
  1162. '============================================================
  1163. ' Aufgabe : Liefert die Gr÷▀e des vorhandenen Speicherplatzes
  1164. '           eines Laufwerkes zurⁿck.
  1165. ' Eingabe : drive = Laufwerksbezeichnung
  1166. ' Ausgabe : keine
  1167. ' Return  : Gr÷▀e des vorhandenen Speicherplatzes
  1168. '------------------------------------------------------------
  1169. '
  1170. Function GetDiskSpaceFree (drive$) As Long
  1171.  
  1172.     ChDrive drive
  1173.     GetDiskSpaceFree = DiskSpaceFree()
  1174.  
  1175. End Function
  1176.  
  1177. '============================================================
  1178. ' Routine : GetFileSize
  1179. '============================================================
  1180. ' Aufgabe : Liefert die Gr÷▀e einer Datei zurⁿck.
  1181. ' Eingabe : FileName = Dateiname
  1182. ' Ausgabe : keine
  1183. ' Return  : Dateigr÷▀e
  1184. '------------------------------------------------------------
  1185. '
  1186. Function GetFileSize (FileName$) As Long
  1187.  
  1188.     Dim x
  1189.  
  1190.     x = FreeFile
  1191.     Open FileName$ For Binary Access Read As x
  1192.     GetFileSize = LOF(x)
  1193.     Close x
  1194.  
  1195. End Function
  1196.  
  1197. '============================================================
  1198. ' Routine : GetFileVersion
  1199. '============================================================
  1200. ' Aufgabe : Liefert die Versionsnummer einer Datei zurⁿck.
  1201. ' Eingabe : FileToCheck = Dateiname
  1202. ' Ausgabe : keine
  1203. ' Return  : Versionsnummer (Parameter vom Typ String)
  1204. '------------------------------------------------------------
  1205. '
  1206. Function GetFileVersion (FileToCheck$) As String
  1207.  
  1208.     Dim lpdwHandle&
  1209.     Dim VersionInfoSize&
  1210.     Dim lpvdata$
  1211.     Dim VersionInfo%
  1212.     Dim lplpBuffer&
  1213.     Dim lpcb%
  1214.     Dim ptrFixed%
  1215.     Dim TransString$
  1216.     Dim ptrString%
  1217.     Dim fixedstr$
  1218.     Dim stringcopy&
  1219.     Dim i
  1220.     Dim char$
  1221.     Dim nextchar$
  1222.     Dim TransValue&
  1223.     Dim TransTable$
  1224.  
  1225.     On Error Resume Next
  1226.  
  1227.     VersionInfoSize& = GetFileVersionInfoSize(FileToCheck, lpdwHandle&)
  1228.     If VersionInfoSize& = 0 Then
  1229.     GetFileVersion = ""
  1230.     Exit Function
  1231.     End If
  1232.     lpvdata$ = String(VersionInfoSize&, Chr$(0))
  1233.     VersionInfo% = GetFileVersionInfo(FileToCheck, lpdwHandle&, VersionInfoSize&, lpvdata$)
  1234.     ptrFixed% = VerQueryValue(lpvdata$, "\FILEVERSION", lplpBuffer&, lpcb%)
  1235.     If ptrFixed% = 0 Then
  1236.     TransString$ = "040904E4"
  1237.     ptrString% = VerQueryValue(lpvdata$, "\StringFileInfo\" & TransString$ & "\CompanyName", lplpBuffer&, lpcb%)
  1238.     If ptrString% <> 0 Then GoTo GetValues
  1239.     ptrFixed% = VerQueryValue(lpvdata$, "\", lplpBuffer&, lpcb%)
  1240.     If ptrFixed% = 0 Then
  1241.         GetFileVersion = ""
  1242.         Exit Function
  1243.     Else
  1244.         TransString$ = ""
  1245.         fixedstr$ = String(lpcb% + 1, Chr(0))
  1246.         stringcopy& = lstrcpyn(fixedstr$, lplpBuffer&, lpcb% + 1)
  1247.         For i = lpcb% To 1 Step -1
  1248.         char$ = Hex(Asc(Mid(fixedstr$, i, 1)))
  1249.         If Len(char$) = 1 Then
  1250.             char$ = "0" + char$
  1251.         End If
  1252.         TransString$ = TransString$ + char$
  1253.         If Len(TransString$ & nextchar$) Mod 8 = 0 Then
  1254.             TransString$ = "&H" & TransString$
  1255.             TransValue& = Val(TransString$)
  1256.             TransString$ = ""
  1257.         End If
  1258.         Next i
  1259.     End If
  1260.     End If
  1261.     TransTable$ = String(lpcb% + 1, Chr(0))
  1262.     TransString$ = String(0, Chr(0))
  1263.     stringcopy& = lstrcpyn(TransTable$, lplpBuffer&, lpcb% + 1)
  1264.     For i = 1 To lpcb%
  1265.     char$ = Hex(Asc(Mid(TransTable$, i, 1)))
  1266.     If Len(char$) = 1 Then
  1267.         char$ = "0" + char$
  1268.     End If
  1269.     If Len(TransString$ & nextchar$) Mod 4 = 0 Then
  1270.         nextchar$ = char$
  1271.     Else
  1272.         TransString$ = TransString$ + char$ + nextchar$
  1273.         nextchar$ = ""
  1274.         char$ = ""
  1275.     End If
  1276.     Next i
  1277.  
  1278. GetValues:
  1279.  
  1280.     ptrString% = VerQueryValue(lpvdata$, "\StringFileInfo\" & TransString$ & "\FileVersion", lplpBuffer&, lpcb%)
  1281.     If ptrString% = 1 Then
  1282.     TransTable$ = String(lpcb%, Chr(0))
  1283.     stringcopy& = lstrcpyn(TransTable$, lplpBuffer&, lpcb% + 1)
  1284.     GetFileVersion = TransTable$
  1285.     Else
  1286.     GetFileVersion = ""
  1287.     End If
  1288.  
  1289. End Function
  1290.  
  1291. '============================================================
  1292. ' Routine : GetIniString
  1293. '============================================================
  1294. ' Aufgabe : Liefert einen String aus dem angegebenen Bereich
  1295. '           und dem angegebenen Eintrag in einer INI-Datei.
  1296. ' Eingabe : Section  = Bereich
  1297. '           Item     = Eintrag
  1298. '           Default  = Standard-String
  1299. '           FileName = Name der INI-Datei
  1300. ' Ausgabe : keine
  1301. ' Return  : Parameter vom Typ String
  1302. '------------------------------------------------------------
  1303. '
  1304. Function GetIniString (Section$, Item$, Default$, FileName$) As String
  1305.  
  1306.     Const BufSize = 2048 ' max. Anzahl Zeichen im Puffer
  1307.  
  1308.     Dim Buffer$ ' Puffer fⁿr den INI-String
  1309.     Dim CopyBytes% ' Anzahl der in den Puffer kopierten Zeichen
  1310.  
  1311.     GetIniString = Default$
  1312.     If FileName$ <> "" Then
  1313.     Buffer$ = String$(BufSize, 32) ' Puffer mit Leerzeichen fⁿllen
  1314.     CopyBytes% = GetPrivateProfileString(Section$, Item$, Default$, Buffer$, Len(Buffer$), FileName$) ' INI-String auslesen
  1315.     If CopyBytes% > 0 Then GetIniString = Mid$(Buffer$, 1, CopyBytes%) ' Leerzeichen l÷schen
  1316.     End If
  1317.  
  1318. End Function
  1319.  
  1320. '============================================================
  1321. ' Routine : GetWindowsDir
  1322. '============================================================
  1323. ' Aufgabe : Liefert das Windows-Verzeichnis zurⁿck.
  1324. ' Eingabe : keine
  1325. ' Ausgabe : keine
  1326. ' Return  : Windows-Verzeichnis
  1327. '------------------------------------------------------------
  1328. '
  1329. Function GetWindowsDir () As String
  1330.  
  1331.     Dim temp$
  1332.     Dim x
  1333.  
  1334.     temp$ = String$(145, 0)
  1335.     x = GetWindowsDirectory(temp$, 145)
  1336.     temp$ = Left$(temp$, x)
  1337.  
  1338.     If Right$(temp$, 1) <> "\" Then
  1339.     GetWindowsDir$ = temp$ + "\"
  1340.     Else
  1341.     GetWindowsDir$ = temp$
  1342.     End If
  1343.  
  1344. End Function
  1345.  
  1346. '============================================================
  1347. ' Routine : GetWindowsSysDir
  1348. '============================================================
  1349. ' Aufgabe : Liefert das Windows-System-Verzeichnis zurⁿck.
  1350. ' Eingabe : keine
  1351. ' Ausgabe : keine
  1352. ' Return  : Windows-System-Verzeichnis
  1353. '------------------------------------------------------------
  1354. '
  1355. Function GetWindowsSysDir () As String
  1356.  
  1357.     Dim temp$
  1358.     Dim x
  1359.  
  1360.     temp$ = String$(145, 0)
  1361.     x = GetSystemDirectory(temp$, 145)
  1362.     temp$ = Left$(temp$, x)
  1363.  
  1364.     If Right$(temp$, 1) <> "\" Then
  1365.     GetWindowsSysDir$ = temp$ + "\"
  1366.     Else
  1367.     GetWindowsSysDir$ = temp$
  1368.     End If
  1369.  
  1370. End Function
  1371.  
  1372. '============================================================
  1373. ' Routine : HideStatusDialog
  1374. '============================================================
  1375. ' Aufgabe : Blendet das Status-Dialogfenster aus.
  1376. ' Eingabe : keine
  1377. ' Ausgabe : keine
  1378. '------------------------------------------------------------
  1379. '
  1380. Sub HideStatusDialog ()
  1381.  
  1382.     Unload frm_StatusDlg
  1383.  
  1384. End Sub
  1385.  
  1386. '============================================================
  1387. ' Routine : InitParameters
  1388. '============================================================
  1389. ' Aufgabe : Initialisiert globale Parameter.
  1390. ' Eingabe : keine
  1391. ' Ausgabe : keine
  1392. '------------------------------------------------------------
  1393. '
  1394. Sub InitParameters ()
  1395.  
  1396.     Dim Result%
  1397.     Dim temp$
  1398.  
  1399.     On Error Resume Next
  1400.  
  1401.     WinSysDir$ = UCase$(GetWindowsSysDir())
  1402.     WinDir$ = UCase$(GetWindowsDir())
  1403.     WinDrive$ = UCase$(Left$(WinDir$, 1)) & ":"
  1404.     If InStr(WinSysDir$, WinDir$) = 0 Then
  1405.     WinSysDir$ = WinDir$
  1406.     End If
  1407.  
  1408.     SetupIniName$ = WinDir$ & "SETUP2.INI"
  1409.  
  1410.     If FileExists(SetupIniName) Then
  1411.  
  1412.     AppName$ = GetIniString(UCase$("Global"), UCase$("App_Name"), "", SetupIniName)
  1413.     If Err <> 0 Then AppName$ = ""
  1414.  
  1415.     SetupName$ = GetIniString(UCase$("Global"), UCase$("Setup_Name"), "Setup", SetupIniName)
  1416.     If Err <> 0 Then SetupName$ = "Setup"
  1417.  
  1418.     WinSysNeeded& = CLng(GetIniString(UCase$("Global"), UCase$("Anzahl_Bytes_Windows"), "0", SetupIniName))
  1419.     If Err <> 0 Then WinSysNeeded& = 0
  1420.  
  1421.     OtherNeeded& = CLng(GetIniString(UCase$("Global"), UCase$("Anzahl_Bytes_Sonstiges"), "0", SetupIniName))
  1422.     If Err <> 0 Then OtherNeeded& = 0
  1423.  
  1424.     Compressed& = CLng(GetIniString(UCase$("Global"), UCase$("Anzahl_Bytes_Ges_Komprimiert"), "0", SetupIniName))
  1425.     If Err <> 0 Then Compressed& = 0
  1426.  
  1427.     temp$ = UCase$(GetIniString(UCase$("Global"), UCase$("OLE2_Benutzung"), "N", SetupIniName))
  1428.     If temp$ = "N" Then
  1429.         fOLE2% = False
  1430.     Else
  1431.         fOLE2% = True
  1432.     End If
  1433.  
  1434.     SetupDlgTitle$ = GetIniString(UCase$("Setup-Fenster"), UCase$("Setup_Titel"), "", SetupIniName)
  1435.     If Err <> 0 Then SetupDlgTitle$ = ""
  1436.  
  1437.     TitleForeColor& = CLng(GetIniString(UCase$("Setup-Fenster"), UCase$("Titel_Vordergrundfarbe"), Str$(&H80000005), SetupIniName))
  1438.     If Err <> 0 Then TitleForeColor& = &H80000005
  1439.  
  1440.     temp$ = UCase$(GetIniString(UCase$("Setup-Fenster"), UCase$("Titel_fett"), "N", SetupIniName))
  1441.     If temp$ = "N" Then
  1442.         TitleFontBold% = False
  1443.     Else
  1444.         TitleFontBold% = True
  1445.     End If
  1446.  
  1447.     temp$ = UCase$(GetIniString(UCase$("Setup-Fenster"), UCase$("Titel_kursiv"), "N", SetupIniName))
  1448.     If temp$ = "N" Then
  1449.         TitleFontItalic% = False
  1450.     Else
  1451.         TitleFontItalic% = True
  1452.     End If
  1453.  
  1454.     temp$ = UCase$(GetIniString(UCase$("Setup-Fenster"), UCase$("Titel_unterstrichen"), "N", SetupIniName))
  1455.     If temp$ = "N" Then
  1456.         TitleFontUnderline% = False
  1457.     Else
  1458.         TitleFontUnderline% = True
  1459.     End If
  1460.  
  1461.     TitleFontName$ = UCase$(GetIniString(UCase$("Setup-Fenster"), UCase$("Titel_Font_Name"), "MS Sans Serif", SetupIniName))
  1462.     If Err <> 0 Then TitleFontName$ = "MS Sans Serif"
  1463.  
  1464.     TitleFontSize# = CDbl(GetIniString(UCase$("Setup-Fenster"), UCase$("Titel_Font_Gr÷▀e"), "24", SetupIniName))
  1465.     If Err <> 0 Then TitleFontSize# = 24
  1466.  
  1467.     SetupDlgBackColor& = CLng(GetIniString(UCase$("Setup-Fenster"), UCase$("Setup_Hintergrundfarbe"), Str$(&H808000), SetupIniName))
  1468.     If Err <> 0 Then SetupDlgBackColor& = &H808000
  1469.  
  1470.     SetupDlgIntro$ = GetIniString(UCase$("Setup-Fenster"), UCase$("Setup_Intro"), "", SetupIniName)
  1471.     If Err <> 0 Then SetupDlgIntro$ = ""
  1472.     SetupDlgIntro$ = WinDir$ + SetupDlgIntro$
  1473.  
  1474.     SetupIntroPosX% = CInt(GetIniString(UCase$("Setup-Fenster"), UCase$("Setup_Intro_PosX"), "12", SetupIniName))
  1475.     If Err <> 0 Then SetupIntroPosX% = 12
  1476.  
  1477.     SetupIntroPosY% = CInt(GetIniString(UCase$("Setup-Fenster"), UCase$("Setup_Intro_PosY"), "80", SetupIniName))
  1478.     If Err <> 0 Then SetupIntroPosY% = 80
  1479.  
  1480.     SetupIntroWidth% = CInt(GetIniString(UCase$("Setup-Fenster"), UCase$("Setup_Intro_Breite"), "609", SetupIniName))
  1481.     If Err <> 0 Then SetupIntroWidth% = 609
  1482.  
  1483.     SetupIntroHeight% = CInt(GetIniString(UCase$("Setup-Fenster"), UCase$("Setup_Intro_H÷he"), "353", SetupIniName))
  1484.     If Err <> 0 Then SetupIntroHeight% = 353
  1485.  
  1486.     ErrorBoxCaption$ = GetIniString(UCase$("Message-Boxen"), UCase$("Kopfzeile_Fehler_Box"), "Fehler", SetupIniName)
  1487.     If Err <> 0 Then ErrorBoxCaption$ = "Fehler"
  1488.     If SetupName$ <> "" Then
  1489.         ErrorBoxCaption$ = SetupName$ & " - " & ErrorBoxCaption$
  1490.     End If
  1491.  
  1492.     CrErrorBoxCaption$ = GetIniString(UCase$("Message-Boxen"), UCase$("Kopfzeile_Kr_Fehler_Box"), "Kritischer Fehler", SetupIniName)
  1493.     If Err <> 0 Then CrErrorBoxCaption$ = "Kritischer Fehler"
  1494.     If SetupName$ <> "" Then
  1495.         CrErrorBoxCaption$ = SetupName$ & " - " & CrErrorBoxCaption$
  1496.     End If
  1497.  
  1498.     InfoBoxCaption$ = GetIniString(UCase$("Message-Boxen"), UCase$("Kopfzeile_Info_Box"), "Hinweis", SetupIniName)
  1499.     If Err <> 0 Then InfoBoxCaption$ = "Hinweis"
  1500.     If SetupName$ <> "" Then
  1501.         InfoBoxCaption$ = SetupName$ & " - " & InfoBoxCaption$
  1502.     End If
  1503.  
  1504.     QuestionBoxCaption$ = GetIniString(UCase$("Message-Boxen"), UCase$("Kopfzeile_Frage_Box"), "Frage", SetupIniName)
  1505.     If Err <> 0 Then QuestionBoxCaption$ = "Frage"
  1506.     If SetupName$ <> "" Then
  1507.         QuestionBoxCaption$ = SetupName$ & " - " & QuestionBoxCaption$
  1508.     End If
  1509.  
  1510.     WarningBoxCaption$ = GetIniString(UCase$("Message-Boxen"), UCase$("Kopfzeile_Warnung_Box"), "Warnung", SetupIniName)
  1511.     If Err <> 0 Then WarningBoxCaption$ = "Warnung"
  1512.     If SetupName$ <> "" Then
  1513.         WarningBoxCaption$ = SetupName$ & " - " & WarningBoxCaption$
  1514.     End If
  1515.  
  1516.     StatusTitle$ = GetIniString(UCase$("Status-Fenster"), UCase$("Status_Titel"), "Status", SetupIniName)
  1517.     If Err <> 0 Then StatusTitle$ = "Status"
  1518.  
  1519.     SrcDialogTitle$ = GetIniString(UCase$("Installation von"), UCase$("Dialog_Titel"), "Installation von ...", SetupIniName)
  1520.     If Err <> 0 Then SrcDialogTitle$ = "Installation von ..."
  1521.  
  1522.     SrcDialogInfo$ = GetIniString(UCase$("Installation von"), UCase$("Dialog_Info"), "Bitte geben Sie Laufwerk und Pfad ein, in dem sich das zu installierende Programm befindet.", SetupIniName)
  1523.     If Err <> 0 Then SrcDialogInfo$ = "Bitte geben Sie Laufwerk und Pfad ein, in dem sich das zu installierende Programm befindet."
  1524.  
  1525.     SrcPathLabel$ = GetIniString(UCase$("Installation von"), UCase$("Label_Quellpfad"), "Quellpfad:", SetupIniName)
  1526.     If Err <> 0 Then SrcPathLabel$ = "Quellpfad:"
  1527.  
  1528.     SrcDrive$ = GetIniString(UCase$("Installation von"), UCase$("Quell_Laufwerk"), "A:", SetupIniName)
  1529.     If Err <> 0 Then SrcDrive$ = "A:"
  1530.     SrcDrive$ = UCase$(SrcDrive$)
  1531.  
  1532.     SrcPath$ = GetIniString(UCase$("Installation von"), UCase$("Quell_Pfad"), "", SetupIniName)
  1533.     If Err <> 0 Or SrcPath$ = "" Then SrcPath$ = SrcDrive$ + "\"
  1534.     If Left$(SrcPath$, 1) = "\" Then
  1535.         SrcPath$ = SrcDrive$ + SrcPath$
  1536.     ElseIf Len(SrcPath$) > 2 Then
  1537.         If InStr(1, SrcPath$, ":") And InStr(2, SrcPath$, "\") Then
  1538.         SrcPath$ = Right$(SrcPath$, Len(SrcPath$) - 2)
  1539.         SrcPath$ = SrcDrive$ + SrcPath$
  1540.         End If
  1541.     End If
  1542.     SrcPath$ = UCase$(SrcPath$)
  1543.  
  1544.     DestDialogTitle$ = GetIniString(UCase$("Installation nach"), UCase$("Dialog_Titel"), "Installation nach ...", SetupIniName)
  1545.     If Err <> 0 Then DestDialogTitle$ = "Installation nach ..."
  1546.  
  1547.     DestDialogInfo$ = GetIniString(UCase$("Installation nach"), UCase$("Dialog_Info"), "Bitte geben Sie Laufwerk und Pfad ein, wonach das Programm installiert werden soll.", SetupIniName)
  1548.     If Err <> 0 Then DestDialogInfo$ = "Bitte geben Sie Laufwerk und Pfad ein, wonach das Programm installiert werden soll."
  1549.  
  1550.     DestPathLabel$ = GetIniString(UCase$("Installation nach"), UCase$("Label_Zielpfad"), "Zielpfad:", SetupIniName)
  1551.     If Err <> 0 Then DestPathLabel$ = "Zielpfad:"
  1552.  
  1553.     DestDrive$ = GetIniString(UCase$("Installation nach"), UCase$("Ziel_Laufwerk"), "C:", SetupIniName)
  1554.     If Err <> 0 Then DestDrive$ = "C:"
  1555.     DestDrive$ = UCase$(DestDrive$)
  1556.  
  1557.     DestPath$ = GetIniString(UCase$("Installation nach"), UCase$("Ziel_Pfad"), "", SetupIniName)
  1558.     If Err <> 0 Or DestPath$ = "" Then DestPath$ = DestDrive$ + "\"
  1559.     If Left$(DestPath$, 1) = "\" Then
  1560.         DestPath$ = DestDrive$ + DestPath$
  1561.     ElseIf Len(DestPath$) > 2 Then
  1562.         If InStr(1, DestPath$, ":") And InStr(2, DestPath$, "\") Then
  1563.         DestPath$ = Right$(DestPath$, Len(DestPath$) - 2)
  1564.         DestPath$ = DestDrive$ + DestPath$
  1565.         End If
  1566.     End If
  1567.     DestPath$ = UCase$(DestPath$)
  1568.     
  1569.     Else
  1570.     Result% = ShowMsgBox("SETUP - Fehler", "Datei " & SetupIniName & " nicht gefunden. Setup kann nicht ausgefⁿhrt werden.", MB_OK + MB_ICONSTOP)
  1571.     End
  1572.     End If
  1573.  
  1574. End Sub
  1575.  
  1576. '============================================================
  1577. ' Routine : InstallCtl3D
  1578. '============================================================
  1579. ' Aufgabe : Installiert die Windows-Klasse zur 3D-Darstellung
  1580. '           von Message-Boxen und liefert True oder False zu-
  1581. '           rⁿck, je nachdem, ob die Operation erfolgreich war
  1582. '           oder nicht.
  1583. ' Eingabe : ProgName = Name des Programms
  1584. ' Ausgabe : keine
  1585. ' Return  : True oder False
  1586. '------------------------------------------------------------
  1587. '
  1588. Function InstallCtl3D (ProgName$) As Integer
  1589.  
  1590.     Dim Inst%, Result%
  1591.  
  1592.     On Error Resume Next
  1593.  
  1594.     InstallCtl3D = False
  1595.     Inst% = GetModuleHandle(ProgName)
  1596.     Result% = Ctl3DRegister(Inst%)
  1597.     Result% = Ctl3DAutoSubclass(Inst%)
  1598.     InstallCtl3D = Result%
  1599.  
  1600. End Function
  1601.  
  1602. '============================================================
  1603. ' Routine : IsValidPath
  1604. '============================================================
  1605. ' Aufgabe : ▄berprⁿft die Gⁿltigkeit eines Pfades und liefert
  1606. '           True bzw. False zurⁿck
  1607. ' Eingabe : Path         = Pfad
  1608. '           DefaultDrive = Standard-Laufwerksbezeichnung
  1609. ' Ausgabe : Path         = formatierter Pfad (Form: "X:\DIR\DIR\")
  1610. ' Return  : True (Pfad gⁿltig) bzw. False (Pfad ungⁿltig)
  1611. '------------------------------------------------------------
  1612. '
  1613. Function IsValidPath (Path$, ByVal DefaultDrive$) As Integer
  1614.  
  1615.     Dim tmp$, temp$
  1616.     Dim drive$
  1617.     Dim legalChar$
  1618.     Dim BackPos, ForePos
  1619.     Dim i
  1620.     Dim periodPos, length
  1621.  
  1622.     On Error GoTo ERR_IsValidPath
  1623.  
  1624.     Path$ = RTrim$(LTrim$(Path$))
  1625.  
  1626.     If Right$(DefaultDrive$, 1) <> ":" Or Len(DefaultDrive$) <> 2 Then
  1627.     ShowErrorBox2 "Falsche oder fehlende Laufwerksbezeichnung." & Chr$(13) & Chr$(13) & "Die Laufwerksbezeichnung mu▀ einen Laufwerksbuchstaben (z.B. 'C') und ':' enthalten (z.B. 'C:')"
  1628.     GoTo ERR_IsValidPath
  1629.     End If
  1630.  
  1631.     If Left$(Path$, 1) = "\" Then
  1632.     Path$ = DefaultDrive$ + Path$
  1633.     End If
  1634.  
  1635.     On Error Resume Next
  1636.  
  1637.     tmp$ = Dir$(Path$)
  1638.     If Err <> 0 Then
  1639.     GoTo ERR_IsValidPath
  1640.     End If
  1641.  
  1642.     If (InStr(Path$, "*") <> 0) GoTo ERR_IsValidPath
  1643.     If (InStr(Path$, "?") <> 0) GoTo ERR_IsValidPath
  1644.     If (InStr(Path$, " ") <> 0) GoTo ERR_IsValidPath
  1645.  
  1646.     If Mid$(Path$, 2, 1) <> Chr$(58) Then GoTo ERR_IsValidPath
  1647.  
  1648.     If Len(Path$) > 2 Then
  1649.     If Right$(Left$(Path$, 3), 1) <> "\" Then
  1650.         Path$ = Left$(Path$, 2) + "\" + Right$(Path$, Len(Path$) - 2)
  1651.     End If
  1652.     End If
  1653.  
  1654.     drive$ = Left$(Path$, 1)
  1655.     ChDrive (drive$)                                                        ' Try to
  1656.     If Err <> 0 Then GoTo ERR_IsValidPath
  1657.  
  1658.     If Right$(Path$, 1) <> "\" Then
  1659.     Path$ = Path$ + "\"
  1660.     End If
  1661.  
  1662.     If Len(Path$) = 3 Then
  1663.     If Right$(Path$, 2) = ":\" Then
  1664.         GoTo EXIT_IsValidPath
  1665.     End If
  1666.     End If
  1667.  
  1668.     If InStr(Path$, "\\") <> 0 Then GoTo ERR_IsValidPath
  1669.  
  1670.     legalChar$ = "!#$%&'()-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`{}~.ⁿΣ÷─╓▄▀"
  1671.     BackPos = 3
  1672.     ForePos = InStr(4, Path$, "\")
  1673.  
  1674.     Do
  1675.     temp$ = Mid$(Path$, BackPos + 1, ForePos - BackPos - 1)
  1676.     For i = 1 To Len(temp$)
  1677.         If InStr(legalChar$, UCase$(Mid$(temp$, i, 1))) = 0 Then GoTo ERR_IsValidPath
  1678.     Next i
  1679.     periodPos = InStr(temp$, ".")
  1680.     length = Len(temp$)
  1681.     If periodPos = 0 Then
  1682.         If length > 8 Then GoTo ERR_IsValidPath
  1683.     Else
  1684.         If periodPos > 9 Then GoTo ERR_IsValidPath
  1685.         If length > periodPos + 3 Then GoTo ERR_IsValidPath
  1686.         If InStr(periodPos + 1, temp$, ".") <> 0 Then GoTo ERR_IsValidPath
  1687.     End If
  1688.     BackPos = ForePos
  1689.     ForePos = InStr(BackPos + 1, Path$, "\")
  1690.     Loop Until ForePos = 0
  1691.  
  1692. EXIT_IsValidPath:
  1693.  
  1694.     IsValidPath = True
  1695.     Exit Function
  1696.  
  1697. ERR_IsValidPath:
  1698.  
  1699.     IsValidPath = False
  1700.     Exit Function
  1701.  
  1702. End Function
  1703.  
  1704. '============================================================
  1705. ' Routine : Main
  1706. '============================================================
  1707. ' Aufgabe : Hauptroutine des Setup-Programms
  1708. ' Eingabe : keine
  1709. ' Ausgabe : keine
  1710. '------------------------------------------------------------
  1711. '
  1712. Sub Main ()
  1713.  
  1714.     Dim TheVerInfo&
  1715.     Dim WinVer&
  1716.     Dim Count%, temp$, Pos, i
  1717.     Dim Continue
  1718.     Dim Cmd$
  1719.     Dim Param_ As ParamType
  1720.     Dim Result%
  1721.     Dim Item$
  1722.  
  1723.     Static Param$(10)
  1724.  
  1725.     On Error GoTo ERR_Main_2
  1726.  
  1727.     ' Windows-Klasse zur 3D-Darstellung von Message-Boxen installieren
  1728.  
  1729.     Result% = InstallCtl3D("[]")
  1730.  
  1731.     ' Parameter initialisieren
  1732.  
  1733.     InitParameters
  1734.  
  1735.     ' Windows-Version ermitteln
  1736.  
  1737.     TheVerInfo& = GetVersion()
  1738.     WinVer& = TheVerInfo& And &HFFFF&
  1739.     If Val(Format$(WinVer& Mod 256) + "." + Format$(WinVer& \ 256)) >= 3.1 Then
  1740.     gfWin31% = True
  1741.     End If
  1742.  
  1743.     ' Wird OLE 2.0 benutzt? Wenn ja, dann wird Windows 3.1 oder h÷her ben÷tigt.
  1744.  
  1745.     If fOLE2% And Not gfWin31% Then
  1746.     ShowInfoBox "Dieses Programm ben÷tigt Windows 3.1 oder h÷her"
  1747.     GoTo ERR_Main_1
  1748.     End If
  1749.  
  1750.     ' Setup-Hauptfenster anzeigen
  1751.  
  1752.     ShowMainForm
  1753.  
  1754.     ' Installationsablauf
  1755.  
  1756.     Count% = 1
  1757.     Continue = True
  1758.  
  1759.     While Continue
  1760.  
  1761.     Cmd$ = ""
  1762.  
  1763.     temp$ = GetIniString("Ablauf", Str$(Count%), "", SetupIniName)
  1764.     Item$ = temp$
  1765.     If temp$ = "" Then Continue = False
  1766.  
  1767.     If temp$ <> "" Then
  1768.         For i = 1 To 10
  1769.         Param$(i) = ""
  1770.         Next i
  1771.         Pos = InStr(1, temp$, " ")
  1772.         If Pos = 0 Then
  1773.         Cmd$ = UCase$(RTrim$(LTrim$(temp$)))
  1774.         temp$ = ""
  1775.         Else
  1776.         Cmd$ = UCase$(RTrim$(LTrim$(Left$(temp$, Pos - 1))))
  1777.         temp$ = RTrim$(LTrim$(Right$(temp$, Len(temp$) - Pos)))
  1778.         If temp$ <> "" Then
  1779.             i = 1
  1780.             While temp$ <> "" And i <= 10
  1781.             Pos = InStr(1, temp$, ";")
  1782.             If Pos = 0 Then
  1783.                 Param$(i) = RTrim$(LTrim$(temp$))
  1784.                 temp$ = ""
  1785.             Else
  1786.                 Param$(i) = RTrim$(LTrim$(Left$(temp$, Pos - 1)))
  1787.                 temp$ = RTrim$(LTrim$(Right$(temp$, Len(temp$) - Pos)))
  1788.             End If
  1789.             i = i + 1
  1790.             Wend
  1791.         End If
  1792.         End If
  1793.  
  1794.         If Cmd$ <> "" Then
  1795.         For i = 1 To 10
  1796.             Param_.i(i) = Param$(i)
  1797.         Next i
  1798.         Result% = ExecCmd(Cmd$, Param_, Count%, Item$)
  1799.         End If
  1800.  
  1801.     End If
  1802.  
  1803.     Count% = Count% + 1
  1804.  
  1805.     Wend
  1806.  
  1807. EXIT_Main:
  1808.  
  1809.     frm_Setup2.Hide
  1810.     RestoreProgMan
  1811.     End
  1812.     Exit Sub
  1813.  
  1814. ERR_Main_1:
  1815.  
  1816.     EndProgram True
  1817.  
  1818. ERR_Main_2:
  1819.  
  1820.     Result% = ShowErrorBox("Fehler Nr. " & Str$(Err) & " aufgetreten.", 1)
  1821.     Select Case Result%
  1822.     Case IDRETRY
  1823.         Resume
  1824.     Case IDIGNORE
  1825.         Resume Next
  1826.     Case IDABORT
  1827.         Exit Sub
  1828.     End Select
  1829.  
  1830. End Sub
  1831.  
  1832. '============================================================
  1833. ' Routine : PromptForNextDisk
  1834. '============================================================
  1835. ' Aufgabe : Fordert den Benutzer auf, eine neue Diskette ins
  1836. '           Laufwerk einzulegen und liefert True bzw. False
  1837. '           zurⁿck, je nachdem, ob die Operation erfolgreich
  1838. '           war oder nicht.
  1839. ' Eingabe : wDiskNum      = Diskettennummer
  1840. '           FileToLookFor = Name der Datei, anhand deren die
  1841. '                           richtige Diskette identifiziert
  1842. '                           werden kann
  1843. ' Ausgabe : keine
  1844. ' Return  : True bzw. False
  1845. '------------------------------------------------------------
  1846. '
  1847. Function PromptForNextDisk (wDiskNum%, FileToLookFor$) As Integer
  1848.  
  1849.     Dim Ready
  1850.     Dim temp$
  1851.     Dim x
  1852.  
  1853.     Ready = False
  1854.  
  1855.     On Error Resume Next
  1856.  
  1857.     FileToLookFor$ = SrcDrive$ + FileToLookFor$
  1858.     temp$ = Dir$(FileToLookFor$)
  1859.     If Err <> 0 Or Len(temp$) = 0 Then
  1860.     While Not Ready
  1861.         Err = 0
  1862.         Beep
  1863.         x = ShowOkCancelBox(InfoBoxCaption, "Bitte Diskette #" + Format$(wDiskNum%) + " ins Laufwerk " + SrcDrive$ + " einlegen.", 1)
  1864.         If x = 2 Then
  1865.         PromptForNextDisk = False
  1866.         GoTo EXIT_PromptForNextDisk
  1867.         Else
  1868.         temp$ = Dir$(FileToLookFor$)
  1869.         If Err = 0 And Len(temp$) <> 0 Then
  1870.             PromptForNextDisk = True
  1871.             Ready = True
  1872.         End If
  1873.         End If
  1874.     Wend
  1875.     Else
  1876.     PromptForNextDisk = True
  1877.     End If
  1878.  
  1879. EXIT_PromptForNextDisk:
  1880.  
  1881. End Function
  1882.  
  1883. '============================================================
  1884. ' Routine : RestoreProgMan
  1885. '============================================================
  1886. ' Aufgabe : Zeigt den 'Program Manager'.
  1887. ' Eingabe : keine
  1888. ' Ausgabe : keine
  1889. '------------------------------------------------------------
  1890. '
  1891. Sub RestoreProgMan ()
  1892.  
  1893.     On Error GoTo ERR_RestoreProgMan
  1894.  
  1895.     AppActivate "Program Manager"
  1896.     SendKeys "%{ }{Enter}", True
  1897.  
  1898. ERR_RestoreProgMan:
  1899.  
  1900.     Exit Sub
  1901.  
  1902. End Sub
  1903.  
  1904. '============================================================
  1905. ' Routine : RunShell
  1906. '============================================================
  1907. ' Aufgabe : Ruft ein externes Programm via Shell auf und lie-
  1908. '           fert True oder False, je nachdem, ob die Operation
  1909. '           erfolgreich war oder nicht.
  1910. ' Eingabe : CmdLine = Kommandozeile
  1911. ' Ausgabe : keine
  1912. ' Return  : True bzw. False
  1913. '------------------------------------------------------------
  1914. '
  1915. Function RunShell (CmdLine$) As Integer
  1916.  
  1917.     Dim Hnd As Integer
  1918.     Dim Dummy As Integer
  1919.  
  1920.     On Error GoTo ERR_RunShell
  1921.  
  1922.     Screen.MousePointer = 11
  1923.  
  1924.     RunShell = True
  1925.  
  1926.     Hnd = Shell(CmdLine, 2)
  1927.     
  1928.     Do
  1929.     Dummy = DoEvents()
  1930.     Loop While GetModuleUsage(Hnd)
  1931.  
  1932.     Screen.MousePointer = 0
  1933.  
  1934. EXIT_RunShell:
  1935.  
  1936.     Exit Function
  1937.  
  1938. ERR_RunShell:
  1939.  
  1940.     RunShell = False
  1941.     Screen.MousePointer = 0
  1942.     GoTo EXIT_RunShell
  1943.  
  1944. End Function
  1945.  
  1946. '============================================================
  1947. ' Routine : ShowMainForm
  1948. '============================================================
  1949. ' Aufgabe : Zeigt das Hauptfenster des Setup-Programms an.
  1950. ' Eingabe : keine
  1951. ' Ausgabe : keine
  1952. '------------------------------------------------------------
  1953. '
  1954. Sub ShowMainForm ()
  1955.  
  1956.     Dim Result%
  1957.  
  1958.     On Error Resume Next
  1959.  
  1960.     Screen.MousePointer = 11
  1961.  
  1962.     frm_Setup2.Caption = SetupName
  1963.     frm_Setup2.lab_Title.Caption = SetupDlgTitle
  1964.     frm_Setup2.lab_Title.ForeColor = TitleForeColor
  1965.     frm_Setup2.lab_Title.FontBold = TitleFontBold
  1966.     frm_Setup2.lab_Title.FontItalic = TitleFontItalic
  1967.     frm_Setup2.lab_Title.FontUnderline = TitleFontUnderline
  1968.     frm_Setup2.lab_Title.FontName = TitleFontName
  1969.     frm_Setup2.lab_Title.FontSize = TitleFontSize
  1970.     frm_Setup2.BackColor = SetupDlgBackColor
  1971.     frm_Setup2.img_Intro.Picture = LoadPicture(SetupDlgIntro$)
  1972.     frm_Setup2.img_Intro.Left = SetupIntroPosX
  1973.     frm_Setup2.img_Intro.Top = SetupIntroPosY
  1974.     frm_Setup2.img_Intro.Width = SetupIntroWidth
  1975.     frm_Setup2.img_Intro.Height = SetupIntroHeight
  1976.     
  1977.     Screen.MousePointer = 0
  1978.  
  1979.     frm_Setup2.Show
  1980.     frm_Setup2.Refresh
  1981.  
  1982. End Sub
  1983.  
  1984. '============================================================
  1985. ' Routine : ShowMessageDialog
  1986. '============================================================
  1987. ' Aufgabe : Zeigt das Message-Dialogfenster an.
  1988. ' Eingabe : Title = Kopfzeile
  1989. '           Msg   = Message
  1990. ' Ausgabe : keine
  1991. '------------------------------------------------------------
  1992. '
  1993. Sub ShowMessageDialog (Title$, Msg$)
  1994.  
  1995.     On Error Resume Next
  1996.  
  1997.     Load frm_MessageDlg
  1998.  
  1999.     CenterForm frm_MessageDlg
  2000.     frm_MessageDlg.Caption = Title$
  2001.     frm_MessageDlg.lab_Message = Msg$
  2002.  
  2003.     frm_MessageDlg.Show
  2004.     frm_MessageDlg.Refresh
  2005.  
  2006. End Sub
  2007.  
  2008. '============================================================
  2009. ' Routine : ShowPathDialog
  2010. '============================================================
  2011. ' Aufgabe : Zeigt das Pfad-Dialogfenster an.
  2012. ' Eingabe : Title        = Kopfzeile
  2013. '           Info         = Info-Text
  2014. '           PathLabel    = Pfad-Label
  2015. '           DafaultDrive = Standard-Laufwerksbezeichnung
  2016. '           DefaultText  = Standard-Text (Voreinstellung)
  2017. ' Ausgabe : Path         = Pfadname
  2018. '           OutButton    = Status ("Continue" oder "Exit")
  2019. '------------------------------------------------------------
  2020. '
  2021. Sub ShowPathDialog (Title$, Info$, PathLabel$, DefaultDrive$, DefaultText$, Path$, OutButton$)
  2022.  
  2023.     On Error Resume Next
  2024.  
  2025.     Screen.MousePointer = 11
  2026.  
  2027.     Load frm_PathDlg
  2028.  
  2029.     frm_PathDlg.Caption = Title$
  2030.     frm_PathDlg.lab_Info = Info$
  2031.     frm_PathDlg.lab_Path = PathLabel$
  2032.     frm_PathDlg.lab_Drive = DefaultDrive$
  2033.     frm_PathDlg.txt_Path = DefaultText$
  2034.     frm_PathDlg.txt_Path.SelStart = 0
  2035.     frm_PathDlg.txt_Path.SelLength = Len(DefaultText$)
  2036.     CenterForm frm_PathDlg
  2037.  
  2038.     Screen.MousePointer = 0
  2039.  
  2040.     frm_PathDlg.Show 1
  2041.  
  2042.     Path$ = frm_PathDlg.lab_OutPath.Tag
  2043.     OutButton$ = frm_PathDlg.lab_OutButton.Tag
  2044.     Unload frm_PathDlg
  2045.  
  2046. End Sub
  2047.  
  2048. '============================================================
  2049. ' Routine : ShowStatusDialog
  2050. '============================================================
  2051. ' Aufgabe : Zeigt das Status-Dialogfenster an.
  2052. ' Eingabe : Title      = Kopfzeile
  2053. '           TotalBytes = Gesamtanzahl der zu kopierenden Bytes
  2054. ' Ausgabe : keine
  2055. '------------------------------------------------------------
  2056. '
  2057. Sub ShowStatusDialog (Title$, TotalBytes&)
  2058.  
  2059.     On Error Resume Next
  2060.  
  2061.     Load frm_StatusDlg
  2062.  
  2063.     frm_StatusDlg.Caption = Title$
  2064.     frm_StatusDlg.lab_Total.Tag = Str$(TotalBytes)
  2065.     position = 0
  2066.     CenterForm frm_StatusDlg
  2067.  
  2068.     frm_StatusDlg.Show
  2069.     frm_StatusDlg.Refresh
  2070.  
  2071. End Sub
  2072.  
  2073. '============================================================
  2074. ' Routine : UpdateStatus
  2075. '============================================================
  2076. ' Aufgabe : Aktualisiert die Status-Anzeige (Fortschritt-Balken).
  2077. ' Eingabe : FileBytes = Anzahl der kopierten Bytes einer Datei
  2078. ' Ausgabe : keine
  2079. '------------------------------------------------------------
  2080. '
  2081. Sub UpdateStatus (FileBytes&)
  2082.  
  2083.     Dim estTotal As Long
  2084.     Dim Txt$
  2085.     Dim r
  2086.  
  2087.     estTotal = Val(frm_StatusDlg.lab_Total.Tag)
  2088.     If estTotal = False Then
  2089.     estTotal = 10000000
  2090.     End If
  2091.  
  2092.     position = position + CSng((FileBytes / estTotal) * 100)
  2093.     If position > 100 Then
  2094.     position = 100
  2095.     End If
  2096.     frm_StatusDlg.pic_StatusBar2.Cls
  2097.     frm_StatusDlg.pic_StatusBar2.Line (0, 0)-((position * (frm_StatusDlg.pic_StatusBar2.ScaleWidth / 100)), frm_StatusDlg.pic_StatusBar2.ScaleHeight), QBColor(4), BF
  2098.  
  2099.     Txt$ = Format$(CLng(position)) + "%"
  2100.     frm_StatusDlg.pic_StatusBar2.CurrentX = (frm_StatusDlg.pic_StatusBar2.ScaleWidth - frm_StatusDlg.pic_StatusBar2.TextWidth(Txt$)) \ 2
  2101.     frm_StatusDlg.pic_StatusBar2.CurrentY = (frm_StatusDlg.pic_StatusBar2.ScaleHeight - frm_StatusDlg.pic_StatusBar2.TextHeight(Txt$)) \ 2
  2102.     frm_StatusDlg.pic_StatusBar2.Print Txt$
  2103.  
  2104.     r = BitBlt(frm_StatusDlg.pic_StatusBar1.hDC, 0, 0, frm_StatusDlg.pic_StatusBar2.ScaleWidth, frm_StatusDlg.pic_StatusBar2.ScaleHeight, frm_StatusDlg.pic_StatusBar2.hDC, 0, 0, SRCCOPY)
  2105.  
  2106. End Sub
  2107.  
  2108.