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

  • Semen Matusovski
    replied
    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
    ------------------

    Leave a comment:


  • Semen Matusovski
    replied
    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).]

    Leave a comment:


  • Semen Matusovski
    started a topic Self-Exe, based on MakeCab/Extract

    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).]
Working...
X