setup1.bas

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

    ' Create the new key, whose name is based on the app's name
   If Not RegCreateKey(HKEY_LOCAL_MACHINE, RegPathWinCurrentVersion(), strAppPaths & gstrSEP_DIR & strAppExe, hKey) Then
        GoTo Err
    End If
    
    fOk = True
    
    ' Default value indicates full EXE pathname
    fOk = fOk And RegSetStringValue(hKey, "", strAppDir & strAppExe)
    
    ' [Path] value indicates the per-app path
    If strPerAppPath <> "" Then
        fOk = fOk And RegSetStringValue(hKey, strAppPathKeyName, strPerAppPath)
    End If
    
    If Not fOk Then
        GoTo Err
    End If
    
    RegCloseKey hKey
    
    Exit Sub
    
Err:
    MsgError ResolveResString(resERR_REG), vbExclamation Or vbOKOnly, gstrTitle
    '
    ' If we are running an SMS install, we can't continue.
    '
    If gfSMS Then
        ExitSetup frmSetup1, gintRET_FATAL
    End If
End Sub

'-----------------------------------------------------------
' FUNCTION: AddQuotesToFN
'
' Given a pathname (directory and/or filename), returns
'   that pathname surrounded by double quotes if the
'   path contains spaces or commas.  This is required for
'   setting up an icon correctly, since otherwise such paths
'   would be interpreted as a pathname plus arguments.
'-----------------------------------------------------------
'
Function AddQuotesToFN(ByVal strFilename) As String
    If InStr(strFilename, " ") Or InStr(strFilename, ",") Then
        AddQuotesToFN = """" & strFilename & """"
    Else
        AddQuotesToFN = strFilename
    End If
End Function

'-----------------------------------------------------------
' SUB: CalcDiskSpace
'
' Calculates disk space required for installing the files
' listed in the specified section of the setup information
' file (SETUP.LST)
'-----------------------------------------------------------
'
Sub CalcDiskSpace(ByVal strsection As String)
    Static fSplitFile As Integer
    Static lDestFileSpace As Long

    Dim intIdx As Integer
    Dim intDrvIdx As Integer
    Dim sFile As FILEINFO
    Dim strDrive As String
    Dim lThisFileSpace As Long

    intIdx = 1

    On Error GoTo CalcDSError

    '
    'For each file in the specified section, read info from the setup info file
    '
    Do While ReadSetupFileLine(strsection, intIdx, sFile) = True
        '
        'if the file isn't split or if this is the first section of a split file
        '
        If sFile.strDestDir <> vbNullString Then
            fSplitFile = sFile.fSplit

            '
            'Get the dest drive used for this file.  If this is the first file using
            'the drive for a destination, add the drive to the drives used 'table',
            'allocate an array element for the holding the drive info, and get
            'available disk space and minimum allocation unit
            '
            strDrive = Left$(sFile.strDestDir, 1)
        
            intDrvIdx = InStr(gstrDrivesUsed, strDrive)
            If intDrvIdx = 0 Then
                gstrDrivesUsed = gstrDrivesUsed & strDrive
                intDrvIdx = Len(gstrDrivesUsed)

                ReDim Preserve gsDiskSpace(intDrvIdx)
                gsDiskSpace(intDrvIdx).lAvail = GetDiskSpaceFree(strDrive)

                gsDiskSpace(intDrvIdx).lMinAlloc = GetDrivesAllocUnit(strDrive)
            End If

            '
            'Calculate size of the dest final (file size + minimum allocation for drive)
            '
            lThisFileSpace = CalcFinalSize(sFile.lFileSize, strDrive)
            mlTotalToCopy = mlTotalToCopy + lThisFileSpace

            '
            'If the file already exists, then if we copy it at all, we'll be
            'replacing it.  So, we get the size of the existing dest file so
            'that we can subtract it from the amount needed later.
            '
            If FileExists(sFile.strDestDir & sFile.strDestName) Then
                lDestFileSpace = FileLen(sFile.strDestDir & sFile.strDestName)
            Else
                lDestFileSpace = 0
            End If
        End If

        '
        'If file not split, or if the last section of a split file
        '
        If sFile.fSplit = False Then
            '
            'If this is the last section of a split file, then if it's the *largest*
            'split file, set the extra space needed for concatenation to this size
            '
            If fSplitFile = True And lThisFileSpace > mlSpaceForConcat Then
                mlSpaceForConcat = lThisFileSpace
            End If

            '
            'Subtract size of existing dest file, if applicable and then accumulate
            'space required
            '
            lThisFileSpace = lThisFileSpace - lDestFileSpace
            If lThisFileSpace < 0 Then
                lThisFileSpace = 0
            End If

            gsDiskSpace(intDrvIdx).lReq = gsDiskSpace(intDrvIdx).lReq + lThisFileSpace
        End If

        intIdx = intIdx + 1
    Loop

    Exit Sub

CalcDSError:
    MsgError Error$ & vbLf & vbLf & ResolveResString(resCALCSPACE), vbCritical, gstrSETMSG
    ExitSetup frmMessage, gintRET_FATAL
End Sub

