frmsetup.frm

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

VERSION 5.00
Begin VB.Form frmsetup 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   1950
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4950
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1950
   ScaleWidth      =   4950
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1 
      Caption         =   "Continue"
      Default         =   -1  'True
      Height          =   375
      Left            =   1680
      TabIndex        =   2
      Top             =   1200
      Width           =   1455
   End
   Begin VB.TextBox txttitle 
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Top             =   480
      Width           =   2775
   End
   Begin VB.Label Label1 
      Caption         =   "Installation Title"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1095
   End
End
Attribute VB_Name = "frmsetup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim p() As String
Dim pl As String
p = Split(pExe, "\")
psexe = p(UBound(p))

g = Mid(psexe, 1, Len(psexe) - 4)
Dim sDir
sDir = Mid(basCommon.GetWindowsSysDir, 3, Len(basCommon.GetWindowsSysDir) - 2)
fs = FreeFile
Open pkjPath + "tat.txt" For Append As #1

    pl = "[" + g + "]" + vbCrLf
    
    pl = pl + "Icon1=" + Chr$(34) + psexe + Chr$(34) + vbCrLf
    
     pl = pl + "title=" + Me.txttitle.Text + vbCrLf
     pl = pl + "StartIn1=$(AppPath)" + vbCrLf
     pl = pl + vbNewLine
   
     pl = pl + "[Setup]" + vbCrLf
     pl = pl + "Title=" + Me.txttitle + vbCrLf
     pl = pl + "DefaultDir=$(ProgramFiles)\" + g + vbCrLf
     pl = pl + "AppExe=" + psexe + vbCrLf
     pl = pl + "AppToUninstall=" + psexe + vbCrLf
     pl = pl + vbNewLine + vbCrLf
     
     pl = pl + "[Setup1 Files]" + vbCrLf
    FIL = "File"
    For i = 0 To Form1.List1.ListCount - 1
        f = GetFil(Form1.List1.List(i))
        bc = GerDir(Form1.List1.List(i))
        
        If InStr(1, bc, sDir) <> 0 Then
            
             pl = pl + FILER + Trim(FIL + str(i + 1)) + "=@" + f + ",$(WinSysPath),$(DLLSelfRegister),$(Shared),12/10/99 7:17:28 AM,847324,8.0.0." + Trim(str(i)) + vbCrLf
             
        Else
             pl = pl + FILER + Trim(FIL + str(i + 1)) + "=@" + f + ",$(AppPath),,,9/8/08 8:00:08 AM,15549,0.0.0." + Trim(str(i)) + vbCrLf
             
        End If
        
        'Print #1, FILER
    Next
    'MsgBox pl
        Print #1, pl
Close #1

 Name App.Path + "\setup.manifest" As App.Path + "\setup.exe"
 Name App.Path + "\setup1.manifest" As App.Path + "\setup1.exe"
    
    Open pkjPath + "tat.txt" For Input As #5
     s = Input(LOF(5), #5)
    Close #5
    
    Open pkjPath + "SETUP.LST" For Append As #6
        Print #6, s
    Close #6
    
    Kill pkjPath + "tat.txt"
    Call FileCopy(App.Path + "\setup.exe", pkjPath + "\support\" + "SETUP.exe")
    Name App.Path + "\setup.exe" As App.Path + "\setup.manifest"
    Call FileCopy(App.Path + "\setup1.exe", pkjPath + "\support\" + "SETUP1.exe")
    Call FileCopy(App.Path + "\setup1.exe", pkjPath + "\" + "SETUP1.exe")
    Name App.Path + "\setup1.exe" As App.Path + "\setup1.manifest"
    
        Call FileCopy(pkjPath + "SETUP.LST", pkjPath + "\support\" + "SETUP.LST")

 For i = 0 To Form1.List1.ListCount - 1
    m = (GetFil(Form1.List1.List(i)))
    Call FileCopy(Form1.List1.List(i), psup + "\" + m)
 Next

Unload Me
End Sub
Function GetFil(sd As String)
On Error Resume Next
'MsgBox sd
Dim p() As String
p = Split(sd, "\")
GetFil = p(UBound(p))
End Function