Why embedded CRC and current CRC differs? - delphi

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.

Related

B-Spline Curves coefficients - division by zero (code in DELPHI)

I was trying to implement the following recursive formula to my code
but to my surprise it turns out that after implementing this to DELPHI, I get an error due to division by zero. I am 98% sure that my knot vector is correctly calculated, which in a way means there shouldn't be any divisions by zero. I am 70% sure that the recursive formula is correctly implemented, for that reason I am posting my code here:
program project1;
uses
SysUtils;
Type
TRealPoint = record
x: single;
y: single;
end;
type
TSample = Class(TObject)
public
KnotVector: array of single;
FitPoints: array of TRealPoint;
Degree: integer;
constructor Create; overload;
function Coefficient(i, p: integer; Knot: single): single;
procedure GetKnots;
destructor Destroy; overload;
end;
constructor TSample.Create;
begin
inherited;
end;
function TSample.Coefficient(i, p: integer; Knot: single): single;
var
s1, s2: single;
begin
If (p = 0) then
begin
If (KnotVector[i] <= Knot) And (Knot < KnotVector[i+1]) then Result := 1.0
else Result := 0.0;
end
else
begin
s1 := (Knot - KnotVector[i])*Coefficient(i, p-1, Knot)/(KnotVector[i+p] - KnotVector[i]); //THIS LINE ERRORS due to division by zero ???
s2 := (KnotVector[i+p+1]-Knot)*Coefficient(i+1,p-1,Knot)/(KnotVector[i+p+1]-KnotVector[i+1]);
Result := s1 + s2;
end;
end;
procedure TSample.GetKnots();
var
KnotValue: single;
i, MaxKnot: integer;
begin
// KNOTS
KnotValue:= 0.0;
SetLength(KnotVector, Length(FitPoints) + 1 + Degree);
MaxKnot:= Length(KnotVector) - (2*Degree + 1);
for i := Low(KnotVector) to High(KnotVector) do
begin
if i <= (Degree) then KnotVector[i] := KnotValue / MaxKnot
else if i > Length(FitPoints) then KnotVector[i] := KnotValue / MaxKnot
else
begin
KnotValue := KnotValue + 1.0;
KnotVector[i] := KnotValue / MaxKnot;
end;
end;
end;
destructor TSample.Destroy;
begin
inherited;
end;
var
i, j: integer;
Test: TSample;
N: array of array of single;
begin
Test := TSample.Create;
//define degree
Test.Degree := 3;
//random fit points
j := 15;
SetLength(Test.FitPoints, j + 1 + Test.Degree);
For i := Low(Test.FitPoints) to High(Test.FitPoints) do
begin
Test.FitPoints[i].x := Random()*2000;
Test.FitPoints[i].y := Random()*2000;
end;
//get knot vector
Test.GetKnots;
//get coefficients
SetLength(N, j+1, j+1);
For j := Low(N) to High(N) do
begin
For i := Low(N[j]) to High(N[j]) do
begin
N[j, i] := Test.Coefficient(i,3,Test.KnotVector[j]);
write(floattostrf(N[j,i], ffFixed, 2, 2) + ', ');
end;
writeln();
end;
readln();
Test.Free;
end.
Basically I'm not sure how to continue. I would need the values of matrix N (see this link) of basis coefficients but somehow using the formula from this link leads me to division by zero.
So... Is there a totally different way how to calculate those coefficients or what is the problem here?
UPDATE
Instead of using my own idea i tried to implement the algorithm from here as suggested by Dsm in the comments. As a result, there is no more divison by zero, but the result is totally unexpected anyways.
For n + 1 = 10 random fit points with spline degree 3 the basis matrix N (see link) is singular - as seen from the attached image.
Instead of that I would expect the matrix to be band matrix. Anyway, here is my updated code:
program project1;
uses
SysUtils;
Type
TRealPoint = record
x: single;
y: single;
end;
type
TMatrix = array of array of double;
type
TSample = Class(TObject)
public
KnotVector: array of double;
FitPoints: array of TRealPoint;
SplineDegree: integer;
Temp: array of double;
A: TMatrix;
procedure GetKnots;
function GetBasis(Parameter: double): boolean;
procedure FormBasisMatrix;
end;
procedure TSample.GetKnots();
var
i, j: integer;
begin
// KNOTS
//https://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/INT-APP/PARA-knot-generation.html
SetLength(KnotVector, Length(FitPoints) + SplineDegree + 1);
for i := Low(KnotVector) to High(KnotVector) do
begin
if i <= SplineDegree then KnotVector[i] := 0
else if i <= (High(KnotVector) - SplineDegree - 1) then KnotVector[i] := (i - SplineDegree) / (Length(FitPoints) - SplineDegree)
else KnotVector[i] := 1;
end;
end;
function TSample.GetBasis(Parameter: double): boolean;
var
m, d, k: integer;
FirstTerm, SecondTerm: double;
begin
//http://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/spline/B-spline/bspline-curve-coef.html
Result := False;
//initialize to 0
SetLength(Temp, Length(FitPoints));
For m := Low(Temp) to High(Temp) do Temp[m] := 0.0;
//special cases
If Abs(Parameter - KnotVector[0]) < 1e-8 then
begin
Temp[0] := 1;
end
else if Abs(Parameter - KnotVector[High(KnotVector)]) < 1e-8 then
begin
Temp[High(Temp)] := 1;
end
else
begin
//find knot span [u_k, u_{k+1})
for k := Low(KnotVector) to High(KnotVector) do if Abs(KnotVector[k] - Parameter) < 1e-8 then break;
Temp[k] := 1.0;
for d := 1 to SplineDegree do
begin
Temp[k - d] := (KnotVector[k + 1] - Parameter) * Temp[k - d + 1] / (KnotVector[k + 1] - KnotVector[k - d + 1]);
for m := k - d + 1 to k - 1 do
begin
FirstTerm := (Parameter - KnotVector[m]) / (KnotVector[m + d] - KnotVector[m]);
SecondTerm := (KnotVector[m + d + 1] - Parameter) / (KnotVector[m + d + 1] - KnotVector[m + 1]);
Temp[m] := FirstTerm * Temp[m] + SecondTerm * Temp[m + 1];
end;
Temp[k] := (Parameter - KnotVector[k]) * Temp[k] / (KnotVector[k + d] - KnotVector[k]);
end;
end;
Result := True;
end;
procedure TSample.FormBasisMatrix;
var
i, j: integer;
begin
SetLength(A, Length(FitPoints), Length(FitPoints));
for j := Low(A) to High(A) do
begin
for i := low(A[j]) to High(A[j]) do //j - row, i - column
begin
If GetBasis(KnotVector[j + SplineDegree]) then A[j, i] := Temp[i];
end;
end;
end;
var
i, j, iFitPoints: integer;
Test: TSample;
N: array of array of single;
begin
Test := TSample.Create;
//define degree
Test.SplineDegree := 3;
//random fit points
iFitPoints := 10;
SetLength(Test.FitPoints, iFitPoints);
For i := Low(Test.FitPoints) to High(Test.FitPoints) do
begin
Test.FitPoints[i].x := Random()*200;
Test.FitPoints[i].y := Random()*200;
end;
//get knot vector
Test.GetKnots;
//get B-Spline basis matrix
Test.FormBasisMatrix;
// print matrix
for j := Low(Test.A) to High(Test.A) do
begin
for i := Low(Test.A) to High(Test.A) do write(FloatToStrF(Test.A[j, i], ffFixed, 2, 2) + ', ');
writeln();
end;
readln();
Test.Free;
end.
This does not appear to be the complete answer, but it may help you on your way, and the result is closer to what you expect, but as I say, not completely there.
First of all the knots do not look right to me. The knots appear to form a 'ramp' function (clamped line), and though I can't work out if 'm' has any specific value, I would expect the function to be continuous, which yours is not. Making it continuous gives better results, e.g.
procedure TSample.GetKnots();
var
i, j: integer;
iL : integer;
begin
// KNOTS
//https://pages.mtu.edu/~shene/COURSES/cs3621/NOTES/INT-APP/PARA-knot-generation.html
iL := Length( FitPoints );
SetLength(KnotVector, iL + SplineDegree + 1);
// set outer knot values and sum used to geterate first internal value
for i := 0 to SplineDegree - 1 do
begin
KnotVector[ i ] := 0;
KnotVector[ High(KnotVector)-i] := 1;
end;
// and internal ones
for i := 0 to High(KnotVector) - 2* SplineDegree + 1 do
begin
KnotVector[ SplineDegree + i - 1] := i / (iL - 1);
end;
end;
I introduced iL = Length( Fitpoints ) for convenience - it is not important.
The second issue I spotted is more of a programming one. In the GetBasis routine, you evaluate k by breaking a for loop. The problem with that is that k is not guaranteed to persist outside the loop, so your use of it later is not guaranteed to succeed (although it may)
Finally, in the same place, your range determination is completely wrong in my opinion. You should be looking for parameter to lie in a half open line segment, but instead you are looking for it to lie close to an endpoint of that line.
Putting these two together
for k := Low(KnotVector) to High(KnotVector) do if Abs(KnotVector[k] - Parameter) < 1e-8 then break;
should be replaced by
k1 := 0;
for k1 := High(KnotVector) downto Low(KnotVector) do
begin
if Parameter >= KnotVector[k1] then
begin
k := k1;
break;
end;
end;
where k1 is an integer.
I can't help feeling that there is a plus 1 error somewhere, but I can't spot it.
Anyway, I hope that this helps you get a bit further.
To build recursive pyramid for coefficient calculation at intervals, you have to start top level of recursion (inner loop of calculations) from the first real (not duplicate) knot index:
For i := Test.Degree...
Also check the last loop index.
P.S. You can remove constructor and destructor from class description and implementation if they have nothing but inherited.

