Unicode problems with Base64 strings and Streams - delphi

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;

Related

Delphi, Lockbox3, calculate md5 throws 'Integer overflow' exception

I use lockbox3 for years, util now with delphi xe7. Now I'm migrating to Alexandria and facing the problem.
With XE7 I used version 3.4 (or so - I cannot find version number in sources). With Alexandria I use whatever comes from Getit package manager.
My code is like follow.
function TForm1.md5(src: string): string;
function Display(Buf: TBytes): String;
var i: Integer;
begin
Result := '';
for i := 0 to 15 do
Result := Result + Format('%0.2x', [Buf[i]]);
Result := LowerCase(Trim(Result));
end;
var
output : AnsiString;
bytes : TBytes;
P, Sz: integer;
aByte: byte;
s: string;
MyHash : THash;
Lib : TCryptographicLibrary;
begin
Lib := TCryptographicLibrary.Create(nil);
MyHash := THash.Create(nil);
MyHash.CryptoLibrary := Lib;
MyHash.HashId := 'native.hash.MD5';
MyHash.Begin_Hash;
MyHash.HashAnsiString(src);
if not assigned(MyHash.HashOutputValue) then
output := 'nil'
else
begin
SetLength(Bytes, 16);
Sz := MyHash.HashOutputValue.Size;
if Sz <> 16 then
output := Format('wrong size: %d', [Sz])
else
begin
P := 0;
MyHash.HashOutputValue.Position := 0;
while MyHash.HashOutputValue.Read(aByte, 1) = 1 do
begin
bytes[P] := aByte;
Inc(P);
end;
result := Display(Bytes);
end;
end;
MyHash.Destroy;
Lib.Destroy;
end;
This works like a charm in old environment. In Alexandria it throws 'Integer overflow' exception at
MyHash.HashAnsiString(src);
Does any body know, how to solve this problem?
regards
M.

Split up serial data in delphi

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

HTML source code from TWebBrowser - How to detect Stream encoding?

