Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0736: Selbstextrahierende EXE-Datei (SFX)

 von 

Beschreibung 

Manchmal ist es nötig, eigene EXE-Dateien von einem Programm aus zu erstellen, die bestimmte Aufgaben selbstständig erledigen, wie z.B. bestimmte angehängte Daten zu dekomprimieren (wie bei manchen WinRar-Archiven)

Dazu muss nichts selbst kompiliert werden, es reicht ein vorgefertigtes Kompilat zu haben, an das die Daten angehängt werden können und das sie liest.

Dieses Beispiel zeigt ein einfaches Konzept für selbstextrahierende Dateien (SFX), bei dem die zu erstellende Basisdatei aus einer Resource geladen wird.

Das eigentliche Archivieren ist nicht implementiert, dazu Tipp 579

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [11,33 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'--------- Anfang Projektgruppe SelfExtraction.vbg  ---------
'------------- Anfang Projektdatei Creator.vbp  -------------
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'------- Anfang Formular "frmMain" alias frmMain.frm  -------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "txtContents"
' Steuerelement: Standarddialog-Steuerelement "dlgFiles"
' Steuerelement: Beschriftungsfeld "Label1"
Option Explicit

Private Sub Command1_Click()
   Dim Filename As String

   ' Dateiauswahldialog anzeigen
   With dlgFiles
      .InitDir = CurDir
      .ShowSave
      Filename = .Filename
   End With
   
   ' Schreiben
   
   ' Hier wird der Einfachheit wegen nur eine Zeichenfolge geschrieben
   ' Es können jedoch auch beliebige andere Daten geschrieben werden,
   ' wie z.B. Dateien für ein selbstextrahierendes Archiv
   
   If Filename <> "" Then
      Call sfx_Open(Filename, 101, "CUSTOM")                   ' Datei  schreiben
      Call sfx_Write(StrConv(txtContents.Text, vbFromUnicode)) ' Anhang schreiben (ByteArray)
      Call sfx_Close                                           ' Datei schließen
   End If

   ' Alles markieren
   With txtContents
      .SelStart = 0
      .SelLength = Len(.Text)
      .SetFocus
   End With
   
   ' Erfolgsmeldung
   Call MsgBox("Das Erstellen wurde erfolgreich ausgeführt", vbInformation)
End Sub

' Alles beenden
Private Sub Command2_Click()
   Call Unload(Me)
   Set frmMain = Nothing
End Sub

Private Sub Form_Load()

End Sub
'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'------- Anfang Modul "mdlCreate" alias mdlCreate.bas -------
Option Explicit


Private ff As Integer   ' Die Dateinummer

' Datei aus Resource schreiben
Public Sub sfx_Open(ByVal Filename As String, Optional ByVal ResID As Long = 101, Optional ByVal ResType As String = "CUSTOM")
   Dim Contents() As Byte
   
   ff = FreeFile
   
   Contents = LoadResData(ResID, ResType)                ' Inhalt laden
   
   Open Filename For Binary Access Write Shared As #ff   ' Öffnen
      Put #ff, , Contents                                ' Schreiben
End Sub

' Daten anhängen (ByteArray)
Public Sub sfx_Write(Data() As Byte)
   Put #ff, , Data
End Sub

' Schließen
Public Sub sfx_Close()
   Close #ff
End Sub
'-------- Ende Modul "mdlCreate" alias mdlCreate.bas --------
'-------------- Ende Projektdatei Creator.vbp  --------------
'--------------- Anfang Projektdatei SFX.vbp  ---------------
'-------- Anfang Formular "frmSFX" alias frmSFX.frm  --------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "txtContents"
' Steuerelement: Beschriftungsfeld "Label1"
Option Explicit

' Die *.exe dieses Projektes wird als Basisexe in die Ressourcendatei von Creator.vbp geladen.

Private IsOK As Boolean ' Gab es Probleme?

' Den Anhang laden und anzeigen
Private Sub Command1_Click()
   txtContents.Text = StrConv(sfx_ReadAll, vbUnicode)
   Command1.Enabled = False
End Sub

' Programm schließen
Private Sub Command2_Click()
   Call Unload(Me)
   Set frmSFX = Nothing
End Sub

' Eigene Datei schließen, wenn es keine Probleme gab
Private Sub Form_Unload(Cancel As Integer)
   If IsOK Then Call sfx_Close
End Sub

' Eigene Datei öffnen und auf Fehler prüfen
Private Sub Form_Load()
   Dim i As Long

   If FileLen(AppPath) <= FileLength - 1 Then
      Call MsgBox("Es ist ein Fehler aufgetreten" & vbCrLf & "Dem Archiv sind keine Daten angehängt", vbCritical)
      IsOK = False
      Command1.Enabled = False
   Else
      Call sfx_Open
      IsOK = True
   End If
End Sub

'--------- Ende Formular "frmSFX" alias frmSFX.frm  ---------
'---------- Anfang Modul "mdlSFX" alias mdlSFX.bas ----------
Option Explicit

Global Const FileLength As Long = &H6001  ' Größe der eigenen Datei

Private ff              As Integer        ' Dateinummer

' Korrekter eigener Pfad
Public Property Get AppPath() As String
   AppPath = App.Path & IIf(Right(App.Path, 1) <> "\", "\", "") & App.EXEName & ".exe"
End Property

' Eigene Datei öffnen und den Dateizeiger zum Beginn des Anhangs schieben
Public Sub sfx_Open()
   ff = FreeFile
   
   Open AppPath For Binary Access Read Shared As #ff
      Seek #ff, FileLength
End Sub

' Anhang (hier als ByteArray) lesen
Public Function sfx_ReadAll() As Byte()
   Dim Contents() As Byte
   
   ReDim Contents(FileLen(AppPath) - FileLength) As Byte
   Get #ff, , Contents
    
   sfx_ReadAll = Contents
End Function

' Schließen
Public Sub sfx_Close()
   Close #ff
End Sub

'----------- Ende Modul "mdlSFX" alias mdlSFX.bas -----------
'---------------- Ende Projektdatei SFX.vbp  ----------------
'---------- Ende Projektgruppe SelfExtraction.vbg  ----------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.