Byte array to Signed integer in Delphi

source array(4 bytes)
[$80,$80,$80,$80] =integer 0
[$80,$80,$80,$81] = 1
[$80,$80,$80,$FF] = 127
[$80,$80,$81,$01] = 128
need to convert this to integer.
below is my code and its working at the moment.
function convert(b: array of Byte): Integer;
var
i, st, p: Integer;
Negative: Boolean;
begin
result := 0;
st := -1;
for i := 0 to High(b) do
begin
if b[i] = $80 then Continue // skip leading 80
else
begin
st := i;
Negative := b[i] < $80;
b[i] := abs(b[i] - $80);
Break;
end;
end;
if st = -1 then exit;
for i := st to High(b) do
begin
p := round(Power(254, High(b) - i));
result := result + b[i] * p;
result := result - (p div 2);
end;
if Negative then result := -1 * result
end;
i'm looking for a better function?
Update:
file link
https://drive.google.com/file/d/0ByBA4QF-YOggZUdzcXpmOS1aam8/view?usp=sharing
in uploaded file ID field offset is from 5 to 9
NEW:
Now i got into new problem which is decoding date field
Date field hex [$80,$8F,$21,$C1] -> possible date 1995-12-15
* in uploaded file date field offset is from 199 to 203
Just an example of some improvements as outlined by David.
The array is passed by reference as a const.
The array is fixed in size.
The use of floating point calculations are converted directly into a constant array.
Const
MaxRange = 3;
Type
TMySpecial = array[0..MaxRange] of Byte;
function Convert(const b: TMySpecial): Integer;
var
i, j: Integer;
Negative: Boolean;
Const
// Pwr[i] = Round(Power(254,MaxRange-i));
Pwr: array[0..MaxRange] of Cardinal = (16387064,64516,254,1);
begin
for i := 0 to MaxRange do begin
if (b[i] <> $80) then begin
Negative := b[i] < $80;
Result := Abs(b[i] - $80)*Pwr[i] - (Pwr[i] shr 1);
for j := i+1 to MaxRange do
Result := Result + b[j]*Pwr[j] - (Pwr[j] shr 1);
if Negative then
Result := -Result;
Exit;
end;
end;
Result := 0;
end;
Note that less code lines is not always a sign of good performance.
Always measure performance before optimizing the code in order to find real bottlenecks.
Often code readability is better than optimizing over the top.
And for future references, please tell us what the algorithm is supposed to do.
Code for testing:
const
X : array[0..3] of TMySpecial =
(($80,$80,$80,$80), // =integer 0
($80,$80,$80,$81), // = 1
($80,$80,$80,$FF), // = 127
($80,$80,$81,$01)); // = 128
var
i,j: Integer;
sw: TStopWatch;
begin
sw := TStopWatch.StartNew;
for i := 1 to 100000000 do
for j := 0 to 3 do
Convert(X[j]);
WriteLn(sw.ElapsedMilliseconds);
ReadLn;
end.

