asked on

Need Two Functions: EXE to String, String to EXE

In my previous question, I said:

I Need To:
(1) Open an exe
(2) Turn the bytes into text
(3) Save Byte Text as text file
(4) Open Text File
(5) Turn it back into bytes
(6) Re-save as executable with new name

***I need the new executable to run exactly as the original with NO changes.***

Then, a member called Rettiseert gave me this and it worked flawlessly:

Private Sub ExeToTxt(ExeName As String, TxtName As String)

Dim B As Byte
Dim FLen As Long
Dim I As Long

Open ExeName For Binary As #1
Open TxtName For Append As #2

FLen = FileLen(ExeName)

For I = 1 To FLen
Get #1, I, B
If Len(Hex(B)) = 2 Then
Print #2, Hex(B);
Else
Print #2, "0" + Hex(B);
End If
Next

Close #2
Close #1

End Sub

Private Sub TxtToExe(TxtName As String, ExeName As String)

Dim B(0 To 1) As Byte
Dim FLen As Long
Dim V As Byte
Dim I As Long

Open ExeName For Binary As #1
Open TxtName For Binary As #2

FLen = FileLen(TxtName)

For I = 1 To FLen Step 2
Get #2, I, B
V = Val("&H" + Format(Chr(B(0))) + Format(Chr(B(1))))
Put #1, , V
Next

Close #2
Close #1

End Sub

Now you can use something like:

ExeToTxt "c:\program.exe", "c:\program.txt"
TxtToExe "c:\program.txt", "c:\NEWprogram.exe"

========================

But! Now what I want is ExeToString and StringToExe. It would be the same as above, but instead of saving the file, I would be able to hold the "binary" text in a String variable, like this:

Public Sub TestExeString()

Dim ExeString as String

ExeString = ExeToString("c:\program.exe")
SaveExeFromString("c:\NEWProgram", ExeString)

End Sub

Ark

See my post on previous thread

Ark

PS https://www.experts-exchange.com/questions/21333979/Need-To-Open-an-exe-Save-as-Text-File-Re-open-Text-File-Re-save-as-new-exe.html#13435401

Ark

Hi
To view code in action:
Open Notepad, copy/paste following text and save as Form1.frm

'=======8<========Form code start=======8<===========
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3555
ClientLeft = 165
ClientTop = 855
ClientWidth = 6585
LinkTopic = "Form1"
ScaleHeight = 3555
ScaleWidth = 6585
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text1
Height = 2835
Left = 300
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
Top = 120
Width = 6075
End
Begin VB.Menu mnuFile
Caption = "File"
Begin VB.Menu mnuOpen
Caption = "&Open..."
Begin VB.Menu mnuOpenHex
Caption = "&Hex dump"
End
Begin VB.Menu mnuOpenExe
Caption = "&Executable"
End
End
Begin VB.Menu mnuSaveAs
Caption = "&SaveAs..."
Begin VB.Menu mnuSaveHex
Caption = "&Hex dump"
End
Begin VB.Menu mnuSaveExe
Caption = "&Executable"
End
End
Begin VB.Menu sep
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "&Exit"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sHexDump As String
Dim sFileName As String

Private Function FileHexDump(ByVal sExeFileName As String) As String
Dim arr() As Byte
Dim sText As String, sLine As String, sHeader As String
Dim fn As Integer
sHexDump = ""
fn = FreeFile
Open sExeFileName For Binary As #fn
ReDim arr(LOF(fn) - 1)
Get #fn, , arr
Close #fn
sText = Space$((UBound(arr) \ 16 + 1) * 79)
On Error Resume Next
For i = 0 To UBound(arr) - 1 Step 16
sLine = ZeroPad(Hex(i), 8) & " | "
For j = 0 To 15
sLine = sLine & ZeroPad(Hex(arr(i + j)), 2) & " "
If Err Then sLine = sLine & " "
Next j
sLine = sLine & "| "
For j = 0 To 15
If arr(i + j) < 32 Then
sLine = sLine & "."
Else
sLine = sLine & Chr(arr(i + j))
End If
Next j
sLine = sLine & vbNewLine
Mid(sText, (i \ 16) * 79 + 1, 79) = sLine
Next i
sHeader = "Address |"
For i = 0 To 15
sHeader = sHeader & " " & ZeroPad(Hex(i), 2)
Next i
sHeader = sHeader & " | ASCII " & vbCrLf & String(78, "=") & vbCrLf
FileHexDump = sHeader & sText
End Function

Private Function ZeroPad(strValue As String, intLen As String) As String
ZeroPad = Right$(String(intLen, "0") & strValue, intLen)
End Function

Private Sub Command1_Click()
End Sub

Private Sub Form_Load()
Text1.Font = "courier"
Text1.Text = "Please load file"
End Sub

Private Sub Form_Resize()
If WindowState = vbMinimized Then Exit Sub
Text1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub mnuOpenExe_Click()
Dim s As String
Dim nFile As Integer
If sFileName <> "" Then
s = Left(sFileName, InStrRev(sFileName, ".")) & "exe"
End If
s = GetFileName(s, "Executables (*.exe)|*.exe|All files (*.*)|*.*", "Open executable")
If s <> "" Then
sFileName = s
sHexDump = FileHexDump(sFileName)
ShowText
End If
End Sub