Based on this question: How can I get HTML source code from TWebBrowser
If I run this code with a html page that has Unicode code page, the result is gibberish becouse TStringStream is not Unicode in D7. the page might be UTF8 encoded or other (Ansi) code page encoded.
How can I detect if a TStream/IPersistStreamInit is Unicode/UTF8/Ansi?
How do I always return correct result as WideString for this function?
function GetWebBrowserHTML(const WebBrowser: TWebBrowser): WideString;
If I replace TStringStream with TMemoryStream, and save TMemoryStream to file it's all good. It can be either Unicode/UTF8/Ansi. but I always want to return the stream back as WideString:
function GetWebBrowserHTML(const WebBrowser: TWebBrowser): WideString;
var
// LStream: TStringStream;
LStream: TMemoryStream;
Stream : IStream;
LPersistStreamInit : IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then exit;
// LStream := TStringStream.Create('');
LStream := TMemoryStream.Create;
try
LPersistStreamInit := WebBrowser.Document as IPersistStreamInit;
Stream := TStreamAdapter.Create(LStream,soReference);
LPersistStreamInit.Save(Stream,true);
// result := LStream.DataString;
LStream.SaveToFile('c:\test\test.txt'); // test only - file is ok
Result := ??? // WideString
finally
LStream.Free();
end;
end;
EDIT: I found this article - How to load and save documents in TWebBrowser in a Delphi-like way
Which does exactlly what I need. but it works correctlly only with Delphi Unicode compilers (D2009+). read Conclusion section:
There is obviously a lot more we could do. A couple of things
immediately spring to mind. We retro-fit some of the Unicode
functionality and support for non-ANSI encodings to the pre-Unicode
compiler code. The present code when compiled with anything earlier
than Delphi 2009 will not save document content to strings correctly
if the document character set is not ANSI.
The magic is obviously in TEncoding class (TEncoding.GetBufferEncoding). but D7 does not have TEncoding. Any ideas?
I used GpTextStream to handle the convertion (Should work for all Delphi versions):
function GetCodePageFromHTMLCharSet(Charset: WideString): Word;
const
WIN_CHARSET = 'windows-';
ISO_CHARSET = 'iso-';
var
S: string;
begin
Result := 0;
if Charset = 'unicode' then
Result := CP_UNICODE else
if Charset = 'utf-8' then
Result := CP_UTF8 else
if Pos(WIN_CHARSET, Charset) <> 0 then
begin
S := Copy(Charset, Length(WIN_CHARSET) + 1, Maxint);
Result := StrToIntDef(S, 0);
end else
if Pos(ISO_CHARSET, Charset) <> 0 then // ISO-8859 (e.g. iso-8859-1: => 28591)
begin
S := Copy(Charset, Length(ISO_CHARSET) + 1, Maxint);
S := Copy(S, Pos('-', S) + 1, 2);
if S = '15' then // ISO-8859-15 (Latin 9)
Result := 28605
else
Result := StrToIntDef('2859' + S, 0);
end;
end;
function GetWebBrowserHTML(WebBrowser: TWebBrowser): WideString;
var
LStream: TMemoryStream;
Stream: IStream;
LPersistStreamInit: IPersistStreamInit;
TextStream: TGpTextStream;
Charset: WideString;
Buf: WideString;
CodePage: Word;
N: Integer;
begin
Result := '';
if not Assigned(WebBrowser.Document) then Exit;
LStream := TMemoryStream.Create;
try
LPersistStreamInit := WebBrowser.Document as IPersistStreamInit;
Stream := TStreamAdapter.Create(LStream, soReference);
if Failed(LPersistStreamInit.Save(Stream, True)) then Exit;
Charset := (WebBrowser.Document as IHTMLDocument2).charset;
CodePage := GetCodePageFromHTMLCharSet(Charset);
N := LStream.Size;
SetLength(Buf, N);
TextStream := TGpTextStream.Create(LStream, tsaccRead, [], CodePage);
try
N := TextStream.Read(Buf[1], N * SizeOf(WideChar)) div SizeOf(WideChar);
SetLength(Buf, N);
Result := Buf;
finally
TextStream.Free;
end;
finally
LStream.Free();
end;
end;

Converting Strings to Hex in a performant way

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...

Handling arbitrary bit length data in Delphi?

