Joining & extracting files

[Darkolord]

Hello,
I have found a function for joining (appending) files to binary files and other to extract it back ... multiple files can be added and then extracted by its "tag"

Public Function AddEmbeddedFile(strSourceFile As String, strAddName As String, strDestinationFile As String) As Boolean
   ' On Error GoTo handleError
    Dim fileListStart As Long
    Dim fileList As String
    Dim lngFileSize As Long
    Dim lngFilePos As Long
    Dim lngCurPos As Long
    Dim strCurFile As String
    Dim iFreeFile As Integer
    Dim oFreeFile As Integer
    Dim fileData As String
    If FileLen(strSourceFile) = 0 Then Exit Function
    oFreeFile = FreeFile()
    Open strDestinationFile For Binary As oFreeFile
    Get oFreeFile, LOF(oFreeFile) - 3, fileListStart
 
    If fileListStart = 0 Then
        fileListStart = LOF(oFreeFile) + 1
        fileList = vbNullString
    Else
        fileList = String(LOF(oFreeFile) - fileListStart - 3, vbNullChar)
        Get oFreeFile, fileListStart, fileList
    End If
    lngFilePos = fileListStart
    lngFileSize = FileLen(strSourceFile)
    iFreeFile = FreeFile()
    Open strSourceFile For Binary As iFreeFile
 
 
    If LOF(iFreeFile) > 1000000 Then
        lngCurPos = -1000000
        Do
            lngCurPos = lngCurPos + 1000000
            If lngCurPos + 999999 > LOF(iFreeFile) Then
                fileData = String(LOF(iFreeFile) - lngCurPos, vbNullChar)
            Else
                fileData = String(1000000, vbNullChar)
            End If
            Get iFreeFile, lngCurPos, fileData
            Put oFreeFile, fileListStart, fileData
            fileListStart = fileListStart + Len(fileData) + 1
        Loop Until lngCurPos + 999999 > LOF(iFreeFile)
    Else
        fileData = String$(LOF(iFreeFile), vbNullChar)
        Get iFreeFile, 1, fileData
        Put oFreeFile, fileListStart, fileData
        fileListStart = fileListStart + Len(fileData) + 1
    End If
    Close iFreeFile
    strAddName = strAddName & vbNullChar
    Put oFreeFile, fileListStart, fileList
    Put oFreeFile, fileListStart + Len(fileList), lngFilePos
    Put oFreeFile, fileListStart + Len(fileList) + 4, lngFileSize
    Put oFreeFile, fileListStart + Len(fileList) + 8, strAddName
    Put oFreeFile, fileListStart + Len(fileList) + 12 + Len(strAddName), fileListStart
    Close oFreeFile
    AddEmbeddedFile = True
    Exit Function
handleError:
    Close
    AddEmbeddedFile = False
    Exit Function
End Function

and the other:

Public Function ExtractEmbeddedFile(strFileName As String, strDestinationFile As String, Optional strSourceFile As String) As Boolean
    On Error GoTo handleError
    Dim fileListStart As Long
    Dim lngFileSize As Long
    Dim lngFilePos As Long
    Dim lngCurPos As Long
    Dim strCurFile As String
    Dim iFreeFile As Integer
    Dim oFreeFile As Integer
    Dim fileData As String
    iFreeFile = FreeFile()
    If LenB(strSourceFile) = 0 Then strSourceFile = App.Path & "\" & App.EXEName & FILE_EXT
    Open strSourceFile For Binary As iFreeFile
    Get iFreeFile, LOF(iFreeFile) - 3, fileListStart
 
    If fileListStart = 0 Then
        Close iFreeFile
        Exit Function
    End If
 
 
    Do
        Get iFreeFile, fileListStart, lngFilePos
        fileListStart = fileListStart + 4
        Get iFreeFile, fileListStart, lngFileSize
        fileListStart = fileListStart + 4
        strCurFile = String$(255, vbNullChar)
        Get iFreeFile, fileListStart, strCurFile
        If Mid$(strCurFile, 1, 1) = vbNullChar Then strCurFile = Mid$(strCurFile, 2)
        strCurFile = Mid$(strCurFile, 1, InStr(1, strCurFile, vbNullChar) - 1)
        fileListStart = fileListStart + Len(strCurFile) + 5
 
        If lngFilePos = 0 Or lngFileSize = 0 Or LenB(strCurFile) = 0 Then
            Close iFreeFile
            Exit Function
        ElseIf strCurFile = strFileName Then
            oFreeFile = FreeFile()
            Open strDestinationFile For Binary As oFreeFile
 
            If lngFileSize > 1000000 Then
                lngCurPos = -1000000
                Do
                    lngCurPos = lngCurPos + 1000000
                    If lngCurPos + 1000000 > lngFileSize Then
                        fileData = String$(lngFileSize - lngCurPos, vbNullChar)
                    Else
                        fileData = String$(1000000, vbNullChar)
                    End If
                    Get iFreeFile, lngCurPos + lngFilePos, fileData
                    Put oFreeFile, lngCurPos + 1, fileData
                Loop Until lngCurPos + 999999 >= lngFileSize
            Else
                fileData = String$(lngFileSize, vbNullChar)
                Get iFreeFile, lngFilePos, fileData
                Put oFreeFile, 1, fileData
            End If
            Close oFreeFile
            Close iFreeFile
            ExtractEmbeddedFile = True
            Exit Function
        End If
    Loop Until fileListStart >= (LOF(iFreeFile) - 7)
    Close iFreeFile
    Exit Function
handleError:
    Close
    ExtractEmbeddedFile = False
    Exit Function
End Function

the problem is that these two functions look quite inefficient to me and I am wondering if any of you have the code that has similar functionality...

thanks