VERSION 5.00 Begin VB.Form frmSetup1 AutoRedraw = -1 'True BackColor = &H00400000& BorderStyle = 0 'None ClientHeight = 1770 ClientLeft = 225 ClientTop = 1590 ClientWidth = 7950 ClipControls = 0 'False DrawStyle = 5 'Transparent FillStyle = 0 'Solid BeginProperty Font Name = "Times New Roman" Size = 24 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H00000000& HasDC = 0 'False Icon = "setup1.frx":0000 LockControls = -1 'True MaxButton = 0 'False MinButton = 0 'False NegotiateMenus = 0 'False PaletteMode = 1 'UseZOrder ScaleHeight = 118 ScaleMode = 3 'Pixel ScaleWidth = 530 WindowState = 2 'Maximized Begin VB.Label lblModify AutoSize = -1 'True BorderStyle = 1 'Fixed Single Caption = $"setup1.frx":0442 BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 450 Left = 15 TabIndex = 1 Top = 15 Visible = 0 'False Width = 7860 WordWrap = -1 'True End Begin VB.Label lblDDE AutoSize = -1 'True BorderStyle = 1 'Fixed Single Caption = "This label is used for DDE connection to the Program Manager" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 15 TabIndex = 0 Top = 1515 Visible = 0 'False Width = 4485 End End Attribute VB_Name = "frmSetup1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit ' ' Can't put this is a resource because it indicated resource load failure, must localize separately ' Private Const mstrRESOURCELOADFAIL$ = "An error occurred while initializing string resources used by Setup." '----------------------------------------------------------- ' SUB: DrawBackGround ' ' Draws the 'blue wash' screen and prints the 'shadowed' ' app setup title '----------------------------------------------------------- ' Private Sub DrawBackGround() Const intBLUESTART% = 255 Const intBLUEEND% = 0 Const intBANDHEIGHT% = 2 Const intSHADOWSTART% = 8 Const intSHADOWCOLOR% = 0 Const intTEXTSTART% = 4 Const intTEXTCOLOR% = 15 Const intRed% = 1 Const intGreen% = 2 Const intBlue% = 4 Const intBackRed% = 8 Const intBackGreen% = 16 Const intBackBlue% = 32 Dim sngBlueCur As Single Dim sngBlueStep As Single Dim intFormHeight As Integer Dim intFormWidth As Integer Dim intY As Integer Dim iColor As Integer Dim iRed As Single, iBlue As Single, iGreen As Single ' 'Get system values for height and width ' intFormHeight = ScaleHeight intFormWidth = ScaleWidth If Len(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_COLOR)) = 0 Then iColor = intBlue Else iColor = CInt(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_COLOR)) End If 'Calculate step size and blue start value ' sngBlueStep = intBANDHEIGHT * (intBLUEEND - intBLUESTART) / intFormHeight sngBlueCur = intBLUESTART ' 'Paint blue screen ' For intY = 0 To intFormHeight Step intBANDHEIGHT If iColor And intBlue Then iBlue = sngBlueCur If iColor And intRed Then iRed = sngBlueCur If iColor And intGreen Then iGreen = sngBlueCur If iColor And intBackBlue Then iBlue = 255 - sngBlueCur If iColor And intBackRed Then iRed = 255 - sngBlueCur If iColor And intBackGreen Then iGreen = 255 - sngBlueCur Line (-1, intY - 1)-(intFormWidth, intY + intBANDHEIGHT), RGB(iRed, iGreen, iBlue), BF sngBlueCur = sngBlueCur + sngBlueStep Next intY ' 'Print 'shadowed' appname ' CurrentX = intSHADOWSTART CurrentY = intSHADOWSTART ForeColor = QBColor(intSHADOWCOLOR) Print Caption CurrentX = intTEXTSTART CurrentY = intTEXTSTART ForeColor = QBColor(intTEXTCOLOR) Print Caption End Sub Private Sub Form_Load() ' ' Most of the work for Setup1 takes place in Form_Load() ' and is mostly driven by the information found in the ' SETUP.LST file. To customize the Setup1 functionality, ' you will generally want to modify SETUP.LST. ' Particularly, information regarding the files you are ' installing is all stored in SETUP.LST. Exceptions include ' the Remote Automation files RacMgr32.Exe and AutMgr32.Exe ' and special redistributable packages such as mdac_typ.exe. ' These require special handling below. ' ' Some customization can also be done by editing the code ' below in Form_Load or in other parts of this program. ' Places that are more likely to need customization are ' documented with suggestions and examples in the code. ' ' 'Uncomment these three lines for debugging. To debug: '1) Rebuild Setup1.exe and rebuild the cab file ' to include the new Setup1.exe. '2) Run setup.exe against the new cab '3) When the message box appears, open the Setup1 project ' in VB, paste the command line from the clipboard into the ' Project/Properties/Make/Command Line Arguments field. '4) F5 in VB. ' 'Clipboard.Clear 'Clipboard.SetText Command$ 'MsgBox Command$ Const fDefCreateGroupUnderWin95 = False Dim strGroupName As String 'Name of Program Group Dim oFont As StdFont Dim lChar As Long Dim cIcons As Integer ' Count of how many icons are required. Dim cGroups As Integer ' Count of how many groups are required. Dim fCreateGroup As Boolean Dim iLoop As Integer Dim sUCASEStartMenuKey As String Dim sUCASEProgramsMenuKey As String Dim sGroup As String Dim strRemAutGroupName As String Dim strPerAppPath As String Dim iRet As Integer gfRegDAO = False On Error GoTo MainError SetFormFont Me 'All the controls and the form are sharing the 'same font object, so create a new font object 'for the form so that the appearance of all the 'controls are not changed also Set oFont = New StdFont With oFont .Size = 24 .Bold = True .Italic = True .Charset = lblModify.Font.Charset .Name = lblModify.Font.Name End With Set Font = oFont ' 'Initialize string resources used by global vars and forms/controls ' GetStrings ' 'Get Windows, Windows\Fonts, and Windows\System directories ' gstrWinDir = GetWindowsDir() gstrWinSysDir = GetWindowsSysDir() gstrFontDir = GetWindowsFontDir() ' ' If the Windows System directory is a subdirectory of the ' Windows directory, the proper place for installation of ' files specified in the setup.lst as $(WinSysDest) is always ' the Windows \System directory. If the Windows \System ' directory is *not* a subdirectory of the Windows directory, ' then the user is running a shared version of Windows. In ' this case, if the user does not have write access to the ' shared system directory, we change the system files ' destination to the windows directory ' ' Avoid Option Compare Text and use explicit UCase comparisons because there ' is a Unicode character (&H818F) which is equal to a path separator when ' using Option Compare Text. If InStr(UCase$(gstrWinSysDir), UCase$(gstrWinDir)) <> 1 Then If Not WriteAccess(gstrWinSysDir) Then gstrWinSysDir = gstrWinDir End If End If ' ' The command-line arguments must be processed as early ' as possible, because without them it is impossible to ' call the app removal program to clean up after an aborted ' setup. ' #If SMS Then ProcessCommandLine Command$, gfSilent, gstrSilentLog, gfSMS, gstrMIFFile, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE gfNoUserInput = (gfSilent Or gfSMS) #Else ProcessCommandLine Command$, gfSilent, gstrSilentLog, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE gfNoUserInput = gfSilent #End If AddDirSep gstrSrcPath ' ' The Setup Bootstrapper (SETUP.EXE) copies SETUP1.EXE and SETUP.LST to ' the end user's windows directory. Information required for setup such ' as setup flags and fileinfo is read from the copy of SETUP.LST found in ' that directory. ' gstrSetupInfoFile = gstrWinDir & gstrFILE_SETUP 'Get the Appname (this will be shown on the blue wash screen) gstrAppName = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPNAME) gintCabs = CInt(ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gstrINI_CABS)) If Len(gstrAppName) = 0 Then MsgError ResolveResString(resNOSETUPLST), vbOKOnly Or vbCritical, gstrSETMSG gstrTitle = ResolveResString(resSETUP, gstrPIPE1, gstrAppName) ExitSetup Me, gintRET_FATAL End If gstrAppExe = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPEXE) gstrTitle = ResolveResString(resSETUP, gstrPIPE1, gstrAppName) If gfSilent Then LogSilentMsg gstrTitle & vbCrLf 'Get a temporary directory to use gsTEMPDIR = String$(255, 0) lChar = GetTempPath(255, gsTEMPDIR) gsTEMPDIR = Left$(gsTEMPDIR, lChar) AddDirSep gsTEMPDIR gsTEMPDIR = gsTEMPDIR & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gsINI_TEMPDIR) AddDirSep gsTEMPDIR ' ' Get the name of the CAB ' gsCABFULLNAME = gstrWinDir & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gstrINI_CABNAME) ' ' Display the background "blue-wash" setup screen as soon as we get the title ' ShowMainForm ' ' Display the welcome dialog ' ShowWelcomeForm ' ' If this flag is set, then the default destination directory is used ' without question, and the user is never given a chance to change it. ' This is intended for installing an .EXE/.DLL as a component rather ' than as an application in an application directory. In this case, ' having an application directory does not really make sense. ' If ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_FORCEUSEDEFDEST) = "1" Then gfForceUseDefDest = True End If ' ' Read default destination directory. If the name specified conflicts ' with the name of a file, then prompt for a new default directory ' gstrDestDir = ResolveDestDir(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPDIR)) Do While FileExists(gstrDestDir) Or Len(gstrDestDir) = 0 If MsgError(ResolveResString(resBADDEFDIR), vbOKCancel Or vbQuestion, gstrSETMSG) = vbCancel Then ExitSetup Me, gintRET_FATAL End If If gfNoUserInput Then ExitSetup Me, gintRET_FATAL Else ShowPathDialog End If Loop ' ' Ensure a trailing backslash on the destination directory ' AddDirSep gstrDestDir Do ' ' Display install button and default directory. The user ' can change the destination directory from here. ' ShowBeginForm ' ' This would be a good place to display an option dialog, allowing the user ' a chance to select installation options: samples, docs, help files, etc. ' Results of this dialog would be checked in the loop below ' 'ShowOptionsDialog (Function you could write with option check boxes, etc.) ' ' ' Initialize "table" of drives used and disk space array ' InitDiskInfo SetMousePtr vbHourglass ShowStaticMessageDialog ResolveResString(resDISKSPACE) ' ' For every section in SETUP.LST that will be installed, call CalcDiskSpace ' with the name of the section ' CalcDiskSpace gstrINI_FILES 'CalcDiskSpace "MySection" 'CalcDiskSpace "MyOtherSection" ' ' If you created an options dialog, you need to check results here to ' determine whether disk space needs to be calculated (if the option(s) ' will be installed) ' 'If chkInstallSamples.Value then ' CalcDiskSpace "Samples" 'End If ' HideStaticMessageDialog SetMousePtr vbDefault ' ' After all CalcDiskSpace calls are complete, call CheckDiskSpace to check ' the results and display warning form (if necessary). If the user wants ' to try another destination directory (or cleanup and retry) then ' CheckDiskSpace will return False ' Loop Until CheckDiskSpace() ' ' Starts logging to the setup logfile (will be used for application removal) ' EnableLogging gstrAppRemovalLog ' ' Should go ahead and force the application directory to be created, ' since the application removal logfile will later be copied there. ' MakePath gstrDestDir, False 'User may not ignore errors here ' ' Create the main program group if one is wanted/needed. ' ' ' If fDefCreateGroupUnderWin95 is set to False (this is the default), then no ' program group will be created under Win95 unless it is absolutely necessary. ' ' By default under Windows 95, no group should be created, and the ' single program icon should be placed directly under the ' Start>Programs menu (unless there are other, user-defined icons to create ' ' ' Read through the SETUP.LST file and determine how many icons are needed. ' cIcons = CountIcons(gsICONGROUP) cGroups = CountGroups(gsICONGROUP) ' ' Do the same for other sections in SETUP.LST if you've added your own. ' 'cIcons = cIcons + CountIcons("MySection") 'cIcons = cIcons + CountIcons("MyOtherSection") ' ' The following variable determines whether or not we create a program ' group for icons. It is controlled by fNoGroupUnderWin95, ' fAdditionalIcons, and FTreatAsWin95(). ' fCreateGroup = (cGroups > 0) If fCreateGroup Then For iLoop = 0 To cGroups - 1 sGroup = GetGroup(gsICONGROUP, iLoop) strGroupName = vbNullString Select Case UCase$(sGroup) Case UCase$(gsSTARTMENUKEY), UCase$(gsPROGMENUKEY) ' Skip start menu and programs - they're already there and don't ' need to be created. Case Else strGroupName = frmGroup.GroupName(frmSetup1, sGroup, GetPrivate(gsICONGROUP, iLoop), GetStart(gsICONGROUP, iLoop)) If UCase$(sGroup) <> UCase$(strGroupName) Then SetGroup gsICONGROUP, iLoop, strGroupName End If End Select fMainGroupWasCreated = True Next End If ' Before we begin copying files, check for mdac_typ ' and if we find it, spawn that off first. We will tell ' it to never reboot, and check at the end to see if we need to. DoEvents If CheckDataAccess Then 'We need to install data access. Display message. ShowStaticMessageDialog ResolveResString(resINSTALLADO) InstallDataAccess HideStaticMessageDialog End If ' ' Show copy form and set copy gauge percentage to zero ' SetMousePtr vbHourglass ShowCopyDialog UpdateStatus frmCopy.picStatus, 0, True ' ' Always start with Disk #1 ' gintCurrentDisk = 1 ' ' For every section in SETUP.LST that needs to be installed, call CopySection ' with the name of the section ' CopySection gstrINI_FILES 'CopySection "MySection" 'CopySection "MyOtherSection" ' ' If you created an options dialog, you need to check results here to ' determine whether to copy the files in the particular section(s). ' 'If chkInstallSamples.Value then ' CopySection "Samples" 'End If ' UpdateStatus frmCopy.picStatus, 1, True HideCopyDialog ' ' Now, do all the 'invisible' update things that are required ' SetMousePtr vbDefault ShowStaticMessageDialog ResolveResString(resUPDATING) ' ' Register all the files that have been saved in the registration array. The ' CopySection API adds a registration entry (when required) if a file is copied. ' RegisterFiles ' ' Register all the licenses that appear in the [Licenses] section of ' Setup.lst. ' RegisterLicenses ' ' If any DAO files were installed, we need to add some special ' keys to the registry to support it so that links will work ' in OLE Database fields. ' If gfRegDAO Then RegisterDAO End If CheckForAndInstallDirectX gstrINI_FILES, Me.hWnd ' ' Create program icons (or links, i.e. shortcuts). ' If fMainGroupWasCreated Or (cIcons > 0) Then ShowStaticMessageDialog ResolveResString(resPROGMAN) CreateIcons gsICONGROUP ' ' Do the same for other sections in SETUP.LST if you've added your own. ' 'CreateIcons "MySection" 'CreateIcons "MyOtherSection" ' End If ' ' Create a separate program group and icons for the Remote Automation ' Connection Manager and the Automation Manager, if either has been ' installed. ' This program group is entirely separate from the one created for the ' application program (if any), because it will be shared by all ' VB applications which install them. ' ' NOTE: This is NOT the place to install additional icons. This is ' NOTE: handled after the Remote Automation icons have been created. ' ShowStaticMessageDialog ResolveResString(resPROGMAN) If Len(gsDest.strAUTMGR32) > 0 Or Len(gsDest.strRACMGR32) > 0 Then 'At least one of these programs was installed. Go ahead 'and create the program group. strRemAutGroupName = ResolveResString(resREMAUTGROUPNAME) ' ' Create the group for the Remote Automation Icons. Note that ' since the user cannot choose the name of this group, there is ' no way at this point to correct an error if one occurs. Therefore, ' fCreateShellGroup will abort setup, without returning, if there ' is an error. ' fCreateShellGroup strRemAutGroupName, False, False 'Now create the icons for AUTMGR32.EXE and RACMGR32.EXE If Len(gsDest.strRACMGR32) > 0 Then CreateShellLink gsDest.strRACMGR32, strRemAutGroupName, vbNullString, ResolveResString(resRACMGR32ICON), True, gsPROGMENUKEY, False End If If Len(gsDest.strAUTMGR32) > 0 Then CreateShellLink gsDest.strAUTMGR32, strRemAutGroupName, vbNullString, ResolveResString(resAUTMGR32ICON), True, gsPROGMENUKEY, False End If End If ' 'Register the per-app path ' If Len(gstrAppExe) > 0 Then strPerAppPath = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPPATH) AddPerAppPath gstrAppExe, gsDest.strAppDir, strPerAppPath End If ExitSetup: HideStaticMessageDialog If fWithinAction() Then 'By now, all logging actions should have been either aborted or committed. MsgError ResolveResString(resSTILLWITHINACTION), vbExclamation Or vbOKOnly, gstrTitle ExitSetup Me, gintRET_FATAL End If MoveAppRemovalFiles strGroupName ExitSetup Me, gintRET_FINISHEDSUCCESS MainError: iRet = MsgError(Err.Description & vbLf & vbLf & ResolveResString(resUNEXPECTED), vbRetryCancel Or vbExclamation, gstrTitle) If gfNoUserInput Then iRet = vbCancel Select Case iRet Case vbRetry Resume Case vbCancel ExitSetup Me, gintRET_ABORT Resume End Select End Sub '----------------------------------------------------------- ' SUB: HideCopyDialog ' ' Unloads the copy files status form '----------------------------------------------------------- ' Private Sub HideCopyDialog() Unload frmCopy End Sub '----------------------------------------------------------- ' SUB: HideStaticMessageDialog ' ' Unloads the setup messages form '----------------------------------------------------------- ' Private Sub HideStaticMessageDialog() Unload frmMessage End Sub '----------------------------------------------------------- ' SUB: ShowBeginForm ' ' Displays the begin setup form '----------------------------------------------------------- ' Private Sub ShowBeginForm() If gfNoUserInput Then If Not IsValidDestDir(gstrDestDir) Then ExitSetup frmSetup1, gintRET_FATAL End If Else frmBegin.Show vbModal End If End Sub '----------------------------------------------------------- ' SUB: ShowCopyDialog ' ' Displays the copy files status form '----------------------------------------------------------- ' Private Sub ShowCopyDialog() CenterForm frmCopy If gfNoUserInput Then frmCopy.cmdExit.Visible = False End If frmCopy.Show frmCopy.Refresh If frmCopy.cmdExit.Visible Then frmCopy.cmdExit.SetFocus End If End Sub '----------------------------------------------------------- ' SUB: ShowMainForm ' ' Displays the main setup 'blue wash' form '----------------------------------------------------------- ' Private Sub ShowMainForm() Caption = gstrTitle Show DrawBackGround Refresh End Sub '----------------------------------------------------------- ' SUB: ShowStaticMessageDialog ' ' Displays a setup message in a 'box' of the appropriate ' size for the message ' ' IN: [strMessage] - message to display '----------------------------------------------------------- ' Private Sub ShowStaticMessageDialog(ByVal strMessage As String) Dim frm As Form Set frm = frmMessage frm.lblMsg.Caption = strMessage ' 'Default height is twice the height of the setup icon. 'If the height of the message text is greater, then 'increase the form height to the label height plus 'half an icon height ' frm.ScaleHeight = frm.imgMsg.Height * 2 If frm.lblMsg.Height > frm.ScaleHeight Then frm.ScaleHeight = frm.lblMsg.Height + frm.imgMsg.Height * 0.5 End If ' 'Vertically center the icon and label within the form ' frm.imgMsg.Top = frm.ScaleHeight / 2 - frm.imgMsg.Height / 2 frm.lblMsg.Top = frm.ScaleHeight / 2 - frm.lblMsg.Height / 2 CenterForm frm frm.Show frm.Refresh End Sub '----------------------------------------------------------- ' SUB: ShowWelcomeForm ' ' Displays the welcome to setup form '----------------------------------------------------------- ' Private Sub ShowWelcomeForm() If Not gfNoUserInput Then frmWelcome.Show vbModal End If End Sub '----------------------------------------------------------- ' SUB: GetStrings ' ' Loads string resources into global vars and forms/controls '----------------------------------------------------------- ' Private Sub GetStrings() On Error GoTo GSErr gstrSETMSG = ResolveResString(resSETMSG) Exit Sub GSErr: MsgError mstrRESOURCELOADFAIL, vbCritical Or vbOKOnly, vbNullString ExitSetup Me, gintRET_FATAL End Sub Private Sub Form_Unload(Cancel As Integer) CleanUpCabs End Sub