Option Explicit

Private Sub cmdAppend_Click()
    If mExe.Append(App.Path & "\test.exe", "Version 2.0") Then
        Text1 = "Append Complete"
    Else
        Text1 = "Append Error!"
    End If
End Sub

      
Option Explicit

Private Sub cmdExtract_Click()
    Dim sText As String
    sText = mExe.Extract(App.Path & "\test.exe")
    If LenB(sText) Then
        Text1 = sText
    Else
        Text1 = "Nothing to Extract"
    End If
End Sub

      
Option Explicit

Private Const SPECIAL As String = "$@ed3253f273f4fvi"

Public Function Append(ByVal sFile As String, _
    ByVal sValue As String) As Boolean
    Dim iFile1 As Integer
    Dim sBuff As String
    Dim sTemp As String
    Dim lPos As Long
On Error GoTo ErrHandler:
    If LenB(Dir$(sFile)) And LenB(sValue) > 0 Then
        sTemp = Extract(sFile)
        If LenB(sTemp) = 0 Then
            iFile1 = FreeFile
            Open sFile For Binary As #iFile1
                lPos = LOF(iFile1) + 1
                sBuff = cmdEnc(SPECIAL) & cmdEnc(sValue)
                Put #iFile1, lPos, sBuff
            Close #iFile1
            Append = True
        End If
    End If
    Exit Function
ErrHandler:
    If iFile1 Then Close #iFile1
    Append = False
End Function

Public Function Extract _
    (ByVal sFile As String) As String
    Dim iFile2 As Integer
    Dim sTemp As String
    Dim sBuff As String
    Dim lPos As Long
On Error GoTo ErrHandler:
    If LenB(Dir$(sFile)) > 0 Then
        iFile2 = FreeFile
        Open sFile For Binary As #iFile2
            sBuff = Input(LOF(iFile2), #iFile2)
        Close #iFile2
        sTemp = cmdEnc(SPECIAL)
        lPos = InStr(1, sBuff, sTemp) + Len(sTemp) - 1
        If lPos > Len(sTemp) - 1 Then
            Extract = cmdDec(Right(sBuff, Len(sBuff) - lPos))
        End If
    End If
    Exit Function
ErrHandler:
    If iFile2 Then Close #iFile2
    Extract = vbNullString
End Function

Private Function cmdDec(ByVal strDec As String) As String
    Dim sinp, sout, sc, nc, P
        sinp = strDec
        sout = ""
    
        For P = 1 To Len(sinp) Step 1
            sc = Mid(sinp, P, 1)
            nc = Asc(sc) - 3
            sout = sout + Chr(nc)
        Next P
    
        cmdDec = sout
End Function

Private Function cmdEnc(ByVal strEnc As String) As String
    Dim sinp, sout, sc, nc, P
        sinp = strEnc
        sout = ""
    
        For P = 1 To Len(sinp) Step 1
            sc = Mid(sinp, P, 1)
            nc = Asc(sc) + 3
            sout = sout + Chr(nc)
        Next P
    
        cmdEnc = sout
End Function