Hex to Binary convert - delphi

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;

Related

String of bits To Hex value

I have a string like '10011011001', And I wish to convert this string into Hex string, what is the best way to do that.
The OP clarified that the input string's length is <= 32. Then the problem becomes simpler.
There are many possible solutions. One of them is this:
function BinStrToHex32(const S: string): string;
begin
var LValue: UInt32 := 0;
for var i := 1 to S.Length do
case S[i] of
'0', '1':
LValue := LValue shl 1 or Ord(S[i] = '1');
else
raise Exception.CreateFmt('Invalid binary number: %s', [S]);
end;
Result := IntToHex(LValue);
end;
which IMHO is quite readable and performs some validation. (For bonus points, you can add overflow checking.)
If there were no restriction to the input string length, then I'd do something like this:
function BinStrToHexStr(const S: string): string;
const
HexDigits: array[0..$F] of Char = '0123456789ABCDEF';
begin
if S.Length mod 8 <> 0 then
raise Exception.Create('Invalid binary string.');
SetLength(Result, S.Length div 4);
var LNibble: Byte := 0;
var c := 0;
for var i := 1 to S.Length do
begin
LNibble := LNibble shl 1 or Ord(S[i] = '1');
if i mod 4 = 0 then
begin
Inc(c);
Result[c] := HexDigits[LNibble];
LNibble := 0;
end;
end;
end;

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.

export delphi stringgrid to excel

