home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD154642242001.psc / frmMain(0).frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-02-11  |  7.8 KB  |  228 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form FrmMain 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Self-Extractor"
  6.    ClientHeight    =   3195
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   5310
  10.    Icon            =   "frmMain(0).frx":0000
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   3195
  13.    ScaleWidth      =   5310
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.CommandButton CmdClose 
  16.       Cancel          =   -1  'True
  17.       Caption         =   "&Close"
  18.       BeginProperty Font 
  19.          Name            =   "Arial"
  20.          Size            =   8.25
  21.          Charset         =   161
  22.          Weight          =   400
  23.          Underline       =   0   'False
  24.          Italic          =   0   'False
  25.          Strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   375
  28.       Left            =   4080
  29.       TabIndex        =   6
  30.       Top             =   2640
  31.       Width           =   1095
  32.    End
  33.    Begin VB.CommandButton CmdOK 
  34.       Caption         =   "&Ok"
  35.       BeginProperty Font 
  36.          Name            =   "Arial"
  37.          Size            =   8.25
  38.          Charset         =   161
  39.          Weight          =   400
  40.          Underline       =   0   'False
  41.          Italic          =   0   'False
  42.          Strikethrough   =   0   'False
  43.       EndProperty
  44.       Height          =   375
  45.       Left            =   4080
  46.       TabIndex        =   5
  47.       Top             =   2160
  48.       Width           =   1095
  49.    End
  50.    Begin VB.CommandButton CmdRemove 
  51.       Caption         =   "&Remove"
  52.       BeginProperty Font 
  53.          Name            =   "Arial"
  54.          Size            =   8.25
  55.          Charset         =   161
  56.          Weight          =   400
  57.          Underline       =   0   'False
  58.          Italic          =   0   'False
  59.          Strikethrough   =   0   'False
  60.       EndProperty
  61.       Height          =   375
  62.       Left            =   4080
  63.       TabIndex        =   4
  64.       Top             =   1440
  65.       Width           =   1095
  66.    End
  67.    Begin VB.CommandButton AddCmd 
  68.       Caption         =   "&Add"
  69.       BeginProperty Font 
  70.          Name            =   "Arial"
  71.          Size            =   8.25
  72.          Charset         =   161
  73.          Weight          =   400
  74.          Underline       =   0   'False
  75.          Italic          =   0   'False
  76.          Strikethrough   =   0   'False
  77.       EndProperty
  78.       Height          =   375
  79.       Left            =   4080
  80.       TabIndex        =   3
  81.       Top             =   960
  82.       Width           =   1095
  83.    End
  84.    Begin VB.ListBox lstFiles 
  85.       BeginProperty Font 
  86.          Name            =   "Arial"
  87.          Size            =   8.25
  88.          Charset         =   161
  89.          Weight          =   400
  90.          Underline       =   0   'False
  91.          Italic          =   0   'False
  92.          Strikethrough   =   0   'False
  93.       EndProperty
  94.       Height          =   2370
  95.       Left            =   120
  96.       TabIndex        =   1
  97.       Top             =   720
  98.       Width           =   3855
  99.    End
  100.    Begin MSComDlg.CommonDialog Dlg 
  101.       Left            =   0
  102.       Top             =   240
  103.       _ExtentX        =   847
  104.       _ExtentY        =   847
  105.       _Version        =   393216
  106.    End
  107.    Begin VB.TextBox ArchiveFName 
  108.       BeginProperty Font 
  109.          Name            =   "Arial"
  110.          Size            =   8.25
  111.          Charset         =   161
  112.          Weight          =   400
  113.          Underline       =   0   'False
  114.          Italic          =   0   'False
  115.          Strikethrough   =   0   'False
  116.       EndProperty
  117.       Height          =   285
  118.       Left            =   120
  119.       Locked          =   -1  'True
  120.       TabIndex        =   0
  121.       Top             =   360
  122.       Width           =   3855
  123.    End
  124.    Begin VB.CommandButton CmdBrowse 
  125.       Caption         =   "&Browse"
  126.       BeginProperty Font 
  127.          Name            =   "Arial"
  128.          Size            =   8.25
  129.          Charset         =   161
  130.          Weight          =   400
  131.          Underline       =   0   'False
  132.          Italic          =   0   'False
  133.          Strikethrough   =   0   'False
  134.       EndProperty
  135.       Height          =   375
  136.       Left            =   4080
  137.       TabIndex        =   2
  138.       Top             =   360
  139.       Width           =   1095
  140.    End
  141.    Begin VB.Label Label2 
  142.       AutoSize        =   -1  'True
  143.       BackStyle       =   0  'Transparent
  144.       Caption         =   "Click on browse to specify a new archive:"
  145.       BeginProperty Font 
  146.          Name            =   "Arial"
  147.          Size            =   8.25
  148.          Charset         =   161
  149.          Weight          =   400
  150.          Underline       =   0   'False
  151.          Italic          =   0   'False
  152.          Strikethrough   =   0   'False
  153.       EndProperty
  154.       Height          =   210
  155.       Left            =   120
  156.       TabIndex        =   7
  157.       Top             =   120
  158.       Width           =   3075
  159.    End
  160. Attribute VB_Name = "FrmMain"
  161. Attribute VB_GlobalNameSpace = False
  162. Attribute VB_Creatable = False
  163. Attribute VB_PredeclaredId = True
  164. Attribute VB_Exposed = False
  165. Function OnlyFileName(file As String) As String
  166.     Dim CheckPos As Long
  167.     Dim FNameLen As Long
  168.     If InStr(file, "\") = 0 And InStr(file, "/") = 0 Then OnlyFileName = file: Exit Function
  169.     CheckPos = 1
  170.     Do
  171.         
  172.         FNameLen = CheckPos
  173.         
  174.         If InStr(CheckPos + 1, file, "\") = 0 Then
  175.             CheckPos = InStr(CheckPos + 1, file, "/")
  176.         Else
  177.             CheckPos = InStr(CheckPos + 1, file, "\")
  178.         End If
  179.     Loop Until CheckPos = 0
  180.     OnlyFileName = Right(file, Len(file) - Len(Left(file, FNameLen)))
  181. End Function
  182. Private Sub CmdBrowse_Click()
  183.     On Error GoTo FinaliseError
  184.     Dlg.CancelError = True
  185.     Dlg.Filter = "EXE Archives|*.exe|"
  186.     Dlg.Flags = cdlOFNFileMustExist
  187.     Dlg.ShowSave
  188.     If Dlg.FileName = "" Then Exit Sub
  189.     ArchiveFName = Dlg.FileName
  190. FinaliseError:
  191. End Sub
  192. Private Sub AddCmd_Click()
  193.     On Error GoTo FinaliseError
  194.     Dlg.CancelError = True
  195.     Dlg.Filter = "All Files|*.*|"
  196.     Dlg.Flags = cdlOFNFileMustExist
  197.     Dlg.ShowOpen
  198.     If Dlg.FileName = "" Then Exit Sub
  199.     For i = 0 To lstFiles.ListCount - 1
  200.         If LCase$(OnlyFileName(Dlg.FileName)) = LCase$(OnlyFileName(lstFiles.List(i))) Then MsgBox "A file with the same name exists!", vbExclamation, "Error": Exit Sub
  201.     Next i
  202.     lstFiles.AddItem Dlg.FileName
  203. FinaliseError:
  204. End Sub
  205. Private Sub CmdOK_Click()
  206.     If ArchiveFName.Text = "" Then MsgBox "Please specify a new EXE - Archive.", vbExclamation, "Self-Extractor": ArchiveFName.SetFocus: Exit Sub
  207.     If lstFiles.ListCount = 0 Then MsgBox "Please specify at least one file to add to the archive.", vbExclamation, "Self-Extractor": Exit Sub
  208.     'If FileExist(ArchiveFName.Text) = True Then If KillFile(ArchiveFName.Text) = False Then MsgBox "Error, could not completly over-right file. Of a error of this, the new archive specified could see a change in size.", vbCritical, "Error"
  209.     If SelfExtract = True Then
  210.         If AddToSelfExtract(ArchiveFName.Text, Me.lstFiles, ArchiveFName.Text) = True Then
  211.             MsgBox "Your new self-extracting archive has now been created.", vbInformation, "Self-Extractor"
  212.         End If
  213.     End If
  214. End Sub
  215. Private Sub CmdClose_Click()
  216.     End
  217. End Sub
  218. Private Sub CmdRemove_Click()
  219.     On Error Resume Next
  220.     lstFiles.RemoveItem lstFiles.ListIndex
  221. End Sub
  222. Private Sub Form_Load()
  223.     If Command <> "" Then ArchiveFName.Text = Command
  224. End Sub
  225. Private Sub Form_Unload(Cancel As Integer)
  226.     End
  227. End Sub
  228.