cfgsfx.frm

前几天看到有人在论坛上寻找压缩代码

VERSION 5.00
Begin VB.Form frmConfigSFX 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Self-Extractor Options"
   ClientHeight    =   4590
   ClientLeft      =   9060
   ClientTop       =   5670
   ClientWidth     =   5445
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4590
   ScaleWidth      =   5445
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtSFXbinaryPath 
      Height          =   285
      Left            =   135
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   405
      Width           =   4785
   End
   Begin VB.TextBox txtSFXIntroMsg 
      Height          =   1500
      Left            =   150
      MultiLine       =   -1  'True
      TabIndex        =   4
      Text            =   "CfgSFX.frx":0000
      Top             =   2370
      Width           =   5150
   End
   Begin VB.TextBox txtSFXExitButton 
      Height          =   285
      Left            =   150
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   1725
      Width           =   5150
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "&Cancel"
      Height          =   390
      Left            =   4155
      TabIndex        =   6
      Top             =   4065
      Width           =   1125
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Height          =   390
      Left            =   2940
      TabIndex        =   5
      Top             =   4065
      Width           =   1125
   End
   Begin VB.TextBox txtSFXDialogTitle 
      Height          =   285
      Left            =   150
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   1065
      Width           =   5150
   End
   Begin VB.CommandButton cmdSFXBinary 
      Caption         =   "..."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   4995
      TabIndex        =   1
      Top             =   405
      Width           =   300
   End
   Begin VB.Label lbSFXIntro 
      Caption         =   "Enter the message to display in the introduction dialog"
      Height          =   225
      Left            =   165
      TabIndex        =   10
      Top             =   2130
      Width           =   5130
   End
   Begin VB.Label lblSFXDialogTitle 
      Caption         =   "Enter the self-extractor's title"
      Height          =   225
      Left            =   150
      TabIndex        =   9
      Top             =   825
      Width           =   5145
   End
   Begin VB.Label lblSFXExitButton 
      Caption         =   "Enter the caption to use for 'Exit' buttons"
      Height          =   225
      Left            =   150
      TabIndex        =   8
      Top             =   1485
      Width           =   5145
   End
   Begin VB.Label lblSFXBinary 
      Caption         =   "Select the self-extractor binary to use"
      Height          =   225
      Left            =   120
      TabIndex        =   7
      Top             =   150
      Width           =   5145
   End
End
Attribute VB_Name = "frmConfigSFX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim Change As Integer

' This function sets the relevant self-extractor properties according
' to the selections made by the user in the Self-Extractor Options dialog box.
'
Sub UpdateSfxProperties()

  frmMain.ZipMain.SfxStrings(xssTitle) = txtSFXDialogTitle.Text
  frmMain.ZipMain.SfxButtons(xsbExit) = txtSFXExitButton.Text
  frmMain.ZipMain.SfxBinary = txtSFXbinaryPath
  frmMain.ZipMain.SfxMessages(xsmIntro) = txtSFXIntroMsg.Text
  
  Change = False
  
End Sub

Private Sub cmdCancel_Click()

  Unload Me
  
End Sub

Private Sub cmdOK_Click()

  UpdateSfxProperties
  Unload Me
  
End Sub

' User clicked on browse button for the self-extractor binary. Display the
' dialog box to allow user to select the self-extractor binary.
'
Private Sub cmdSfxBinary_Click()
  
  Dim ArchiveName As String
  
    ArchiveName = SelectZipFile(SelectBin)
    If Len(ArchiveName) > 0 Then
      txtSFXbinaryPath = ArchiveName
    End If
 
End Sub

Private Sub Form_Load()
    
  DisplayCurrentSfxProperties

End Sub

Sub DisplayCurrentSfxProperties()

  txtSFXDialogTitle.Text = frmMain.ZipMain.SfxStrings(xssTitle)
  txtSFXExitButton.Text = frmMain.ZipMain.SfxButtons(xsbExit)
  txtSFXbinaryPath = frmMain.ZipMain.SfxBinary
  txtSFXIntroMsg.Text = frmMain.ZipMain.SfxMessages(xsmIntro)
  
  Change = False
  
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

  Dim UserAnswer As Integer
  
  If UnloadMode = vbFormControlMenu And Change = True Then
    UserAnswer = MsgBox("Do you want to discard the changes?", vbYesNoCancel + vbQuestion, "Self-Extractor Options")
    Select Case UserAnswer
      Case vbNo
        UpdateSfxProperties
      Case vbCancel
        Cancel = 1
      Case vbYes
    End Select
  End If
  
End Sub

' Display a message box to the user to remind them that there are many
' settings that can be configured in the self-extractor that aren't offered
' in the Self-Extractor Options dialog box.
'
Private Sub Form_Unload(Cancel As Integer)

  Dim Message As String
    
  Message = "The self-extracting archives created by this sample application will have the following non-default property settings: " + Chr(13) + Chr(13)
  Message = Message + "   ZipMain.DefaultExtractDir = " + Chr(34) + "%e" + Chr(34) + " (Directory where self-extractor is run from)" + Chr(13)
  Message = Message + "   ZipMain.SfxButtons(Sfx_Button_Exit) =" + Chr(34) + frmMain.ZipMain.SfxButtons(xsbExit) + Chr(34) + Chr(13)
  Message = Message + "   ZipMain.SfxStrings(Sfx_String_Title) = " + Chr(34) + frmMain.ZipMain.SfxStrings(xssTitle) + Chr(34) + Chr(13)
  Message = Message + "   ZipMain.SfxMessages(Sfx_Message_Intro) = " + Chr(34) + Left$(Trim$(frmMain.ZipMain.SfxMessages(xsmIntro)), 50) + "..." + Chr(34) + Chr(13) + Chr(13)
  Message = Message + "The self-extractor dialog box only lets you configure a tiny portion of the self-extractor's settings. Look in the SetSfxConfiguration() procedure for a complete list of settings you can configure." + Chr(13)
  MsgBox Message, vbOKOnly + vbInformation, "Self-Extractor Options"

End Sub

Private Sub txtSFXbinaryPath_Change()

  Change = True

End Sub

Private Sub txtSFXDialogTitle_Change()
  Change = True
End Sub

Private Sub txtSFXIntroMsg_Change()
  Change = True
End Sub

Private Sub txtSFXExitButton_Change()
  Change = True
End Sub