Private Sub mnuOpenHex_Click()
Dim s As String
Dim nFile As Integer
If sFileName <> "" Then
s = Left(sFileName, InStrRev(sFileName, ".")) & "txt"
End If
s = GetFileName(s, "Text files (*.txt)|*.txt|All files (*.*)|*.*", "Open hex dump")
If s <> "" Then
sFileName = s
nFile = FreeFile
Open sFileName For Binary Access Read As #nFile
sHexDump = String(LOF(nFile), " ")
Get #nFile, , sHexDump
ShowText
Close #nFile
End If
End Sub

Private Sub ShowText()
If Len(sHexDump) > 60904 Then
MsgBox "File too big to be shown in Text box." & vbCrLf & "Truncated to first 12K"
Text1.Text = Left(sHexDump, 60904) & vbCrLf & "Truncated..."
Else
Text1.Text = sHexDump
End If
End Sub

Private Sub mnuSaveAs_Click()
mnuSaveHex.Enabled = Len(sHexDump)
mnuSaveExe.Enabled = Len(sHexDump)
End Sub

Private Sub mnuSaveExe_Click()
If sHexDump = "" Then
MsgBox "Nothing to save!", vbCritical, "Save error"
Exit Sub
End If
Dim nFile As Integer
Dim s As String
If sFileName <> "" Then
s = Left(sFileName, InStrRev(sFileName, ".")) & "exe"
End If
s = GetFileName(s, "Executables (*.exe)|*.exe|All files (*.*)|*.*", "Save executable", False)
If s <> "" Then
sFileName = s
s = MakeExe
If Dir(sFileName) <> "" Then Kill sFileName
nFile = FreeFile
Open sFileName For Binary Access Write As #nFile
Put #nFile, , s
Close #nFile
End If
End Sub

Private Sub mnuSaveHex_Click()
If sHexDump = "" Then
MsgBox "Nothing to save!", vbCritical, "Save error"
Exit Sub
End If
Dim nFile As Integer
Dim s As String
If sFileName <> "" Then
s = Left(sFileName, InStrRev(sFileName, ".")) & "txt"
End If
s = GetFileName(s, "Text files (*.txt)|*.txt|All files (*.*)|*.*", "Save hex dump", False)
If s <> "" Then
sFileName = s
If Dir(sFileName) <> "" Then Kill sFileName
nFile = FreeFile
Open sFileName For Binary Access Write As #nFile
Put #nFile, , sHexDump
Close #nFile
End If
End Sub

Private Function MakeExe() As String
Dim aStrings() As String
Dim aExe() As String
Dim s As String
Dim i As Long, j As Long
aStrings = Split(sHexDump, vbCrLf)
ReDim aExe(UBound(aStrings) - 2)
For i = 2 To UBound(aStrings)
s = Mid(aStrings(i), 12, 48)
If s <> "" Then
For j = 0 To 15
aExe(i - 2) = aExe(i - 2) & Chr(CLng("&H" & Mid(s, j * 3 + 1, 2)))
Next j
End If
Next i
MakeExe = Join(aExe, "")
End Function
'=======8<========Form code end=======8<===========
'Clear notepad, copy/paste following text and save as Module1.bas

'=======8<========Module code start=======8<=========
Attribute VB_Name = "mOpenSave"
Option Explicit

Private Type OPENFILENAME 'Open & Save Dialog
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_HELPBUTTON = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXISTS = &H1000
Private Const OFN_EXPLORER = &H80000
'OFN_EXPLORER OR OFN_FILEMUSTEXISTS
Private Const OFN_OPENFLAGS = &H81000
'OFN_OPENFLAGS OR OFN_OVERWRITEPROMPT AND NOT OFN_FILEMUSTEXIST
Private Const OFN_SAVEFLAGS = &H80002

Public Const MAX_PATH = 260
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Function GetFileName(Optional ByVal sFileName As String, Optional ByVal sFilter As String, Optional ByVal sTitle As String, Optional bOpen As Boolean = True) As String
Dim OFN As OPENFILENAME
Dim ret As Long, i As Long
Dim sExt As String
With OFN
.lStructSize = Len(OFN)
For i = 1 To Len(sFilter)
If Mid(sFilter, i, 1) = "|" Then
Mid(sFilter, i, 1) = vbNullChar
End If
Next
sFilter = sFilter & String$(2, 0)
.lpstrFilter = sFilter
.lpstrTitle = sTitle
.lpstrInitialDir = App.Path
.hInstance = App.hInstance
.lpstrFile = sFileName & String(MAX_PATH - Len(sFileName), 0)
.lpstrFileTitle = String(MAX_PATH, 0)
.nMaxFile = MAX_PATH
End With
If bOpen Then
OFN.flags = OFN.flags Or OFN_OPENFLAGS
ret = GetOpenFileName(OFN)
Else
OFN.flags = OFN.flags Or OFN_SAVEFLAGS
ret = GetSaveFileName(OFN)
End If
If ret Then GetFileName = TrimNull(OFN.lpstrFile)
End Function

