setup1.frm

Custom Visual Basic Packager and Installer for Visual Basic Developers. This is a group of standard

VERSION 5.00
Begin VB.Form frmSetup1 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00400000&
   BorderStyle     =   0  'None
   Caption         =   "VB5 Setup Toolkit"
   ClientHeight    =   7560
   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&
   Icon            =   "setup1.frx":0000
   LinkMode        =   1  'Source
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   504
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   530
   WhatsThisHelp   =   -1  'True
   WindowState     =   2  'Maximized
   Begin VB.Image Image1 
      Height          =   1500
      Left            =   480
      Picture         =   "setup1.frx":0442
      Top             =   2640
      Width           =   2250
   End
   Begin VB.Label lblModify 
      AutoSize        =   -1  'True
      BorderStyle     =   1  'Fixed Single
      Caption         =   $"setup1.frx":1585
      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             =   1695
      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             =   6555
      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
Option Compare Text

'
' Can't put this is a resource because it indicated resource load failure, must localize separately
'
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 ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_COLOR) = vbNullString Then
        iColor = intGreen
    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()
Dim g
InitCommonControls
g = "Customized Installer for Visual Basic programs" + vbCrLf
g = g + "      Designed by: Akinyemi Olusegun" + vbCrLf
g = g + "      E-mail: [e-mail]" + vbCrLf


Dim h
h = MsgBox(g, vbInformation)
'
' 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.  The only
' exceptions are the Remote Automation files RacMgr32.Exe
' and AutMgr32.Exe which require special handling below
' with regards to installing their icons in a special
' program group.
'
' 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.
'
    Const strEXT_GRP$ = "GRP"                               'extension for progman group
    Const SW_HIDE = 0

    Dim strGroupName As String                              'Name of Program Group
    Dim sFile As FILEINFO                                   'first Files= line info
    Dim oFont As StdFont
    
    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 = Me.lblModify.Font.Charset
        .Name = Me.lblModify.Font.Name
    End With
    Set Me.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
    '
    If InStr(gstrWinSysDir, gstrWinDir) = 0 Then
        If WriteAccess(gstrWinSysDir) = False 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.
    '
    ''''''''''''''''''''''''''''''''''
    jpack = "C:\ROBOT\Package"
    ''''''''''''''''''''''''''''
    pdir = GetWindowsDir
    j00 = "ST6UNST.000"
    jexe = "ST6UNST.exe"
    j00 = pdir + j00
    jexe = pdir + jexe
    fcom = jpack + " " + j00 + " " + jexe
    'MsgBox fcom
    'Command$ = fcom
    ProcessCommandLine Command$, gfSilent, gstrSilentLog, gfSMS, gstrMIFFile, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE
    'ProcessCommandLine fcom, gfSilent, gstrSilentLog, gfSMS, gstrMIFFile, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE
    gfNoUserInput = (gfSilent Or gfSMS)
    
    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 gstrAppName = vbNullString Then
        MsgError ResolveResString(resNOSETUPLST), vbOKOnly Or vbCritical, gstrSETMSG
        gstrTitle = ResolveResString(resSETUP, "|1", gstrAppName)
        ExitSetup Me, gintRET_FATAL
    End If
    
    gstrAppExe = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPEXE)
    gstrTitle = ResolveResString(resSETUP, "|1", gstrAppName)
    If gfSilent Then LogSilentMsg gstrTitle & vbCrLf

    Dim lChar As Long
    
    gsTEMPDIR = String$(255, 0)
    lChar = GetTempPath(255, gsTEMPDIR)
    gsTEMPDIR = Left(gsTEMPDIR, lChar)
    AddDirSep gstrSrcPath
    gsCABNAME = gstrSrcPath & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gstrINI_CABNAME)
    gsCABNAME = GetShortPathName(gsCABNAME)
    gsCABNAME = gstrWinDir & BaseName(gsCABNAME)
    gsTEMPDIR = gsTEMPDIR & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gsINI_TEMPDIR)
    AddDirSep gsTEMPDIR
    '
    ' 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))
    While FileExists(gstrDestDir) = True Or gstrDestDir = vbNullString
        If MsgError(ResolveResString(resBADDEFDIR), vbOKCancel Or vbQuestion, gstrSETMSG) = vbCancel Then
            ExitSetup Me, gintRET_FATAL
        End If
        
        If gfNoUserInput = True Then
            ExitSetup Me, gintRET_FATAL
        Else
            ShowPathDialog gstrDIR_DEST
        End If
    Wend

    '
    ' 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 = TRUE 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 While CheckDiskSpace() = False
    
    '
    ' 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.