CRC-CCITT (0xFFFF) function? - delphi

Can someone help me with Delphi implementation of CRC-CCITT (0xFFFF)?
Already get the Java version, but confusing on how to port it to Delphi
public static int CRC16CCITT(byte[] bytes) {
int crc = 0xFFFF; // initial value
int polynomial = 0x1021; // 0001 0000 0010 0001 (0, 5, 12)
for (byte b : bytes) {
for (int i = 0; i < 8; i++) {
boolean bit = ((b >> (7-i) & 1) == 1);
boolean c15 = ((crc >> 15 & 1) == 1);
crc <<= 1;
if (c15 ^ bit) crc ^= polynomial;
}
}
crc &= 0xffff;
//System.out.println("CRC16-CCITT = " + Integer.toHexString(crc));
return crc;
}
and for PHP implementation
<?php
function crc16($data)
{
$crc = 0xFFFF;
for ($i = 0; $i < strlen($data); $i++)
{
$x = (($crc >> 8) ^ ord($data[$i])) & 0xFF;
$x ^= $x >> 4;
$crc = (($crc << 8) ^ ($x << 12) ^ ($x << 5) ^ $x) & 0xFFFF;
}
return $crc;
}

0xFFFF translates to $FFFF
& translates to and
^ translates to xor
<< translates to shl
>> translates to shr
x ^= y translates to x := x xor y, similar for &=, <<=, etc.
These operators generally have higher precedence in Delphi so they usually need to have their arguments parenthesized.
I'm quite sure that there are plenty of other implementations of CRC16 etc. for Delphi, see e.g. Improve speed on Crc16 calculation

function CRC16CCITT(bytes: TBytes): Word;
const
polynomial = $1021; // 0001 0000 0010 0001 (0, 5, 12)
var
crc: Word;
I, J: Integer;
b: Byte;
bit, c15: Boolean;
begin
crc := $FFFF; // initial value
for I := 0 to High(bytes) do
begin
b := bytes[I];
for J := 0 to 7 do
begin
bit := (((b shr (7-J)) and 1) = 1);
c15 := (((crc shr 15) and 1) = 1);
crc := crc shl 1;
if ((c15 xor bit) <> 0) then crc := crc xor polynomial;
end;
end;
Result := crc and $ffff;
end;

You can find one in Delphi Encryption Compendium (DEC) component.
5 Checksums (CRC32, CRC16-CCITT, CRC16-Standard ...)
http://blog.digivendo.com/2008/11/delphi-encryption-compendium-dec-52-for-d2009-released/