Public Function TrimNull(startstr As String) As String
Dim pos As Integer
pos = InStr(startstr, Chr$(0))
If pos Then
TrimNull = Left$(startstr, pos - 1)
Exit Function
End If
TrimNull = startstr
End Function
'=======8<========Module code end=======8<=========
Start new VB project, remove default Form1 and add these two files
Run project

timothyspriggs

ASKER

Ark,

Okay I see what you are doing and it is nice work. We are almost there... BUT...

Well, I did a hex dump with your code and it turned a 60KB exe into a 308KB hex dump. In contrast, rettiseert's code only doubled the size to 120KB. I understand that by necessity your code does more formatting by turning bits into pure string, but unless I am mistaken, the killer character in a pure bit string is the null (if there are others let me know). So, why couldn't we take rettiseert's string, find nulls, and replace them with a token (maby a "~"). We could do the same with any other Non-ASCII character and give it its own token. Then we would have a pure ASCII string. Later when we are returning to exe, we would just replace those tokens with their byte counterparts and save. Wouldn't that keep the ExeToString function from inflating the original code so much. We should end up with a string that is more compareable to rettiseert's string in size while retaining your function's extensibility.

Let me know,
Tim

Ark

Hi
Exe file is an array of bytes, which can be represents as ASCII string. The problem is - bytes less then 32(SPACE) have no accociated printable characters. Any other character (including "~" and others) are valid bytes and may present inside exe, so we can not determine if "~" is original or replaced char.

timothyspriggs

ASKER

Ok, perhaps this then:

I have a Regular Expressions wrapper that I can use for an example here, though I know that it can't be used for this application, I think it could shed some light on what I am saying.

In my RegExp wrapper, I allow users to write {*} to represent "any number of any chracters". Of course, this isn't an actual expression, but you would be hard pressed to get an end-user to remember a complex series of characters. Naturally, at some point in this chaotic universe, someone may want to actually write "{*}" and mean it literally. In that case, I allow them to write "{{*}}". Simplistic, I know. But it shows what I mean. Of course, doing this requires a butt-load of logic that otherwise might not have to be there, but in this case I will sacrifice performance a little to satisfy a useability requirement.

In the case of turning a byte array into a string, I would be willing to sacrifice a little performance on each end (encode/decode) in order to reduce file size. So, a few questions, once answered, should tell me whether what I want to do is reliable.

1) How many characters in a given byte array are characters that will break the string?
In other words, I know that a null character breaks the string for purposes of displaying
the string in a text box or notepad. Are there others?

2) Is it possible, upon arriving at one of those characters, to put in a replacement token instead of that character?
For instance, instead of a Null character, put <BUGS BUNNY> (or something shorter -- haha)?

3) When re-compiling the byte array, is it realistic to replace the token with the corresponding Byte character?
So, when looping, and you find <BUGS BUNNY>, you replace it with VBNull or VBNullString

4) Most importantly, will this reduce the resulting file size? or are there so many non-ASCII characters that the resulting file will be the same size or bigger?

Once I know the answers to these question, I will close this question and pop you the points. You have been great, I only wish there were more than 500 points to give.

-- Tim

ASKER CERTIFIED SOLUTION

Ark

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Ark

Oops,
FileHexDump = sText
Should be
FileHexDumpShort = sText

timothyspriggs

ASKER

Ark,

I went ahead and gave you the points here, but I have a couple more quick questions:

(1) Where is the function "ZeroPad()"? Couldn't find it in any of your code.

(2) Though I assume the above code will work once you give me ZeroPad(), Did you have a HexDumpToExe() to go with it?

Thanks,

Tim

timothyspriggs

ASKER

Ark -- I will open a new question so you can get the points for your effort.

Ark

'Purpose - add leading zeroes to string (usually hex)
'using - Debug.Print ZeroPad("7", 2) Return "07"
'Debug.Print ZeroPad("1F", 8) Return "0000001F"

Private Function ZeroPad(strValue As String, intLen As String) As String
ZeroPad = Right$(String(intLen, "0") & strValue, intLen)
End Function

Private Sub HexDumpToExe(ByVal sHexDump As String, ByVal sExeFileName As String)
Dim arr() As Byte
Dim fn As Integer
Dim i As Long

Redim arr(Len(sHexDump/2) - 1)
For i = 1 To Len(sHexDump) Step 2
arr(i) = CByte(Mid(sHexDump, i, 2))
Next i

If Dir(sExeFileName) <> "" Then Kill sExeFileName
fn = FreeFile
Open sExeFileName For Binary Access Write As #fn
Get #fn, , arr
Close #fn
End Function

timothyspriggs

ASKER

Thanks, Ark.

I have opened a new question worth 500 Points, so if you comment to it I can give you the points.

-- Tim

timothyspriggs

ASKER

The new post can be found here:

https://www.experts-exchange.com/questions/21336845/More-Exe-Byte-Array-to-string-and-String-to-Exe-Nonsense-Almost-there.html