When I encode/decode SMS PDU (GSM 7 Bit) user data, do I need prepend the UDH first?

While I can successfully encode and decode the user data part of an SMS message when a UDH is not present, I'm having trouble doing so when a UDH is present (in this case, for concatenated SMS).
When I decode or encode the user data, do I need to prepend the UDH to the text before doing so?
This article provides an encoding routine sample that compensates for the UDH with padding bits (which I still don't completely understand) but it doesn't give an example of data being passed to the routine so I don't have a clear use case (and I could not find a decoding sample on the site):
http://mobiletidings.com/2009/07/06/how-to-pack-gsm7-into-septets/.
So far, I have been able to get some results if I prepend the UDH to the user data before decoding it, but I suspect this is just a coincidence.
As an example (using values from https://en.wikipedia.org/wiki/Concatenated_SMS):
UDH := '050003000302';
ENCODED_USER_DATA_PART := 'D06536FB0DBABFE56C32'; // with padding, evidently
DecodedUserData := Decode7Bit(UDH + ENCODED_USER_DATA_PART);
Writeln(DecodedUserData);
Output: "ß#ø¿Æ #hello world"
EncodedUserData := Encode7Bit(DecodedUserData);
DecodedUserData := Decode7Bit(EncodedEncodedUserData);
Writeln(DecodedUserData);
Same Output: "ß#ø¿Æ #hello world"
Without prepending the UDH I get garbage:
DecodedUserData := Decode7Bit(ENCODED_USER_DATA_PART);
Writeln(DecodedUserData);
Output: "PKYY§An§eYI"
What is correct way of handling this?
Am I supposed to include the UDH with the text when encoding the user data?
Am I supposed to strip off the garbage characters after decoding, or am I (as I suspect) completely off base with this assumption?
While the decoding algorithm here seems to work without a UDH it doesn't seem to take any UDH information into account:
Looking for GSM 7bit encode/decode algorithm.
I would be eternally grateful if someone could set me straight on the correct way to proceed. Any clear examples/code samples would be very much appreciated. ;-)
I will also provide a small sample application that includes the algorithms if anyone feels it will help solve the riddle.
EDIT 1:
I'm using Delphi XE2 Update 4 Hotfix 1
EDIT 2:
Thanks to help from #whosrdaddy, I was able to successfully get my encoding/decoding routines to work.
As a side note, I was curious as to why the user data needed to be on a 7-bit boundary when the UDH wasn't encoded with it, but the last sentence in the paragraph from the ETSI specification quoted by #whosrdaddy answered that:
If 7 bit data is used and the TP-UD-Header does not finish on a septet boundary then fill bits are inserted after the last
Information Element Data octet so that there is an integral number of
septets for the entire TP-UD header. This is to ensure that the SM
itself starts on an octet boundary so that an earlier phase mobile
will be capable of displaying the SM itself although the TP-UD Header
in the TP-UD field may not be understood
My code is based in part on examples from the following resources:
Looking for GSM 7bit encode/decode algorithm
https://en.wikipedia.org/wiki/Concatenated_SMS
http://mobiletidings.com/2009/02/18/combining-sms-messages/
http://mobiletidings.com/2009/07/06/how-to-pack-gsm7-into-septets/
http://mobileforensics.files.wordpress.com/2007/06/understanding_sms.pdf
http://www.dreamfabric.com/sms/
http://www.mediaburst.co.uk/blog/concatenated-sms/
Here's the code for anyone else who's had trouble with SMS encoding/decoding. I'm sure it can be simplified/optimized (and comments are welcome), but I've tested it with several different permutations and UDH header lengths with success. I hope it helps.
unit SmsUtils;
interface
uses Windows, Classes, Math;
function Encode7Bit(const AText: string; AUdhLen: Byte;
out ATextLen: Byte): string;
function Decode7Bit(const APduData: string; AUdhLen: Integer): string;
implementation
var
g7BitToAsciiTable: array [0 .. 127] of Byte;
gAsciiTo7BitTable: array [0 .. 255] of Byte;
procedure InitializeTables;
var
AsciiValue: Integer;
i: Integer;
begin
// create 7-bit to ascii table
g7BitToAsciiTable[0] := 64; // #
g7BitToAsciiTable[1] := 163;
g7BitToAsciiTable[2] := 36;
g7BitToAsciiTable[3] := 165;
g7BitToAsciiTable[4] := 232;
g7BitToAsciiTable[5] := 223;
g7BitToAsciiTable[6] := 249;
g7BitToAsciiTable[7] := 236;
g7BitToAsciiTable[8] := 242;
g7BitToAsciiTable[9] := 199;
g7BitToAsciiTable[10] := 10;
g7BitToAsciiTable[11] := 216;
g7BitToAsciiTable[12] := 248;
g7BitToAsciiTable[13] := 13;
g7BitToAsciiTable[14] := 197;
g7BitToAsciiTable[15] := 229;
g7BitToAsciiTable[16] := 0;
g7BitToAsciiTable[17] := 95;
g7BitToAsciiTable[18] := 0;
g7BitToAsciiTable[19] := 0;
g7BitToAsciiTable[20] := 0;
g7BitToAsciiTable[21] := 0;
g7BitToAsciiTable[22] := 0;
g7BitToAsciiTable[23] := 0;
g7BitToAsciiTable[24] := 0;
g7BitToAsciiTable[25] := 0;
g7BitToAsciiTable[26] := 0;
g7BitToAsciiTable[27] := 0;
g7BitToAsciiTable[28] := 198;
g7BitToAsciiTable[29] := 230;
g7BitToAsciiTable[30] := 223;
g7BitToAsciiTable[31] := 201;
g7BitToAsciiTable[32] := 32;
g7BitToAsciiTable[33] := 33;
g7BitToAsciiTable[34] := 34;
g7BitToAsciiTable[35] := 35;
g7BitToAsciiTable[36] := 164;
g7BitToAsciiTable[37] := 37;
g7BitToAsciiTable[38] := 38;
g7BitToAsciiTable[39] := 39;
g7BitToAsciiTable[40] := 40;
g7BitToAsciiTable[41] := 41;
g7BitToAsciiTable[42] := 42;
g7BitToAsciiTable[43] := 43;
g7BitToAsciiTable[44] := 44;
g7BitToAsciiTable[45] := 45;
g7BitToAsciiTable[46] := 46;
g7BitToAsciiTable[47] := 47;
g7BitToAsciiTable[48] := 48;
g7BitToAsciiTable[49] := 49;
g7BitToAsciiTable[50] := 50;
g7BitToAsciiTable[51] := 51;
g7BitToAsciiTable[52] := 52;
g7BitToAsciiTable[53] := 53;
g7BitToAsciiTable[54] := 54;
g7BitToAsciiTable[55] := 55;
g7BitToAsciiTable[56] := 56;
g7BitToAsciiTable[57] := 57;
g7BitToAsciiTable[58] := 58;
g7BitToAsciiTable[59] := 59;
g7BitToAsciiTable[60] := 60;
g7BitToAsciiTable[61] := 61;
g7BitToAsciiTable[62] := 62;
g7BitToAsciiTable[63] := 63;
g7BitToAsciiTable[64] := 161;
g7BitToAsciiTable[65] := 65;
g7BitToAsciiTable[66] := 66;
g7BitToAsciiTable[67] := 67;
g7BitToAsciiTable[68] := 68;
g7BitToAsciiTable[69] := 69;
g7BitToAsciiTable[70] := 70;
g7BitToAsciiTable[71] := 71;
g7BitToAsciiTable[72] := 72;
g7BitToAsciiTable[73] := 73;
g7BitToAsciiTable[74] := 74;
g7BitToAsciiTable[75] := 75;
g7BitToAsciiTable[76] := 76;
g7BitToAsciiTable[77] := 77;
g7BitToAsciiTable[78] := 78;
g7BitToAsciiTable[79] := 79;
g7BitToAsciiTable[80] := 80;
g7BitToAsciiTable[81] := 81;
g7BitToAsciiTable[82] := 82;
g7BitToAsciiTable[83] := 83;
g7BitToAsciiTable[84] := 84;
g7BitToAsciiTable[85] := 85;
g7BitToAsciiTable[86] := 86;
g7BitToAsciiTable[87] := 87;
g7BitToAsciiTable[88] := 88;
g7BitToAsciiTable[89] := 89;
g7BitToAsciiTable[90] := 90;
g7BitToAsciiTable[91] := 196;
g7BitToAsciiTable[92] := 204;
g7BitToAsciiTable[93] := 209;
g7BitToAsciiTable[94] := 220;
g7BitToAsciiTable[95] := 167;
g7BitToAsciiTable[96] := 191;
g7BitToAsciiTable[97] := 97;
g7BitToAsciiTable[98] := 98;
g7BitToAsciiTable[99] := 99;
g7BitToAsciiTable[100] := 100;
g7BitToAsciiTable[101] := 101;
g7BitToAsciiTable[102] := 102;
g7BitToAsciiTable[103] := 103;
g7BitToAsciiTable[104] := 104;
g7BitToAsciiTable[105] := 105;
g7BitToAsciiTable[106] := 106;
g7BitToAsciiTable[107] := 107;
g7BitToAsciiTable[108] := 108;
g7BitToAsciiTable[109] := 109;
g7BitToAsciiTable[110] := 110;
g7BitToAsciiTable[111] := 111;
g7BitToAsciiTable[112] := 112;
g7BitToAsciiTable[113] := 113;
g7BitToAsciiTable[114] := 114;
g7BitToAsciiTable[115] := 115;
g7BitToAsciiTable[116] := 116;
g7BitToAsciiTable[117] := 117;
g7BitToAsciiTable[118] := 118;
g7BitToAsciiTable[119] := 119;
g7BitToAsciiTable[120] := 120;
g7BitToAsciiTable[121] := 121;
g7BitToAsciiTable[122] := 122;
g7BitToAsciiTable[123] := 228;
g7BitToAsciiTable[124] := 246;
g7BitToAsciiTable[125] := 241;
g7BitToAsciiTable[126] := 252;
g7BitToAsciiTable[127] := 224;
// create ascii to 7-bit table
ZeroMemory(#gAsciiTo7BitTable, SizeOf(gAsciiTo7BitTable));
for i := 0 to High(g7BitToAsciiTable) do
begin
AsciiValue := g7BitToAsciiTable[i];
gAsciiTo7BitTable[AsciiValue] := i;
end;
end;
function ConvertAsciiTo7Bit(const AText: string; AUdhLen: Byte): AnsiString;
const
ESC = #27;
ESCAPED_ASCII_CODES = [#94, #123, #125, #92, #91, #126, #93, #124, #164];
var
Septet: Byte;
Ch: AnsiChar;
i: Integer;
begin
for i := 1 to Length(AText) do
begin
Ch := AnsiChar(AText[i]);
if not(Ch in ESCAPED_ASCII_CODES) then
Septet := gAsciiTo7BitTable[Byte(Ch)]
else
begin
Result := Result + ESC;
case (Ch) of
#12: Septet := 10;
#94: Septet := 20;
#123: Septet := 40;
#125: Septet := 41;
#92: Septet := 47;
#91: Septet := 60;
#126: Septet := 61;
#93: Septet := 62;
#124: Septet := 64;
#164: Septet := 101;
else Septet := 0;
end;
end;
Result := Result + AnsiChar(Septet);
end;
end;
function Convert7BitToAscii(const AText: AnsiString): string;
const
ESC = #27;
var
TextLen: Integer;
Ch: Char;
i: Integer;
begin
Result := '';
TextLen := Length(AText);
i := 1;
while (i <= TextLen) do
begin
Ch := Char(AText[i]);
if (Ch <> ESC) then
Result := Result + Char(g7BitToAsciiTable[Ord(Ch)])
else
begin
Inc(i); // skip ESC
if (i <= TextLen) then
begin
Ch := Char(AText[i]);
case (Ch) of
#10: Ch := #12;
#20: Ch := #94;
#40: Ch := #123;
#41: Ch := #125;
#47: Ch := #92;
#60: Ch := #91;
#61: Ch := #126;
#62: Ch := #93;
#64: Ch := #124;
#101: Ch := #164;
end;
Result := Result + Ch;
end;
end;
Inc(i);
end;
end;
function StrToHex(const AText: AnsiString): AnsiString; overload;
var
TextLen: Integer;
begin
// set the text buffer size
TextLen := Length(AText);
// set the length of the result to double the string length
SetLength(Result, TextLen * 2);
// convert the string to hex
BinToHex(PAnsiChar(AText), PAnsiChar(Result), TextLen);
end;
function StrToHex(const AText: string): string; overload;
begin
Result := string(StrToHex(AnsiString(AText)));
end;
function HexToStr(const AText: AnsiString): AnsiString; overload;
var
ResultLen: Integer;
begin
// set the length of the result to half the Text length
ResultLen := Length(AText) div 2;
SetLength(Result, ResultLen);
// convert the hex back into a string
if (HexToBin(PAnsiChar(AText), PAnsiChar(Result), ResultLen) <> ResultLen) then
Result := 'Error Converting Hex To String: ' + AText;
end;
function HexToStr(const AText: string): string; overload;
begin
Result := string(HexToStr(AnsiString(AText)));
end;
function Encode7Bit(const AText: string; AUdhLen: Byte;
out ATextLen: Byte): string;
// AText: Ascii text
// AUdhLen: Length of UDH including UDH Len byte (e.g. '050003CC0101' = 6 bytes)
// ATextLen: returns length of text that was encoded. This can be different
// than Length(AText) due to escape characters
// Returns text as encoded PDU hex string
var
Text7Bit: AnsiString;
Pdu: AnsiString;
PduIdx: Integer;
PduLen: Byte;
PaddingBits: Byte;
BitsToMove: Byte;
Septet: Byte;
Octet: Byte;
PrevOctet: Byte;
ShiftedOctet: Byte;
i: Integer;
begin
Result := '';
Text7Bit := ConvertAsciiTo7Bit(AText, AUdhLen);
ATextLen := Length(Text7Bit);
BitsToMove := 0;
// determine how many padding bits needed based on the UDH
if (AUdhLen > 0) then
PaddingBits := 7 - ((AUdhLen * 8) mod 7)
else
PaddingBits := 0;
// calculate the number of bytes needed to store the 7-bit text
// along with any padding bits that are required
PduLen := Ceil(((ATextLen * 7) + PaddingBits) / 8);
// reserve space for the PDU bytes
Pdu := AnsiString(StringOfChar(#0, PduLen));
PduIdx := 1;
for i := 1 to ATextLen do
begin
if (BitsToMove = 7) then
BitsToMove := 0
else
begin
// convert the current character to a septet (7-bits) and make room for
// the bits from the next one
Septet := (Byte(Text7Bit[i]) shr BitsToMove);
if (i = ATextLen) then
Octet := Septet
else
begin
// convert the next character to a septet and copy the bits from it
// to the octet (PDU byte)
Octet := Septet or
Byte((Byte(Text7Bit[i + 1]) shl Byte(7 - BitsToMove)));
end;
Byte(Pdu[PduIdx]) := Octet;
Inc(PduIdx);
Inc(BitsToMove);
end;
end;
// The following code pads the pdu on the *right* by shifting it to the *left*
// by <PaddingBits>. It does this by using the same bit storage convention as
// the 7-bit compression routine above, by taking the most significant
// <PaddingBits> from each PDU byte and moving them to the least significant
// bits of the next PDU byte. If there is no room in the last PDU byte for the
// high bits of the previous byte that were removed, then those bits are
// placed into an additional byte reserved for this purpose.
// Note: <PduLen> has already been set to account for the reserved byte if
// it is required.
if (PaddingBits > 0) then
begin
SetLength(Result, (PduLen * 2));
PrevOctet := 0;
for PduIdx := 1 to PduLen do
begin
Octet := Byte(Pdu[PduIdx]);
if (PduIdx = 1) then
ShiftedOctet := Byte(Octet shl PaddingBits)
else
ShiftedOctet := Byte(Octet shl PaddingBits) or
Byte(PrevOctet shr (8 - PaddingBits));
Byte(Pdu[PduIdx]) := ShiftedOctet;
PrevOctet := Octet;
end;
end;
Result := string(StrToHex(Pdu));
end;
function Decode7Bit(const APduData: string; AUdhLen: Integer): string;
// APduData: Hex string representation of PDU data
// AUdhLen: Length of UDH including UDH Len (e.g. '050003CC0101' = 6 bytes)
// Returns decoded Ascii text
var
Pdu: AnsiString;
NumSeptets: Byte;
Septets: AnsiString;
PduIdx: Integer;
PduLen: Integer;
by: Byte;
currBy: Byte;
left: Byte;
mask: Byte;
nextBy: Byte;
Octet: Byte;
NextOctet: Byte;
PaddingBits: Byte;
ShiftedOctet: Byte;
i: Integer;
begin
Result := '';
PaddingBits := 0;
// convert hex string to bytes
Pdu := AnsiString(HexToStr(APduData));
PduLen := Length(Pdu);
// The following code removes padding at the end of the PDU by shifting it
// *right* by <PaddingBits>. It does this by taking the least significant
// <PaddingBits> from the following PDU byte and moving them to the most
// significant the current PDU byte.
if (AUdhLen > 0) then
begin
PaddingBits := 7 - ((AUdhLen * 8) mod 7);
for PduIdx := 1 to PduLen do
begin
Octet := Byte(Pdu[PduIdx]);
if (PduIdx = PduLen) then
ShiftedOctet := Byte(Octet shr PaddingBits)
else
begin
NextOctet := Byte(Pdu[PduIdx + 1]);
ShiftedOctet := Byte(Octet shr PaddingBits) or
Byte(NextOctet shl (8 - PaddingBits));
end;
Byte(Pdu[PduIdx]) := ShiftedOctet;
end;
end;
// decode
// number of septets in PDU after excluding the padding bits
NumSeptets := ((PduLen * 8) - PaddingBits) div 7;
Septets := AnsiString(StringOfChar(#0, NumSeptets));
left := 7;
mask := $7F;
nextBy := 0;
PduIdx := 1;
for i := 1 to NumSeptets do
begin
if mask = 0 then
begin
Septets[i] := AnsiChar(nextBy);
left := 7;
mask := $7F;
nextBy := 0;
end
else
begin
if (PduIdx > PduLen) then
Break;
by := Byte(Pdu[PduIdx]);
Inc(PduIdx);
currBy := ((by AND mask) SHL (7 - left)) OR nextBy;
nextBy := (by AND (NOT mask)) SHR left;
Septets[i] := AnsiChar(currBy);
mask := mask SHR 1;
left := left - 1;
end;
end; // for
// remove last character if unused
// this is kind of a hack, but frankly I don't know how else to compensate
// for it.
if (Septets[NumSeptets] = #0) then
SetLength(Septets, NumSeptets - 1);
// convert 7-bit alphabet to ascii
Result := Convert7BitToAscii(Septets);
end;
initialization
InitializeTables;
end.
no you don't include the UDH part when encoding, but you if read the GSM phase 2 specification on page 57, they mention this fact : "If 7 bit data is used and the TP-UD-Header does not finish on a septet boundary then fill bits are inserted
after the last Information Element Data octet so that there is an integral number of septets for the entire
TP-UD header". When you include a UDH part this could not be the case, so all you need to do is calculate the offset (= number of fill bits)
Calculating the offset, this code assumes that UDHPart is a AnsiString:
Len := Length(UDHPart) shr 1;
Offset := 7 - ((Len * 8) mod 7); // fill bits
now when encoding the 7bit data, you proceed as normal but at the end, you shift the data Offset bits to the left, this code has the encoded data in variable result (ansistring):
// fill bits
if Offset > 0 then
begin
v := Result;
Len := Length(v);
BytesRemain := ceil(((Len * 7)+Offset) / 8);
Result := StringOfChar(#0, BytesRemain);
for InPos := 1 to BytesRemain do
begin
if InPos = 1 then
Byte(Result[InPos]) := Byte(v[InPos]) shl offset
else
Byte(Result[InPos]) := (Byte(v[InPos]) shl offset) or (Byte(v[InPos-1]) shr (8 - offset));
end;
end;
Decoding is same thing really, you first shift the 7 bit data offset bits to the right before decoding...
I hope this will set you onto the right track...
In your case
Data is D06536FB0DBABFE56C32
Get first char is D0 => h (in first 7 bit, the 8th bit not use)
The rest is 6536FB0DBABFE56C32
In bin
(01100101)0011011011111011000011011011101010111111111001010110110000110010
Shift right to left. => each right 7 bit is a char!
001100100110110011100101101111111011101000001101111 1101100 110110(0 1100101)
I shift 7 to left. you can get string from above. but i do for easy show :D
(1100101)(1101100)(1101100)(1101111)(0100000)(1110111)(1101111)(1110010)(1101100)(1100100)00
And the string is "ello world"
combine with first char you get "hello world"

Hex to Binary convert

I have converted my jpeg file as HEX code through hex converter.
Now how to convert that hex to binary and save as Jpeg file on disk.
Like:
var declared as Hex code and then convert that var hex code to binary and save on disk ?
Edit:
Var
myfileHex := 'FAA4F4AAA444444'; // long as HEX code of my JPEG
function HexToBin(myfileHex): string;
begin
// Convert Hex to bin and save file as...
end;
Delphi already has HexToBin (Classes) procedure, since at least D5.
Try this code:
procedure HexStringToBin;
var
BinaryStream: TMemoryStream;
HexStr: AnsiString;
begin
HexStr := 'FAA4F4AAA44444';
BinaryStream := TMemoryStream.Create;
try
BinaryStream.Size := Length(HexStr) div 2;
if BinaryStream.Size > 0 then
begin
HexToBin(PAnsiChar(HexStr), BinaryStream.Memory, BinaryStream.Size);
BinaryStream.SaveToFile('c:\myfile.bin')
end;
finally
BinaryStream.Free;
end;
end;
The same could be done with any binary TStream e.g. TFileStream.
Hex is very easy to decode manually:
procedure HexToBin(const Hex: string; Stream: TStream);
var
B: Byte;
C: Char;
Idx, Len: Integer;
begin
Len := Length(Hex);
If Len = 0 then Exit;
If (Len mod 2) <> 0 then raise Exception.Create('bad hex length');
Idx := 1;
repeat
C := Hex[Idx];
case C of
'0'..'9': B := Byte((Ord(C) - '0') shl 4);
'A'..'F': B := Byte(((Ord(C) - 'A') + 10) shl 4);
'a'..'f': B := Byte(((Ord(C) - 'a') + 10) shl 4);
else
raise Exception.Create('bad hex data');
end;
C := Hex[Idx+1];
case C of
'0'..'9': B := B or Byte(Ord(C) - '0');
'A'..'F': B := B or Byte((Ord(C) - 'A') + 10);
'a'..'f': B := B or Byte((Ord(C) - 'a') + 10);
else
raise Exception.Create('bad hex data');
end;
Stream.WriteBuffer(B, 1);
Inc(Idx, 2);
until Idx > Len;
end;
begin
FStream := TFileStream.Create('myfile.jpg', fmCreate);
HexToBin(myFileHex, FStream);
FStream.Free;
end;

How to migrate from Delphi6 to Delphi2010 (Unicode Problem)

Hi I was using the Francois Piette's RasDial with Delphi 6, but it stopped working in Delphi 2010
How can I keep using these functions like before?
class function Encryption.DecriptPasswd(strPasswd: string): string;
type
PWORD = ^WORD;
var
Buffer : String;
PW : String[255];
P : PWORD;
I : Integer;
V : Integer;
begin
PW := ' ';
P := PWORD(#PW[0]);
I := 1;
while I <= Length(strPasswd) do
begin
Buffer := Copy(strPasswd, I, 5);
I := I + 5;
V := StrToInt(Buffer) - 34567;
P^ := V;
Inc(P);
end;
Result := PW;
end;
class function Encryption.EncriptPasswd(strPasswd: string): string;
type
PWORD = ^WORD;
var
Len : Integer;
I : Integer;
V : DWORD;
P : PChar;
Buffer : String[255];
begin
Buffer := strPasswd;
Len := Length(Buffer) + 1;
if (Len mod 2) <> 0 then
Inc(Len);
if Len < 10 then
Len := 10;
I := Length(Buffer);
if I = 0 then
Buffer := IntToStr(GetTickCount)
else
while Length(Buffer) < 10 do
Buffer := Buffer + Buffer;
SetLength(Buffer, I);
Result := '';
P := PChar(#Buffer[0]);
for I := 1 to Len div 2 do
begin
V := 34567 + PWORD(P)^;
P := P + 2;
Result := Result + Format('%5.5d', [V]);
end;
end;
You can start by changing all string declarations (except the string[255] ones, which already are) to AnsiString, all Char to AnsiChar, and all PChar to PAnsiChar.
Then go here for the first in a series of three articles on porting pre-Unicode versions of Delphi to Unicode. They're really well written by Nick Hodges, former Product Manager for Delphi when it was a CodeGear product. They cover all the details you need to make the changes to your other existing code.
String[255] is short string (one byte)
but when you add pchar, it grows two bytes by two bytes
try replace pchar by pansichar

Resources