Convert string to hex with a specific format?

camille · Post by **camille** » Thu Mar 10, 2022 9:49 pm

Hi,

does anyone have a function to convert a normal string to a hex output like this (unicode, if a char has multiple bytes, all of them are shown) and returns that as a string as well?

E.g. for:

Code: Select all

Chinese-漢-character

A space must be between all bytes to improve readability and it would be nice if we could call the function with an argument how many bytes should be displayed on each line. In the picture it's 16 so that would probably be a good default value.

Thank you!

BarryG · Post by **BarryG** » Thu Mar 10, 2022 9:53 pm

BinaryGadget -> https://www.purebasic.fr/english/viewto ... 55#p423055

AZJIO · Post by **AZJIO** » Fri Mar 11, 2022 2:13 am

You need to enable admin rights.You can read the beginning of the disc

Code: Select all

EnableExplicit
#block = 512 ; multiple of disk sector
Global hDevice, bResult.b, dwBytesRead.l, FilePtr.l
Global Dim Buff.a(#block)
hDevice = CreateFile_("\\.\PhysicalDrive0", #GENERIC_READ, #FILE_SHARE_READ | #FILE_SHARE_WRITE, #NUL, #OPEN_EXISTING, 0,  #NUL)
; hDevice = CreateFile_("\\?\C:\bootmgr", #GENERIC_READ, #FILE_SHARE_READ | #FILE_SHARE_WRITE, #NUL, #OPEN_EXISTING, 0,  #NUL)
If hDevice <> #INVALID_HANDLE_VALUE
	FilePtr = SetFilePointer_(hDevice, #block * 0, #NUL, #FILE_BEGIN)
; 	FilePtr = SetFilePointer_(hDevice, #block * 1, #NUL, #FILE_BEGIN)
	If FilePtr <> #INVALID_SET_FILE_POINTER
		bResult = ReadFile_(hDevice, @Buff(), #block, @dwBytesRead, #NUL);
		If Not (bResult And dwBytesRead = #block)
			End
		EndIf
	EndIf
	CloseHandle_(hDevice)
; 	MessageRequester("", Str(dwBytesRead))
	ShowMemoryViewer(@Buff(), ArraySize(Buff()))
EndIf

Define i, j, res.s, c16 = 16, symbol.s
For i=0 To 511
	res + RSet(Hex(Buff(i)), 2, "0") + " "
	c16 - 1
	If c16 = 0
		res + "    "
		For j=i-15 To i
			If Buff(j) = 0
				symbol = "."
; 			ElseIf Buff(j) = 9 Or Buff(j) = 10 Or Buff(j) = 13 Or Buff(j) = 11
			ElseIf Buff(j) < 32
				symbol = " "
			Else
				symbol = Chr(Buff(j))
			EndIf
			res + symbol
		Next
		res + #CRLF$
		c16 = 16
	EndIf
Next
res = RSet(res , Len(res) - 2)

#Editor = 1
If OpenWindow(0, 0, 0,570+10, 590+10, "Beginning of disk 0", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	EditorGadget(#Editor , 5, 5, 560+10, 580+10, #PB_Editor_ReadOnly)
	SetGadgetText(#Editor, res)
	SendMessage_(GadgetID(#Editor),#WM_SETFONT,LoadFont(1,"Consolas",11,0),1)

	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_CloseWindow
				CloseWindow(0)
				End
		EndSelect
	ForEver
EndIf

And now any file and shift by 512

Code: Select all

; AZJIO

EnableExplicit

Enumeration
	#Editor
	#btnOpen
	#btnPrev
	#btnNext
	#btnFind
EndEnumeration

; Wilbert
; https://www.purebasic.fr/english/viewtopic.php?p=525097#p525097
XIncludeFile "FindData.pbi"
UseModule FindData

#Window = 0
#block   = 512
Global Dim Buff.a(#block)
Global res.s, flgFO = 0, hDevice, PosFile = 0, tmp$, FSize.q, CurPath$


Procedure Fill(Array Buff.a(1))
	Protected i, j, c16 = 16, symbol.s
	res = ""
	For i = 0 To 511
		res + RSet(Hex(Buff(i)), 2, "0") + " "
		c16 - 1
		If c16 = 0
			res + "    "
			For j = i - 15 To i
				If Buff(j) = 0
					symbol = "."
					; 			ElseIf Buff(j) = 9 Or Buff(j) = 10 Or Buff(j) = 13 Or Buff(j) = 11
				ElseIf Buff(j) < 32
					symbol = " "
				Else
					symbol = Chr(Buff(j))
				EndIf
				res + symbol
			Next
			res + #CRLF$
			c16 = 16
		EndIf
	Next
	res = RSet(res , Len(res) - 2)
	SetGadgetText(#Editor, res)
EndProcedure

Procedure FileNext()
	Protected bResult.b, dwBytesRead.l, FilePtr.l
	FilePtr = SetFilePointer_(hDevice, #block * PosFile, #NUL, #FILE_BEGIN)
	If FilePtr <> #INVALID_SET_FILE_POINTER And FilePtr < FSize
		bResult = ReadFile_(hDevice, @Buff(), #block, @dwBytesRead, #NUL);
		If bResult And dwBytesRead <> 0
			If dwBytesRead < #block
				FillMemory(@Buff() + dwBytesRead , #block - dwBytesRead, 0, #PB_Ascii)
			EndIf
			flgFO = 1
			Fill(Buff())
		EndIf
	Else
		PosFile - 1
	EndIf
; 	MessageRequester("", Str(dwBytesRead))
; 	ShowMemoryViewer(@Buff(), ArraySize(Buff()))
EndProcedure

Procedure OpenFile2(tmp$)
	If flgFO
		CloseHandle_(hDevice)
		flgFO = 0
	EndIf
	PosFile = 0
	; hDevice = CreateFile_("\\.\PhysicalDrive0", #GENERIC_READ, #FILE_SHARE_READ | #FILE_SHARE_WRITE, #NUL, #OPEN_EXISTING, 0,  #NUL)
	hDevice = CreateFile_("\\?\" + tmp$, #GENERIC_READ, #FILE_SHARE_READ | #FILE_SHARE_WRITE, #NUL, #OPEN_EXISTING, 0,  #NUL)
	If hDevice <> #INVALID_HANDLE_VALUE
		FileNext()
	EndIf
EndProcedure

Procedure BinFind()
	Protected length.q, Input$, *mem, BPos, *memFind, bytes
	Input$ = InputRequester("Найти", "Введите текст", "")
	If Asc(Input$) And flgFO And FSize < 10000000
		If ReadFile(0, CurPath$, #PB_File_SharedRead)
			length = Lof(0)
			*mem = AllocateMemory(length)
			If *mem
				bytes = ReadData(0, *mem, length)
				*memFind = Ascii(Input$)
				BPos = FastSearch(*mem, bytes, *memFind, StringByteLength(Input$, #PB_Ascii))
				If BPos <> -1
					PosFile = BPos / #block
					FileNext()
					SetWindowTitle(0, "block: " + Str(PosFile))
				EndIf
				FreeMemory(*memFind)
				FreeMemory(*mem)
			EndIf
			CloseFile(0)
		EndIf
	EndIf
EndProcedure

If OpenWindow(#Window, 0, 0, 570 + 10, 630 + 10, "Hex view", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	EditorGadget(#Editor , 5, 5, 560 + 10, 580 + 10, #PB_Editor_ReadOnly)
	
	SendMessage_(GadgetID(#Editor), #WM_SETFONT, LoadFont(1, "Consolas", 11, 0), 1)
	ButtonGadget(#btnOpen, 10, 605, 70, 30, "Open")
	ButtonGadget(#btnPrev, 90, 605, 30, 30, "<")
	ButtonGadget(#btnNext, 130, 605, 30, 30, ">")
	ButtonGadget(#btnFind, 170, 605, 70, 30, "Find")
	
	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #btnOpen
						tmp$ = OpenFileRequester("Open file", GetCurrentDirectory(), "all (*.*)|*", 0)
						If Asc(tmp$)
							FSize = FileSize(tmp$)
							If FSize > 0
								CurPath$ = tmp$
								OpenFile2(tmp$)
								tmp$ = ""
							EndIf
						EndIf
					Case #btnPrev
						If flgFO = 0
							Continue
						EndIf
						PosFile - 1
						If PosFile < 0
							PosFile = FSize / #block
						EndIf
						FileNext()
						SetWindowTitle(#Window, "block: " + Str(PosFile))
					Case #btnNext
						If flgFO = 0
							Continue
						EndIf
						PosFile + 1
						FileNext()
						SetWindowTitle(#Window, "block: " + Str(PosFile))
					Case #btnFind
						BinFind()
				EndSelect
			Case #PB_Event_CloseWindow
				If flgFO
					CloseHandle_(hDevice)
				EndIf
				CloseWindow(#Window)
				Break
		EndSelect
	ForEver
EndIf

infratec · Post by **infratec** » Fri Mar 11, 2022 8:17 am

Save it as ConvertToHex.pbi

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf


DataSection
  HexChars:
  Data.a '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
EndDataSection


Structure HexCharStructure
  Nibble.a[0]
EndStructure


Procedure.s MemoryToHex(*Ptr.Ascii, Length.i, ValuesPerLine.i=16, ShowString.i=#True)
  
  Protected Result$, ShowString$, ValueCounter.i, *EndPtr, Byte.a, *HexChar.HexCharStructure
  
  
  *HexChar = ?HexChars
  *EndPtr = *Ptr + Length
  While *Ptr < *EndPtr
    Byte = *Ptr\a
    ;Result$ + RSet(Hex(Byte), 2, "0") + " "
    Result$ + Chr(*HexChar\Nibble[Byte >> 4]) + Chr(*HexChar\Nibble[Byte & $0F]) + " "
    If ShowString
      If Byte >= ' '
        ShowString$ + Chr(*Ptr\a)
      Else
        ShowString$ + "."
      EndIf
    EndIf
    ValueCounter + 1
    *Ptr + 1
    
    If ValueCounter % ValuesPerLine = 0
      If ShowString
        Result$ + " " + ShowString$
      Else
        Result$ = RTrim(Result$, " ")
      EndIf
      ShowString$ = ""
      Result$ + #LF$
    EndIf
  Wend
  
  If ShowString
    Result$ + Space(3 * ValuesPerLine - (ValueCounter % ValuesPerLine) * 3) + " " + ShowString$
  Else
    Result$ = RTrim(Result$, " ")
  EndIf
  
  ProcedureReturn Result$
  
EndProcedure




Procedure.s StringToHex(String$, ValuesPerLine.i=16, Format.i=#PB_Unicode, ShowTrailingZero.i=#True, ShowString.i=#True)
  
  Protected Result$, *Ptr, *Buffer, Length.i
  
  
  Select Format
    Case #PB_Ascii
      *Buffer = Ascii(String$)
      *Ptr = *Buffer
      Length = MemorySize(*Buffer)
      If Not ShowTrailingZero
        Length - 1
      EndIf
      
    Case #PB_UTF8
      *Buffer = UTF8(String$)
      *Ptr = *Buffer
      Length = MemorySize(*Buffer)
      If Not ShowTrailingZero
        Length - 1
      EndIf
      
    Default
      *Ptr = @String$
      Length = StringByteLength(String$)
      If ShowTrailingZero
        Length + 2
      EndIf
      
  EndSelect
  
  Result$ = MemoryToHex(*Ptr, Length, ValuesPerLine, ShowString)
  
  If *Buffer
    FreeMemory(*Buffer)
  EndIf
  
  ProcedureReturn Result$
  
EndProcedure




CompilerIf #PB_Compiler_IsMainFile
  Debug StringToHex("Hello World äöüß")
  Debug ""
  Debug StringToHex("Hello World äöüß", 10)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Ascii)
  Debug ""
  Debug StringToHex("Hello World äöüß", 8, #PB_UTF8)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #False)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #False, #False)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #True, #False)
CompilerEndIf

camille · Post by **camille** » Fri Mar 11, 2022 9:03 am

@All Thank you!

@infratec

That's absolutely perfect and works exactly as I need it to. Brilliant!

infratec · Post by **infratec** » Fri Mar 11, 2022 10:27 pm

I fixed a missing FreeMemory() and reduced the code size with a loop for unicode.

infratec · Post by **infratec** » Mon Mar 14, 2022 8:25 am

To be more flexible I rewrote that stuff and use now MemoryToHex() as a procedure call inside StringToHex().

AZJIO · Post by **AZJIO** » Mon Mar 14, 2022 10:39 am

infratec
Maybe it makes sense to make an array of data. Calculations will be faster. Use CopyMemoryString.
Instead Result$ + RSet(Hex(Byte), 2, "0") + " "
Result$ + aHex(Byte) + " "

Code: Select all

Procedure StrToArrLetter1(Array Arr.s{2}(1), String$)
	Protected LenStr, i
	LenStr = Len(String$) / 2
	If LenStr
		ReDim Arr(LenStr - 1)
		PokeS(Arr(), String$, -1, #PB_String_NoZero)
	EndIf
	ProcedureReturn
EndProcedure

Global Dim aHex.s{2}(0)
StrToArrLetter1(aHex(), "0001020304..") ; ArraySize = 256

For Byte=0 To ArraySize(aHex())
	Debug aHex(Byte)
Next

infratec · Post by **infratec** » Mon Mar 14, 2022 9:10 pm

I replaced

Code: Select all

RSet(Hex(Byte, 2, "0"))

Maybe it is a bit faster now.

AZJIO · Post by **AZJIO** » Tue Mar 15, 2022 12:49 am

infratec
16K file appends rows 16000*3 times. This is the main problem. This runs in 1600 ms.
If you join strings using CopyMemoryString, then this is done in 5 ms.
By the way both your versions are executed for one and too time.

Code: Select all

EnableExplicit

Enumeration
	#Editor
	#btnOpen
EndEnumeration

#Window = 0
Global tmp$, FSize.q

Global Dim aHex.s{2}(255)

Define i
For i = 0 To 255
	aHex(i) = RSet(Hex(i), 2, "0")
Next
; For i = 0 To 255
; 	Debug aHex(i)
; Next

Procedure.s JoinL2(List StringList.s())

	Protected.i slen, tlen, *buffer
	ForEach StringList()
		tlen + Len(StringList())
	Next

	Protected Dim buffer.c(tlen)
	*buffer = @buffer()
	If FirstElement(StringList())
		CopyMemoryString(StringList(), @*buffer)
		While NextElement(StringList())
			CopyMemoryString(StringList())
		Wend
	EndIf

	ProcedureReturn PeekS(@buffer())

EndProcedure

Procedure.s MemoryToHex(*Ptr.Ascii, Length.i, ValuesPerLine.i = 16, ShowString.i = #True)

	Protected Result$, ShowString$, ValueCounter.i, *EndPtr, Byte.a
	Protected NewList TextL.s()


	*EndPtr = *Ptr + Length
	While *Ptr < *EndPtr
		Byte = *Ptr\a
		AddElement(TextL())
		TextL() = aHex(Byte) + " "
		If ShowString
			If Byte >= ' '
				ShowString$ + Chr(*Ptr\a)
			Else
				ShowString$ + "."
			EndIf
		EndIf
		ValueCounter + 1
		*Ptr + 1

		If ValueCounter % ValuesPerLine = 0

			If ShowString
				AddElement(TextL())
				TextL() = " " + ShowString$
			Else
				TextL() = RTrim(TextL(), " ")
			EndIf
			ShowString$ = ""
			AddElement(TextL())
			TextL() = #LF$
		EndIf
	Wend

	If ShowString
		AddElement(TextL())
		TextL() = Space(3 * ValuesPerLine - (ValueCounter % ValuesPerLine) * 3) + " " + ShowString$
	Else
		TextL() = RTrim(TextL(), " ")
	EndIf

	Result$ = JoinL2(TextL())

	ProcedureReturn Result$

EndProcedure

Procedure.s OpenFile2(tmp$)
	Protected length.q, *mem, bytes.q, Result$, StartTime
	If ReadFile(0, tmp$)
		length = Lof(0)
		*mem = AllocateMemory(length)
		If *mem
			bytes = ReadData(0, *mem, length)
			StartTime = ElapsedMilliseconds()
			Result$ = MemoryToHex(*mem, bytes)
			; 			Debug "Elapsed time between marks " + Str(ElapsedMilliseconds()-StartTime) + " ms"
			SetWindowTitle(#Window, Str(ElapsedMilliseconds() - StartTime) + " ms")
			FreeMemory(*mem)
		EndIf
		CloseFile(0)
		ProcedureReturn Result$
	EndIf
EndProcedure

If OpenWindow(#Window, 0, 0, 570 + 10, 630 + 10, "Hex view", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	EditorGadget(#Editor , 5, 5, 560 + 10, 580 + 10, #PB_Editor_ReadOnly)

	SendMessage_(GadgetID(#Editor), #WM_SETFONT, LoadFont(1, "Consolas", 11, 0), 1)
	ButtonGadget(#btnOpen, 10, 605, 70, 30, "Open")

	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #btnOpen
						tmp$ = OpenFileRequester("Open file", GetCurrentDirectory(), "all (*.*)|*", 0)
						If Asc(tmp$)
							FSize = FileSize(tmp$)
							If FSize > 0
								SetGadgetText(#Editor, OpenFile2(tmp$))
								tmp$ = ""
							EndIf
						EndIf
				EndSelect
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				Break
		EndSelect
	ForEver
EndIf

test

Code: Select all

EnableExplicit
DisableDebugger

Global Dim aHex.s{2}(255)

Define j, i, z.s, StartTime, tmp$
For i = 0 To 255
	aHex(i) = RSet(Hex(i), 2, "0")
Next

StartTime = ElapsedMilliseconds()
For j = 0 To 10000
	For i = 0 To 255
		z = RSet(Hex(i), 2, "0")
	Next
Next
tmp$ + Str(ElapsedMilliseconds() - StartTime) + " ms" + #CRLF$

StartTime = ElapsedMilliseconds()
For j = 0 To 10000
	For i = 0 To 255
		z = aHex(i)
	Next
Next
tmp$ + Str(ElapsedMilliseconds() - StartTime) + " ms"

MessageRequester("", tmp$)

The length of the string is known, you can reserve memory for one string and copy characters into it.

AZJIO · Post by **AZJIO** » Tue Mar 15, 2022 4:08 am

1 ms (1600 -> 5 -> 1)

Code: Select all

EnableExplicit
; DisableDebugger

Enumeration
	#Editor
	#btnOpen
EndEnumeration

#Window = 0
Global tmp$, FSize.q

Global Dim aHex.s{2}(255)

Define i
For i = 0 To 255
	aHex(i) = RSet(Hex(i), 2, "0")
Next
; For i = 0 To 255
; 	Debug aHex(i)
; Next

Procedure.s MemoryToHex(*Ptr.Ascii, Length.i, ValuesPerLine.i = 16, ShowString.i = #True)
	
	Protected Result$, ValueCounter.i, *EndPtr, Byte.a
	Protected CountStr, CountMem, *MemAll, tmp$, *MemPoint, *MemSwSt, *MemSwStPoint
; 	remainder = Length % ValuesPerLine
; 	CountStr = Length / ValuesPerLine + 1
; 	CountMem = CountStr * ValuesPerLine * 12
; 	CountMem = Length * 9
	*MemAll = AllocateMemory((Length / ValuesPerLine + 1) * (ValuesPerLine * 4 + 2) * 2)
	*MemPoint = *MemAll
	If *MemAll
; 	Debug CountMem; 
; 	CopyMemoryString(@"", @*MemPoint)
	*MemSwSt = AllocateMemory(ValuesPerLine * 2 + 2)
	*MemSwStPoint = *MemSwSt
	
	
	*EndPtr = *Ptr + Length
	While *Ptr < *EndPtr
		CopyMemoryString(aHex(*Ptr\a) + " ", @*MemPoint)
		If *Ptr\a >= ' '
			CopyMemoryString(Chr(*Ptr\a), @*MemSwStPoint)
		Else
			CopyMemoryString(".", @*MemSwStPoint)
		EndIf
		ValueCounter + 1
		*Ptr + 1
		
		If ValueCounter % ValuesPerLine = 0
; 			Debug StringByteLength(PeekS(*MemSwSt, -1, #PB_Unicode))
			CopyMemoryString(" " + PeekS(*MemSwSt, -1, #PB_Unicode) + #LF$, @*MemPoint)
			*MemSwStPoint = *MemSwSt
		EndIf
	Wend
	If Length % ValuesPerLine
		CopyMemoryString(Space(3 * ValuesPerLine - (ValueCounter % ValuesPerLine) * 3) + " " + PeekS(*MemSwSt, -1, #PB_Unicode), @*MemPoint)
	Else
		CopyMemory(*MemPoint, *MemPoint - 2 , 1)
; 		Result$ = RTrim(Result$, #LF$)
	EndIf
	Result$ = PeekS(*MemAll, -1, #PB_Unicode)
	; 	Debug Result$
; 	Debug Length * 9
; 	Debug CountStr * ValuesPerLine * 9
; 	Debug (Length / ValuesPerLine + 1) * (ValuesPerLine * 4 + 2) * 2
; 	CountStr = Length / ValuesPerLine + 1
; 	CountMem = CountStr * ValuesPerLine * 12
; 	Debug StringByteLength(Result$)
	FreeMemory(*MemAll)
	FreeMemory(*MemSwSt)
	EndIf
	ProcedureReturn Result$
	
EndProcedure

Procedure.s OpenFile2(tmp$)
	Protected length.q, *mem, bytes.q, Result$, StartTime
	If ReadFile(0, tmp$)
		length = Lof(0)
		*mem = AllocateMemory(length)
		If *mem
			bytes = ReadData(0, *mem, length)
			StartTime = ElapsedMilliseconds()
			Result$ = MemoryToHex(*mem, bytes)
			; 			Debug "Elapsed time between marks " + Str(ElapsedMilliseconds()-StartTime) + " ms"
			SetWindowTitle(#Window, Str(ElapsedMilliseconds() - StartTime) + " ms")
			FreeMemory(*mem)
		EndIf
		CloseFile(0)
		ProcedureReturn Result$
	EndIf
EndProcedure

If OpenWindow(#Window, 0, 0, 570 + 10, 630 + 10, "Hex view", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	EditorGadget(#Editor , 5, 5, 560 + 10, 580 + 10, #PB_Editor_ReadOnly)
	
	SendMessage_(GadgetID(#Editor), #WM_SETFONT, LoadFont(1, "Consolas", 11, 0), 1)
	ButtonGadget(#btnOpen, 10, 605, 70, 30, "Open")
	
	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #btnOpen
						tmp$ = OpenFileRequester("Open file", GetCurrentDirectory(), "all (*.*)|*", 0)
						If Asc(tmp$)
							FSize = FileSize(tmp$)
							If FSize > 0
								SetGadgetText(#Editor, OpenFile2(tmp$))
								tmp$ = ""
							EndIf
						EndIf
				EndSelect
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				Break
		EndSelect
	ForEver
EndIf

infratec · Post by **infratec** » Tue Mar 15, 2022 8:06 am

Everything depends on your needs.

The request was not for a big file, it was for a string.
If there is realy the need for fast execution, I would write that stuff in assembler, but then the most users can not follow the code.

Joris · Post by **Joris** » Tue Mar 15, 2022 9:28 am

Our friend Wilbert has made some assembler code for this.
Somewhere on the forum...

infratec · Post by **infratec** » Tue Mar 15, 2022 12:02 pm

For the speed freaks:

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf


DataSection
  HexChars:
  Data.a '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
EndDataSection


Structure HexCharStructure
  Nibble.a[0]
EndStructure


Procedure.s MemoryToHex(*Ptr.Ascii, Length.i, ValuesPerLine.i=16, ShowString.i=#True)
  
  Protected Result$, ShowString$, ValueCounter.i, *EndPtr, Byte.a, *HexChar.HexCharStructure, *LineBuffer, *HexLinePtr.Ascii, *AscLinePtr.Ascii, MaxLines.i
  
  
  MaxLines = Length / ValuesPerLine + 1
  
  If ShowString
    *LineBuffer = AllocateMemory((ValuesPerLine * 6 + 4) * MaxLines + (ValuesPerLine * 2 + 2 + 2) * MaxLines + 2 * MaxLines)
    *AscLinePtr = *LineBuffer + ValuesPerLine * 6
    *AscLinePtr\a = ' '
  Else
    *LineBuffer = AllocateMemory((ValuesPerLine * 6 + 2) * MaxLines + 2 * MaxLines)
  EndIf
  
  *HexChar = ?HexChars
  *EndPtr = *Ptr + Length
  *HexLinePtr = *LineBuffer
  *AscLinePtr = *LineBuffer + ValuesPerLine * 6 + 2
  While *Ptr < *EndPtr
    Byte = *Ptr\a
    *HexLinePtr\a = *HexChar\Nibble[Byte >> 4]
    *HexLinePtr + 2
    *HexLinePtr\a = *HexChar\Nibble[Byte & $0F]
    *HexLinePtr + 2
    *HexLinePtr\a = ' '
    *HexLinePtr + 2
    If ShowString
      If Byte >= ' '
        *AscLinePtr\a = Byte
      Else
        *AscLinePtr\a = '.'
      EndIf
      *AscLinePtr + 2
    EndIf
    ValueCounter + 1
    *Ptr + 1
    
    If ValueCounter % ValuesPerLine = 0
      If ShowString
        *AscLinePtr\a = #LF
        *HexLinePtr + ValuesPerLine * 2 + 2 + 2
        *AscLinePtr = *HexLinePtr + ValuesPerLine * 6
        *AscLinePtr\a = ' '
        *AscLinePtr + 2
      Else
        *HexLinePtr\a = #LF
        *HexLinePtr + 2
      EndIf
    EndIf
  Wend
  
  If ShowString
    *AscLinePtr\a = 0
    While *HexLinePtr\a <> ' '
      *HexLinePtr\a = ' '
      *HexLinePtr + 2
    Wend
  Else
    *HexLinePtr\a = 0
  EndIf
  
  Result$ = PeekS(*LineBuffer)
  
  FreeMemory(*LineBuffer)
  
  ProcedureReturn Result$
  
EndProcedure




Procedure.s StringToHex(String$, ValuesPerLine.i=16, Format.i=#PB_Unicode, ShowTrailingZero.i=#True, ShowString.i=#True)
  
  Protected Result$, *Ptr, *Buffer, Length.i
  
  
  Select Format
    Case #PB_Ascii
      *Buffer = Ascii(String$)
      *Ptr = *Buffer
      Length = MemorySize(*Buffer)
      If Not ShowTrailingZero
        Length - 1
      EndIf
      
    Case #PB_UTF8
      *Buffer = UTF8(String$)
      *Ptr = *Buffer
      Length = MemorySize(*Buffer)
      If Not ShowTrailingZero
        Length - 1
      EndIf
      
    Default
      *Ptr = @String$
      Length = StringByteLength(String$)
      If ShowTrailingZero
        Length + 2
      EndIf
      
  EndSelect
  
  Result$ = MemoryToHex(*Ptr, Length, ValuesPerLine, ShowString)
  
  If *Buffer
    FreeMemory(*Buffer)
  EndIf
  
  ProcedureReturn Result$
  
EndProcedure




CompilerIf #PB_Compiler_IsMainFile
  Debug StringToHex("Hello World äöüß")
  Debug ""
  Debug StringToHex("Hello World äöüß", 10)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Ascii)
  Debug ""
  Debug StringToHex("Hello World äöüß", 8, #PB_UTF8)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #False)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #False, #False)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #True, #False)
  Debug ""
  
  Define Filename$, File.i, *Buffer, StartTime.q, Hex$, EndTime.q
  
  Filename$ = OpenFileRequester("Choose a file", "", "All|*.*", 0)
  If Filename$
    File = ReadFile(#PB_Any, Filename$)
    If File
      *Buffer = AllocateMemory(Lof(File), #PB_Memory_NoClear)
      If *Buffer
        If ReadData(File, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
          StartTime = ElapsedMilliseconds()
          Hex$ = MemoryToHex(*Buffer, MemorySize(*Buffer))
          EndTime = ElapsedMilliseconds()
          ;Debug Hex$
          MessageRequester("MemoryToHex", StrF((EndTime - StartTime) / 1000, 3))
          
          LoadFont(0, "Courier New", 10)
          SetGadgetFont(#PB_Default, FontID(0))
          OpenWindow(0, 0, 0, 600, 400, "Memory2Hex", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
          EditorGadget(0, 0, 0, 600, 400)
          SetGadgetText(0, Hex$)
          Repeat
          Until WaitWindowEvent() = #PB_Event_CloseWindow
          
        EndIf
        FreeMemory(*Buffer)
      EndIf
      CloseFile(File)
    EndIf
  EndIf
CompilerEndIf

No copy stuff, no adding of strings, only one PeekS() at the end.

infratec · Post by **infratec** » Tue Mar 15, 2022 1:00 pm

A version which needs only half of the RAM
(but the output takes longer, don't know why)

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf


DataSection
  HexChars:
  Data.a '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
EndDataSection


Structure HexCharStructure
  Nibble.a[0]
EndStructure


Procedure.s MemoryToHex(*Ptr.Ascii, Length.i, ValuesPerLine.i=16, ShowString.i=#True)
  
  Protected Result$, ShowString$, ValueCounter.i, *EndPtr, Byte.a, *HexChar.HexCharStructure, *LineBuffer, *HexLinePtr.Ascii, *AscLinePtr.Ascii, MaxLines.i
  
  
  MaxLines = Length / ValuesPerLine + 1
  
  If ShowString
    *LineBuffer = AllocateMemory((ValuesPerLine * 3 + 2) * MaxLines + (ValuesPerLine + 1 + 1) * MaxLines + MaxLines, #PB_Memory_NoClear)
    *AscLinePtr = *LineBuffer + ValuesPerLine * 3
    *AscLinePtr\a = ' '
  Else
    *LineBuffer = AllocateMemory((ValuesPerLine * 3 + 1) * MaxLines + MaxLines, #PB_Memory_NoClear)
  EndIf
  
  *HexChar = ?HexChars
  *EndPtr = *Ptr + Length
  *HexLinePtr = *LineBuffer
  *AscLinePtr = *LineBuffer + ValuesPerLine * 3 + 1
  While *Ptr < *EndPtr
    Byte = *Ptr\a
    *HexLinePtr\a = *HexChar\Nibble[Byte >> 4]
    *HexLinePtr + 1
    *HexLinePtr\a = *HexChar\Nibble[Byte & $0F]
    *HexLinePtr + 1
    *HexLinePtr\a = ' '
    *HexLinePtr + 1
    If ShowString
      If Byte >= ' '
        *AscLinePtr\a = Byte
      Else
        *AscLinePtr\a = '.'
      EndIf
      *AscLinePtr + 1
    EndIf
    ValueCounter + 1
    *Ptr + 1
    
    If ValueCounter = ValuesPerLine
      If ShowString
        *AscLinePtr\a = #LF
        *HexLinePtr + ValuesPerLine + 1 + 1
        *AscLinePtr = *HexLinePtr + ValuesPerLine * 3
        *AscLinePtr\a = ' '
        *AscLinePtr + 1
      Else
        *HexLinePtr\a = #LF
        *HexLinePtr + 1
      EndIf
      ValueCounter = 0
    EndIf
  Wend
  
  If ShowString
    *AscLinePtr\a = 0
    While ValueCounter < ValuesPerLine
      *HexLinePtr\a = ' '
      *HexLinePtr + 1
      *HexLinePtr\a = ' '
      *HexLinePtr + 1
      *HexLinePtr\a = ' '
      *HexLinePtr + 1
      ValueCounter + 1
    Wend
  Else
    *HexLinePtr\a = 0
  EndIf
  
  Result$ = PeekS(*LineBuffer, -1, #PB_Ascii)
  
  FreeMemory(*LineBuffer)
  
  ProcedureReturn Result$
  
EndProcedure




Procedure.s StringToHex(String$, ValuesPerLine.i=16, Format.i=#PB_Unicode, ShowTrailingZero.i=#True, ShowString.i=#True)
  
  Protected Result$, *Ptr, *Buffer, Length.i
  
  
  Select Format
    Case #PB_Ascii
      *Buffer = Ascii(String$)
      *Ptr = *Buffer
      Length = MemorySize(*Buffer)
      If Not ShowTrailingZero
        Length - 1
      EndIf
      
    Case #PB_UTF8
      *Buffer = UTF8(String$)
      *Ptr = *Buffer
      Length = MemorySize(*Buffer)
      If Not ShowTrailingZero
        Length - 1
      EndIf
      
    Default
      *Ptr = @String$
      Length = StringByteLength(String$)
      If ShowTrailingZero
        Length + 2
      EndIf
      
  EndSelect
  
  Result$ = MemoryToHex(*Ptr, Length, ValuesPerLine, ShowString)
  
  If *Buffer
    FreeMemory(*Buffer)
  EndIf
  
  ProcedureReturn Result$
  
EndProcedure




CompilerIf #PB_Compiler_IsMainFile
  Debug StringToHex("Hello World äöüß")
  Debug ""
  Debug StringToHex("Hello World äöüß", 10)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Ascii)
  Debug ""
  Debug StringToHex("Hello World äöüß", 8, #PB_UTF8)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #False)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #False, #False)
  Debug ""
  Debug StringToHex("Hello World äöüß", 16, #PB_Unicode, #True, #False)
  Debug ""
  
  Define Filename$, File.i, *Buffer, StartTime.q, Hex$, EndTime.q
  
  Filename$ = OpenFileRequester("Choose a file", "", "All|*.*", 0)
  If Filename$
    File = ReadFile(#PB_Any, Filename$)
    If File
      *Buffer = AllocateMemory(Lof(File), #PB_Memory_NoClear)
      If *Buffer
        If ReadData(File, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
          StartTime = ElapsedMilliseconds()
          Hex$ = MemoryToHex(*Buffer, MemorySize(*Buffer))
          EndTime = ElapsedMilliseconds()
          ;Debug Hex$
          ;MessageRequester("MemoryToHex", StrF((EndTime - StartTime) / 1000, 3))
          
          LoadFont(0, "Courier New", 10)
          SetGadgetFont(#PB_Default, FontID(0))
          OpenWindow(0, 0, 0, 600, 400, "MemoryToHex", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
          EditorGadget(0, 0, 0, 600, 380)
          CreateStatusBar(0, WindowID(0))
          AddStatusBarField(100)
          StatusBarText(0, 0, "Time: " + StrF((EndTime - StartTime) / 1000, 3) + "s", #PB_StatusBar_Center)
          
          SetGadgetText(0, Hex$)
          
          Repeat
          Until WaitWindowEvent() = #PB_Event_CloseWindow
          
        EndIf
        FreeMemory(*Buffer)
      EndIf
      CloseFile(File)
    EndIf
  EndIf
CompilerEndIf

Maybe this can be better optimized with the C compiler because + 1 instead of + 2 which means INC instead of ADD.

PureBasic Forums - English

Convert string to hex with a specific format?

Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?

Re: Convert string to hex with a specific format?