In Win7 RegEdit edit or view a binary just like 1A 2B 3C 4D
now I get a string
str := '1A,2B,3C,4D';
how to write str into Registry , and in Win7 RegEdit it display 1A 2B 3C 4D
var
Data: array of Byte; // or whatever binary container you want to use
Reg: TRegistry;
begin
...
SetLength(Data, 4);
Data[0] := $1A;
Data[1] := $2B;
Data[2] := $3C;
Data[3] := $4D;
Reg := TRegistry.Create(KEY_SET_VALUE);
try
Reg.RootKey := ...;
if Reg.OpenKey('...', True) then
begin
Reg.WriteBinaryData('Value', Data[0], 4);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
...
end;
You can use TRegistry.WriteBinaryData. If you want to write binary $1A,$2B,$3C,$4D instead of string data '1A,2B,3C,4D' try to change it into #$1A#$2B#$3C#$4D.
str := #$1A#$2B#$3C#$4D;
and use WriteBinaryData to write the registry:
Reg.WriteBinaryData('KeyName', str, Length(str) * SizeOf(Byte));
Related
I've written a Delphi program which creates MJPEG files, which can be several GB in length. The JPGs are grabbed from a DirectX camera using DSPack. That part works fine and creates a file of JPG images in the format:
FF D8 ....(image data)... FF D9 FF D8 .... (image data)... FF D9 FF D8 etc
FF D8 marks the start of a JPG and FF D9 marks the end. Each JPG is around 21KB in size.
Now, I'm trying to write a matching MJPEG player.
In the Form's FormCreate procedure, I create a FileStream and display the first JPG which works fine:
procedure TForm1.FormCreate(Sender: TObject);
var
b: Array[0..1] of Byte;
jpg: TJPEGImage;
begin
:
:
MemoryStream:= TMemoryStream.Create;
jpg:= TJPEGImage.Create;
MJPEGStream:= TFileStream.Create(MJPEGFileName, fmOpenRead);
MJPEGStream.Position:= 0;
repeat
MJPEGStream.Read(b[0], 2); // Find end of first jpg
MemoryStream.Write(b[0], 2); // and write to memory
until (b[0] = $FF) and (b[1] = $D9);
MemoryStream.Position:= 0;
jpg.LoadFromStream(memoryStream);
Image1.Picture.Assign(jpg);
MemoryStream.Free;
jpg.Free;
end;
I leave the FileStream open so, hopefully, its Position pointer is retained.
I have a button on the form, the intention being to jog forwards one JPG at a time but, although the first 'jog' advances one JPG, subsequent jogs advance a random number of times. Here's the procedure:
procedure TForm1.btnJogForwardClick(Sender: TObject);
var
b: Array[0..1] of Byte;
jpg: TJPEGImage;
begin
MemoryStream:= TMemoryStream.Create;
try
repeat
MJPEGStream.Read(b[0], 2);
MemoryStream.Write(b[0], 2);
until ((b[0] = $FF) and (b[1] = $D9));
MemoryStream.Position:= 0;
jpg:= TJPEGImage.Create;
try
try
jpg.LoadFromStream(MemoryStream);
Image1.Picture.Assign(jpg);
except
end;
finally
jpg.Free;
end;
finally
MemoryStream.Free;
end;
I've checked with a 3rd Party MJPEG player and that is able to jog frame by frame so I know the MJPEG file is ok. Any suggestions as to why my procedure isn't stepping uniformly frame by frame would be appreciated.
Thanks,
John.
Thanks for the comments and suggestions. I think I've managed to sort it.
const
JPGSizeMax = 100000;
procedure TForm1.FormCreate(Sender: TObject);
var
b: Array[0..JPGSizeMax] of Byte;
:
:
begin
:
:
MJPEGStream:= TFileStream.Create(MJPEGFileName, fmOpenRead);
MJPEGStream.Position:= 0;
MJPEGStream.Read(b[0], JPGSizeMax);
for i:= 0 to JPGSizeMax do
begin
if (b[i] = $D9) and (b[i-1] = $FF) then
begin
Count:= i;
break;
end;
end;
MemoryStream.Write(b[0], Count);
FilePosition:= Count + 1;
MemoryStream.Position:= 0;
jpg.LoadFromStream(memoryStream);
Image1.Picture.Assign(jpg);
MemoryStream.Free;
jpg.Free;
end;
The procedure for the Jog button is much the same:
MJPEGStream.Position:= FilePosition;
MJPEGStream.Read(b[0], JPGSizeMax);
for i:= 0 to JPGSizeMax do
begin
if (b[i] = $D9) and (b[i-1] = $FF) then
begin
Count:= i;
break;
end;
end;
memoryStream.Write(b[0], Count);
FilePosition:= FilePosition + count + 1;
// etc
Thanks again for pointing me in the right direction.
John.
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;
edited :
My file has several lines. I encrypt the file onto a new file. I want to store each line of decrypted file (=a stream) into StringList.
First, I have a file contain :
aa
bb
cc
I encrypt the file with this function :
procedure EnDecryptFile(pathin, pathout: string; Chave: Word) ;
var
InMS, OutMS: TMemoryStream;
cnt: Integer;
C: byte;
begin
InMS := TMemoryStream.Create;
OutMS := TMemoryStream.Create;
try
InMS.LoadFromFile(pathin) ;
InMS.Position := 0;
for cnt := 0 to InMS.Size - 1 do
begin
InMS.Read(C, 1) ;
C := (C xor not (ord(chave shr cnt))) ;
OutMS.Write(C, 1) ;
end;
OutMS.SaveToFile(pathout) ;
finally
InMS.Free;
OutMS.Free;
end;
end;
My purpose now is to store original value of each line into StringList. I don't want to store decrypted file into harddisk, so I use stream.
This is the function to decrypt the file into stream :
procedure DecryptFile(pathin: string; buff: TMemoryStream; Chave: Word);
var
InMS: TMemoryStream;
cnt: Integer;
C: byte;
begin
InMS := TMemoryStream.Create;
try
InMS.LoadFromFile(pathin);
InMS.Position := 0;
for cnt := 0 to InMS.Size - 1 do
begin
InMS.Read(C, 1);
C := (C xor not(ord(Chave shr cnt)));
buff.Write(C, 1);
end;
// buff.SaveToFile('c:\temp\dump.txt') ;
finally
InMS.free;
end;
end;
--
bbuffer := TMemoryStream.Create;
try
DecryptFile(path, bbuffer, 10); //
//ShowMessage(IntToStr(bbuffer.size)); // output : 1000
bbuffer.Position := 0;
SL := TStringList.Create;
try
SL.LoadFromStream(bbuffer);
for I := 0 to SL.Count - 1 do // SL.Count = 1
begin;
//add each line of orginal file into SL??
end;
finally
SL.free;
end;
finally
bbuffer.free;
end;
Load from stream takes a TStream so you can give it a TFileStream as well as an TMemoryStream. The code you posted should work without any problems. What exactly does not work?
You might have to use
bbuffer.Position := 0;
to reset the position to the start of the stream before loading it into the string list.
EDIT: You write single bytes to a stream and then try to load a string list from it. That won't work. The stream is just a collection of bytes. How should the string list know where one string ends and the next one starts? TStringList.SaveToStream writes separator bytes to the stream so that it can parse the string list back. So, you could do your encryption on the string list and then write the whole string list to the stream, then read the stringlist and do the decryption on the string list.
I am trying to remotely read a binary (REG_BINARY) registry value, but I get nothing but junk back. Any ideas what is wrong with this code? I'm using Delphi 2010:
function GetBinaryRegistryData(ARootKey: HKEY; AKey, AValue, sMachine: string; var sResult: string): boolean;
var
MyReg: TRegistry;
RegDataType: TRegDataType;
DataSize, Len: integer;
sBinData: string;
bResult: Boolean;
begin
bResult := False;
MyReg := TRegistry.Create(KEY_QUERY_VALUE);
try
MyReg.RootKey := ARootKey;
if MyReg.RegistryConnect('\\' + sMachine) then
begin
if MyReg.KeyExists(AKey) then
begin
if MyReg.OpenKeyReadOnly(AKey) then
begin
try
RegDataType := MyReg.GetDataType(AValue);
if RegDataType = rdBinary then
begin
DataSize := MyReg.GetDataSize(AValue);
if DataSize > 0 then
begin
SetLength(sBinData, DataSize);
Len := MyReg.ReadBinaryData(AValue, PChar(sBinData)^, DataSize);
if Len <> DataSize then
raise Exception.Create(SysErrorMessage(ERROR_CANTREAD))
else
begin
sResult := sBinData;
bResult := True;
end;
end;
end;
except
MyReg.CloseKey;
end;
MyReg.CloseKey;
end;
end;
end;
finally
MyReg.Free;
end;
Result := bResult;
end;
And I call it like this:
GetBinaryRegistryData(
HKEY_LOCAL_MACHINE,
'\SOFTWARE\Microsoft\Windows NT\CurrentVersion',
'DigitalProductId', '192.168.100.105',
sProductId
);
WriteLn(sProductId);
The result I receive from the WriteLn on the console is:
ñ ♥ ???????????6Z ????1 ???????☺ ???♦ ??3 ? ??? ?
??
Assuming that you are already connected remotely, try using the GetDataAsString function
to read binary data from the registry.
sResult := MyReg.GetDataAsString(AValue);
You're using Delphi 2010, so all your characters are two bytes wide. When you set the length of your result string, you're allocating twice the amount of space you need. Then you call ReadBinaryData, and it fills half your buffer. There are two bytes of data in each character. Look at each byte separately, and you'll probably find that your data looks less garbage-like.
Don't use strings for storing arbitrary data. Use strings for storing text. To store arbitrary blobs of data, use TBytes, which is an array of bytes.
I have TBytes variable with a value [0,0,15,15]. How can I convert it to "00FF" ?
I dont want to use loops, bcoz this logic to be used in time intensive function.
(I tried using BinToHex, but I could not get it working with string variable.)
Thanks & Regards,
Pavan.
// Swapping is necessary because x86 is little-endian.
function Swap32(value: Integer): Integer;
asm
bswap eax
end;
function FourBytesToHex(const bytes: TBytes): string;
var
IntBytes: PInteger;
FullResult: string;
begin
Assert(Length(bytes) = SizeOf(IntBytes^));
IntBytes := PInteger(bytes);
FullResult := IntToHex(Swap32(IntBytes^), 8);
Result := FullResult[2] + FullResult[4] + FullResult[6] + FullResult[8];
end;
If that last line looks a little strange, it's because you requested a four-byte array be turned into a four-character string, whereas in the general case, eight hexadecimal digits are required to represent a four-byte value. I'm simply assumed that your byte values are all below 16, so only one hexadecimal digit is needed. If your example was a typo, then simply replace the last two lines with this one:
Result := IntToHex(Swap32(IntBytes^), 8);
By the way, your requirement forbidding loops will not be met. IntToHex uses a loop internally.
function ByteToHex(InByte:byte):shortstring;
const Digits:array[0..15] of char='0123456789ABCDEF';
begin
result:=digits[InByte shr 4]+digits[InByte and $0F];
end;
Example :
MyHex := ByteTohex($FF);
the result
MyHex is "FF".
MyHex := ByteTohex(255);
the result
MyHex is "FF".
MyHex := ByteTohex($55);
the result
MyHex is "55".
This one is quite fast and works with any array size.. It's like BinToHex, but instead of expecting 0..255 byte values, it only uses the low nibble.
procedure BinToSingleHex(Buffer, Text: PAnsiChar; BufSize: Integer);
const
Convert: array[0..15] of AnsiChar = '0123456789ABCDEF';
var
I: Integer;
begin
for I := 0 to BufSize - 1 do
begin
Text[0] := Convert[Byte(Buffer[I]) and $F];
Inc(Text);
end;
end;
Assembler that does the same:
procedure BinToSingleHex(Buffer, Text: PAnsiChar; BufSize: Integer);assembler;
asm
PUSH ESI
PUSH EDI
MOV ESI,EAX
MOV EDI,EDX
MOV EDX,0
JMP ##1
##0: DB '0123456789ABCDEF'
##1: LODSB
AND DL,AL
AND DL,0FH
MOV AL,##0.Byte[EDX]
STOSB
DEC ECX
JNE ##1
POP EDI
POP ESI
end;
usage:
type THexDigit=0..15;
const ArSize=16;
var Ar:array[0..Pred(ArSize)] of THexDigit=(0,1,2,3,4,5,6,7,8,9,8,7,6,5,4,3);
S:Array[0..Pred(ArSize)] of AnsiChar;
BinToSingleHex(#Ar,S,Length(Ar));
WriteLn(S);
Bit late to the party but why not a simple lookup table?
const
HexChars : Array[0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
Assuming TBytes values of 0..15
Function (ABytea: TBytes): string
begin
Result := HexChars[ABytea[0]];
Result := Result + HexChars[ABytea[1]];
Result := Result + HexChars[ABytea[2]];
Result := Result + HexChars[ABytea[3]];
end;
of course neater with a loop :) and needs modifying for byte values above 15:
begin
Result := HexChars[ABytea[0] shr 4];
Result := Result + HexChars[ABytea[0] and $0F];
Result := Result + HexChars[ABytea[1] shr 4];
Result := Result + HexChars[ABytea[1] and $0F];
Result := Result + HexChars[ABytea[2] shr 4];
Result := Result + HexChars[ABytea[2] and $0F];
Result := Result + HexChars[ABytea[3] shr 4];
Result := Result + HexChars[ABytea[3] and $0F];
end;
Still neater with a loop especially if TBytes gets larger
I had the same problem. My solution using System.SysUtils.TByteHelper.ToHexString (with loop)
function ToHexString(const MinDigits: Integer): string; overload; inline;
Example code:
procedure TForm1.Button2Click(Sender: TObject);
begin
var text:string;
var w:integer:=0;
var bytearray: Tarray<byte>:= [$DE, $AD, $BE, $EF];
repeat
text:= text+ pbyte(#bytearray[w])^.ToHexString(2);
inc(w);
until w >= high(bytearray);
end;
bytearray := $DE $AD $BE $EF
text := DEADBEEF