Convert string to hex with a specific format?

[infratec]

Small improvement for the last version:

Now the allocated memory is not cleared, which saves a bit of time.
For that I need to change the last line stuff after the loop.

[infratec]

I added the possibility to add addresses in front.
But I placed the code in Tricks 'n' Tips:

https://www.purebasic.fr/english/viewtopic.php?t=78858

[AZJIO]

with addresses
with search

Code: Select all

EnableExplicit
; DisableDebugger

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

Declare BinFind()

#Window = 0
Global tmp$, FSize.q
Global NewList FindPosL()
Global CurPath$

Global Dim aHex.s{2}(255)

Define i
For i = 0 To 255
	aHex(i) = RSet(Hex(i), 2, "0")
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, x
	*MemAll = AllocateMemory((Length / ValuesPerLine + 1) * (ValuesPerLine * 4 + 2 + 9) * 2)
	*MemPoint = *MemAll
	If *MemAll
		; 	CopyMemoryString(@"", @*MemPoint)
		*MemSwSt = AllocateMemory(ValuesPerLine * 2 + 2)
		*MemSwStPoint = *MemSwSt

		x = 0
		CopyMemoryString(RSet(Hex(x, #PB_Quad), 8, "0") + #TAB$, @*MemPoint)

		*EndPtr = *Ptr + Length
		While *Ptr < *EndPtr

			CopyMemoryString(aHex(*Ptr\a) + " ", @*MemPoint)
			If *Ptr\a >= ' '
				CopyMemoryString(Chr(*Ptr\a), @*MemSwStPoint)
			Else
				CopyMemoryString(".", @*MemSwStPoint)
			EndIf
			*Ptr + 1
			ValueCounter + 1


			If ValueCounter % ValuesPerLine = 0
				; Debug StringByteLength(PeekS(*MemSwSt, -1, #PB_Unicode))
				; 			*MemPoint - 2
				CopyMemoryString(" " + PeekS(*MemSwSt, -1, #PB_Unicode) + #LF$, @*MemPoint)
				*MemSwStPoint = *MemSwSt
				x + 16
				CopyMemoryString(RSet(Hex(x, #PB_Quad), 8, "0") + #TAB$, @*MemPoint)
			EndIf
		Wend
		If Length % ValuesPerLine
			CopyMemoryString(Space(3 * ValuesPerLine - (ValueCounter % ValuesPerLine) * 3) + " " + PeekS(*MemSwSt, -1, #PB_Unicode), @*MemPoint)
		Else
			CopyMemory(*MemPoint, *MemPoint - (2 * 10) , 1)
			; 		Result$ = RTrim(Result$, #LF$)
		EndIf
		Result$ = PeekS(*MemAll, -1, #PB_Unicode)
		Debug Str((Length / ValuesPerLine + 1) * (ValuesPerLine * 4 + 2 + 9) * 2) + " - calculate"
		Debug Str(StringByteLength(Result$)) + " - required"
		FreeMemory(*MemAll)
		FreeMemory(*MemSwSt)
	EndIf
	ProcedureReturn Result$

EndProcedure

Procedure.s OpenFile2(tmp$)
	Protected length.q, *mem, bytes.q, Result$, StartTime, EndTime
	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"
			EndTime = ElapsedMilliseconds()
			SetWindowTitle(#Window, Str(FSize) + " bytes,  Time: " + StrF((EndTime - StartTime) / 1000, 3) + "s")
			; 			SetWindowTitle(#Window, Str(FSize) + " bytes, " + Str(ElapsedMilliseconds() - StartTime) + " ms")
			FreeMemory(*mem)
		EndIf
		CloseFile(0)
		ProcedureReturn Result$
	EndIf
EndProcedure

If OpenWindow(#Window, 0, 0, 670 + 10, 630 + 10, "Hex view", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	EditorGadget(#Editor , 5, 5, 660 + 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(#btnFind, 170, 605, 70, 30, "Find")
; 	ButtonGadget(#btnPrev, 250, 605, 30, 30, "<")
; 	ButtonGadget(#btnNext, 290, 605, 30, 30, ">")

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



Procedure BinFind()
	Protected length.q, Input$, *mem, BPos, bytes
	Protected line, remainder, PosFind, PosFind0, PosFind3, pos, posEnd, Size, *Buffer, NewList BinList.s()
	If Asc(CurPath$) And FSize < 10000000
		Input$ = InputRequester("Найти", "Введите текст", "")
		If Asc(Input$)
			If ReadFile(0, CurPath$, #PB_File_SharedRead)
				length = Lof(0)
				*mem = AllocateMemory(length)
				If *mem
					bytes = ReadData(0, *mem, length)
					If bytes
						pos = *mem
						posEnd = *mem + bytes
						While pos < posEnd
							If AddElement(BinList())
								BinList() = PeekS(pos, -1, #PB_Ascii)
								pos + StringByteLength(BinList(), #PB_Ascii) + 1
							EndIf
						Wend
						ClearList(FindPosL())
						; Debug ListSize(BinList())
						ForEach BinList()
							PosFind0 + 1
							If Asc(BinList())
								PosFind = FindString(BinList(), Input$, 1, #PB_String_NoCase)
								If PosFind
									AddElement(FindPosL())
									FindPosL() = PosFind0 + PosFind
									line = FindPosL()  / 16
									remainder = FindPosL()  % 16
									PosFind3 = line * (16 * 4 + 2 + 9) + 56 + remainder
									SendMessage_(GadgetID(#Editor), #EM_SETSEL, PosFind3, PosFind3 + Len(Input$))
									; MessageRequester("", "line = " + Str(line) + " " + Str(PosFind3))
									Break
								EndIf
								PosFind0 + Len(BinList())
							EndIf
						Next
					EndIf
					FreeMemory(*mem)
				EndIf
				CloseFile(0)
			EndIf
		EndIf
	EndIf
EndProcedure