⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 setup1.frm

📁 Custom Visual Basic Packager and Installer for Visual Basic Developers. This is a group of standard
💻 FRM
📖 第 1 页 / 共 2 页
字号:
    '
    Const fDefCreateGroupUnderWin95 = False
    '
    ' 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
    '
    Dim cIcons As Integer            ' Count of how many icons are required.
    Dim cGroups As Integer           ' Count of how many groups are required.
    '
    ' 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().
    '
    Dim fCreateGroup As Boolean
    If TreatAsWin95() Then
        '
        ' Win95 only:
        ' We create a program group only if we have additional icons besides
        ' the application executable (if any), or if fDefCreateGroupUnderWin95
        ' has been set to True to override this default behavior.
        '
        fCreateGroup = (cGroups > 0)
    Else
        '
        ' Win32 NT only:
        ' We must always create a Program Manager group
        ' because we always create an icon for the application removal program.
        '
        fCreateGroup = True
    End If
    
    Dim iLoop As Integer
    
    If fCreateGroup Then
        For iLoop = 0 To cGroups - 1
            strGroupName = ""
            If (GetGroup(gsICONGROUP, iLoop) = gsSTARTMENUKEY) Or (GetGroup(gsICONGROUP, iLoop) = gsPROGMENUKEY) Then
                'Skip these, they're not needed.
            Else
                strGroupName = frmGroup.GroupName(frmSetup1, GetGroup(gsICONGROUP, iLoop), GetPrivate(gsICONGROUP, iLoop), GetStart(gsICONGROUP, iLoop))
                If GetGroup(gsICONGROUP, iLoop) <> strGroupName Then SetGroup gsICONGROUP, iLoop, strGroupName
            End If
            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
    'if you know your package includes some files that are required
    'to be copied or registered on the system then the next line is
    'for this
    '''''''''''''''''''''''''''''''''''''
    'CopySection gstrOTHERFILES
    '''''''''''''''''''''''''''''''''''
    '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 = TRUE then
    '    CopySection "Samples"
    'End If
    '

    UpdateStatus frmCopy.picStatus, 1, True
    
    HideCopyDialog

    '
    ' If we installed AXDIST.EXE, we now need to run it
    ' so it will install any additional files it contains.
    '
    If gfAXDist = True Then
        '
        'Synchronously shell out and run the utility with the correct switches
        '
        If FileExists(gstrAXDISTInstallPath) Then
            SyncShell gstrAXDISTInstallPath, INFINITE, , True
        End If
    End If
    '
    '
    ' If we installed WINt351.EXE, we now need to run it
    ' so it will install any additional files it contains.
    '
    If gfWINt351 = True Then
        '
        'Synchronously shell out and run the utility with the correct switches
        '
        If FileExists(gstrWINt351InstallPath) Then
            SyncShell gstrWINt351InstallPath, INFINITE, , True
        End If
    End If
    '
    ' 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 = True Then
        RegisterDAO
    End If
    '
    ' Create program icons (or links, i.e. shortcuts).
    '
    If (fMainGroupWasCreated = True) Or ((cIcons > 0) And TreatAsWin95()) 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 gsDest.strAUTMGR32 <> "" Or gsDest.strRACMGR32 <> "" Then
        'At least one of these programs was installed.  Go ahead
        'and create the program group.
        Dim strRemAutGroupName As String
        
        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,
        ' fCreateOSProgramGroup will abort setup, without returning, if there
        ' is an error.
        '
        fCreateOSProgramGroup frmSetup1, strRemAutGroupName, False, False

        'Now create the icons for AUTMGR32.EXE and RACMGR32.EXE
        If gsDest.strRACMGR32 <> "" Then
            CreateOSLink frmSetup1, strRemAutGroupName, gsDest.strRACMGR32, "", ResolveResString(resRACMGR32ICON), True, gsPROGMENUKEY, False
        End If
        If gsDest.strAUTMGR32 <> "" Then
            CreateOSLink frmSetup1, strRemAutGroupName, gsDest.strAUTMGR32, "", ResolveResString(resAUTMGR32ICON), True, gsPROGMENUKEY, False
        End If
    End If

    '
    'Register the per-app path
    '
    If gstrAppExe <> "" Then
        Dim strPerAppPath As String
        strPerAppPath = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPPATH)
        AddPerAppPath gstrAppExe, gsDest.strAppDir, strPerAppPath
    End If

ExitSetup:
    HideStaticMessageDialog
    RestoreProgMan
    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:
    Dim iRet As Integer
    iRet = MsgError(Error$ & 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 Case
    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 IsValidDestDir(gstrDestDir) = False 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
    frmCopy.Show
    frmCopy.Refresh
    If gfNoUserInput = True Then
        frmCopy.cmdExit.Visible = False
    Else
        frmCopy.cmdExit.SetFocus
    End If
End Sub

'-----------------------------------------------------------
' SUB: ShowMainForm
'
' Displays the main setup 'blue wash' form
'-----------------------------------------------------------
'
Private Sub ShowMainForm()
    Me.Caption = gstrTitle
    Me.Show
    DrawBackGround
    Me.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)
    'Get rid of the cab file in the windows dir (if it exists).
    Dim lCount As Long
    Dim sCab As String
    Dim sTemp As String
    
    lCount = 0
    'Get rid of the cab file in the windows dir (if it exists).
    Do
        If gintCabs = 1 Then
            sCab = gstrWinDir
            AddDirSep sCab
            sCab = sCab & BaseName(gsCABNAME)
            If FileExists(sCab) Then Kill sCab
            Exit Do
        End If
        lCount = lCount + 1
        sCab = gstrWinDir
        AddDirSep sCab
        sTemp = Left(gsCABNAME, Len(gsCABNAME) - 5) & CStr(lCount) & gstrSEP_EXT & gsINI_CABNAME
        sCab = sCab & BaseName(sTemp)
        If FileExists(sCab) Then
            Kill sCab
        Else
            Exit Do
        End If
    Loop
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -