Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Self-Exe, based on MakeCab/Extract

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Self-Exe, based on MakeCab/Extract

    Following code demonstrates possible variant of creating PB Self-Exe distributives.

    Software includes two parts.
    - Utility (named PbSfx), which is necessary to compile only one time.
    - Setup as it is. This program is necessary to change every time, depends of your needs.

    How to use.
    Step 1. (only “one time”).
    Copy makecab.exe and PbSfx to the directory, visible through PATH (for example, to C:\PBDLL60\BIN)

    Step 2.
    Imagine that you have a directory D:\MyDir (with subdirectories), where you debug your program.
    Let’s assume that name of future distributive is X.Exe.

    Create in any text editor a file (D:\MyDir\X.Sfx), which includes a list of files and subdirectories.

    For example, you need to include Program.Exe, Dynamic.Dll and Info.Dat from D:\MyDir and Picture.Bmp from D:\MyDir\SubDir1
    In this case X.Sfx looks so:

    $AppDir
    Program.Exe
    Dynamic.Dll
    Info.Dat
    $AppDir\SubDir1
    Picture.Bmp

    Lines, beginning from $, describes directories. Program understands $Windows (windows directory) and $System (system directory) also.

    Start PbSfx.Exe without parameters (current directory should be D:\MyDir).
    Utility will create the subdirectory Release with files X0.Cab, X1.Cab, X2.Cab.

    Step 3.
    Save skeleton of setup program as D:\MyDir\X.Bas.
    Start it from IDE. “Big” self-Exe will be located in D:\MyDir\Release\X.Exe

    [This message has been edited by Semen Matusovski (edited April 30, 2000).]

  • #2
    Current "skeleton" of setup program.
    Code:
       ' Skeleton of setup program, prepared by PB Sfx utility
       #Compile Exe
       #Dim All
       #Register None
       #Include "Win32Api.Inc"
    
       Global ErrMsg As String, TmpAsciiz As Asciiz * %MAX_PATH
       Global ExeDir As String, WinDir As String, SysDir As String
       Global AppDir As String, DstDir As String
       Global ExeInfo As String, Contents As String, lContents As Long
       Global TotalFilesSize As Double, ExtractedSize As Double
       Global hDlgMain As Long, hDlgProgress As Long
    
       %ID_Frame1    = 101
       %ID_InsideDir = 102
       %ID_SelectDir = 103
       %ID_Frame2    = 104
       %ID_DstDir    = 105
       %ID_Install   = 106
       %ID_Cancel    = 107
       %ID_Extract   = 108
       %ID_Progress  = 109
    
       Declare Sub CoTaskMemFree Lib "ole32.dll" Alias "CoTaskMemFree" (pv As Long)
    
       Type FILE_IN_CABINET_INFO
          NameInCabinet As Asciiz Ptr
          FileSize As Dword
          Win32Error As Dword
          DosDate As Word
          DosTime As Word
          DosAttribs As Word
          FullTargetName As Asciiz * %MAX_PATH
       End Type
    
       %SPFILENOTIFY_FILEINCABINET  = &H11
       %SPFILENOTIFY_FILEEXTRACTED  = &H13
    
       Declare Function SetupIterateCabinet Lib "SetupApi.Dll" Alias "SetupIterateCabinetA" _
          (CabinetFile As Asciiz, ByVal Reserved As Dword, _
          ByVal MsgHandler As Long, ByVal hContext As Long) As Long
    
       $Signature = "[CREATED BY PBSFX 1.01]"
    
       Sub Decrypt (Info As String)
          ' Decrypt Cabinet file
       End Sub
    
       Function UCaseSl(DirNm As String) As String
          If Left$(DirNm, 2) = "\\" Then ExitProcess -1
          CharUpperBuff ByVal StrPtr(DirNm), Len(DirNm)
          If Right$(DirNm, 1) <> "\" Then Function = DirNm + "\" Else Function = DirNm
       End Function
    
       Function MkDirEx (DirNm As String) As Long
          Static k1 As Long, k2 As Long
          k1 = 4
          Do
             If k1 > Len(DirNm) Then Exit Do
             k2 = Instr(k1, DirNm, "\")
             MkDir Left$(DirNm, k2 - 1): k1 = k2 + 1
          Loop
          If (GetAttr(DirNm) And 16) = 16 Then Function = %False Else Function = %True
       End Function
    
       CallBack Function PicProc
          Static hBrush() As Long, hDC() As Long, hBmp() As Long, Clr() As Long
          Static i As Long, Done As Long, LpPaint As PaintStruct, tRect As Rect
          Select Case CbMsg
             Case %WM_INITDIALOG
                ReDim hDC(0 To 2): ReDim hBrush(1 To 2): ReDim hBmp(1 To 2): ReDim Clr(1 To 2)
                hBrush(1) = CreateSolidBrush(Rgb(  0,   0, 255)): Clr(1) = %White
                hBrush(2) = CreateSolidBrush(Rgb(255, 255, 255)): Clr(2) = %Black
             Case %WM_DESTROY
                For i = 1 To 2: DeleteObject hBrush(i): Next
                InvalidateRect GetParent(CbHndl), ByVal 0, %True
                UpdateWindow GetParent(CbHndl)
             Case %WM_ERASEBKGND: Function = 1: Exit Function
             Case %WM_USER + 1
                Done = CbWparam
                InValidateRect CbHndl, ByVal 0, %True: UpdateWindow CbHndl
             Case %WM_PAINT
                GetClientRect CbHndl, tRect
                hDC(0) = BeginPaint(CbHndl, LpPaint)
                For i = 1 To 2
                   hDC(i)  = CreateCompatibleDC(hDC(0))
                   hBmp(i) = CreateCompatibleBitMap (hDC(0), tRect.nRight, tRect.nBottom)
                   SelectObject hDc(i), hBmp(i)
                   FillRect hDC(i), tRect, hBrush(i)
                   SetBkMode hDC(i), %TRANSPARENT
                   SetTextColor hDC(i), Clr(i)
                   DrawText hDC(i), Trim$(Str$(Done)) + "%", -1, tRect, _
                      %DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER
                Next
                BitBlt hDC(2), 0, 0, tRect.nRight * Done * 0.01, tRect.nBottom, hDC(1), 0, 0, %SRCCOPY
                BitBlt hDC(0), 0, 0, tRect.nRight, tRect.nBottom, hDC(2), 0, 0, %SRCCOPY
                EndPaint CbHndl, LpPaint
                For i = 1 To 2: DeleteDC hDC(i): DeleteObject hBmp(i): Next
                Function = 0: Exit Function
          End Select
       End Function
    
       Sub SetClientSizeInUnits (hDlg As Long, WidthUnits As Long, HeightUnits As Long)
          Static lpRect As Rect, x As Long, y As Long
          GetWindowRect hDlg, lpRect
          x = (lpRect.nRight - lpRect.nLeft): y = (lpRect.nBottom - lpRect.nTop)
          GetClientRect hDlg, lpRect
          x = x - lpRect.nRight: y = y - lpRect.nBottom
    
          lpRect.nRight = WidthUnits: lpRect.nBottom = HeightUnits
          MapDialogRect hDlg, lpRect
          x = x + lpRect.nRight: y = y + lpRect.nBottom
          SetWindowPos hDlg, 0, (GetSystemMetrics(%SM_CXSCREEN) - x) / 2, _
             (GetSystemMetrics(%SM_CYSCREEN) - y) / 2, x, y, %SWP_NOZORDER
       End Sub
    
       Sub DeCompress
          Local i As Long, j As Long, k1 As Long, k2 As Long, CabInfo As String
          k1 = 1
          Do
             If k1 > lContents Then Exit Do
             k2 = Instr(k1, Contents, $CRLF): If k2 = 0 Then Exit Do
             i =  Instr(k1, Contents, "|"): j = Instr(i + 1, Contents, "|")
             DstDir = UCaseSl(Mid$(Contents, j + 1, k2 - j - 1))
             If Left$(DstDir, 8) = "$APPDIR\"  Then DstDir = AppDir + Mid$(DstDir,  9) Else _
             If Left$(DstDir, 9) = "$WINDOWS\" Then DstDir = WinDir + Mid$(DstDir, 10) Else _
             If Left$(DstDir, 8) = "$SYSTEM\"  Then DstDir = SysDir + Mid$(DstDir,  9)
             If MkDirEx(DstDir) Then Exit Do
             CabInfo = Mid$(ExeInfo, Val(Mid$(Contents, k1, i - k1)), _
                Val(Mid$(Contents, i + 1, j - i)))
             Open "Temp.Cab" For Output As #1 Len = 16384
             Decrypt CabInfo: Print #1, CabInfo: Close #1
             If Err <> 0 Then ErrMsg = "Can't write cabinet file": Exit Do
             SetupIterateCabinet "Temp.Cab", 0, CodePtr(CabinetCallback), 0
             k1 = k2 + 2
          Loop
       End Sub
       
       CallBack Function DlgProc
          Select Case CbMsg
             Case %WM_INITDIALOG
                SetClientSizeInUnits CbHndl, 250, 70
                Control Add Frame,   CbHndl, %ID_Frame1, " Inside (drive/directory) ", 5, 5, 240, 27
                Control Add TextBox, CbHndl, %ID_InsideDir, ExeDir, 10, 15, 210, 12
                Control Add Button,  CbHndl, %ID_SelectDir, "...", 225, 15, 15, 12
                Control Add Frame,   CbHndl, %ID_Frame2, " Application folder ", 5, 35, 120, 27
                Control Add TextBox, CbHndl, %ID_DstDir, "MyApp", 10, 45, 110, 12
                Control Add Button,  CbHndl, %ID_Install, "&Install", 140, 43, 50, 16, %BS_DEFAULT
                Control Add Button,  CbHndl, %ID_Cancel, "&Cancel", 195, 43, 50, 16
    
             Case %WM_COMMAND
                Select Case CbCtl
                   Case %ID_SelectDir
                      Static pidl As Long, sBrowseInfo As BROWSEINFO, DisplayName As Asciiz * 256
                      sBrowseInfo.hWndOwner = CbHndl
                      sBrowseInfo.pIDLRoot = 0
                      sBrowseInfo.pszDisplayName = VarPtr(DisplayName)
                      ' sBrowseInfo.lpszTitle = StrPtr(Title)
                      sBrowseInfo.ulFlags = 1 ' (%BIF_RETURNONLYFSDIRS)
                      pidl = SHBrowseForFolder(sBrowseInfo)
                      If SHGetPathFromIDList(ByVal pidl, TmpAsciiz) Then _
                         Control Set Text CbHndl, %ID_InsideDir, TmpAsciiz
                      CoTaskMemFree ByVal pidl
                   Case %ID_Install
                      Do
                         Control Get Text CbHndl, %ID_DstDir To DstDir
                         Control Get Text CbHndl, %ID_InsideDir To AppDir
                         AppDir = UCaseSl(Trim$(AppDir)): If Len(AppDir) < 3 Then Beep: Exit Do
                         If Trim$(DstDir) <> "" Then AppDir = AppDir + UCaseSl(DstDir)
                         If Len(AppDir) < 4 Then Beep: Exit Do
                         If MkDirEx(AppDir) Then Beep: Exit Do
                         Control Set Text CbHndl, %ID_Frame1, " Exctracting "
                         Control Kill CbHndl, %ID_InsideDir
                         Control Kill CbHndl, %ID_SelectDir
                         Control Add TextBox, CbHndl, %ID_Extract, ExeDir, 10, 17, 230, 12, %ES_READONLY
    
                         Control Set Text CbHndl, %ID_Frame2, " Progress "
                         Control Set Size CbHndl, %ID_Frame2, 180, 27
                         Control Kill CbHndl, %ID_DstDir
                         Control Kill CbHndl, %ID_Install
                         Dialog New CbHndl, "", 10, 45, 170, 12, %WS_CHILD Or %WS_VISIBLE Or _
                            %WS_BORDER To hDlgProgress
                         Dialog Show Modeless hDlgProgress Call PicProc
                         DeCompress: Dialog End CbHndl
                         Exit Do
                      Loop
                   Case %ID_Cancel
                      Dialog End CbHndl
                End Select
          End Select
       End Function
    
       Function CabinetCallback (ByVal pMyInstallData As Long, _
          ByVal Notification As Dword, ByVal Param1 As Dword, ByVal Param2 As Dword) As Long
          Static szTarget As Asciiz * %MAX_PATH
          Static RemSize As Double
          Static pFile_In_Cabinet_Info As FILE_IN_CABINET_INFO Ptr
          Select Case Notification
              Case %SPFILENOTIFY_FILEINCABINET
                pFile_In_Cabinet_Info = Param1
                @pFile_In_Cabinet_Info.FullTargetName = DstDir + _
                    @[email protected]
                RemSize = @pFile_In_Cabinet_Info.FileSize
                Control Set Text hDlgMain, %ID_Extract, @pFile_In_Cabinet_Info.FullTargetName
                UpdateWindow GetDlgItem(hDlgMain, %ID_Extract)
                Function = 1: Exit Function ' FILEOP_DOIT (Extract the file)
             Case %SPFILENOTIFY_FILEEXTRACTED
                ExtractedSize = ExtractedSize + RemSize
                Dialog Send hDlgProgress, %WM_USER + 1, CLng(ExtractedSize / TotalFilesSize * 100), 0
          End Select
          Function = 0
       End Function
       
       Function PbMain
          Local i As Long
    
          GetModuleFileName(GetModuleHandle(ByVal 0), TmpAsciiz, SizeOf(TmpAsciiz)
          ExeDir = UCaseSl(Left$(TmpAsciiz, Instr(-1, TmpAsciiz, "\") - 1))
          ChDrive Left$(ExeDir, 2): ChDir ExeDir
    
          Open TmpAsciiz For Binary Shared As #1: Get$ #1, Lof(1), ExeInfo: Close #1
          If Err <> 0 Then Exit Function ' Unexpected error
          If Right$(ExeInfo, Len($Signature)) <> $Signature Then _
             i = Shell ("PbSfx *", 1): Exit Function ' Started from IDE
          i = Len(ExeInfo) - Len($Signature) - 11
          TotalFilesSize = Cvd(ExeInfo, i): lContents = Cvl(ExeInfo, i + 8)
          Contents = Mid$(ExeInfo, i - lContents, lContents)
          GetWindowsDirectory TmpAsciiz, SizeOf(TmpAsciiz): WinDir = UCaseSl(ByCopy TmpAsciiz)
          GetSystemDirectory  TmpAsciiz, SizeOf(TmpAsciiz): SysDir = UCaseSl(ByCopy TmpAsciiz)
          Dialog New %HWND_DESKTOP, "Setup", , , 0, 0, %WS_SYSMENU Or %WS_MINIMIZEBOX To hDlgMain
          Dialog Show Modal hDlgMain Call DlgProc
          If ExtractedSize = TotalFilesSize Then MsgBox "Successful" Else MsgBox "Errors"
       End Function
    [This message has been edited by Semen Matusovski (edited April 30, 2000).]

    Comment


    • #3
      Current release of PB Sfx utility
      Code:
         ' PB Sfx  utility for creating self-extracting setup files
         '============================== Release 1.01 Apr, 30, 2000
      
         #Compile Exe
         #Dim All
         #Register None
         #Include "Win32Api.Inc"
      
         %maxCabs = 50
         $Signature = "[CREATED BY PBSFX 1.01]"
         $Release = "Release"
      
         Global WinDir As String, SysDir As String, ExeDir As String, RlsDir As String
         Global AppDir As String, AppName As String, TmpAsciiz As Asciiz * %MAX_PATH
         Global ErrMsg As String, Er As Long
         Global NmCabs() As String, nCabs As Long, TotalFilesSize As Double
      
         Sub Encrypt (Info As String)
            ' Crypt Cabinet file
         End Sub
      
         Function UCaseSl(DirNm As String) As String
            If Left$(DirNm, 2) = "\\" Then ExitProcess -1
            CharUpperBuff ByVal StrPtr(DirNm), Len(DirNm)
            If Right$(DirNm, 1) <> "\" Then Function = DirNm + "\" Else Function = DirNm
         End Function
      
         Function GetSizeOfFile(FileSpec As Asciiz) As Double
            Static FindData As WIN32_FIND_DATA, hFindFile As Long
            hFindFile = FindFirstFile(FileSpec, FindData)
            If hFindFile = %INVALID_HANDLE_VALUE Then Function = -1 Else _
            If (FindData.dwFileAttributes And %FILE_ATTRIBUTE_DIRECTORY) Then Function = -2 Else _
            Function = FindData.nFileSizeHigh * &H100000000 + FindData.nFileSizeLow: _
                       FindClose hFindFile
         End Function
      
         Sub AddSfxPart
            Local Info As String, i As Long, Contents As String
      
            Open RlsDir + AppName + ".Exe" For Output As #1 Len = 16384
            If Err <> 0 Then ErrMsg = "Can't create " + RlsDir + AppName + ".Exe": Exit Sub
      
            Open AppDir + AppName + ".Exe" For Binary Shared As #2
            Get$ #2, Lof(2), Info: Close #2
            If Err <> 0 Then ErrMsg = "Can't read " + AppDir + AppName + ".Exe": Exit Sub
            Print #1, Info;
      
            Open RlsDir + AppName + "0.Cab" For Input Shared As #2 Len = 16384: i = 0
            While Not Eof(2)
               Line Input #2, TmpAsciiz: TmpAsciiz = Trim$(TmpAsciiz)
               If TmpAsciiz <> "" Then
                  If i = 0 Then
                     i = 1: TotalFilesSize = Val(TmpAsciiz)
                  Else
                     Incr nCabs: If nCabs > %maxCabs Then Er = 1: Exit Do
                     NmCabs(nCabs) = TmpAsciiz
                  End If
               End If
            Wend
            Close #2
            If Er <> 0 Or Err <> 0 Or nCabs = 0 Then _
               ErrMsg = "Problems in " + RlsDir + AppName + "0.Cab": Exit Sub
      
            For i = 1 To nCabs
               Open RlsDir + AppName + Mid$(Str$(i), 2) + ".Cab" For Binary Shared As #2 Len = 16384
               Get$ #2, Lof(2), Info: Close #2
               If Err <> 0 Then ErrMsg = "Can't read " + _
                 RlsDir + AppName + Mid$(Str$(i), 2) + ".Cab": Exit Sub
               EnCrypt Info
               Contents = Contents + Mid$(Str$(Lof(1) + 1), 2) + "|" + _
                                     Mid$(Str$(Len(Info)), 2) + "|" + _
                                     NmCabs(i) + $CRLF
               Print #1, Info;
            Next
            Print #1, Contents;
            Print #1, Mkd$(TotalFilesSize) + Mkl$(Len(Contents)) + $Signature;
            Close #1
            i = Shell(RlsDir + AppName + ".Exe", 1)
         End Sub
      
         Sub CreateCabinetFile
            %maxFiles = 500: ReDim NmFiles(1 To %maxFiles) As String
            Local nFiles As Long, EofSfx As Long, i As Long
            Dim FilesDir As String, FileSize As Double
      
            Open AppName + ".Sfx" For Input Shared As #1 Len = 16384
            If Err <> 0 Then ErrMsg = "Can't read " + AppName + ".Sfx": Exit Sub
            nCabs = 1
            Do
               EofSfx = Eof(1): If IsFalse(EofSfx) Then Line Input #1, TmpAsciiz
               If (EofSfx Or Left$(TmpAsciiz, 1) = "$") And nFiles > 0 Then
                  If nCabs = 0 Then nCabs = 1: NmCabs(1) = "$APPDIR\"
                  FilesDir = UCaseSl(NmCabs(nCabs))
                  ' Undestands $AppDir $Windows $System
                  If Left$(FilesDir, 8) = "$APPDIR\"  Then FilesDir = AppDir + Mid$(FilesDir,  9) Else _
                  If Left$(FilesDir, 9) = "$WINDOWS\" Then FilesDir = WinDir + Mid$(FilesDir, 10) Else _
                  If Left$(FilesDir, 8) = "$SYSTEM\"  Then FilesDir = SysDir + Mid$(FilesDir,  9)
                  ChDrive Left$(FilesDir, 2): ChDir FilesDir
                  If UCaseSl(CurDir$) <> FilesDir Then ErrMsg = "Can't find " + FilesDir: Exit Sub
      
                  For i = 1 To nFiles
                     FileSize = GetSizeOfFile(ByCopy NmFiles(i))
                     If FileSize < 0 Then ErrMsg = "Can't find " + FilesDir + NmFiles(i): Exit Sub
                     TotalFilesSize = TotalFilesSize + FileSize
                  Next
      
                  Open "PbSfx.Ddf" For Output As #2 Len = 16384
                  If Err <> 0 Then ErrMsg = "Can't create PbSfx.Ddf in " + FilesDir: Exit Sub
                  Print #2, ".OPTION Explicit"
                  Print #2, ".Set Cabinet=Off"
                  Print #2, ".Set Compress=Off"
                  Print #2, ".Set MaxDiskSize=CDROM"
                  Print #2, ".Set DiskDirectoryTemplate=" + Chr$(34) + AppDir  + $Release + Chr$(34)
                  Print #2, ".Set CompressionType=MSZIP"
                  Print #2, ".Set CompressionLevel=7"
                  Print #2, ".Set CompressionMemory=21"
                  Print #2, ".Set CabinetNameTemplate=" + Chr$(34) + AppName + _
                     Mid$(Str$(nCabs), 2) + ".Cab" + Chr$(34)
                  Print #2, ".Set Cabinet=On"
                  Print #2, ".Set Compress=On"
                  For i = 1 To nFiles
                     Print #2, Chr$(34) + NmFiles(i) + Chr$(34)
                  Next
                  Close #2
                  Shell "makecab /f PbSfx.Ddf"
                  Kill "Setup.Inf": Kill "Setup.Rpt": Kill "PbSfx.Ddf"
                  ChDrive Left$(AppDir, 2): ChDir AppDir
               End If
               If EofSfx Then Exit Do
               If Left$(TmpAsciiz, 1) = "*" Then ' Comments
               ElseIf Left$(TmpAsciiz, 1) = "$" Then
                  If nFiles > 0 Then nFiles = 0: Incr nCabs
                  If nCabs > %maxCabs Then Er = 1: Exit Do
                  NmCabs(nCabs) = "$" + Trim$(Mid$(TmpAsciiz, 2)): _
                     If Len(NmCabs(nCabs)) < 2 Then Er = 2: Exit Do
               Else
                  Incr nFiles: If nFiles > %maxFiles Then Er = 3: Exit Do
                  NmFiles(nFiles) = Trim$(TmpAsciiz): _
                     If NmFiles(nFiles) = ""  Then Er = 4: Exit Do
               End If
            Loop
            Close #1
            If nFiles = 0 Then Decr nCabs
            If nCabs = 0 Then Er = 5
            If Er <> 0 Then ErrMsg = "Syntax error in " + AppName + ".Sfx": Exit Sub
            Open RlsDir + AppName + "0.Cab" For Output As #1 Len = 16384
            Print #1, Format$(TotalFilesSize, "#")
            For i = 1 To nCabs: Print #1, NmCabs(i): Next: Close #1
            If Err <> 0 Then ErrMsg = "Strange error"
         End Sub
      
         Function PbMain
            GetWindowsDirectory TmpAsciiz, SizeOf(TmpAsciiz): WinDir = UCaseSl(ByCopy TmpAsciiz)
            GetSystemDirectory  TmpAsciiz, SizeOf(TmpAsciiz): SysDir = UCaseSl(ByCopy TmpAsciiz)
            Do
               GetModuleFileName GetModuleHandle(ByVal 0), TmpAsciiz, SizeOf(TmpAsciiz)
               ExeDir = Left$(TmpAsciiz, Instr(-1, TmpAsciiz, "\"))
               If Dir$(UCaseSl(CurDir$) + "*.Sfx", 39) = "" Then _
                  ChDrive Left$(ExeDir, 2): ChDir ExeDir ' From IDE
      
               AppDir = UCaseSl(CurDir$): RlsDir = UCaseSl(AppDir + $Release)
               AppName = Dir$("*.Sfx", 39)
               If Len(AppName) > 4 Then AppName = Left$(AppName, Len(AppName) - 4) Else _
                  ErrMsg = ".Sfx is not found": Exit Do
               ReDim NmCabs(1 To %maxCabs) As String
               If Command$ = "" Then CreateCabinetFile Else AddSfxPart
               Exit Do
            Loop
            If ErrMsg <> "" Then MsgBox ErrMsg, , "PB Sfx"
         End Function
      ------------------

      Comment

      Working...
      X