I developed the following function to convert strings to hex values.
function StrToHex(const S: String): String;
const
HexDigits: array[0..15] of Char = '0123456789ABCDEF';
var
I: Integer;
P1: PChar;
P2: PChar;
B: Byte;
begin
SetLength(Result, Length(S) * 2);
P1 := #S[1];
P2 := #Result[1];
for I := 1 to Length(S) do
begin
B := Byte(P1^);
P2^ := HexDigits[B shr 4];
Inc(P2);
P2^ := HexDigits[B and $F];
Inc(P1);
Inc(P2);
end;
end;
Now I was wondering whether there is a more efficient way to convert the strings?
Depending on your Delphi version:
D5-D2007
uses classes;
function String2Hex(const Buffer: Ansistring): string;
begin
SetLength(result, 2*Length(Buffer));
BinToHex(#Buffer[1], #result[1], Length(Buffer));
end;
D2009+
uses classes;
function String2Hex(const Buffer: Ansistring): string;
begin
SetLength(result, 2*Length(Buffer));
BinToHex(#Buffer[1], PWideChar(#result[1]), Length(Buffer));
end;
Try this one
function String2Hex(const Buffer: Ansistring): string;
var
n: Integer;
begin
Result := '';
for n := 1 to Length(Buffer) do
Result := LowerCase(Result + IntToHex(Ord(Buffer[n]), 2));
end;
I know this is a very old topic, but I feel like I kinda need to share my code regarding the question. For years I use my own HexEncode, very similar with Forlan's code up there, but just today I found a faster way to encode Hex. With my old HexEncode, encoding a 180kb binary file took about 50 seconds, while with this function it took up 6 seconds.
function getHexEncode(txt : AnsiString) : AnsiString;
var
a : integer ;
st : TStringStream;
buf : array [0..1] of AnsiChar;
tmp : ShortString;
begin
st := TStringStream.Create;
st.Size := Length(txt)*2;
st.Position := 0;
for a:=1 to Length(txt) do
begin
tmp := IntToHex(Ord(txt[a]),2);
buf[0] := tmp[1];
buf[1] := tmp[2];
st.Write(buf,2);
end;
st.Position := 0;
Result := st.DataString;
st.Free;
//Result := ''; //my old code
//for a:=1 to Length(txt) do Result := Result+IntToHex(Ord(txt[a]),2); //my old code
end;
It seems good enough, you could always have a byte->2 hex digits lookup table, but that (and similar optimizations) seems like overkill to me in most cases.
// StrToInt('$' + MyString);
Oops, did not read the question very good...
Related
I am a newbie in Delphi programming and I need some help. I have a problem with spliting my serial data. This is my code:
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var
DataByte : string;
x, i: integer;
save_data : TStringList;
begin
save_data := TStringList.create;
for x := 0 to Count-1 do begin
ComPort1.ReadStr(DataByte,1);
if DataByte = 'n' then
begin
memo1.Text := '';
end
else
begin
memo1.Text := memo1.Text + DataByte;
Split(' ', DataByte, save_data);
end;
end;
save_gyroX := save_data[0];
save_gyroY := save_data[1];
save_gyroZ := save_data[2];
save_accelX := save_data[3];
save_accelY := save_data[4];
save_accelZ := save_data[5];
SerialProcess();
save_data.Free;
end;
My Split(' ', DataByte, save_data); doesn't work. I don't understand because I just split String data which is taken from the serial port. This is my Split() procedure:
procedure TForm1.Split(const Delimiter: Char; Input: string; const Strings: TStrings) ;
begin
Assert(Assigned(Strings));
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
I do not know why my program is giving me a EStringListError error.
You are calling ReadStr() to read individual bytes, and calling Split() on every byte (except for 'n'). So the TStringList will only ever hold 1 string at a time. Like MBo said, you need to fix your loop to avoid that, eg:
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var
DataByte : string;
x: integer;
save_data : TStringList;
begin
ComPort1.ReadStr(DataByte, Count);
for x := 1 to Length(DataByte) do
begin
if DataByte[x] = 'n' then
begin
Memo1.Text := '';
end
else
begin
Memo1.Text := Memo1.Text + DataByte[x];
end;
end;
save_data := TStringList.create;
try
Split(' ', DataByte, save_data);
save_gyroX := save_data[0];
save_gyroY := save_data[1];
save_gyroZ := save_data[2];
save_accelX := save_data[3];
save_accelY := save_data[4];
save_accelZ := save_data[5];
SerialProcess();
finally
save_data.Free;
end;
end;
That being said, you are not taking into account that the number of bytes you receive for any given OnRxChar event call is arbitrary. It is whatever raw bytes have been read at that exact moment. You are assuming a full string with at least 6 delimited substrings, and that is simply not guaranteed. You need to buffer the raw data as you receive it, and then parse and remove only completed strings from the buffer as needed.
Try something more like this:
var
DataBuffer: string;
// consider using the OnRxBuf event instead...
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var
DataByte : string;
x: integer;
save_data : TStringList;
begin
ComPort1.ReadStr(DataByte, Count);
DataBuffer := DataBuffer + DataByte;
x := Pos('n', DataBuffer);
if x = 0 then Exit;
save_data := TStringList.Create;
try
repeat
DataByte := Copy(DataBuffer, 1, x-1);
Delete(DataBuffer, 1, x);
Memo1.Text := DataByte;
Split(' ', DataByte, save_data);
if save_data.Count >= 6 then
begin
save_gyroX := save_data[0];
save_gyroY := save_data[1];
save_gyroZ := save_data[2];
save_accelX := save_data[3];
save_accelY := save_data[4];
save_accelZ := save_data[5];
SerialProcess();
end;
x := Pos('n', DataBuffer);
until x = 0;
finally
save_data.Free;
end;
end;
if Comport is Dejan Crnila CPort class, then this line
ComPort1.ReadStr(DataByte,1);
replaces Databyte contents every time, and this string always is 1-byte length.
Just read all bytes from buffer with single call
ComPort1.ReadStr(DataByte, Count);
and do work with string
I have been working on a project in Lazarus and have decided to move it to Delphi XE for the time being (due to some limitations).
A brief overview of what is going on:
At runtime I am loading external files and adding them to streams. The streams belong to several different classes that descend from one main object (TObject). These classes are added to a TList from the main object, basically each class has its own stream property and the class is child to the main object.
In this main object I have a save and load procedure:
When saving the object it also saves all the stream data from the other classes to file by using string to stream. The output string here must be base64 encoded as I am saving to XML.
When opening the file, the idea is to decode the base64 string and move it back into the streams just as if it were the original file before it was base64 encoded.
In Lazarus it works, and here is the important code (note, some of it was not written by me).
const
Keys64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';
function Encode64String(S: string): string;
function Decode64String(S: string): string;
function Encode64StringToStream(const Input: TStream; var Output: string): Boolean;
procedure Decode64StringToStream(const Input: string; Output: TStream);
procedure StringToStream(Stream: TStream; const S: string);
function StreamToString(MS: TMemoryStream): string;
implementation
function Encode64String(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Ord(s[i]);
b := b * 256 + x;
a := a + 8;
while a >= 6 do
begin
a := a - 6;
x := b div (1 shl a);
b := b mod (1 shl a);
Result := Result + Keys64[x + 1];
end;
end;
if a > 0 then
begin
x := b shl (6 - a);
Result := Result + Keys64[x + 1];
end;
end;
function Decode64String(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Pos(s[i], Keys64) - 1;
if x >= 0 then
begin
b := b * 64 + x;
a := a + 6;
if a >= 8 then
begin
a := a - 8;
x := b shr a;
b := b mod (1 shl a);
x := x mod 256;
Result := Result + chr(x);
end;
end
else
Exit;
end;
end;
function Encode64StringToStream(const Input: TStream; var Output: string): Boolean;
var
MS: TMemoryStream;
begin
Result := False;
MS := TMemoryStream.Create;
try
Input.Seek(0, soFromBeginning);
MS.CopyFrom(Input, Input.Size);
MS.Seek(0, soFromBeginning);
Output := Encode64String(StreamToString(MS));
finally
MS.Free;
end;
Result := True;
end;
procedure Decode64StringToStream(const Input: string; Output: TStream);
var
MS: TMemoryStream;
begin
try
MS := TMemoryStream.Create;
try
StringToStream(MS, Decode64String(Input));
MS.Seek(0, soFromBeginning);
Output.CopyFrom(MS, MS.Size);
Output.Position := 0;
finally
MS.Free;
end;
except on E: Exception do
raise Exception.Create('stream decode error - ' + E.Message);
end;
end;
procedure StringToStream(Stream: TStream; const S: string);
begin
Stream.Write(Pointer(S)^, Length(S));
end;
function StreamToString(MS: TMemoryStream): string;
begin
SetString(Result, PChar(MS.Memory), MS.Size div SizeOf(Char));
end;
I am 99% sure the problem here is going to be unicode related. It's a shame because I believe Lazarus/Freepascal has always been unicode but not Delphi and so uses different string types making it almost impossible for the less professional users like myself to solve!
To be honest I think all the code above is a bit of a mess, and it feels like I am just trying to guess what to change the strings to without really knowing what I am doing.
My first thought was to change everything from String to AnsiString. This nearly worked one time but when trying to use Decode64StringToStream I got zero data back. Other times the data was not properly saving as base64 encoded format, and sometimes I even got errors like TStream.Seek not implemented or something.
PS, I have read the guides and there is plenty around such as the whitepapers etc on how to migrate old Delphi projects to newer unicode versions and to be honest I am still at a loss with it. I thought replacing string to AnsiString would have been enough, but it seems it isn't.
Any tips, pointers or general advice or clues would be greatly appreciated thanks.
I think what you want to do is:
Convert the Unicode string to UTF-8 encoding. This is often the most space efficient format for Unicode text.
Encode the string using base64.
Then to decode you just reverse the steps.
The code looks like this:
function Encode(const Input: string): AnsiString;
var
utf8: UTF8String;
begin
utf8 := UTF8String(Input);
Result := EncdDecd.EncodeBase64(PAnsiChar(utf8), Length(utf8));
end;
function Decode(const Input: AnsiString): string;
var
bytes: TBytes;
utf8: UTF8String;
begin
bytes := EncdDecd.DecodeBase64(Input);
SetLength(utf8, Length(bytes));
Move(Pointer(bytes)^, Pointer(utf8)^, Length(bytes));
Result := string(utf8);
end;
I have this code that gets called from an injected DLL from a foreign process. It sould read some memory ranges but I sometimes get a segmentation fault at this line DataBuffer := TCharPointer(Address + CharOffset)^;. So is there any way to check if the memory is readable?
function GetCurrentData(Address: Pointer): PChar;
var
DataBuffer: Char;
CharArray: Array of Char;
CharOffset: Integer;
ReadBytes: longword;
begin
CharOffset := 0;
SetLength(CharArray, 0);
repeat
DataBuffer := TCharPointer(Address + CharOffset)^;
CharOffset := CharOffset + 1;
SetLength(CharArray, CharOffset);
CharArray[CharOffset - 1] := DataBuffer;
until (Ord(DataBuffer) = 0);
Result := PChar(#CharArray[0]);
end;
i also tryed to catch the exception but for some reason this is not working. The host programm still crashes.
unit UnitEventBridgeExports;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Windows, ShellAPI, JwaTlHelp32, SimpleIPC;
type
TCharPointer = ^Char;
const
WOWEXE = 'TestProgramm.exe';
var
IPCClient: TSimpleIPCClient;
PID: DWord;
Process: THandle;
procedure EventCalled;
procedure InitializeWoWEventBridge; stdcall;
implementation
function GetProcessIDByName(Exename: String): DWord;
var
hProcSnap: THandle;
pe32: TProcessEntry32;
begin
Result := 0;
hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
if hProcSnap <> INVALID_HANDLE_VALUE then
begin
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(hProcSnap, pe32) = True then
begin
while Process32Next(hProcSnap, pe32) = True do
begin
if pos(Exename, pe32.szExeFile) <> 0 then
Result := pe32.th32ProcessID;
end;
end;
CloseHandle(hProcSnap);
end;
end;
procedure InitializeEventBridge; stdcall;
begin
IPCClient := TSimpleIPCClient.Create(nil);
IPCClient.ServerID := 'EventBridgeServer';
IPCClient.Active := True;
IPCClient.SendStringMessage('init');
PID := GetProcessIDByName(EXE);
Process := OpenProcess(PROCESS_ALL_ACCESS, False, PID);
end;
function GetCurrentData(Address: Pointer): PChar;
var
DataBuffer: Char;
CharArray: Array of Char;
CharOffset: Integer;
ReadBytes: longword;
CharPointer: TCharPointer;
BreakLoop: Boolean;
begin
CharOffset := 0;
SetLength(CharArray, 0);
BreakLoop := False;
repeat
try
CharPointer := TCharPointer(Address + CharOffset);
DataBuffer := CharPointer^;
CharOffset := CharOffset + 1;
SetLength(CharArray, CharOffset);
CharArray[CharOffset - 1] := DataBuffer;
except
BreakLoop := True;
end;
until (Ord(DataBuffer) = 0) or BreakLoop;
Result := PChar(#CharArray[0]);
end;
procedure EventCalled;
var
TmpAddress: Pointer;
StringData: PChar;
begin
{$ASMMODE intel}
asm
mov [TmpAddress], edi
end;
StringData := GetCurrentData(TmpAddress);
IPCClient.SendStringMessage('update:' + StringData);
//IPCClient.SendStringMessage('update');
end;
end.
Your GetCurrentData() implementation is returning a pointer to a local array that goees out of scope when the function exits, then EventCalled() tries to use that poiner after it is no longer valid. Try this instead:
function GetCurrentData(Address: Pointer): AnsiString;
var
Offset: Integer;
begin
Result := '';
Offset := 0;
repeat
try
if PByte(Longint(Address) + Offset)^ = #0 then Break;
Inc(Offset);
except
Break;
end;
until False;
SetString(Result, PAnsiChar(Address), Offset);
end;
procedure EventCalled;
var
TmpAddress: Pointer;
StringData: AnsiString;
begin
{$ASMMODE intel}
asm
mov [TmpAddress], edi
end;
StringData := GetCurrentData(TmpAddress);
IPCClient.SendStringMessage('update:' + StringData);
//IPCClient.SendStringMessage('update');
end;
IsBadReadPtr API is here to help. You give address and size, and you get the readability back. Raymond Chen suggests to never use it though.
Other than that, VirtualQuery should give you information about the address in question to tell its readability.
Since Ken in comments below re-warned about danger of IsBadReadPtr, I bring it up to the answer to not pass by. Be sure to read the comments and links to Raymdond's blog. Be sure to see also:
Most efficient replacement for IsBadReadPtr?
How to check if a pointer is valid?
Situation: a whole number saved as hex in a byte array(TBytes). Convert that number to type integer with less copying, if possible without any copying.
here's an example:
array = ($35, $36, $37);
This is '5', '6', '7' in ansi. How do I convert it to 567(=$273) with less trouble?
I did it by copying twice. Is it possible to be done faster? How?
You can use LookUp Table instead HexToInt...
This procedure works only with AnsiChars and of course no error checking is provided!
var
Table :array[byte]of byte;
procedure InitLookupTable;
var
n: integer;
begin
for n := 0 to Length(Table) do
case n of
ord('0')..ord('9'): Table[n] := n - ord('0');
ord('A')..ord('F'): Table[n] := n - ord('A') + 10;
ord('a')..ord('f'): Table[n] := n - ord('a') + 10;
else Table[n] := 0;
end;
end;
function HexToInt(var hex: TBytes): integer;
var
n: integer;
begin
result := 0;
for n := 0 to Length(hex) -1 do
result := result shl 4 + Table[ord(hex[n])];
end;
function BytesToInt(const bytes: TBytes): integer;
var
i: integer;
begin
result := 0;
for i := 0 to high(bytes) do
result := (result shl 4) + HexToInt(bytes[i]);
end;
As PA pointed out, this will overflow with enough digits, of course. The implementation of HexToInt is left as an exercise to the reader, as is error handling.
You can do
function CharArrToInteger(const Arr: TBytes): integer;
var
s: AnsiString;
begin
SetLength(s, length(Arr));
Move(Arr[0], s[1], length(s));
result := StrToInt(s);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
a: TBytes;
begin
a := TBytes.Create($35, $36, $37);
Caption := IntToStr(CharArrToInteger(a));
end;
If you know that the string is null-terminated, that is, if the final character in the array is 0, then you can just do
function CharArrToInteger(const Arr: TBytes): integer;
begin
result := StrToInt(PAnsiChar(#Arr[0]));
end;
procedure TForm1.FormCreate(Sender: TObject);
var
a: TBytes;
begin
a := TBytes.Create($35, $36, $37, 0);
Caption := IntToStr(CharArrToInteger(a));
end;
The most natural approach, however, is to use an array of characters instead of an array of bytes! Then the compiler can do some tricks for you:
procedure TForm1.FormCreate(Sender: TObject);
var
a: TCharArray;
begin
a := TCharArray.Create(#$35, #$36, #$37);
Caption := IntToStr(StrToInt(string(a)));
end;
It cannot be any faster than that ;-)
function HexToInt(num:pointer; size:Cardinal): UInt64;
var i: integer;
inp: Cardinal absolute num;
begin
if(size > SizeOf(Result)) then Exit;
result := 0;
for i := 0 to size-1 do begin
result := result shl 4;
case(PByte(inp+i)^) of
ord('0')..ord('9'): Inc(Result, PByte(inp+i)^ - ord('0'));
ord('A')..ord('F'): Inc(Result, PByte(inp+i)^ - ord('A') + 10);
ord('a')..ord('f'): Inc(Result, PByte(inp+i)^ - ord('a') + 10);
end;
end;
end;
function fHexToInt(b:TBytes): UInt64; inline;
begin
Result:=HexToInt(#b[0], Length(b));
end;
...
b:TBytes = ($35, $36, $37);
HexToInt(#b[0], 3);
fHexToInt(b);
Is it possible to pass a string as a TSysCharSet variable?
This does not compile of course:
var
AValidChars: SysUtils.TSysCharSet;
AResult: string;
begin
// Edit1.Text can contain 0..9 or a..z
AValidChars := SysUtils.TSysCharSet( [Edit1.Text] );
end;
Thanks,
Bill
No, it is not possible to simply pass a string as a TSysCharSet.
What you can do however is to create a TSysCharSet which contains all the chars in the string. This code would do this:
var
AValidChars: SysUtils.TSysCharSet;
s: AnsiString;
i: integer;
begin
// Edit1.Text can contain 0..9 or a..z
AValidChars := [];
s := Edit1.Text;
for i := 1 to Length(s) do
Include(AValidChars, s[i]);
end;
If you are not using an earlier Delphi version you could also make use of "for ... in" instead of the loop above:
var
AValidChars: SysUtils.TSysCharSet;
c: AnsiChar;
begin
// Edit1.Text can contain 0..9 or a..z
AValidChars := [];
for c in Edit1.Text do
Include(AValidChars, c);
end;
Note that in both code snippets AnsiString / AnsiChar is used, as this technique will not work with WideString or the Unicode string type introduced with Delphi 2009.
Many thanks to Craig Stuntz, Ken White and Rob Kennedy for their very valuable comments, I have edited this answer to address all of their points.
If in your Edit1.Text you have the string:
'0..9'
Then the following code should help you:
var
AValidChars: SysUtils.TSysCharSet;
StartChar, EndChar: char;
c: char;
begin
StartChar := Edit1.Text[1]; // some validation should be done
EndChar := Edit1.Text[4];
AValidChars := [];
for c := StartChar to EndChar do
Include(AValidChars, c);
end;
A Delphi/Pascal parser can be used to validate the input.
Update:
More elaborated function supporting set constructors:
function StrToSysCharSet(const S: string): TSysCharSet;
var
Elements: TStringList;
CurrentElement: string;
StartChar, EndChar: char;
c: char;
i: Integer;
p: Integer;
function ReadChar: Char;
begin
Result := CurrentElement[p];
Inc(p);
end;
function NextIsDotDot: Boolean;
begin
Result := '..' = Copy(CurrentElement, p, 2);
end;
begin
Elements := TStringList.Create;
try
Elements.CommaText := S;
Result := [];
for i := 0 to Elements.Count - 1 do
begin
CurrentElement := Trim(Elements[i]);
p := 1;
StartChar := ReadChar;
if NextIsDotDot then
begin
Inc(p, 2);
EndChar := ReadChar;
for c := StartChar to EndChar do
Include(Result, c);
end
else
Include(Result, StartChar);
end;
finally
Elements.Free;
end;
end;
It can be used like this:
S := '0..9, a..z';
AValidChars := StrToSysCharSet(S);
or
S := '0..9 and a..z';
AValidChars := StrToSysCharSet(AnsiReplaceText(S, ' and ', ', '));
Adapting to support
S := '''0''..''9'' and ''a''..''z'''
is simple.