i found some code that works:
function crc16(Buffer:String;Polynom,Initial:Cardinal):Cardinal;
var
i,j: Integer;
begin
Result:=Initial;
for i:=1 to Length(Buffer) do begin
Result:=Result xor (ord(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;
source : http://www.miscel.dk/MiscEl/CRCcalculations.html

unit CRC16CCITT;
interface
function ComputeCRC16CCITT(crc: word; const data: PByte; len:integer) : word;
implementation
const
crc16_table: array [0..$FF] of word = (0,4489,8978,12955,17956,22445,25910,29887,35912,40385,44890,48851,51820,56293,59774,
63735,4225,264,13203,8730,22181,18220,30135,25662,40137,36160,49115,44626,56045,52068,63999,
59510,8450,12427,528,5017,26406,30383,17460,21949,44362,48323,36440,40913,60270,64231,51324,
55797,12675,8202,4753,792,30631,26158,21685,17724,48587,44098,40665,36688,64495,60006,55549,
51572,16900,21389,24854,28831,1056,5545,10034,14011,52812,57285,60766,64727,34920,39393,43898,
47859,21125,17164,29079,24606,5281,1320,14259,9786,57037,53060,64991,60502,39145,35168,48123,
43634,25350,29327,16404,20893,9506,13483,1584,6073,61262,65223,52316,56789,43370,47331,35448,
39921,29575,25102,20629,16668,13731,9258,5809,1848,65487,60998,56541,52564,47595,43106,39673,
35696,33800,38273,42778,46739,49708,54181,57662,61623,2112,6601,11090,15067,20068,24557,28022,
31999,38025,34048,47003,42514,53933,49956,61887,57398,6337,2376,15315,10842,24293,20332,32247,
27774,42250,46211,34328,38801,58158,62119,49212,53685,10562,14539,2640,7129,28518,32495,19572,
24061,46475,41986,38553,34576,62383,57894,53437,49460,14787,10314,6865,2904,32743,28270,23797,
19836,50700,55173,58654,62615,32808,37281,41786,45747,19012,23501,26966,30943,3168,7657,12146,
16123,54925,50948,62879,58390,37033,33056,46011,41522,23237,19276,31191,26718,7393,3432,16371,
11898,59150,63111,50204,54677,41258,45219,33336,37809,27462,31439,18516,23005,11618,15595,3696,
8185,63375,58886,54429,50452,45483,40994,37561,33584,31687,27214,22741,18780,15843,11370,7921,
3960);
function ComputeCRC16CCITT(crc: word; const data: PByte; len:integer) : word;
var
i : integer;
begin
for i := 0 to len-1 do
crc := (crc shr 8) xor crc16_table[(crc xor data[i]) and $ff];
result := crc;
end;
end.

Related

Is Delphi's Skewness correct

In Delphi one can calculate Skewness using System.Math's function MomentSkewKurtosis().
var m1, m2, m3, m4, skew, k: Extended;
System.Math.MomentSkewKurtosis([1.1,
3.345,
12.234,
11.945,
14.235,
16.876,
20.213,
11.001,
7.098,
21.234], m1, m2, m3, m4, skew, k);
This will prints skew equal to -0.200371489809269.
Minitab prints the value -0.24
SigmaXL prints the value -0.23611
The reason is that Delphi does not not perform adjustment.
Here is my implementation which calculates adjustment:
function Skewness(const X: array of Extended; const Adjusted: Boolean): Extended;
begin
var AMean := Mean(X);
var xi_minus_mean_power_3 := 0.0;
var xi_minus_mean_power_2 := 0.0;
for var i := Low(X) to High(X) do
begin
xi_minus_mean_power_3 := xi_minus_mean_power_3 + IntPower((X[i] - AMean), 3);
xi_minus_mean_power_2 := xi_minus_mean_power_2 + IntPower((X[i] - AMean), 2);
end;
// URL : https://www.gnu.org/software/octave/doc/v4.0.1/Descriptive-Statistics.html
{ mean ((x - mean (x)).^3)
skewness (X) = ------------------------.
std (x).^3
}
var N := Length(X);
Result := xi_minus_mean_power_3 / N /
IntPower(Sqrt(1 / N * xi_minus_mean_power_2), 3);
// URL : https://www.gnu.org/software/octave/doc/v4.0.1/Descriptive-Statistics.html
{ sqrt (N*(N-1)) mean ((x - mean (x)).^3)
skewness (X, 0) = -------------- * ------------------------.
(N - 2) std (x).^3
}
if Adjusted then
Result := Result * Sqrt(N * Pred(N)) / (N - 2);
end;
The helper routine IntPower is as follows:
function IntPower(const X: Extended; const N: Integer): Extended;
/// <remarks>
/// Calculate any float to non-negative integer power. Developed by Rory Daulton and used with permission. Last modified December 1998.
/// </remarks>
function IntPow(const Base: Extended; const Exponent: LongWord): Extended;
{ Heart of Rory Daulton's IntPower: assumes valid parameters &
non-negative exponent }
{$IFDEF WIN32}
asm
fld1 // Result := 1
cmp eax, 0 // eax := Exponent
jz ##3
fld Base
jmp ##2
##1: fmul ST, ST // X := Base * Base
##2: shr eax,1
jnc ##1
fmul ST(1),ST // Result := Result * X
jnz ##1
fstp st // pop X from FPU stack
##3:
fwait
end;
{$ENDIF}
{$IFDEF WIN64}
begin
Result := Power(Base, Exponent);
end;
{$ENDIF}
begin
if N = 0 then
Result := 1
else if (X = 0) then
begin
if N < 0 then
raise EMathError.Create('Zero cannot be raised to a negative power.')
else
Result := 0
end
else if (X = 1) then
Result := 1
else if X = -1 then
begin
if Odd (N) then
Result := -1
else
Result := 1
end
else if N > 0 then
Result := IntPow (X, N)
else
begin
var P: LongWord;
if N <> Low (LongInt) then
P := Abs(N)
else
P := LongWord(High(LongInt)) + 1;
try
Result := IntPow(X, P);
except
on EMathError do
begin
Result := IntPow(1 / X, P); // try again with another method, perhaps less precise
Exit;
end;
end;
Result := 1 / Result;
end;
end;
With that function the adjusted skewness becomes the accurate -0.237611357234441 matching Matlab and Minitab.
The only explanation I found is:
https://octave.org/doc/v4.0.1/Descriptive-Statistics.html
"The adjusted skewness coefficient is obtained by replacing the sample
second and third central moments by their bias-corrected versions."
Same goes with Kurtosis:
function Kurtosis(const X: array of Extended; const Adjusted: Boolean): Extended;
begin
var AMean := Mean(X);
var xi_minus_mean_power_4 := 0.0;
var xi_minus_mean_power_2 := 0.0;
for var i := Low(X) to High(X) do
begin
xi_minus_mean_power_4 := xi_minus_mean_power_4 + IntPower((X[i] - AMean), 4);
xi_minus_mean_power_2 := xi_minus_mean_power_2 + IntPower((X[i] - AMean), 2);
end;
{ mean ((x - mean (x)).^4)
k1 = ------------------------
std (x).^4
}
var N := Length(X);
Result := xi_minus_mean_power_4 / N /
IntPower(1 / N * xi_minus_mean_power_2, 2);
{ N - 1
k0 = 3 + -------------- * ((N + 1) * k1 - 3 * (N - 1))
(N - 2)(N - 3)
}
if Adjusted then
// Mathlab, Minitab and SigmaXL do not add 3 (which is the kurtosis for normal distribution
Result := {3 + }(N - 1) / ((N - 2) * (N - 3)) * ((N + 1) * Result - 3 * (N - 1));
end;
What is the reason for such adjustments and why Delphi decided not to implement it?

How to implement a fast RNG?

I am trying to port an existing random generator based on 128 bit XorShift from C. But I have trouble with generating the seed which is just generating the same number again and again.
static uint64_t s[ 2 ];
static uint64_t __inline next(void) {
uint64_t s1 = s[ 0 ];
const uint64_t s0 = s[ 1 ];
s[ 0 ] = s0;
s1 ^= s1 << 23;
return ( s[ 1 ] = ( s1 ^ s0 ^ ( s1 >> 17 ) ^ ( s0 >> 26 ) ) ) + s0;
}
uint64_t getusertime() {
struct rusage rusage;
getrusage( 0, &rusage );
return rusage.ru_utime.tv_sec * 1000000ULL + ( rusage.ru_utime.tv_usec / 1000 ) * 1000;
}
int main( int argc, char* argv[] ) {
const long long int n = strtoll( argv[1], NULL, 0 );
uint64_t t = 0;
for( int i = 0; i < 2; i++ ) s[ i ] = -1ULL / 3;
const int64_t start = getusertime();
for( long long int i = n; i-- != 0; ) t ^= next();
const int64_t elapsed = getusertime() - start;
const double secs = elapsed / 1E6;
printf( "%f s, %.02f queries/s, %.02f ns/query\n", secs, n / secs, 1E9 * secs / n );
if ( t == 0 ) putchar( 0 );
return 0;
}
program Project1;
var
S: Array [0..1] of UInt64;
function XorShift128: UInt64;
var
s0, s1: UInt64;
begin
s1 := s[0];
s0 := s[1];
s[0] := s0;
s1 := s1 xor (s1 shl 23);
s[1] := (s1 xor s0 xor (s1 shr 17) xor (s0 shr 26));
Result := s[1] + s0;
end;
procedure GenerateSeed;
var
I: Integer;
begin
for I := 0 to High(S) do
S[I] := MaxLongInt div 3;
end;
var
I: UInt64;
begin
GenerateSeed;
I := XorShift128;
end.
The reason you get the same value every time you run the program in the question is that you use the same seed every time. If I am understanding your comments correctly. The other difference between the C and the Pascal is the seed – see below.
However, your code is fine and is an accurate translation of the C code. The output of this C program:
#include <stdio.h>
#include <stdint.h>
static uint64_t s[ 2 ];
static uint64_t __inline next(void) {
uint64_t s1 = s[ 0 ];
const uint64_t s0 = s[ 1 ];
s[ 0 ] = s0;
s1 ^= s1 << 23;
return ( s[ 1 ] = ( s1 ^ s0 ^ ( s1 >> 17 ) ^ ( s0 >> 26 ) ) ) + s0;
}
int main(void)
{
s[ 0 ] = s[ 1 ] = 715827882; // the value of MaxLongInt div 3
printf("%llu\n", next());
printf("%llu\n", next());
printf("%llu\n", next());
return 0;
}
is
6004846026386057
6004846115863870
12676181551404632061
The output of this Delphi program:
program Project1;
{$APPTYPE CONSOLE}
var
S: Array [0..1] of UInt64;
function XorShift128: UInt64;
var
s0, s1: UInt64;
begin
s1 := s[0];
s0 := s[1];
s[0] := s0;
s1 := s1 xor (s1 shl 23);
s[1] := (s1 xor s0 xor (s1 shr 17) xor (s0 shr 26));
Result := s[1] + s0;
end;
procedure GenerateSeed;
var
I: Integer;
begin
for I := 0 to High(S) do
S[I] := MaxLongInt div 3;
end;
begin
GenerateSeed;
Writeln(XorShift128);
Writeln(XorShift128);
Writeln(XorShift128);
end.
is
6004846026386057
6004846115863870
12676181551404632061
I note that the C code in the question uses a different seed from your translation. It seeds the state with -1ULL / 3 and that leads to this output:
46820872945684
46912499612351
13066320939010318272
To match that in the Delphi code you would use high(UInt64) div 3. Do that and you get the output above.
An important note here is that your Delphi code only supplies 64 bits of seed, but your C code supplies 128. I expect that you should supply 128 bits of seed.

Why embedded CRC and current CRC differs?

I have found this Delphi examle. It is supposed to embed CRC and check current CRC. Both should match, but I get different results. How to fix it? And how to speed it up?
CRC32Calc.pas
unit CRC32Calc;
interface
uses Classes, SysUtils, windows, messages;
type
Long = record
LoWord: Word;
HiWord: Word;
end;
const
CRCPOLY = $EDB88320;
procedure BuildCRCTable;
function RecountCRC(b: byte; CrcOld: LongWord): LongWord;
function GetCRC32(FileName: string; Full: boolean): string;
function SetEmbeddedCRC(FileName: string): string;
function GetEmbeddedCRC(FileName: string): string;
function BytesToHexStr(pB: PByte; BufSize: LongWord): String;
function HexStrToBytes(Str: String): String;
implementation
var
CRCTable: array [0 .. 512] Of LongWord;
// A helper routine that creates and initializes
// the lookup table that is used when calculating a CRC polynomial
procedure BuildCRCTable;
var
i, j: Word;
r: LongWord;
begin
FillChar(CRCTable, SizeOf(CRCTable), 0);
for i := 0 to 255 do
begin
r := i shl 1;
for j := 8 downto 0 do
if (r and 1) <> 0 then
r := (r Shr 1) xor CRCPOLY
else
r := r shr 1;
CRCTable[i] := r;
end;
end;
// A helper routine that recalculates polynomial relative to the specified byte
function RecountCRC(b: byte; CrcOld: LongWord): LongWord;
begin
RecountCRC := CRCTable[byte(CrcOld xor LongWord(b))
] xor ((CrcOld shr 8) and $00FFFFFF)
end;
// A helper routine that converts Word into String
function HextW(w: Word): string;
const
h: array [0 .. 15] Of char = '0123456789ABCDEF';
begin
HextW := '';
HextW := h[Hi(w) shr 4] + h[Hi(w) and $F] + h[Lo(w) shr 4] + h[Lo(w) and $F];
end;
// A helper routine that converts LongWord into String
function HextL(l: LongWord): string;
begin
with Long(l) do
HextL := HextW(HiWord) + HextW(LoWord);
end;
// Calculate CRC32 checksum for the specified file
function GetCRC32(FileName: string; Full: boolean): string;
var
f: TFileStream;
i, CRC: LongWord;
aBt: byte;
begin
// Build a CRC table
BuildCRCTable;
CRC := $FFFFFFFF;
// Open the file
f := TFileStream.Create(FileName, (fmOpenRead or fmShareDenyNone));
// To calculate CRC for the whole file use this loop boundaries
if Full then
for i := 0 to f.Size - 1 do
begin
f.Read(aBt, 1);
CRC := RecountCRC(aBt, CRC);
end
else
// To calculate CRC for the file excluding the last 4 bytes
// use these loop boundaries
for i := 0 to f.Size - 5 do
begin
f.Read(aBt, 1);
CRC := RecountCRC(aBt, CRC);
end;
f.Destroy;
CRC := Not CRC;
Result := HextL(CRC);
end;
// Calculate CRC and writes it to the end of file
function SetEmbeddedCRC(FileName: string): string;
var
f: TFileStream;
CRCOffset: LongWord;
CRC: string;
begin
f := TFileStream.Create(FileName, (fmOpenReadWrite or fmShareDenyNone));
CRCOffset := f.Size;
// Append a placeholder for actual CRC to the file
f.Seek(CRCOffset, TSeekOrigin.soBeginning);
f.Write(PByte(HexStrToBytes('FFFFFFFF'))^, 4);
// Obtain CRC
CRC := GetCRC32(FileName, True);
// Write CRC to the end of file
f.Seek(CRCOffset, TSeekOrigin.soBeginning);
f.Write(PByte(HexStrToBytes(CRC))^, 4);
f.Destroy;
Result := CRC;
end;
// Extract the CRC that was stored at last 4 bytes of a file
function GetEmbeddedCRC(FileName: string): string;
var
f: TFileStream;
CRCOffset: LongWord;
pB: PByte;
begin
GetMem(pB, 4);
// Open file
f := TFileStream.Create(FileName, (fmOpenRead or fmShareDenyNone));
// Proceed upto the end of file
CRCOffset := f.Size - 4;
f.Seek(CRCOffset, TSeekOrigin.soBeginning);
// Read the last four bytes where the CRC is stored
f.Read(pB^, 4);
f.Destroy;
Result := BytesToHexStr(pB, 4);
end;
// A helper routine that converts byte value to string with hexadecimal integer
function BytesToHexStr(pB: PByte; BufSize: LongWord): String;
var
i, j, b: LongWord;
begin
SetLength(Result, 2 * BufSize);
for i := 1 to BufSize do
begin
for j := 0 to 1 do
begin
if j = 1 then
b := pB^ div 16
else
b := pB^ - (pB^ div 16) * 16;
case b of
0:
Result[2 * i - j] := '0';
1:
Result[2 * i - j] := '1';
2:
Result[2 * i - j] := '2';
3:
Result[2 * i - j] := '3';
4:
Result[2 * i - j] := '4';
5:
Result[2 * i - j] := '5';
6:
Result[2 * i - j] := '6';
7:
Result[2 * i - j] := '7';
8:
Result[2 * i - j] := '8';
9:
Result[2 * i - j] := '9';
10:
Result[2 * i - j] := 'A';
11:
Result[2 * i - j] := 'B';
12:
Result[2 * i - j] := 'C';
13:
Result[2 * i - j] := 'D';
14:
Result[2 * i - j] := 'E';
15:
Result[2 * i - j] := 'F';
end;
end;
Inc(pB);
end;
end;
// A helper routine that converts string with hexadecimal integer to byte value
function HexStrToBytes(Str: String): String;
var
b, b2: byte;
lw, lw2, lw3: LongWord;
begin
lw := Length(Str) div 2;
SetLength(Result, lw);
for lw2 := 1 to lw do
begin
b := 0;
for lw3 := 0 to 1 do
begin
case Str[2 * lw2 - lw3] of
'0':
b2 := 0;
'1':
b2 := 1;
'2':
b2 := 2;
'3':
b2 := 3;
'4':
b2 := 4;
'5':
b2 := 5;
'6':
b2 := 6;
'7':
b2 := 7;
'8':
b2 := 8;
'9':
b2 := 9;
'a':
b2 := 10;
'b':
b2 := 11;
'c':
b2 := 12;
'd':
b2 := 13;
'e':
b2 := 14;
'f':
b2 := 15;
'A':
b2 := 10;
'B':
b2 := 11;
'C':
b2 := 12;
'D':
b2 := 13;
'E':
b2 := 14;
'F':
b2 := 15;
else
b2 := 0;
end;
if lw3 = 0 then
b := b2
else
b := b + 16 * b2;
end;
Result[lw2] := char(b);
end;
end;
end.
AppendCRC
program AppendCRC;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes,
CRC32Calc in '..\CRC32Checker\CRC32Calc.pas';
var
FileName: string;
begin
{ TODO -oUser -cConsole Main : Insert code here }
if ParamCount = 1 then
begin
FileName := ParamStr(1);
// Verify whether a file exists
if not FileExists(FileName) then
begin
WriteLn('The specified file does not exist.');
Exit;
end;
WriteLn('Full checksum (before): ' + GetCRC32(FileName, True));
SetEmbeddedCRC(FileName);
WriteLn('Half checksum: ' + GetCRC32(FileName, False));
WriteLn('Full checksum (after): ' + GetCRC32(FileName, True));
WriteLn('GetEmbeddedCRC: :' + GetEmbeddedCRC(FileName));
WriteLn('The checksum was successfully embedded.')
end
else
begin;
WriteLn('Wrong parameters.');
WriteLn('Parameter1 - Full path to file.');;
end;
end.
My results are:
AppendCRC.exe Hello_Delphi_World.exe
Full checksum (before): 1912DA64
Half checksum: 1912DA64
Full checksum (after): B3F0A43E
GetEmbeddedCRC: :4400A000
The checksum was successfully embedded.
I am using Delphi XE5.
You should understand how this code works.
Overall idea is to append the CRC as an extra 4 bytes, out of the EXE structure, to the end of file. (A better idea would be to put CRC into a special field inside EXE Header in the beginning).
However that raises the hen and the egg problem: after we calculate CRC and embed it - the CRC file is changed (the value of CRC is appended) and the CRC of changed files changes too.
So you basically has to implement two modes/function of CRC calculation: for the whole file and for the file without last 4 bytes. You should use the latter mode to calculate CRC after appending (you call it embedding), and the former one to calculate CRC before it on vanilla just compiled program.
Your GetCRC32 function always cuts last 4 bytes from the file, thus before embedding it calculates CRC only of some part of file, not of the whole file. But there ahve to be two different modes.
PS: you can also "embed" CRC into NTFS Alternate Stream, like having MyApp.exe program and CRC stored as MyApp.exe:CRC.
PPS. i think using unbuffered read byte by byte in the GetCRC32 should be very slow. If possible, better use TBytesStream to read the file into memory as whole and then scan in usual loop over array. Or read it by chunks of 4096 bytes rather than by byte variables.
For the last non-complete buffer you would clean the rest of buffer with zeroes for example.

Delphi: string encryption method and base64

Please suggest me a good string encryption method. Not XOR, it isn't strong enough.
Can I use Base64 to represent the encrypted string, but without "=" on the string's end? I can add it manually. Is it normal? That is a user will use Base64 without "=" in a program, and I will add it. I do not want to have a view with '=', it isn't nice :)
Thanks!!!
Here's one encryption library: http://www.cityinthesky.co.uk/opensource/dcpcrypt
Yes, you can show a base64 string without the '=' sign on the end. You just need to make sure that when you pass the value to a method the method is smart enough to add it back on before attempting the decrypt. This is a pretty common scenario.
heres a function (or a couple of functions) to encode and decode strings you can use, you can call it using Base64Encode('string to be encoded') and Base64Decode('string to be decoded') hope this helps.
const
B64: array[0..63] of byte= (65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,
109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,
54,55,56,57,43,47);
function B64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
var
i, iptr, optr: integer;
Input, Output: PByteArray;
begin
Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
iptr:= 0; optr:= 0;
for i:= 1 to (Size div 3) do
begin
Output^[optr+0]:= B64[Input^[iptr] shr 2];
Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
Output^[optr+2]:= B64[((Input^[iptr+1] and 15) shl 2) + (Input^[iptr+2] shr 6)];
Output^[optr+3]:= B64[Input^[iptr+2] and 63];
Inc(optr,4); Inc(iptr,3);
end;
case (Size mod 3) of
1: begin
Output^[optr+0]:= B64[Input^[iptr] shr 2];
Output^[optr+1]:= B64[(Input^[iptr] and 3) shl 4];
Output^[optr+2]:= byte('=');
Output^[optr+3]:= byte('=');
end;
2: begin
Output^[optr+0]:= B64[Input^[iptr] shr 2];
Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
Output^[optr+2]:= B64[(Input^[iptr+1] and 15) shl 2];
Output^[optr+3]:= byte('=');
end;
end;
Result:= ((Size+2) div 3) * 4;
end;
function Base64Encode(const Value: AnsiString): AnsiString;
begin
SetLength(Result,((Length(Value)+2) div 3) * 4);
B64Encode(#Value[1],#Result[1],Length(Value));
end;
function B64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
var
i, j, iptr, optr: integer;
Temp: array[0..3] of byte;
Input, Output: PByteArray;
begin
Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
iptr:= 0; optr:= 0;
Result:= 0;
for i:= 1 to (Size div 4) do
begin
for j:= 0 to 3 do
begin
case Input^[iptr] of
65..90 : Temp[j]:= Input^[iptr] - Ord('A');
97..122: Temp[j]:= Input^[iptr] - Ord('a') + 26;
48..57 : Temp[j]:= Input^[iptr] - Ord('0') + 52;
43 : Temp[j]:= 62;
47 : Temp[j]:= 63;
61 : Temp[j]:= $FF;
end;
Inc(iptr);
end;
Output^[optr]:= (Temp[0] shl 2) or (Temp[1] shr 4);
Result:= optr+1;
if (Temp[2]<> $FF) and (Temp[3]= $FF) then
begin
Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
Result:= optr+2;
Inc(optr)
end
else if (Temp[2]<> $FF) then
begin
Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
Output^[optr+2]:= (Temp[2] shl 6) or Temp[3];
Result:= optr+3;
Inc(optr,2);
end;
Inc(optr);
end;
end;
function Base64Decode(const Value: AnsiString): AnsiString;
begin
SetLength(Result,(Length(Value) div 4) * 3);
SetLength(Result,B64Decode(#Value[1],#Result[1],Length(Value)));
end;

how to convert big-endian numbers to native numbers delphi

I want to know how to convert big-endian numbers to native numbers in Delphi. I am porting some C++ code in that I came across:
unsigned long blockLength = *blockLengthPtr++ << 24;
blockLength |= *blockLengthPtr++ << 16;
blockLength |= *blockLengthPtr++ << 8;
blockLength |= *blockLengthPtr;
unsigned long dataLength = *dataLengthPtr++ << 24;
dataLength |= *dataLengthPtr++ << 16;
dataLength |= *dataLengthPtr++ << 8;
dataLength |= *dataLengthPtr;
I am not familiar with C++, so I don't understand what those operators do.
Andreas's answer is a pretty good example of how to do it in pure pascal, but it still looks kinda awkward, just like the C++ code. This can actually be done in a single assembly instruction, though which one depends on whether you're using 32-bit or 16-bit integers:
function SwapEndian32(Value: integer): integer; register;
asm
bswap eax
end;
function SwapEndian16(Value: smallint): smallint; register;
asm
rol ax, 8
end;
To reverse the order of the bits:
procedure SwapEndiannessOfBits(var Value: cardinal);
var
tmp: cardinal;
i: Integer;
begin
tmp := 0;
for i := 0 to 8*sizeof(Value) - 1 do
inc(tmp, ((Value shr i) and $1) shl (8*sizeof(Value) - i - 1));
Value := tmp;
end;
To reverse the order of the bytes:
procedure SwapEndiannessOfBytes(var Value: cardinal);
var
tmp: cardinal;
i: Integer;
begin
tmp := 0;
for i := 0 to sizeof(Value) - 1 do
inc(tmp, ((Value shr (8*i)) and $FF) shl (8*(sizeof(Value) - i - 1)));
Value := tmp;
end;
I think the last one is what you are looking for. Most likely there are faster and more elegant solutions, though.
Disclaimer: I might be totally wrong. I feel a bit confused at the moment. Hopefully someone else will see this question and provide a more definite answer!

Resources