strconv.ParseFloat turning values to 0 when it shouldn't - parsing

I have the following code:
buffer := make([]byte, 256)
conn.Read(buffer)
result:= string(buffer)
fmt.Println("Val:", result)
floatResult, _ := strconv.ParseFloat(result, 64)
fmt.Println("Val on float:", floatResult)
The output is the following:
Val: 40.385167
Val on float: 0
This seems the correct way to parse string into float64's, is there something i'm missing?

You can create new slice with len equals read bytes (look at Reader)
buffer := make([]byte, 256)
i, _ := conn.Read(buffer) // i 👉🏻 number of read bytes
result:= string(buffer[:i]) // create new slice with 'len' equals number of read bytes
fmt.Println("Val:", result)
floatResult, _ := strconv.ParseFloat(result, 64)
fmt.Println("Val on float:", floatResult)
PLAYGROUND (io.Reader stub)

Related

Delphi speed up decode and show a custom image

In my project I receive data from a tcp connection with a custom protocol in packets of 1095 bytes, then I must look for a sync word and try to show gray scale image.
At first step I read data and save them in a TStringList fifo
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
rowFrame : string;
data: TIdBytes;
begin
offReCStatus := false;
repeat
AContext.Connection.IOHandler.ReadBytes(data, 1099, False);
rowFrame :='';
for I := 0 to length(data)-1 do
begin
rowFrame := rowFrame + (data[i].ToHexString);
end;
tcpFrameList.Append( rowFrame );
until offReCStatus = true;
end;
Then in a separated thread, I try the data from the list.
{I added some comments in code}
Get first string from string list
Convert it to binary and append to previous data
Find sync word and copy data after sync word
Split image data to 1024 * 10 bits to load image
Draw image from data
Find new sync word(number 3)
Note: one very important thing is the sync-word is not byte,its bits and can start from middle of a byte for example 10 101011-00010101-00001100-10011001-01111111-00 111111 in this case 10 at first and 111111 at the end merged to sync word and its not AC543265FC‬ any more.in the past in fpga I wrote code that shift the bits until find the 40 bits sync word but i don't know how this can be done in Delphi!
procedure TMyThread.Execute;
var
str3,str4,frameStr,frameId,strData, str6 : string;
iPos,y ,imageBit , frameIdNum :integer;
imageRol : TStringList;
begin
while not Terminated do
begin
FTermEvent.WaitFor( 500 );
if not Terminated then
begin
while tcpFrameList.Count >0 do //process que
begin
try
dta := dta + HexStrToBinStr(tcpFrameList[0]);//convert hex data to binary string and append to olddata
tcpFrameList.Delete(0);//delete converted thread
str3 := '1010110001010100001100100110010111111100';//sync word ‭"AC543265FC‬"
iPos := pos( str3 , dta );//find 1st sync word in binary data
while dta.Length>20000 do //process data to find sync words
begin
Delete(dta,1, iPos-1 );//delete data until first sync word
str4 := copy( dta , 1, 12240);//copy image frame data after sync word
Delete(dta,1, 12240 );//delete image frame data that copied
strData := copy(BinToHex(str4),11); //hex image data
frameId := copy( strData , 1, 6 ); //get image column id from data
frameStr := copy( strData , 107, 330 );//get image color data as protocol
frameStr := frameStr + copy( strData , 501, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 1011, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 1521, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 2031, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 2541, 446 );//get image data as in protocol
imageBin := HexStrToBinStr( frameStr );
//now we have 10240 bit that for one frame column .10240 is 1024 of 10 bits for each pixel
imageRol := TstringList.Create;
imageRol := spliToLength( imageBin,10);//split 10240 to 1024 *10
frameIdNum := HexToDec(frameId);//frame id to show image
//application.ProcessMessages;
TThread.Synchronize (TThread.CurrentThread,
procedure () var y,n:integer;
begin
form1.Image1.Width := frameIdNum+1;//set TImage width
for y := 0 to imageRol.Count-1 do //process imageRol to grab 1024 pixel color of new column
begin
str6 := imageRol[y];
imageBit := trunc( BinToDec( str6 ) /4 );//div 10bit(1024) to 4 to get a number 0-255 for color
form1.Image1.Canvas.Pixels[frameIdNum ,y)] := RGB( imageBit , imageBit , imageBit );//gray scale image
end;
end);
iPos := pos( str3 , dta );
end;
except
on E : Exception do
TThread.Synchronize (TThread.CurrentThread,
procedure ()
begin
form1.Memo1.Lines.Add(E.ClassName+' , message: '+E.Message);
end);
end;
end;
end;
end;
end;
The code above is working good but its slow..
I don't know how can process data as bits so try to convert data between hex and string to complete the process. Is there a way to do this job without any hex converting from tcp layer!?
I commented the code to explain what happening.but tell me to add some more data where necessary.
Here is an example how you could process the Binary data.
DISCLAMER
This code sample is far from optimized as I tried to keep it simple so one can grasp the concept how to process binary data.
The main concept here is that we have a 40 bit sync word (marker) but since we are dealing with individual bits, it can be on a non byte boundary. So all we need to do is read at least 48 bits (6 bytes) into a 64 bit integer and shift the bits to the right until we find our marker. I did not include the RGB pixel extraction logic, I leave that as an exercise for you :), I think you can decode it with WIC as GUID_WICPixelFormat32bppBGR101010
program SO59584303;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Classes,
System.SysUtils;
type ImageArray = TArray<Byte>;
const FrameSync : UInt64 = $AC543265FC; // we need Int64 as our marker is > 32 bits
function GetByte(const Value : UInt64; const ByteNum : Byte) : Byte; inline;
begin
Result := (Value shr ((ByteNum-1)*8)) and $FF ;
end;
procedure WriteInt64BigEndian(const Value: UInt64; NumberOfBytes : Integer; var Stream : TBytes; var Ps : Integer);
var
I : Integer;
begin
for I := NumberOfBytes downto 1 do
begin
Stream[Ps] := GetByte(Value, I);
Inc(Ps);
end;
end;
function ReadInt64BigEndian(const NumberOfBytes : Integer; const Stream : TBytes; var Ps : Integer) : UInt64;
var
I : Integer;
B : Byte;
begin
Result := 0;
for I := NumberOfBytes downto 1 do
begin
B := Stream[Ps];
Result := Result or (UInt64(B) shl ((I-1)* 8));
Inc(Ps);
// sanity check
if Ps >= Length(Stream) then
Exit;
end;
end;
procedure ReadPixelData(const Stream : TBytes; Var Ps : Integer; const Shift : Byte; var Buffer : ImageArray);
// our buffer
var
I : UInt64;
BPos : Integer;
begin
BPos := 0;
// 1024 * 10 bit pixel = 10240 bits = 1280 bytes // initialize buffer
SetLength(Buffer, 1280);
// fill with 0's
FillChar(Buffer[0], Length(Buffer), 0);
if Shift = 0 then
begin
// if we are byte boundary, we can just copy our data
Move(Stream[Ps], Buffer[0], Length(Buffer));
Inc(Ps, Length(Buffer));
end
else
while Bpos < Length(Buffer) do
begin
// Read 8 bytes at a time and shift x bits to the right, mask off highest byte
// this means we can get max 7 bytes at a time
I := (ReadInt64BigEndian(8, Stream, Ps) shr Shift) and $00FFFFFFFFFFFFFF;
// Write 7 bytes to our image data buffer
WriteInt64BigEndian(I, 7, Buffer, BPos);
// go one position back for the next msb bits
Dec(Ps);
end;
end;
procedure WritePixelData(var Stream : TBytes; Var Ps : Integer; var Shift : Byte);
var
Count : Integer;
ByteNum : Byte;
Data : UInt64;
begin
for Count := 1 to 160 do
begin
// write four bytes at a time, due to the shifting we get 5 bytes in total
Data := $F1F2F3F4;
if (Shift > 0) then
begin
// special case, we need to fillup shift bits on last written byte in the buffer with highest byte from our UInt64
Data := Data shl Shift;
Stream[Ps-1] := Stream[Ps-1] or GetByte(Data, 5);
end;
WriteInt64BigEndian(Data, 4, Stream, Ps);
Data := $F5F6F7F8;
if (Shift > 0) then
begin
// special case, we need to fillup shift bits on last written byte in the buffer with highest byte from our UInt64
Data := Data shl Shift;
Stream[Ps-1] := Stream[Ps-1] or GetByte(Data, 5);
end;
WriteInt64BigEndian(Data, 4, Stream, Ps);
end;
end;
procedure GenerateData(var Stream : TBytes);
var
Count : Integer;
I : UInt64;
Ps : Integer;
Shift : Byte;
begin
Count := 1285*4+10;
SetLength(Stream, Count); // make room for 4 Imageframes (1280 bytes or 10240 bits) and 5 byte marker (40 bits) + 10 bytes extra room
FillChar(Stream[0], Count, 0);
Ps := 1;
// first write some garbage
Stream[0] := $AF;
// our first marker will be shifted 3 bits to the left
Shift := 3;
I := FrameSync shl Shift;
// write our Framesync (40+ bits = 6 bytes)
WriteInt64BigEndian(I, 6, Stream, Ps);
// add our data, 1280 bytes or 160 times 8 bytes, we use $F1 F2 F3 F4 F5 F6 F7 F8 as sequence
// (fits in Int 64) so that we can verify our decoding stage later on
WritePixelData(Stream, Ps, Shift);
// write some garbage
Stream[Ps] := $AE;
Inc(Ps);
// our second marker will be shifted 2 bits to the left
Shift := 2;
I := FrameSync shl Shift;
WriteInt64BigEndian(I, 6, Stream, Ps);
WritePixelData(Stream, Ps, Shift);
// write some garbage
Stream[Ps] := $AD;
Inc(Ps);
// our third marker will be shifted 1 bit to the left
Shift := 1;
I := FrameSync shl Shift;
WriteInt64BigEndian(I, 6, Stream, Ps);
WritePixelData(Stream, Ps, Shift);
// write some garbage
Stream[Ps] := $AC;
Inc(Ps);
// our third marker will be shifted 5 bits to the left
Shift := 5;
I := FrameSync shl Shift;
WriteInt64BigEndian(I, 6, Stream, Ps);
WritePixelData(Stream, Ps, Shift);
SetLength(Stream, Ps-1)
end;
procedure DecodeData(const Stream : TBytes);
var
Ps : Integer;
OrgPs : Integer;
BPos : Integer;
I : UInt64;
Check : UInt64;
Shift : Byte;
ByteNum : Byte;
ImageData : ImageArray;
begin
Ps := 0;
Shift := 0;
while Ps < Length(Stream) do
begin
// try to find a marker
// determine the number of bytes we need to read, 40bits = 5 bytes,
// when we have shifted bits this will require 6 bytes
if Shift = 0 then
ByteNum := 5
else
ByteNum := 6;
// save initial position in the stream
OrgPs := Ps;
// read our marker
I := ReadInt64BigEndian(ByteNum, Stream, Ps);
// if we have shifted bits, shift them on byte boundary and make sure we only have the 40 lower bits
if Shift > 0 then
I := (I shr Shift) and $FFFFFFFFFF;
if I = FrameSync then
begin
// we found our marker, process pixel data (ie read next 10240 bits, taking shift into account)
// If we have shift, our first bits will be found in the last marker byte, so go back one position in the stream
if Shift > 0 then
Dec(Ps);
ReadPixelData(Stream, Ps, Shift, ImageData);
// process Image array accordingly, here we will just check that we have our written data back
BPos := 0;
Check := $F1F2F3F4F5F6F7F8;
for ByteNum := 1 to 160 do
begin
I := ReadInt64BigEndian(8, ImageData, BPos);
// if our data is not correct, raise error
Assert(I = Check, 'error decoding image data');
end;
end
else
begin
Ps := OrgPs;
// we did not find our marker, advance 1 bit
Inc(Shift);
if Shift > 7 then
begin
// reset shift value
Shift := 0;
// advance to next byte boundary
Inc(Ps);
end;
end;
end;
end;
Var
AStream : TBytes;
begin
try
GenerateData(AStream);
DecodeData(AStream);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

