home *** CD-ROM | disk | FTP | other *** search
/ Dictionnaire Multimedia Multilingue / DictionnaireMultimedia-Win31Mac.bin / pc / setup1.bas < prev    next >
BASIC Source File  |  1993-04-27  |  26KB  |  778 lines

  1.  
  2. Sub AddShareIfNeeded (SharePath$, ShareFile$)
  3.     On Error GoTo ShareError
  4.  
  5.     fh% = FreeFile
  6.     Open "C:\AUTOEXEC.BAT" For Input As fh%
  7.  
  8.     fFound% = 0
  9.     While Not fFound% And Not EOF(fh%)
  10.     Line Input #fh%, Temp1$
  11.     If InStr(1, UCase$(Temp1$), "REM") = 0 And InStr(1, Temp1$, ";") = 0 And InStr(1, UCase$(Temp1$), "SHARE") > 0 Then
  12.        fFound% = True
  13.     End If
  14.     Wend
  15.  
  16.     Close #fh%
  17.  
  18.     If Not fFound% Then
  19.     MsgBox "Please add <PATH>SHARE.EXE /L:500 to your AUTOEXEC.BAT"
  20.     End If
  21.  
  22.     Exit Sub
  23. ShareError:
  24.     Close #fh%, #fh2%
  25.     Exit Sub
  26. End Sub
  27.  
  28. '-------------------------------------------------------
  29. ' Centers the passed form just above center on the screen
  30. '-------------------------------------------------------
  31. Sub CenterForm (x As Form)
  32.   
  33.     Screen.MousePointer = 11
  34.     x.Top = (Screen.Height * .85) / 2 - x.Height / 2
  35.     x.Left = Screen.Width / 2 - x.Width / 2
  36.     Screen.MousePointer = 0
  37.  
  38. End Sub
  39.  
  40. Sub ConcatSplitFiles (firstfile$, cSplit%)
  41.     Dim x%, fh1%, fh2%, outfile$, outfileLen&, CopyLeftOver&, CopyChunk#, filevar$
  42.     Dim iFileMax%, iFile%, y%
  43.  
  44.     For x% = 2 To cSplit%
  45.     
  46.     fh1% = FreeFile
  47.     Open Left$(firstfile$, Len(firstfile$) - 1) + Format$(1) For Binary As fh1%
  48.         
  49.     fh2% = FreeFile
  50.     outfile$ = Left$(firstfile$, Len(firstfile$) - 1) + Format$(x%)
  51.     Open outfile$ For Binary As fh2%
  52.         
  53.     ' Goto the end of file (plus one bytes) to start writing data
  54.     Seek #fh1%, LOF(fh1%) + 1
  55.  
  56.     outfileLen& = LOF(fh2%)
  57.     CopyLeftOver& = outfileLen& Mod 10
  58.     CopyChunk# = (outfileLen& - CopyLeftOver&) / 10
  59.     filevar$ = String$(CopyLeftOver&, 32)
  60.     Get #fh2%, , filevar$
  61.     Put #fh1%, , filevar$
  62.     filevar$ = String$(CopyChunk#, 32)
  63.     iFileMax% = 10
  64.     For iFile% = 1 To iFileMax%
  65.         Get #fh2%, , filevar$
  66.         Put #fh1%, , filevar$
  67.     Next iFile%
  68.  
  69.     Close fh1%, fh2%
  70.     y% = SetTime(outfile$, firstfile$)
  71.     Kill outfile$
  72.  
  73.     Next x%
  74.     
  75.     FileCopy Left$(firstfile$, Len(firstfile$) - 1) + Format$(1), firstfile$
  76.     Kill Left$(firstfile$, Len(firstfile$) - 1) + Format$(1)
  77. End Sub
  78.  
  79. '---------------------------------------------------------------
  80. ' Copies file SrcFilename from SourcePath to DestinationPath.
  81. '
  82. ' Returns 0 if it could not find the file, or other runtime
  83. ' error occurs.  Otherwise, returns true.
  84. '
  85. ' If the source file is older, the function returns success (-1)
  86. ' even though no file was copied, since no error occurred.
  87. '---------------------------------------------------------------
  88. Function CopyFile (ByVal SourcePath As String, ByVal DestinationPath As String, ByVal SrcFilename As String, ByVal DestFileName As String)
  89. ' ----- VerInstallFile() flags -----
  90.     Const VIFF_FORCEINSTALL% = &H1, VIFF_DONTDELETEOLD% = &H2
  91.     Const OF_DELETE% = &H200
  92.     Const VIF_TEMPFILE& = &H1
  93.     Const VIF_MISMATCH& = &H2
  94.     Const VIF_SRCOLD& = &H4
  95.  
  96.     Const VIF_DIFFLANG& = &H8
  97.     Const VIF_DIFFCODEPG& = &H10
  98.     Const VIF_DIFFTYPE& = &H20
  99.     Const VIF_WRITEPROT& = &H40
  100.     Const VIF_FILEINUSE& = &H80
  101.     Const VIF_OUTOFSPACE& = &H100
  102.     Const VIF_ACCESSVIOLATION& = &H200
  103.     Const VIF_SHARINGVIOLATION = &H400
  104.     Const VIF_CANNOTCREATE = &H800
  105.     Const VIF_CANNOTDELETE = &H1000
  106.     Const VIF_CANNOTRENAME = &H2000
  107.     Const VIF_CANNOTDELETECUR = &H4000
  108.     Const VIF_OUTOFMEMORY = &H8000
  109.  
  110.     Const VIF_CANNOTREADSRC = &H10000
  111.     Const VIF_CANNOTREADDST = &H20000
  112.  
  113.     Const VIF_BUFFTOOSMALL = &H40000
  114.     Dim TmpOFStruct As OFStruct
  115.     On Error GoTo ErrorCopy
  116.  
  117.     Screen.MousePointer = 11
  118.  
  119.     '--------------------------------------
  120.     ' Add ending \ symbols to path variables
  121.     '--------------------------------------
  122.     If Right$(SourcePath$, 1) <> "\" Then
  123.     SourcePath$ = SourcePath$ + "\"
  124.     End If
  125.     If Right$(DestinationPath$, 1) <> "\" Then
  126.     DestinationPath$ = DestinationPath$ + "\"
  127.     End If
  128.     
  129.     '----------------------------
  130.     ' Update status dialog info
  131.     '----------------------------
  132.     Statusdlg.Label1.Caption = "Source file: " + Chr$(10) + Chr$(13) + UCase$(SourcePath$ + SrcFilename$)
  133.     Statusdlg.Label1.Refresh
  134.     Statusdlg.Label2.Caption = "Destination file: " + Chr$(10) + Chr$(13) + UCase$(DestinationPath$ + DestFileName$)
  135.     Statusdlg.Label2.Refresh
  136.  
  137.     '-----------------------------------------
  138.     ' Check the validity of the path and file
  139.     '-----------------------------------------
  140. CheckForExist:
  141.     If Not FileExists(SourcePath$ + SrcFilename$) Then
  142.     Screen.MousePointer = 0
  143.     x% = MsgBox("Error occurred while attempting to copy file.  Could not locate file: """ + SourcePath$ + SrcFilename$ + """", 34, "SETUP")
  144.     Screen.MousePointer = 11
  145.     If x% = 3 Then
  146.         CopyFile = False
  147.     ElseIf x% = 4 Then
  148.         GoTo CheckForExist
  149.     ElseIf x% = 5 Then
  150.         GoTo SkipThisFile
  151.     End If
  152.     Else
  153.     '-------------------------------------------------
  154.     ' VerInstallFile installs the file. We need to initialize
  155.     ' some arguments for the temp file that is created by the call
  156.     '-------------------------------------------------
  157. TryToCopyAgain:
  158.     CurrDir$ = String$(255, 0)
  159.     TmpFile$ = String$(255, 0)
  160.     lpwTempFileLen% = 255
  161.     InFileVer$ = GetFileVersion(SourcePath$ + SrcFilename$)
  162.     OutFileVer$ = GetFileVersion(DestinationPath$ + DestFileName$)
  163.     
  164.     ' Install if no version info is available
  165.     If Len(InFileVer$) <> 0 And Len(OutFileVer$) <> 0 Then
  166.         ' Don't install older or same version of file
  167.         If InFileVer$ <= OutFileVer$ Then
  168.         UpdateStatus GetFileSize(SourcePath$ + SrcFilename$)
  169.         CopyFile = True
  170.         Exit Function
  171.         End If
  172.     End If
  173.  
  174.     Result& = VerInstallFile&(0, SrcFilename$, DestFileName$, SourcePath$, DestinationPath$, CurrDir$, TmpFile$, lpwTempFileLen%)
  175.  
  176.     '--------------------------------------------
  177.     ' After copying, update the installation meter
  178.     '---------------------------------------------
  179.     
  180.     S$ = DestinationPath$
  181.     If Right$(S$, 1) <> "\" Then S$ = S$ + "\"
  182.     S$ = S$ + DestFileName$
  183.     If Not TryAgain% Then UpdateStatus GetFileSize(S$)
  184.  
  185.     '--------------------------------
  186.     ' There are many return values that you can test for.
  187.     ' The constants are listed above.
  188.     ' The following lines of code return will set the Function to
  189.     ' True if the VerInstallFile call was successful.
  190.     '
  191.     ' If the call was unsuccessful due to a different language on the
  192.     ' users machine, VerInstallFile is called again to force installation.
  193.     ' You can change this to not install if you choose.
  194.     ' Be careful about using FORCEINSTALL.  Other flags could be
  195.     ' set which indicate that this file should not be overridden.
  196.     '
  197.     ' Under any other circumstance, the tempfile created by VerInstallFile
  198.     ' is removed using OpenFile and the CopyFile function returns false.
  199.     '--------------------------------------------------------
  200.     
  201.     If Result& = 0 Or (Result& And VIF_SRCOLD&) = VIF_SRCOLD& Then
  202.         CopyFile = True
  203.     ElseIf (Result& And VIF_DIFFLANG&) = VIF_DIFFLANG& Then
  204.         Result& = VerInstallFile&(VIFF_FORCEINSTALL%, SrcFilename$, DestFileName$, SourcePath$, DestinationPath$, CurrDir$, TmpFile$, lpwTempFileLen%)
  205.         CopyFile = True
  206.     ElseIf (Result& And VIF_WRITEPROT&) = VIF_WRITEPROT& Then
  207.         Result& = VerInstallFile&(VIFF_FORCEINSTALL%, SrcFilename$, DestFileName$, SourcePath$, winSysDir$ + "\", CurrDir$, TmpFile$, lpwTempFileLen%)
  208.         CopyFile = True
  209.     ElseIf (Result& And VIF_CANNOTREADSRC) = VIF_CANNOTREADSRC Then
  210.         ' VerInstallFile does will not handle compressed files that have been split.
  211.         ' Use VB's FileCopy stmt
  212.         FileCopy SourcePath$ + SrcFilename$, DestinationPath$ + DestFileName$
  213.         CopyFile = True
  214.     Else
  215.         Screen.MousePointer = 0
  216.         If (Result& And VIF_FILEINUSE&) = VIF_FILEINUSE& Then
  217.         x% = MsgBox(DestFileName$ & " is in use. Please close all applications and re-attempt Setup.", 34)
  218.         If x% = 3 Then
  219.             CopyFile = False
  220.         ElseIf x% = 4 Then
  221.             TryAgain% = True
  222.             GoTo TryToCopyAgain
  223.         ElseIf x% = 5 Then
  224.             CopyFile = True
  225.             GoTo SkipThisFile
  226.         End If
  227.         Else
  228.         MsgBox DestFileName$ & " could not be installed."
  229.         CopyFile = False
  230.         End If
  231.         Screen.MousePointer = 11
  232.     End If
  233.  
  234.     If (Result& And VIF_TEMPFILE&) = VIF_TEMPFILE& Then copyresult% = OpenFile(TmpFile$, TmpOFStruct, OF_DELETE%)
  235.        Screen.MousePointer = 0
  236.        Exit Function
  237.     End If
  238.  
  239. SkipThisFile:
  240.        Exit Function
  241. ErrorCopy:
  242.     CopyFile = False
  243.     Screen.MousePointer = 0
  244.     Exit Function
  245.  
  246. End Function
  247.  
  248. '---------------------------------------------
  249. ' Create the path contained in DestPath$
  250. ' First char must be drive letter, followed by
  251. ' a ":\" followed by the path, if any.
  252. '---------------------------------------------
  253. Function CreatePath (ByVal DestPath$) As Integer
  254.     Screen.MousePointer = 11
  255.  
  256.     '---------------------------------------------
  257.     ' Add slash to end of path if not there already
  258.     '---------------------------------------------
  259.     If Right$(DestPath$, 1) <> "\" Then
  260.     DestPath$ = DestPath$ + "\"
  261.     End If
  262.       
  263.  
  264.     '-----------------------------------
  265.     ' Change to the root dir of the drive
  266.     '-----------------------------------
  267.     On Error Resume Next
  268.     ChDrive DestPath$
  269.     If Err <> 0 Then GoTo errorOut
  270.     ChDir "\"
  271.  
  272.     '-------------------------------------------------
  273.     ' Attempt to make each directory, then change to it
  274.     '-------------------------------------------------
  275.     BackPos = 3
  276.     forePos = InStr(4, DestPath$, "\")
  277.     Do While forePos <> 0
  278.     temp$ = Mid$(DestPath$, BackPos + 1, forePos - BackPos - 1)
  279.  
  280.     Err = 0
  281.     MkDir temp$
  282.     If Err <> 0 And Err <> 75 Then GoTo errorOut
  283.  
  284.     Err = 0
  285.     ChDir temp$
  286.     If Err <> 0 Then GoTo errorOut
  287.  
  288.     BackPos = forePos
  289.     forePos = InStr(BackPos + 1, DestPath$, "\")
  290.     Loop
  291.          
  292.     CreatePath = True
  293.     Screen.MousePointer = 0
  294.     Exit Function
  295.          
  296. errorOut:
  297.     MsgBox "Error While Attempting to Create Directories on Destination Drive.", 48, "SETUP"
  298.     CreatePath = False
  299.     Screen.MousePointer = 0
  300.  
  301. End Function
  302.  
  303. '-------------------------------------------------------------
  304. ' Procedure: CreateProgManGroup
  305. ' Arguments: X           The Form where a Label1 exist
  306. '            GroupName$  A string that contains the group name
  307. '            GroupPath$  A string that contains the group file
  308. '                        name  ie 'myapp.grp'
  309. '-------------------------------------------------------------
  310. Sub CreateProgManGroup (x As Form, GroupName$, GroupPath$)
  311.     
  312.     Screen.MousePointer = 11
  313.     
  314.     '----------------------------------------------------------------------
  315.     ' Windows requires DDE in order to create a program group and item.
  316.     ' Here, a Visual Basic label control is used to generate the DDE messages
  317.     '----------------------------------------------------------------------
  318.     On Error Resume Next
  319.  
  320.     
  321.     '--------------------------------
  322.     ' Set LinkTopic to PROGRAM MANAGER
  323.     '--------------------------------
  324.     x.Label1.LinkTopic = "ProgMan|Progman"
  325.     x.Label1.LinkMode = 2
  326.     For i% = 1 To 10                                         ' Loop to ensure that there is enough time to
  327.       z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
  328.     Next                                                     ' for debug windows.
  329.     x.Label1.LinkTimeout = 100
  330.  
  331.  
  332.     '---------------------
  333.     ' Create program group
  334.     '---------------------
  335.     x.Label1.LinkExecute "[CreateGroup(" + GroupName$ + Chr$(44) + GroupPath$ + ")]"
  336.  
  337.  
  338.     '-----------------
  339.     ' Reset properties
  340.     '-----------------
  341.     x.Label1.LinkTimeout = 50
  342.     x.Label1.LinkMode = 0
  343.     
  344.     Screen.MousePointer = 0
  345. End Sub
  346.  
  347. '----------------------------------------------------------
  348. ' Procedure: CreateProgManItem
  349. '
  350. ' Arguments: X           The form where Label1 exists
  351. '
  352. '            CmdLine$    A string that contains the command
  353. '                        line for the item/icon.
  354. '                        ie 'c:\myapp\setup.exe'
  355. '
  356. '            IconTitle$  A string that contains the item's
  357. '                        caption
  358. '----------------------------------------------------------
  359. Sub CreateProgManItem (x As Form, CmdLine$, IconTitle$)
  360.     
  361.     Screen.MousePointer = 11
  362.     
  363.     '----------------------------------------------------------------------
  364.     ' Windows requires DDE in order to create a program group and item.
  365.     ' Here, a Visual Basic label control is used to generate the DDE messages
  366.     '----------------------------------------------------------------------
  367.     On Error Resume Next
  368.  
  369.  
  370.     '---------------------------------
  371.     ' Set LinkTopic to PROGRAM MANAGER
  372.     '---------------------------------
  373.     x.Label1.LinkTopic = "ProgMan|Progman"
  374.     x.Label1.LinkMode = 2
  375.     For i% = 1 To 10                                         ' Loop to ensure that there is enough time to
  376.       z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
  377.     Next                                                     ' for debug windows.
  378.     x.Label1.LinkTimeout = 100
  379.  
  380.     
  381.     '------------------------------------------------
  382.     ' Create Program Item, one of the icons to launch
  383.     ' an application from Program Manager
  384.     '------------------------------------------------
  385.     If gfWin31% Then
  386.     ' Win 3.1 has a ReplaceItem, which will allow us to replace existing icons
  387.     x.Label1.LinkExecute "[ReplaceItem(" + IconTitle$ + ")]"
  388.     End If
  389.     x.Label1.LinkExecute "[AddItem(" + CmdLine$ + Chr$(44) + IconTitle$ + Chr$(44) + ",,)]"
  390.     x.Label1.LinkExecute "[ShowGroup(groupname, 1)]"         ' This will ensure that Program Manager does not
  391.                                  ' have a Maximized group, which causes problem in RestoreProgMan
  392.  
  393.     '-----------------
  394.     ' Reset properties
  395.     '-----------------
  396.     x.Label1.LinkTimeout = 50
  397.     x.Label1.LinkMode = 0
  398.     
  399.     Screen.MousePointer = 0
  400. End Sub
  401.  
  402. '----------------------------------------------------------
  403. ' Check for the existence of a file by attempting an OPEN.
  404. '----------------------------------------------------------
  405. Function FileExists (path$) As Integer
  406.  
  407.     x = FreeFile
  408.  
  409.     On Error Resume Next
  410.     Open path$ For Input As x
  411.     If Err = 0 Then
  412.     FileExists = True
  413.     Else
  414.     FileExists = False
  415.     End If
  416.     Close x
  417.  
  418. End Function
  419.  
  420. '------------------------------------------------
  421. ' Get the disk space free for the current drive
  422. '------------------------------------------------
  423. Function GetDiskSpaceFree (drive As String) As Long
  424.     ChDrive drive
  425.     GetDiskSpaceFree = DiskSpaceFree()
  426. End Function
  427.  
  428. '----------------------------------------------------
  429. ' Get the disk Allocation unit for the current drive
  430. '----------------------------------------------------
  431. Function GetDrivesAllocUnit (drive As String) As Long
  432.     ChDrive drive
  433.     GetDrivesAllocUnit = AllocUnit()
  434. End Function
  435.  
  436. '------------------------
  437. ' Get the size of the file
  438. '------------------------
  439. Function GetFileSize (source$) As Long
  440.     x = FreeFile
  441.     Open source$ For Binary Access Read As x
  442.     GetFileSize = LOF(x)
  443.     Close x
  444. End Function
  445.  
  446. Function GetFileVersion (FileToCheck As String) As String
  447.     On Error Resume Next
  448.     VersionInfoSize& = GetFileVersionInfoSize(FileToCheck, lpdwHandle&)
  449.     If VersionInfoSize& = 0 Then
  450.     GetFileVersion = ""
  451.     Exit Function
  452.     End If
  453.     lpvdata$ = String(VersionInfoSize&, Chr$(0))
  454.     VersionInfo% = GetFileVersionInfo(FileToCheck, lpdwHandle&, VersionInfoSize&, lpvdata$)
  455.     ptrFixed% = VerQueryValue(lpvdata$, "\FILEVERSION", lplpBuffer&, lpcb%)
  456.     If ptrFixed% = 0 Then
  457.     ' Take a shot with the hardcoded TransString
  458.     TransString$ = "040904E4"
  459.     ptrString% = VerQueryValue(lpvdata$, "\StringFileInfo\" & TransString$ & "\CompanyName", lplpBuffer&, lpcb%)
  460.     If ptrString% <> 0 Then GoTo GetValues
  461.     ptrFixed% = VerQueryValue(lpvdata$, "\", lplpBuffer&, lpcb%)
  462.     If ptrFixed% = 0 Then
  463.         GetFileVersion = ""
  464.         Exit Function
  465.     Else
  466.         TransString$ = ""
  467.         fixedstr$ = String(lpcb% + 1, Chr(0))
  468.         stringcopy& = lstrcpyn(fixedstr$, lplpBuffer&, lpcb% + 1)
  469.         For i = lpcb% To 1 Step -1
  470.         char$ = Hex(Asc(Mid(fixedstr$, i, 1)))
  471.         If Len(char$) = 1 Then
  472.             char$ = "0" + char$
  473.         End If
  474.         TransString$ = TransString$ + char$
  475.         If Len(TransString$ & nextchar$) Mod 8 = 0 Then
  476.             TransString$ = "&H" & TransString$
  477.             TransValue& = Val(TransString$)
  478.             TransString$ = ""
  479.         End If
  480.         Next i
  481.     End If
  482.     End If
  483.     TransTable$ = String(lpcb% + 1, Chr(0))
  484.     TransString$ = String(0, Chr(0))
  485.     stringcopy& = lstrcpyn(TransTable$, lplpBuffer&, lpcb% + 1)
  486.     For i = 1 To lpcb%
  487.     char$ = Hex(Asc(Mid(TransTable$, i, 1)))
  488.     If Len(char$) = 1 Then
  489.         char$ = "0" + char$
  490.     End If
  491.     If Len(TransString$ & nextchar$) Mod 4 = 0 Then
  492.         nextchar$ = char$
  493.     Else
  494.         TransString$ = TransString$ + char$ + nextchar$
  495.         nextchar$ = ""
  496.         char$ = ""
  497.     End If
  498.     Next i
  499. GetValues:
  500.     ptrString% = VerQueryValue(lpvdata$, "\StringFileInfo\" & TransString$ & "\FileVersion", lplpBuffer&, lpcb%)
  501.     If ptrString% = 1 Then
  502.     TransTable$ = String(lpcb%, Chr(0))
  503.     stringcopy& = lstrcpyn(TransTable$, lplpBuffer&, lpcb% + 1)
  504.     GetFileVersion = TransTable$
  505.     Else
  506.     GetFileVersion = ""
  507.     End If
  508. End Function
  509.  
  510. '--------------------------------------------------
  511. ' Calls the windows API to get the windows directory
  512. '--------------------------------------------------
  513. Function GetWindowsDir () As String
  514.     temp$ = String$(145, 0)              ' Size Buffer
  515.     x = GetWindowsDirectory(temp$, 145)  ' Make API Call
  516.     temp$ = Left$(temp$, x)              ' Trim Buffer
  517.  
  518.     If Right$(temp$, 1) <> "\" Then      ' Add \ if necessary
  519.     GetWindowsDir$ = temp$ + "\"
  520.     Else
  521.     GetWindowsDir$ = temp$
  522.     End If
  523. End Function
  524.  
  525. '---------------------------------------------------------
  526. ' Calls the windows API to get the windows\SYSTEM directory
  527. '---------------------------------------------------------
  528. Function GetWindowsSysDir () As String
  529.     temp$ = String$(145, 0)                 ' Size Buffer
  530.     x = GetSystemDirectory(temp$, 145)      ' Make API Call
  531.     temp$ = Left$(temp$, x)                 ' Trim Buffer
  532.  
  533.     If Right$(temp$, 1) <> "\" Then         ' Add \ if necessary
  534.     GetWindowsSysDir$ = temp$ + "\"
  535.     Else
  536.     GetWindowsSysDir$ = temp$
  537.     End If
  538. End Function
  539.  
  540. '------------------------------------------------------
  541. ' Function:   IsValidPath as integer
  542. ' arguments:  DestPath$         a string that is a full path
  543. '             DefaultDrive$     the default drive.  eg.  "C:"
  544. '
  545. '  If DestPath$ does not include a drive specification,
  546. '  IsValidPath uses Default Drive
  547. '
  548. '  When IsValidPath is finished, DestPath$ is reformated
  549. '  to the format "X:\dir\dir\dir\"
  550. '
  551. ' Result:  True (-1) if path is valid.
  552. '          False (0) if path is invalid
  553. '-------------------------------------------------------
  554. Function IsValidPath (DestPath$, ByVal DefaultDrive$) As Integer
  555.  
  556.     '----------------------------
  557.     ' Remove left and right spaces
  558.     '----------------------------
  559.     DestPath$ = RTrim$(LTrim$(DestPath$))
  560.     
  561.  
  562.     '-----------------------------
  563.     ' Check Default Drive Parameter
  564.     '-----------------------------
  565.     If Right$(DefaultDrive$, 1) <> ":" Or Len(DefaultDrive$) <> 2 Then
  566.     MsgBox "Bad default drive parameter specified in IsValidPath Function.  You passed,  """ + DefaultDrive$ + """.  Must be one drive letter and "":"".  For example, ""C:"", ""D:""...", 64, "Setup Kit Error"
  567.     GoTo parseErr
  568.     End If
  569.     
  570.  
  571.     '-------------------------------------------------------
  572.     ' Insert default drive if path begins with root backslash
  573.     '-------------------------------------------------------
  574.     If Left$(DestPath$, 1) = "\" Then
  575.     DestPath$ = DefaultDrive + DestPath$
  576.     End If
  577.     
  578.     '-----------------------------
  579.     ' check for invalid characters
  580.     '-----------------------------
  581.     On Error Resume Next
  582.     tmp$ = Dir$(DestPath$)
  583.     If Err <> 0 Then
  584.     GoTo parseErr
  585.     End If
  586.     
  587.  
  588.     '-----------------------------------------
  589.     ' Check for wildcard characters and spaces
  590.     '-----------------------------------------
  591.     If (InStr(DestPath$, "*") <> 0) GoTo parseErr
  592.     If (InStr(DestPath$, "?") <> 0) GoTo parseErr
  593.     If (InStr(DestPath$, " ") <> 0) GoTo parseErr
  594.      
  595.     
  596.     '------------------------------------------
  597.     ' Make Sure colon is in second char position
  598.     '------------------------------------------
  599.     If Mid$(DestPath$, 2, 1) <> Chr$(58) Then GoTo parseErr
  600.     
  601.  
  602.     '-------------------------------
  603.     ' Insert root backslash if needed
  604.     '-------------------------------
  605.     If Len(DestPath$) > 2 Then
  606.       If Right$(Left$(DestPath$, 3), 1) <> "\" Then
  607.     DestPath$ = Left$(DestPath$, 2) + "\" + Right$(DestPath$, Len(DestPath$) - 2)
  608.       End If
  609.     End If
  610.  
  611.     '-------------------------
  612.     ' Check drive to install on
  613.     '-------------------------
  614.     drive$ = Left$(DestPath$, 1)
  615.     ChDrive (drive$)                                                        ' Try to change to the dest drive
  616.     If Err <> 0 Then GoTo parseErr
  617.     
  618.     '-----------
  619.     ' Add final \
  620.     '-----------
  621.     If Right$(DestPath$, 1) <> "\" Then
  622.     DestPath$ = DestPath$ + "\"
  623.     End If
  624.     
  625.  
  626.     '-------------------------------------
  627.     ' Root dir is a valid dir
  628.     '-------------------------------------
  629.     If Len(DestPath$) = 3 Then
  630.     If Right$(DestPath$, 2) = ":\" Then
  631.         GoTo ParseOK
  632.     End If
  633.     End If
  634.     
  635.  
  636.     '------------------------
  637.     ' Check for repeated Slash
  638.     '------------------------
  639.     If InStr(DestPath$, "\\") <> 0 Then GoTo parseErr
  640.     
  641.     '--------------------------------------
  642.     ' Check for illegal directory names
  643.     '--------------------------------------
  644.     legalChar$ = "!#$%&'()-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`{}~.ⁿΣ÷─╓▄▀"
  645.     BackPos = 3
  646.     forePos = InStr(4, DestPath$, "\")
  647.     Do
  648.     temp$ = Mid$(DestPath$, BackPos + 1, forePos - BackPos - 1)
  649.     
  650.     '----------------------------
  651.     ' Test for illegal characters
  652.     '----------------------------
  653.     For i = 1 To Len(temp$)
  654.         If InStr(legalChar$, UCase$(Mid$(temp$, i, 1))) = 0 Then GoTo parseErr
  655.     Next i
  656.  
  657.     '-------------------------------------------
  658.     ' Check combinations of periods and lengths
  659.     '-------------------------------------------
  660.     periodPos = InStr(temp$, ".")
  661.     length = Len(temp$)
  662.     If periodPos = 0 Then
  663.         If length > 8 Then GoTo parseErr                         ' Base too long
  664.     Else
  665.         If periodPos > 9 Then GoTo parseErr                      ' Base too long
  666.         If length > periodPos + 3 Then GoTo parseErr             ' Extension too long
  667.         If InStr(periodPos + 1, temp$, ".") <> 0 Then GoTo parseErr' Two periods not allowed
  668.     End If
  669.  
  670.     BackPos = forePos
  671.     forePos = InStr(BackPos + 1, DestPath$, "\")
  672.     Loop Until forePos = 0
  673.  
  674. ParseOK:
  675.     IsValidPath = True
  676.     Exit Function
  677.  
  678. parseErr:
  679.     IsValidPath = False
  680. End Function
  681.  
  682. '----------------------------------------------------
  683. ' Prompt for the next disk.  Use the FileToLookFor$
  684. ' argument to verify that the proper disk, disk number
  685. ' wDiskNum, was inserted.
  686. '----------------------------------------------------
  687. Function PromptForNextDisk (wDiskNum As Integer, FileToLookFor$) As Integer
  688.  
  689.     '-------------------------
  690.     ' Test for file
  691.     '-------------------------
  692.     Ready = False
  693.     On Error Resume Next
  694.     temp$ = Dir$(FileToLookFor$)
  695.  
  696.     '------------------------
  697.     ' If not found, start loop
  698.     '------------------------
  699.     If Err <> 0 Or Len(temp$) = 0 Then
  700.     While Not Ready
  701.         Err = 0
  702.         '----------------------------
  703.         ' Put up msg box
  704.         '----------------------------
  705.         Beep
  706.         x = MsgBox("Please insert disk # " + Format$(wDiskNum%), 49, "SETUP")
  707.         If x = 2 Then
  708.         '-------------------------------
  709.         ' Use hit cancel, abort the copy
  710.         '-------------------------------
  711.         PromptForNextDisk = False
  712.         GoTo ExitProc
  713.         Else
  714.         '----------------------------------------
  715.         ' User hits OK, try to find the file again
  716.         '----------------------------------------
  717.         temp$ = Dir$(FileToLookFor$)
  718.         If Err = 0 And Len(temp$) <> 0 Then
  719.             PromptForNextDisk = True
  720.             Ready = True
  721.         End If
  722.         End If
  723.     Wend
  724.     Else
  725.     PromptForNextDisk = True
  726.     End If
  727.  
  728.     
  729.  
  730. ExitProc:
  731.  
  732. End Function
  733.  
  734. Sub RestoreProgMan ()
  735.     On Error GoTo RestoreProgManErr
  736.     AppActivate "Program Manager"   ' Activate Program Manager.
  737.     SendKeys "%{ }{Enter}", True      ' Send Restore keystrokes.
  738. RestoreProgManErr:
  739.     Exit Sub
  740. End Sub
  741.  
  742. '-----------------------------------------------------------------------------
  743. ' Set the Destination File's date and time to the Source file's date and time
  744. '-----------------------------------------------------------------------------
  745. Function SetFileDateTime (SourceFile As String, DestinationFile As String) As Integer
  746.     x = SetTime(SourceFile, DestinationFile)
  747.     SetFileDateTime = -1
  748. End Function
  749.  
  750. Sub UpdateStatus (FileBytes As Long)
  751. '-----------------------------------------------------------------------------
  752. ' Update the status bar using form.control Statusdlg.Picture2
  753. '-----------------------------------------------------------------------------
  754.     Static position
  755.     Dim estTotal As Long
  756.  
  757.     estTotal = Val(Statusdlg.total.Tag)
  758.     If estTotal = False Then
  759.     estTotal = 10000000
  760.     End If
  761.  
  762.     position = position + CSng((FileBytes / estTotal) * 100)
  763.     If position > 100 Then
  764.     position = 100
  765.     End If
  766.     Statusdlg.Picture2.Cls
  767.     Statusdlg.Picture2.Line (0, 0)-((position * (Statusdlg.Picture2.ScaleWidth / 100)), Statusdlg.Picture2.ScaleHeight), QBColor(4), BF
  768.  
  769.     Txt$ = Format$(CLng(position)) + "%"
  770.     Statusdlg.Picture2.CurrentX = (Statusdlg.Picture2.ScaleWidth - Statusdlg.Picture2.TextWidth(Txt$)) \ 2
  771.     Statusdlg.Picture2.CurrentY = (Statusdlg.Picture2.ScaleHeight - Statusdlg.Picture2.TextHeight(Txt$)) \ 2
  772.     Statusdlg.Picture2.Print Txt$
  773.  
  774.     r = BitBlt(Statusdlg.Picture1.hDC, 0, 0, Statusdlg.Picture2.ScaleWidth, Statusdlg.Picture2.ScaleHeight, Statusdlg.Picture2.hDC, 0, 0, SRCCOPY)
  775.  
  776. End Sub
  777.  
  778.