I'm trying to export data from a stringgrid in delphi 7 to microsoft excel. I have been using this code to do it:
objExcel := TExcelApplication.Create(nil);
objExcel.Visible[LOCALE_USER_DEFAULT] := true;
objWB := objExcel.workbooks.add(null,LOCALE_USER_DEFAULT);
lineNumber := 1;
for i:=1 to stringgrid1.rowcount-1 do begin
for j:=0 to stringgrid1.ColCount-1 do begin
objWB.Worksheets.Application.Cells.Item[i+lineNumber,j+1] := ''''+stringgrid1.Cells[j,i];
end;
end;
but when the data is big, it takes a very long time to finish. is there other faster way to export data from delphi 7 stringgrid to excel?
The quickest way is to use an array of Variant,and just pass the entire array to Excel:
uses OleAuto;
var
xls, wb, Range: OLEVariant;
arrData: Variant;
RowCount, ColCount, i, j: Integer;
begin
{create variant array where we'll copy our data}
RowCount := StringGrid1.RowCount;
ColCount := StringGrid1.ColCount;
arrData := VarArrayCreate([1, RowCount, 1, ColCount], varVariant);
{fill array}
for i := 1 to RowCount do
for j := 1 to ColCount do
arrData[i, j] := StringGrid1.Cells[j-1, i-1];
{initialize an instance of Excel}
xls := CreateOLEObject('Excel.Application');
{create workbook}
wb := xls.Workbooks.Add;
{retrieve a range where data must be placed}
Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1, 1],
wb.WorkSheets[1].Cells[RowCount, ColCount]];
{copy data from allocated variant array}
Range.Value := arrData;
{show Excel with our data}
xls.Visible := True;
end;
The problem is that you are calling the Excel object for every cell; this is a slow operation at the best of times, so doing this for a large number of cells is going to take a long time. I had a case of this not so long ago: 4000 rows with 9 columns took about 44 seconds to transfer to Excel.
My current solution involves creating a csv file then importing that csv into Excel.
const
fn = 'c:\windows\temp\csv.csv';
var
csv: tstringlist;
row, col: integer;
s: string;
begin
csv:= tstringlist.create;
for row:= 1 to stringgrid1.rowcount do
begin
s:= '';
for col:= 0 to stringgrid1.ColCount-1 do
s:= s + stringgrid1.Cells[col, row-1] + ',';
csv.add (s)
end;
csv.savetofile (fn);
csv.free;
objExcel := TExcelApplication.Create(nil);
objExcel.workbooks.open (fn);
deletefile (fn);
end;
Another way comes from Mike Shkolnik which I am quoting as is:
var
xls, wb, Range: OLEVariant;
arrData: Variant;
begin
{create variant array where we'll copy our data}
arrData := VarArrayCreate([1, yourStringGrid.RowCount, 1, yourStringGrid.ColCount], varVariant);
{fill array}
for i := 1 to yourStringGrid.RowCount do
for j := 1 to yourStringGrid.ColCount do
arrData[i, j] := yourStringGrid.Cells[j-1, i-1];
{initialize an instance of Excel}
xls := CreateOLEObject('Excel.Application');
{create workbook}
wb := xls.Workbooks.Add;
{retrieve a range where data must be placed}
Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1, 1],
wb.WorkSheets[1].Cells[yourStringGrid.RowCount, yourStringGrid.ColCount]];
{copy data from allocated variant array}
Range.Value := arrData;
{show Excel with our data}
xls.Visible := True;
end;
I suggest that you try both methods and see which is faster for your purposes.
procedure WriteToExcel();
var
txt : TextFile;
Str : string;
i : integer;
begin
try
SaveDialog1.FileName := 'excelFile('+FormatDateTime('yyyy-dd-mm hh-nn-ss' ,(Now))+')';
if SaveDialog1.Execute then
begin
AssignFile(txt, SaveDialog1.FileName+'.csv');
try
if FileExists(SaveDialog1.FileName) then
Append(txt)
else
ReWrite(txt);
Str := 'title1, title2, title3, title4, title5';
WriteLn(txt, Str);
ShowQuery.First();
for i:=1 to StringGrid1.RowCount do
begin
Str := StringGrid1.Cols[i][1] + ',';
Str := Str + StringGrid1.Cols[i][2] + ',';
Str := Str + StringGrid1.Cols[i][3] + ',';
Str := Str + StringGrid1.Cols[i][4] + ',';
Str := Str + StringGrid1.Cols[i][5];
WriteLn(txt, Str);
end;
finally
CloseFile(txt);
end;
end;
except
end;
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

Convert hex string to ansistring in Delphi 2010

I used to use this function to convert hex string to string in Delphi 6 :
const
testSign = '207F8060287F585054505357FFD55861';
function Hex2Dec(const data: string): byte;
var
nH1, nH2: byte;
begin
if data[1] in ['0' .. '9'] then
nH1 := strtoint(data[1])
else
nH1 := 9 + ord(data[1]) - 64;
if data[2] in ['0' .. '9'] then
nH2 := strtoint(data[2])
else
nH2 := 9 + ord(data[2]) - 64;
Result := nH1 * 16 + nH2;
end;
function HexStrToStr(const HexStr: string): string;
var
BufStr: string;
LenHex: Integer;
x, y: Integer;
begin
LenHex := Length(HexStr) div 2;
x := 1;
y := 0;
while y <> LenHex do
begin
Inc(y);
BufStr := BufStr + Chr(Hex2Dec(HexStr[x] + HexStr[x + 1]));
Inc(x, 2);
end;
Result := BufStr;
end;
Now I want to use the function with Delphi 2010.
const
testSign: AnsiString = '207F8060287F585054505357FFD55861';
function Hex2Dec(const data: ansistring): byte;
var
nH1, nH2: byte;
begin
if data[1] in ['0' .. '9'] then
nH1 := strtoint(data[1])
else
nH1 := 9 + ord(data[1]) - 64;
if data[2] in ['0' .. '9'] then
nH2 := strtoint(data[2])
else
nH2 := 9 + ord(data[2]) - 64;
Result := nH1 * 16 + nH2;
end;
function HexStrToStr(const HexStr: ansistring): ansistring;
var
BufStr: ansistring;
LenHex: Integer;
x, y: Integer;
begin
LenHex := Length(HexStr) div 2;
x := 1;
y := 0;
while y <> LenHex do
begin
Inc(y);
BufStr := BufStr + Chr(Hex2Dec(HexStr[x] + HexStr[x + 1]));
Inc(x, 2);
end;
Result := BufStr;
end;
Output from first code in D6 :
' '#$7F'€`('#$7F'XPTPSWÿÕXa'
Output from second code in D2010 :
' '#$7F#$0080'`('#$7F'XPTPSWÿÕXa'
How do I fix the code in D2010 so it can produces same result like D6?
Besides the solutions others provided, you can also make use of the built-in function:
function HexStrToStr(const HexStr: string): string;
var
tmp: AnsiString;
begin
Assert(not Odd(Length(HexStr)), 'HexToStr input length must be an even number');
SetLength(tmp, Length(HexStr) div 2);
HexToBin(PWideChar(HexStr), #tmp[1], Length(tmp));
result := tmp;
end;
This implementation assumes that the hex-encoded string has been an Ansistring in the first place. For flexibility I suggest to use TBytes instead.

Resources