'-----------------------------------------------------------
' SUB: CalcFinalSize
'
' Computes the space required for a file of the size
' specified on the given dest path.  This includes the
' file size plus a padding to ensure that the final size
' is a multiple of the minimum allocation unit for the
' dest drive
'-----------------------------------------------------------
'
Function CalcFinalSize(lBaseFileSize As Long, strDestPath As String) As Long
    Dim lMinAlloc As Long
    Dim intPadSize As Long

    lMinAlloc = gsDiskSpace(InStr(gstrDrivesUsed, Left$(strDestPath, 1))).lMinAlloc
    intPadSize = lMinAlloc - (lBaseFileSize Mod lMinAlloc)
    If intPadSize = lMinAlloc Then
        intPadSize = 0
    End If

    CalcFinalSize = lBaseFileSize + intPadSize
End Function

'-----------------------------------------------------------
' SUB: CenterForm
'
' Centers the passed form just above center on the screen
'-----------------------------------------------------------
'
Sub CenterForm(frm As Form)
    SetMousePtr vbHourglass

    frm.Top = (Screen.Height * 0.85) \ 2 - frm.Height \ 2
    frm.Left = Screen.Width \ 2 - frm.Width \ 2

    SetMousePtr gintMOUSE_DEFAULT
End Sub
'-----------------------------------------------------------
' SUB: UpdateDateTime
'
' Updates the date/time for bootstrap files
'-----------------------------------------------------------
'
Sub UpdateDateTime()
    Dim intIdx As Integer
    Dim sFile As FILEINFO
    Dim lTime As FileTime
    Dim hFile As Long
    '
    'For each file in the specified section, read info from the setup info file
    '
    intIdx = 1
    Do While ReadSetupFileLine(gstrINI_BOOTFILES, intIdx, sFile) = True
        Dim sCurDate As String, sFileDate As String
        
        sFileDate = Format(FileDateTime(sFile.strDestDir & sFile.strDestName), "m/d/yyyy h:m")
        sCurDate = Format(Now, "m/d/yyyy h:m")
        
        If sFileDate = sCurDate Then
            lTime = GetFileTime(sFile.varDate)
            hFile = CreateFile(sFile.strDestDir & sFile.strDestName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
            Call SetFileTime(hFile, lTime, lTime, lTime)
            DoEvents
            CloseHandle hFile
        End If
        intIdx = intIdx + 1
    Loop
    
End Sub

'-----------------------------------------------------------
' FUNCTION: CheckDiskSpace
'
' Reads from the space required array generated by calling
' the 'CalcDiskSpace' function and determines whether there
' is sufficient free space on all of the drives used for
' installation
'
' Returns: True if there is enough space, False otherwise
'-----------------------------------------------------------
'
Function CheckDiskSpace() As Integer
    Static fDontAskOnSpaceErr As Integer

    Dim intIdx As Integer
    Dim intTmpDrvIdx As Integer
    Dim lDiskSpaceLeft As Long
    Dim lMostSpaceLeft As Long
                                             
    '
    'Default to True (enough space on all drives)
    '
    CheckDiskSpace = True

    '
    'For each drive that is the destination for one or more files, compare
    'the space available to the space required.
    '
    For intIdx = 1 To Len(gstrDrivesUsed)
        lDiskSpaceLeft = gsDiskSpace(intIdx).lAvail - gsDiskSpace(intIdx).lReq
        If lDiskSpaceLeft < 0 Then
            GoSub CheckDSAskSpace
        Else
            '
            'If no "TMP" drive was found, or if the "TMP" drive wasn't ready,
            'save the index of the drive and the amount of space on the drive
            'which will have the most free space.  If no "TMP" drive was
            'found in InitDiskInfo(), then this drive will be used as a
            'temporary drive for concatenating split files
            '
            If mstrConcatDrive = vbNullString Then
                If lDiskSpaceLeft > lMostSpaceLeft Then
                    lMostSpaceLeft = lDiskSpaceLeft
                    intTmpDrvIdx = intIdx
                End If
            Else
                '
                '"TMP" drive was specified, so we'll use that
                '
                If Left$(mstrConcatDrive, 1) = Mid$(gstrDrivesUsed, intIdx, 1) Then
                    intTmpDrvIdx = intIdx
                End If
            End If
        End If
    Next

    '
    'If at least one drive was specified as a destination (if there was at least
    'one CalcDiskSpace call in Form_Load of SETUP1.FRM), then subtract the extra
    'space needed for concatenation from either:
    '   The "TMP" drive if available  - OR -
    '   The drive with the most space remaining
    '
    If intTmpDrvIdx > 0 Then
        gsDiskSpace(intTmpDrvIdx).lReq = gsDiskSpace(intTmpDrvIdx).lReq + mlSpaceForConcat
        If gsDiskSpace(intTmpDrvIdx).lAvail < gsDiskSpace(intTmpDrvIdx).lReq Then
            GoSub CheckDSAskSpace
        End If

        '
        'If a "TMP" drive was found, we use it regardless, otherwise we use the drive
        'with the most free space
        '
        If mstrConcatDrive = vbNullString Then
            mstrConcatDrive = Mid$(gstrDrivesUsed, intTmpDrvIdx, 1) & gstrCOLON & gstrSEP_DIR
            AddDirSep mstrConcatDrive
        End If
    End If

    Exit Function