I am working on a display/control utility to replace an ancient dedicated hardware controller for a piece of industrial machinary. The controller itself is beyond repair (someone replaced the 1 amp fuse with a 13 amp one "because it kept blowing"). The hardware interface is through a standard RS232 port. The data format is dedicated:
No control characters are used with the exeption of ETB (Chr 23) to demark end of a message.
The data is 7-bit, but only a subset of the possible 7-bit characters is used. The content of each 7-bit data character is therefore effectively reduced to only 6 bits of data.
The data is not character aligned, e.g. for the first message type, the first 3 bits are the message type, the next 8 bits are a counter, the next 15 bits are a data value, next 7 bits are a value etc
So reducing the data from it's 7-bit carrier to it's 6 bit content gives (for example)
| 6 || 6 || 6 || 6 || 6 || 6 || 6 ||~
001001010001010100101010101101010101110111 ~
|3|| 8 || 15 || 7 || ~~
M C D D D
s o a a a
g u t t t
n a a a
t
Specific messages are fixed length but the different messages are of different lengths and contain different numbers of parameters.
I have a working prototype handling one specific message type, but it is currently using way too many case statements ;-).
I am looking for suggestions as to a clean way of handling such packed, arbitrary bit length data?
I assume that different messages/packets have different variable lengths. A clean way to handle arbitrary bit length data like that would be
uses ubitstream;
procedure decode(buffer: Tbytes; var results: Tcustom_record);
var
bstream: TBitStream;
msg: byte; // 3 bits
cnt: byte; // 8 bits
Data_1: Word; // 15 bits
Data_2: Word; // 7 bits
Data_3: Word; // ~~ bits
begin
bstream:=TBitStream.Create;
bstream.Load(buffer, sizeof(buffer) );
msg := bstream.readCardinal(3);
if msg = 1 then begin
cnt := bstream.readCardinal(8);
Data_1 := bstream.readCardinal(15);
Data_2 := bstream.readCardinal(7);
Data_3 := bstream.readCardinal(~~);
end else if msg = 2 then begin // different msg type with different lengths
cnt := bstream.readCardinal(5);
Data_1 := bstream.readCardinal(14);
Data_2 := bstream.readCardinal(12);
Data_3 := bstream.readCardinal(~~);
end; // etc etc...
bstream.free;
end;
You will need ubitstream.pas
unit ubitstream;
interface
uses classes, sysutils;
Type
TBitStream = class
constructor Create;
destructor Free;
public
procedure clear;
procedure LoadFromStr(s: string);
procedure Load(fileName: string); overload;
procedure Load(bs:TBitStream; offset: cardinal; count:cardinal); overload;
procedure Load(bs:TBitStream; count:cardinal); overload;
procedure Load(byteArray: TBytes); overload;
procedure Load(byteArray: TBytes; offset:cardinal); overload;
procedure Save(fileName: string); overload;
procedure Save(var byteArray: TBytes); overload;
function toHex:String;
function toBin:String;
//Sequential Access
function readCardinal(count: integer):cardinal;
function readBit:byte;
function readString(count:cardinal):ansistring;
procedure writeBit(bit: byte);
procedure writeBits(count: cardinal; data: TBytes); overload;
procedure writeBits(count: cardinal; pdata: Pbyte); overload;
procedure writeString(s: ansistring);
//----------------------------------------------------
function getSize:smallint;
procedure setSize(newSize: smallint);
property Size: smallint read getSize write setSize;
function getPos: cardinal;
procedure setPos(newPosition: cardinal);
property Position: cardinal read getPos write setPos;
function eos:boolean;//End Of Stream
protected
//Random Access
function getCardinal(offset: cardinal; count: cardinal):cardinal;
function getBit(offset: cardinal):byte;
function getString(offset: cardinal; count:cardinal; var readCount: cardinal):ansistring;
procedure setBit(offset: cardinal; bit: byte);
procedure setBits(offset: cardinal; count: cardinal; data: TBytes);
//----------------------------------------------------
private
bits: TBytes;//Array of byte;
stream_pos: cardinal; //position for sequential operations bits-based
bitsize: cardinal;
end;
implementation
uses strutils;
constructor TBitStream.Create;
begin
SetLength(bits,1); //initial size is 1b
stream_pos := 0;
bitsize:=8;
end;
destructor TBitStream.Free;
begin
SetLength(bits,0); //free array
bits:=nil;
bitsize:=0;
stream_pos:=0;
end;
procedure TBitStream.clear;
// clear data
begin
bits:=nil;
SetLength(bits,1);
bits[0] := 0;
stream_pos := 0;
bitsize := 8;
end;
function TBitStream.getSize:smallint;
begin
if (bitsize mod 8)>0 then getSize := (bitsize div 8) +1
else getSize := bitsize div 8;
end;
procedure TBitStream.setSize(newSize: smallint);
begin
SetLength(bits,newSize);
bitsize:=newSize*8;
if stream_pos>bitsize then stream_pos:=bitsize; //set to end of stream
end;
function TBitStream.getCardinal(offset: cardinal; count: cardinal):cardinal;
//return count of bits from offset as 32-bit data type
//offset and count size in bits
var
res: cardinal;
i,shift: cardinal;
begin
getCardinal:=0;
if (offset+count>Size*8) then raise Exception.Create('Index out of array bounds!');
if count>32 then exit; //no more than 32-bit
res := getBit(offset);
// writeln(offset,' ',getBit(offset),' ',res);
shift := 1;
for i:=offset+1 to offset+count-1 do begin
res := res or (getBit(i) shl shift);
inc(shift);
// writeln(i,' ',getBit(i),' ',res);
end;
getCardinal := res;
end;
procedure TBitStream.setBit(offset: cardinal; bit: byte);
//offset in bits
var
b: byte;
off1: cardinal;
pos1: byte;
begin
if (offset>=Size*8) then
begin
SetLength(bits,(offset div 8)+1);
end;
bitsize:=offset;
off1 := offset div 8;
pos1 := offset mod 8;
b := bits[off1];
if bit=0 then begin //drop bit
b := b and (not (1 shl pos1));
end else begin //set bit
b := b or (1 shl pos1);
end;
bits[off1] := b;
end;
procedure TBitStream.setBits(offset: cardinal; count: cardinal; data: TBytes);
//set count of bits at offset from bytes array
//offset and count size in bits
var
i,j: cardinal;
b,bit: byte;
byteCount: cardinal;
off: cardinal;
Label STOP;
begin
if (offset+count>=Size*8) then begin
SetLength(bits,((offset+count) div 8)+1); //Reallocate bits array
end;
bitsize:=offset+count;
byteCount := count div 8;
off := offset;
if (count mod 8)>0 then inc(byteCount);
for i:=0 to byteCount-1 do begin //dynamic arrays is zero-based
b := data[i];
for j:=0 to 7 do begin //all bits in byte
bit := (b and (1 shl j)) shr j;
setBit(off,bit);
inc(off);
if (off>offset+count) then goto STOP;
end;
end;
STOP:
end;
function TBitStream.getBit(offset: cardinal):byte;
//offset in bits
var
b: byte;
off1: cardinal;
pos1: byte;
begin
getBit := 0;
if (offset>Size*8) then raise Exception.Create('Index out of array bounds!');
off1 := offset div 8;
pos1 := offset mod 8;
// if (offset mod 8)>0 then inc(off1);
b := bits[off1];
b := (b and (1 shl pos1)) shr pos1;//get bit
getBit := b;
end;
function TBitStream.getString(offset: cardinal; count:cardinal; var readCount: cardinal):ansistring;
//count, offset in bits
var
s: ansistring;
len,i: cardinal;
b: byte;
off: cardinal;
begin
getString:='';
s := '';
readCount := 0;
off := offset;
if (count mod 7)<>0 then exit; //string must contain 7-bits chars....
len := count div 7;
for i:=1 to len do begin
if (offset>Size*8) then raise Exception.Create('Index out of array bounds!');
b := getCardinal(off,7);
inc(off,7);
inc(readCount,7);
if b=$7F then break; //this is EOL code
s := s + ansichar(b);
end;
getString := s;
end;
function TBitStream.toHex:String;
var
i:integer;
s,res:string;
begin
res:='';
for i:=Low(bits) to High(bits) do begin
s := Format('%02.2X ',[bits[i]]);
res := res + s;
end;
toHex := res;
end;
function TBitStream.toBin:String;
var
i,j:integer;
s,res:string;
b: byte;
begin
res:='';
for i:=Low(bits) to High(bits) do begin
//s := Format('%02.2X',[bits[i]]);
b := bits[i];
s:='';
for j:=7 downto 0 do begin
if (b and (1 shl j))>0 then s:=s+'1' else s:=s+'0';
end;
s := s+' ';
res := res + s;
end;
toBin := res;
end;
procedure TBitStream.LoadFromStr(s: string);
//load data from hex string
var
i,j: cardinal;
b: byte;
c1,c2:byte;
begin
clear;
s:=AnsiReplaceStr(s,' ','');
if (length(s) mod 2) <> 0 then exit;
i:=1;j:=0;
SetLength(bits, length(s) div 2);
bitsize:=(length(s) div 2 ) * 8;
repeat
c1:=0; c2:=0;
if s[i] in ['0','1','2','3','4','5','6','7','8','9'] then c1:=ord(s[i])-$30;
if s[i] in ['A','B','C','D','E','F'] then c1:=10+ord(s[i])-$41;
if s[i+1] in ['0','1','2','3','4','5','6','7','8','9'] then c2:=ord(s[i+1])-$30;
if s[i+1] in ['A','B','C','D','E','F'] then c2:=10+ord(s[i+1])-$41;
b:=c1*16+c2;
bits[j]:=b;
inc(i,2);
inc(j);
until i>=length(s);
end;
procedure TBitStream.Load(fileName: string);
//load data from binary file
var
f: file of byte;
i: cardinal;
b: byte;
begin
clear;
i:=0;
assign(f,fileName);
reset(f);
while not eof(f) do begin
blockread(f,b,1);
SetLength(bits,i+1);
bitsize:= (i+1) * 8;
bits[i] := b;
inc(i);
end;
close(f);
end;
procedure TBitStream.Save(fileName: string);
//save data to binary file
var
i:cardinal;
f: file of byte;
b: byte;
begin
assign(f,fileName);
rewrite(f);
for i:=Low(bits) to High(bits) do begin
b := bits[i];
blockwrite(f,b,1);
end;
close(f);
end;
procedure TBitStream.Save(var byteArray: TBytes);
//save data to array of bytes
var
i: cardinal;
begin
byteArray:=nil; //dealloc bytearray
SetLength(byteArray,Size);
for i:=0 to Size-1 do begin
byteArray[i] := bits[i];
end;
end;
procedure TBitStream.Load(bs:TBitStream; offset: cardinal; count: cardinal);
//load data from other stream
//offset/count in bits
var
i,len,off: cardinal;
b: byte;
begin
clear;
off := offset;
len := count div 8;
setLength(bits, len);
bitsize:=count;
for i:=0 to len-1 do begin
b:=bs.getCardinal(off,8);
if (i>Size) then begin
SetLength(bits,i+1);
end;
bits[i] := b;
inc(off,8);
end;
end;
procedure TBitStream.Load(bs:TBitStream; count: cardinal);
//load data from other stream
//count in bits
begin
Load(bs, bs.Position, count);
bs.Position:=bs.Position+count;
end;
procedure TBitStream.Load(byteArray: TBytes);
//load data from array of bytes
var
i,len: cardinal;
begin
clear;
len := High(byteArray)+1;
setLength(bits, len);
bitsize:=len * 8;
for i:=0 to len-1 do begin
bits[i] := byteArray[i];
end;
end;
procedure TBitStream.Load(byteArray: TBytes; offset:cardinal);
//offset in bytes
var
i,len: cardinal;
begin
clear;
len := High(byteArray)+1;
if offset>len then exit;
setLength(bits, len-offset);
bitsize:=(len-offset) * 8;
for i:=offset to len-1 do begin
bits[i-offset] := byteArray[i];
end;
end;
function TBitStream.getPos: cardinal;
begin
getPos := stream_pos;
end;
procedure TBitStream.setPos(newPosition: cardinal);
begin
if (newPosition>bitsize) then exit;
stream_pos := newPosition;
end;
function TBitStream.readCardinal(count: integer):cardinal;
begin
readCardinal := getCardinal(stream_pos, count);
inc(stream_pos,count);
end;
function TBitStream.readBit:byte;
begin
readBit := getBit(stream_pos);
inc(stream_pos);
end;
function TBitStream.readString(count:cardinal):ansistring;
//count in bits
var readCount: cardinal;
begin
readString := getString(stream_pos,count,readCount);
inc(stream_pos,readCount);
end;
procedure TBitStream.writeBit(bit: byte);
begin
setBit(stream_pos,bit);
inc(stream_pos);
end;
procedure TBitStream.writeBits(count: cardinal; data: TBytes);
begin
setBits(stream_pos,count,data);
inc(stream_pos,count);
end;
procedure TBitStream.writeBits(count: cardinal; pdata: pbyte);
var
i:cardinal;
len:cardinal;
bytes: TBytes;
begin
len:=count div 8;
if (count mod 8)>0 then inc(len);
setLength(bytes,len);
for i:=0 to len-1 do begin
bytes[i]:=pdata^;
inc(pdata);
end;
writeBits(count,bytes);
end;
function TBitStream.eos:boolean;
begin
eos := stream_pos=bitsize;//High(bits)+1;
end;
procedure TBitStream.writeString(s: ansistring);
var
i:cardinal;
b:Tbytes;
begin
setLength(b,1);
for i:=1 to length(s) do begin
b[0]:=byte(s[i]);
setBits(stream_pos,7,b);
inc(stream_pos,7);
end;
b[0]:=$7f;
setBits(stream_pos,7,b);
inc(stream_pos,7);
b:=nil;
end;
end.
Use SHL/SHR along with masking to read out of your buffer. I would write a few functions to operate against the buffer (which I would declare as an array of byte) and return the value of a specific number of bits form a starting bit position. For instance, lets say that your largest value will never be more than 16 bits (a word). Since your mapped to an array of bytes, if you always grab 3 bytes from the array (watch for the upper bounds) and throw into an integer you can then mask and shift to get your specific value. The location of the bytes you want to get will then be (assuming a 0 based array):
Byte1Index = FirstBit DIV 8;
Byte2Index = Byte1Index + 1;
Byte3Index = Byte1Index + 2;
Pull these into your integer from your array.
TempInt := 0;
if Byte1Index <= High(Buffer) then
TempInt := Buffer[Byte1Index];
if Byte2Index <= High(Buffer) then
TempInt := TempInt OR ((Buffer[Byte2Index] and $000000FF) SHL 8);
if Byte3Index <= High(Buffer) then
TempInt := TempInt OR ((Buffer[Byte2Index] and $000000FF) SHL 16);
Then adjust your result to align properly
if FirstBit MOD 8 <> 0 then
TempInt := TempInt SHR (FirstBit MOD 8);
Then mask against the most number of bits you want to return:
Result := TempInt AND $00003FFF;
You can build the final mask programatically:
FinalMask := ($FFFFFFFF shl bitcount) xor $FFFFFFFF;
EDIT
This method is currently limited to 32 bits, but can be extended to at the most 64 bits by changing the masks from 32bit integers to 64bit integers (from $FFFFFFFF to $FFFFFFFFFFFFFFFF for example). Performance gains can also be made by not loading the extra bytes if they aren't needed, I just included here examples for 16 bits, however you will always want to grab at least an extra byte if the Bitsneeded + FirstBiT MOD 8 <> 0
For the messaging side of things I would create a base object which knows how to read data out of a buffer, then extend this into an object which knows how to also read parameters, and then create object descendants which know how to process each message type. You would still have a case statement, but it would be at a simple dispatcher level doing nothing more than passing the buffer off to the appropriate object to handle.
One possible way to handle this, while being terribly inefficient in terms of memory usage, would be to break up the bits as the data is read in. So, let's say you read in the data from the port in 8-bit (1-byte) chunks. Your first read would bring in 00100101. Break this into an array of 8 integers (e.g. bits[0] := 0; bits[1] := 0; bits[2] := 1; ...)
Now you can write helper routine(s) that will retrieve the value you are looking for from the array:
function getInt(start, len: integer): integer;
function getChar(start: integer): String;
These functions would use the start (and possibly len) parameters to combine the appropriate bits out of your array into a usable value.
I'd probably use ASM blocks to handle this with some assembler code - if you can use x86 assembly it would be much easier to parse the data and convert them to a more readable format to pass along.

Resources