How to print code128C?

I am trying to print a code128C (numbers only) but I believe that the way of sending the data is incorrect ... at the time of reading the code the conversion does not result in the data initially informed.
In code128A I submit an ASCCI code, the printer converts to hex and print...the reader convert it back to ASCII.
In code128C if I submit an ASCCI, at the time of reading the reader converts to decimal, which does not result in the initial value.
EX:
128A Input: '1' Printer: 31 Reading: 1
128C Input: '1' Printer: 31 Reading: 49
I imagine that I should submit the input code already in integer .... but as the command is composed of other information I do not know how to send it in integer.
This is the code of code128A:
ComandoAnsiString := tp.cod128A('12'); //Data entry
function TTP650.cod128A(cod: AnsiString): AnsiString;
begin
// Fill out the CODE 128 printing protocol
Result := #29+#107+#73 + chr(length(cod)+2) + #123+#65 + cod;
end;
WritePrinter( HandleImp, PAnsiChar(ComandoAnsiString), Length(ComandoAnsiString),
CaracteresImpressos); //send to printer
This is the code I've been trying with code128C:
ComandoAnsiString := tp.cod128C('12');
function TTP650.cod128C(cod: AnsiString): AnsiString;
begin
Result := #29+#107+#73 + chr(length(cod)+2) + #123+#67 + cod;
end;
WritePrinter( HandleImp, PAnsiChar(ComandoAnsiString), Length(ComandoAnsiString),
CaracteresImpressos);
I'm dealing with a thermal printer and one codebar reader simple, default.
The sending codes(WritePrinter) are from the library WinSpool ... the rest are codes written by me.
Important code information is on pages 47 to 50 of the guide.
Guide
Assuming users will enter the wanted barcodes as a string of digits which may be stored somewhere as string and at the time of printing, passed to the printing function as human readable string.
The printing function will then convert to an array of bytes, packing the digits according to CODE C (each pair of two decimal digits, forming a value 00..99, stored in a byte). Iow, if the entry string of digits is e.g. '123456', then this is represented by three bytes with values 12, 34, 56.
function cod128C(const cod: string): TBytes;
const
GS = 29; // GS - Print bar code
k = 107; // k - -"-
m = 73; // m - CODE128
CS = 123; // { - select code set //}
CC = 67; // C - CODE C
var
i, len, n, x: integer;
s: string;
begin
len := Length(cod);
if len = 0 then exit;
// raise for odd number of digits in cod, ...
// if Odd(len) then
// raise Exception.Create('cod must have even number of digits');
s := cod;
// ... alternatively assume a preceeding zero digit before the first digit
// in cod
if Odd(len) then
begin
s := '0'+s;
inc(len);
end;
len := len div 2; // we pack 2 digits into one byte
SetLength(result, 6 + len);
result[0] := GS;
result[1] := k;
result[2] := m;
result[3] := 2 + len; // length of cod, + 2 for following code set selector
result[4] := CS;
result[5] := CC;
n := length(s);
i := 1; // index to S
x := 6; // index to result
while i < n do
begin
result[x] := StrToInt(MidStr(s, i, 2));
inc(i, 2);
inc(x, 1);
end;
end;
And with a form with a button, edit and memo you can test the function and send it to your printer with the following.
procedure TForm1.Button1Click(Sender: TObject);
var
cmnd: TBytes;
i: integer;
s: string;
begin
cmnd := cod128C(Edit1.Text);
for i := 0 to Length(cmnd)-1 do
s := s+IntToStr(cmnd[i])+', ';
Memo1.Lines.Add(s);
WritePrinter( HandleImp, #cmnd[0], Length(cmnd), CaracteresImpressos);
end;
You may want to add a check for only decimal digits in the input string, but I leave that to you.

String to BCD (embarcadero delphi)

Edit:
I have (test file in ascii) the following record in ascii: "000000000.00"
I need to output it ISO upon parsing it's counter part in BCD (the other test file in bcd/ebcdic). I believe it takes 6 char in BCD and 11 in ascii.
So my need was something that could convert it back and forth.
First I thought of taking each chars, feed it to a convert function and convert it back hence my messed up question.
I hope i'm more clear.
Yain
Dr. Peter Below (of Team B) donated these in the old Borland Delphi newsgroups a few years ago:
// NO NEGATIVE NUMBERS either direction.
// BCD to Integer
function BCDToInteger(Value: Integer): Integer;
begin
Result := (Value and $F);
Result := Result + (((Value shr 4) and $F) * 10);
Result := Result + (((Value shr 8) and $F) * 100);
Result := Result + (((Value shr 16) and $F) * 1000);
end;
// Integer to BCD
function IntegerToBCD(Value: Integer): Integer;
begin
Result := Value div 1000 mod 10;
Result := (Result shl 4) or Value div 100 mod 10;
Result := (Result shl 4) or Value div 10 mod 10;
Result := (Result shl 4) or Value mod 10;
end;
As you may know, the ASCII codes of the numerals 0 through 9 are 48 through 57. Thus, if you convert each character in turn to its ASCII equivalent and subtract 48, you get its numerical value. Then you multiply by ten, and add the next number. In pseudo code (sorry, not a delphi guy):
def bcdToInt( string ):
val = 0
for each ch in string:
val = 10 * val + ascii(ch) - 48;
return val;
If your "string" in fact contains "true BCD values" (that is, numbers from 0 to 9, rather than their ASCII equivalent 48 to 57), then don't subtract the 48 in the above code. Finally, if two BCD values are tucked into a single byte, you would access successive members with a bitwise AND with 0x0F (15). But in that case, Ken White's solution is clearly more helpful. I hope this is enough to get you going.
functions below work for 8 digit hexadecimal and BCD values.
function BCDToInteger(Value: DWORD): Integer;
const Multipliers:array[1..8] of Integer=(1, 10, 100, 1000, 10000, 100000, 1000000, 10000000);
var j:Integer;
begin
Result:=0;
for j:=1 to 8 do //8 digits
Result:=Result+(((Value shr ((j-1)*4)) and $0F) * Multipliers[j]);
end;//BCDToInteger
function IntegerToBCD(Value: DWORD): Integer;
const Dividers:array[1..8] of Integer=(1, 10, 100, 1000, 10000, 100000, 1000000, 10000000);
var j:Integer;
begin
Result:=0;
for j:=8 downto 1 do //8 digits
Result:=(Result shl 4) or ((Value div Dividers[j]) mod 10);
end;//IntegerToBCD

Delphi> Vertical scanline? (Get columns instead of rows?)

I'm trying to write an algorithm that will detect the space between 'RF' and 'WOOLF in the image below.
I need something like Scanline for COLUMNS not rows.
My algorithm will be scanning each column for the presence of black pixels, if it finds any it will store '1', else it will store '0', so for example the image above might be:
000001111111111111111111100000000000000000000000011111111111111111111111111111111111111111111111111
so I will know that the space starts on pixel 30.
Why can't you just access the pixels through Scanline?
for i := 0 to (column count)-1 do begin //enumerate columns
black_pixels:=false
for j := 0 to (row count)-1 do //enumerate scanlines
if PByte(integer(Scanline[j]) + i)^=0 then begin
//black pixels in column i
black_pixels:=true;
break;
end;
end;
(just an example, I don't remember the specifics of using scanline)
Even if you're concerned with locality, you can just setup an array of size (column count), and update it while scanning through j, i:
for j := 0 to (row count)-1 do
for i := 0 to (column count)-1 do
if PByte(integer(Scanline[j]) + i)^=0 then
blackpixels[i] := true;
For 1-bit images the data is stored in scanline by bits, though (see this document). To access bit k of BYTE_VALUE (counting from 0), use:
((BYTE_VALUE shr k) and 1)
As requested, additional explanations on how this works.
"Shl" and "shr" are "shift left" and "shift right" operations. What they do is shift the bits inside of the byte to the left (highest bit side) and to the right (lowest bit side). For instance:
01101101 shr 0 = 01101101
01101101 shr 1 = 00110110
01101101 shr 2 = 00011011
01101101 shr 3 = 00001101
In the same way
01101101 shl 0 = 01101101
01101101 shl 1 = 11011010
01101101 shl 2 = 10110100
01101101 shl 3 = 01101000
Binary AND ("C := A and B") is an operation which for every bit, takes it's values from A and from B and sets it's value in C to 1 only when A and B have 1's at the same place.
For instance:
01101101 and
00000000 =
00000000 (B has no 1's at all)
01101101 and
11111111 =
01101101 (B has all 1's, so every 1 from A is transferred to C)
01101101 and
11001100 =
01001100
Therefore what ((BYTE_VALUE shr (i-1)) and 1) does is:
First, shifts BYTE_VALUE (i-1) bits to the right, thus making it's i-th bit the rightmost. But the new BYTE_VALUE can still have unrelated bits to the left of it.
Then, zeroes out all the bits except for the new rightmost.
For instance, if we want to know the 5th rightmost bit of 01101101, we shr it by 4:
01101101 shr 4 = 00000110
But although the rightmost bit is zero, the whole value is still not zero. We AND it with 1 == 00000001:
00000110 and 00000001 = 00000000 = 0
Back to the topic. When your columns are packed by bits, this is how you enumerate them:
setLength(blackpixels, ColumnCount);
for i := 0 to ColumnCount - 1 do
blackpixels[i] := false;
for j := 0 to RowCount-1 do
for i := 0 to ColumnCount div 8-1 do begin
byte_value := PByte(integer(Bitmap.Scanline[j]) + i)^; //read the byte which contains 8 columns
for k := 0 to 7 do
if ((byte_value shr (7-k)) and 1)=0 then
blackpixels[i*8+k] := true;
end;
Here's the working example, just in case:
//Assuming img is declared as img: TImage;
//mm is declared as mm: TMemo;
var blackpixels: array of boolean;
i, j, k: integer;
byte_value: byte;
RowCount, ColumnCount: integer;
Bitmap: TBitmap;
s: string;
begin
RowCount := img.Picture.Bitmap.Height;
ColumnCount := img.Picture.Bitmap.Width;
Bitmap := img.Picture.Bitmap;
setLength(blackpixels, ColumnCount);
for i := 0 to ColumnCount - 1 do
blackpixels[i] := false;
if Bitmap.PixelFormat=pf1Bit then begin
for j := 0 to RowCount-1 do
for i := 0 to ColumnCount div 8-1 do begin
byte_value := PByte(integer(Bitmap.Scanline[j]) + i)^; //read the byte which contains 8 columns
for k := 0 to 7 do
if ((byte_value shr (7-k)) and 1)=0 then //(7-k) because pixels seems to be stored inside of the byte "left-to-right" (highest to lowest)
blackpixels[i*8+k] := true;
end;
end else
raise Exception.Create('Invalid pixel format');
//Print array
if ColumnCount > 0 then
s := BoolToStr(blackpixels[0], false)
else s := '';
for i := 1 to ColumnCount - 1 do
s := s + ', ' + BoolToStr(blackpixels[i], false);
s := '(' + s + ')';
mm.Lines.Add(s);

Improve speed on Crc16 calculation

I need to calculate Crc16 checksums with a $1021 polynom over large files, below is my current implementation but it's rather slow on large files (eg a 90 MB file takes about 9 seconds).
So my question is how to improve my current implementation (to make it faster), I have googled and looked at some samples implementing a table lookup but my problem is that I don't understand how to modify them to include the polynom (probably my math is failing).
{ based on http://miscel.dk/MiscEl/CRCcalculations.html }
function Crc16(const Buffer: PByte; const BufSize: Int64;
const Polynom: WORD=$1021; const Seed: WORD=0): Word;
var
i,j: Integer;
begin
Result := Seed;
for i:=0 to BufSize-1 do
begin
Result := Result xor (Buffer[i] shl 8);
for j:=0 to 7 do begin
if (Result and $8000) <> 0 then
Result := (Result shl 1) xor Polynom
else Result := Result shl 1;
end;
end;
Result := Result and $FFFF;
end;
If you want this to be fast, you need to implement a table-lookup CRC algorithm.
See chapter 10 of A PAINLESS GUIDE TO CRC ERROR DETECTION ALGORITHMS INDEX V3.00 (9/24/96)
Look for CRC routines from jclMath.pas unit of Jedi Code Library. It uses CRC lookup tables.
http://jcl.svn.sourceforge.net/viewvc/jcl/trunk/jcl/source/common/
Your Result variable is a Word, which means there are 64k possible values it could have upon entry to the inner loop. Calculate the 64k possible results that the loop could generate and store them in an array. Then, instead of looping eight times for each byte of the input buffer, simply look up the next value of the checksum in the array. Something like this:
function Crc16(const Buffer: PByte; const BufSize: Int64;
const Polynom: Word = $1021; const Seed: Word = 0): Word;
{$J+}
const
Results: array of Word = nil;
OldPolynom: Word = 0;
{$J-}
var
i, j: Integer;
begin
if (Polynom <> OldPolynom) or not Assigned(Results) then begin
SetLength(Results, 65535);
for i := 0 to Pred(Length(Results)) do begin
Results[i] := i;
for j := 0 to 7 do
if (Results[i] and $8000) <> 0 then
Results[i] := (Results[i] shl 1) xor Polynom
else
Results[i] := Results[i] shl 1;
end;
OldPolynom := Polynom;
end;
Result := Seed;
for i := 0 to Pred(BufSize) do
Result := Results[Result xor (Buffer[i] shl 8)];
end;
That code recalculates the lookup table any time Polynom changes. If that parameter varies among a set of values, then consider caching the lookup tables you generate for them so you don't waste time calculating the same tables repeatedly.
If Polynom will always be $1021, then don't even bother having a parameter for it. Calculate all 64k values in advance and hard-code them in a big array, so your entire function is reduced to just the last three lines of my function above.
Old thread, i know. Here is my implementation (just one loop):
function crc16( s : string; bSumPos : Boolean = FALSE ) : Word;
var
L, crc, sum, i, x, j : Word;
begin
Result:=0;
L:=length(s);
if( L > 0 ) then
begin
crc:=$FFFF;
sum:=length(s);
for i:=1 to L do
begin
j:=ord(s[i]);
sum:=sum+((i) * j);
x:=((crc shr 8) xor j) and $FF;
x:=x xor (x shr 4);
crc:=((crc shl 8) xor (x shl 12) xor (x shl 5) xor x) and $FFFF;
end;
Result:=crc+(Byte(bSumPos) * sum);
end;
end;
Nice thing is also that you can create an unique id with it, for example to get an unique identifier for a filename, like:
function uniqueId( s : string ) : Word;
begin
Result:=crc16( s, TRUE );
end;
Cheers,
Erwin Haantjes

Resources