Read REG_BINARY to String - winapi

I use this code to read binary data from the registry to a string
function ReadBinary (RootKey: HKEY; SubKey,ValueName: WideString; var Data : String): Bool;
var
Key : HKey;
Buffer : array of char;
Size : Cardinal;
RegType : DWORD;
begin
result := FALSE;
RegType := REG_BINARY;
if RegOpenKeyExW(RootKey, pwidechar(SubKey), 0, KEY_READ, Key) = ERROR_SUCCESS then begin
if RegQueryValueExW(Key,pwidechar(ValueName),NIL,#RegType, NIL,#Size) = ERROR_SUCCESS then begin
SetLength (Buffer, Size + 1);
FillChar(Buffer, SizeOf (Buffer), #0);
if RegQueryValueExW(Key,pwidechar(ValueName),NIL,#RegType, #Buffer[0],#Size) = ERROR_SUCCESS then begin
result := TRUE;
Data := String (Buffer); // Shows empty or sometimes 1 random char.
end;
end;
end;
RegCloseKey (Key);
end;
EDIT2:
It works fine with a fixed declared array of byte/char
function ReadBinary (RootKey: HKEY; SubKey,ValueName: WideString; var Data : String): Bool;
var
Key : HKey;
Buffer : array [0..200] of char;
Size : Cardinal;
RegType : DWORD;
begin
result := FALSE;
RegType := REG_BINARY;
if RegOpenKeyExW(RootKey, pwidechar(SubKey), 0, KEY_READ, Key) = ERROR_SUCCESS then begin
if RegQueryValueExW(Key,pwidechar(ValueName),NIL,#RegType, NIL,#Size) = ERROR_SUCCESS then begin
FillChar(Buffer, SizeOf (Buffer), #0);
if RegQueryValueExW(Key,pwidechar(ValueName),NIL,#RegType, #Buffer,#Size) = ERROR_SUCCESS then begin
result := TRUE;
Data := String (Buffer);
end;
end;
end;
RegCloseKey (Key);
end;
I'm stuck.
What do I do wrong and what is the solution?
Thank you for your help.
EDIT:
I am aware of that I am reading binary data from the registry. So it might be already 0 terminated and can return false results. I can guarantee that there are no #0 chars in the binary data because I wrote a long text (String with CR/LF) in the Value before.

Buffer: array of char;
is dynamic array of chars, that is, in fact, pointer variable. And this string resets the pointer to Nil:
FillChar(Buffer, SizeOf (Buffer), #0);
So dynamic array is not valid now.
To fill the contents of dynamic array by zeroes, you have to use
FillChar(Buffer[0], SizeOf(Buffer[0]) * Length(Buffer), #0)
but this is not necessary, because SetLength makes the job.

dynamic array is somethign like pointer. In C/C++ it would be exactly the same. In Delphi it is not, but you may for semantics think this way. #Buffer is not address of 1st car, but the address of the pointer itself. Ib both calls to FillChar and RegQueryValueExW you should pass Buffer[0] and #Buffer[0] instead
Why do u use Windows API instead of standard TRegistry ? Or maybe TNT Unicode Controls or somethign similar have readymade unicode-aware registry access.
Win API xxxxxxxW functions are unicode aware. Did you checked what data you got ? Is it 8-but or 16-bit ? look received data as array of bytes in HEX - do they contain $00 bytes or not ? It looks like they do and you got unicode data into the buffer. Then it would be expected and correct behaviour of string to only accept 1 letter (or 0, depending on intel or motorola byte order). Check what binary data you've got in Buffer.
Personally, i'd made Buffer as array of bytes. Then after registry access i'd used SetString procedure to get value if D7 has it. If not, then i'd copy it like SetLength(Data, Size); Move(Buffer[0], Data[1], Size); And i'd remove FillChar completely. This way copying would be both slightly faster and not break on 1st stray #0 byte.
I'd not use ambiguous char and string types when doing low-level binary data typecasting, but rather use concrete AnsiString and AnsiChar types. If your code would somewhen be compiled by newer Unicode-capable Delphi or FreePascal, that would keep it working. Shortcuts "char" and "string" may change their meaning depending on compiler version. And then you would have hard time determining why and where it broke and what to do.

Related

Binary file error in Lazarus Pascal with custom records - error SIGSEGV

I don't work with Pascal very often so I apologise if this question is basic. I am working on a binary file program that writes an array of custom made records to a binary file.
Eventually I want it to be able to write multiple arrays of different custom record types to one single binary file.
For that reason I thought I would write an integer first being the number of bytes that the next array will be in total. Then I write the array itself. I can then read the first integer type block - to tell me the size of the next blocks to read in directly to an array.
For example - when writing the binary file I would do something like this:
assignfile(f,MasterFileName);
{$I-}
reset(f,1);
{$I+}
n := IOResult;
if n<> 0 then
begin
{$I-}
rewrite(f);
{$I+}
end;
n:= IOResult;
If n <> 0 then
begin
writeln('Error creating file: ', n);
end
else
begin
SetLength(MyArray, 2);
MyArray[0].ID := 101;
MyArray[0].Att1 := 'Hi';
MyArray[0].Att2 := 'MyArray 0 - Att2';
MyArray[0].Value := 1;
MyArray[1].ID := 102;
MyArray[1].Att1:= 'Hi again';
MyArray[1].Att2:= MyArray 1 - Att2';
MyArray[1].Value:= 5;
SizeOfArray := sizeOf(MyArray);
writeln('Size of character array: ', SizeOfArray);
writeln('Size of integer var: ', sizeof(SizeOfArray));
blockwrite(f,sizeOfArray,sizeof(SizeOfArray),actual);
blockwrite(f,MyArray,SizeOfArray,actual);
Close(f);
Then you could re-read the file with something like this:
Assign(f, MasterFileName);
Reset(f,1);
blockread(f,SizeOfArray,sizeof(SizeOfArray),actual);
blockread(f,MyArray,SizeOfArray,actual);
Close(f);
This has the idea that after these blocks have been read that you can then have a new integer recorded and a new array then saved etc.
It reads the integer parts of the records in but nothing for the strings. The record would be something like this:
TMyType = record
ID : Integer;
att1 : string;
att2 : String;
Value : Integer;
end;
Any help gratefully received!!
TMyType = record
ID : Integer;
att1 : string; // <- your problem
That field att1 declared as string that way means that the record contains a pointer to the actual string data (att1 is really a pointer). The compiler manages this pointer and the memory for the associated data, and the string can be any (reasonable) length.
A quick fix for you would be to declare att1 something like string[64], for example: a string which can be at maximum 64 chars long. That would eliminate the pointer and use the memory of the record (the att1 field itself, which now is a special static array) as buffer for string characters. Declaring the maximum length of the string, of course, can be slightly dangerous: if you try to assign the string a string too long, it will be truncated.
To be really complete: it depends on the compiler; some have a switch to make your declaration "string" usable, making it an alias for "string[255]". This is not the default though. Consider also that using string[...] is faster and wastes memory.
You have a few mistakes.
MyArray is a dynamic array, a reference type (a pointer), so SizeOf(MyArray) is the size of a pointer, not the size of the array. To get the length of the array, use Length(MyArray).
But the bigger problem is saving long strings (AnsiStrings -- the usual type to which string maps --, WideStrings, UnicodeStrings). These are reference types too, so you can't just save them together with the record. You will have to save the parts of the record one by one, and for strings, you will have to use a function like:
procedure SaveStr(var F: File; const S: AnsiString);
var
Actual: Integer;
Len: Integer;
begin
Len := Length(S);
BlockWrite(F, Len, SizeOf(Len), Actual);
if Len > 0 then
begin
BlockWrite(F, S[1], Len * SizeOf(AnsiChar), Actual);
end;
end;
Of course you should normally check Actual and do appropriate error handling, but I left that out, for simplicity.
Reading back is similar: first read the length, then use SetLength to set the string to that size and then read the rest.
So now you do something like:
Len := Length(MyArray);
BlockWrite(F, Len, SizeOf(Len), Actual);
for I := Low(MyArray) to High(MyArray) do
begin
BlockWrite(F, MyArray[I].ID, SizeOf(Integer), Actual);
SaveStr(F, MyArray[I].att1);
SaveStr(F, MyArray[I].att2);
BlockWrite(F, MyArray[I].Value, SizeOf(Integer), Actual);
end;
// etc...
Note that I can't currently test the code, so it may have some little errors. I'll try this later on, when I have access to a compiler, if that is necessary.
Update
As Marco van de Voort commented, you may have to do:
rewrite(f, 1);
instead of a simple
rewrite(f);
But as I replied to him, if you can, use streams. They are easier to use (IMO) and provide a more consistent interface, no matter to what exactly you try to write or read. There are streams for many different kinds of I/O, and all derive from (and are thus compatible with) the same basic abstract TStream class.

Retrieve the default associated file types of an application?

The function ShellFindExecutable allows finding the program which is associated with a specific file type:
function ShellFindExecutable(const FileName, DefaultDir: string): string;
var
Res: HINST;
Buffer: array [0..MAX_PATH-1] of Char;
I: Integer;
begin
ResetMemory(Buffer, SizeOf(Buffer));
Res := FindExecutable(PChar(FileName), PCharOrNil(DefaultDir), Buffer);
if Res > 32 then
begin
// FindExecutable replaces #32 with #0
for I := Low(Buffer) to High(Buffer) - 1 do
if Buffer[I] = #0 then
Buffer[I] := #32;
Buffer[High(Buffer)] := #0;
Result := Trim(Buffer);
end
else
Result := '';
end;
For example:
DefProgram := ShellFindExecutable('R:\test.txt', '');
// DefProgram: C:\Program Files (x86)\Notepad++\notepad++.exe
But how can I find the file type(s)/extension(s) for which a specific existing program is the default associated application?
Delphi 10.1 Berlin
Windows 7 x64
I don't believe that there is an API function specifically to do that. You will need to iterate through each registered extension, for instance by enumerating keys in HKCR, and check which executable is associated with the open verb.
Rather than using FindAssociation I suspect that IQueryAssociations will be more efficient and robust.
Furthermore what you claim about FindAssociation replacing spaces with nulls is simply not true. You can replace the body of your if statement with Result := Buffer.

GetLocaleInfo prevents my application from exiting

Here is the code I had used to detect default system language:
var
Buffer : PChar;
Size : integer;
LocaleName: String;
begin
Size := GetLocaleInfo (LOCALE_USER_DEFAULT, LOCALE_SENGLANGUAGE, nil, 0);
GetMem(Buffer, Size);
try
GetLocaleInfo (LOCALE_USER_DEFAULT, LOCALE_SENGLANGUAGE, Buffer, Size);
LocaleName := string(Buffer);
finally
FreeMem(Buffer);
end;
ShowMessage(LocaleName);
end;
This code works great, alas for as long as the code is there my application will not quit until I use the Task Manager to stop it. Finally I found this little code that also does the trick and allow my application to quit:
Var
MyLang: PChar
LocaleName: string;
Ident: integer;
begin
GetMem(MyLang, 250);
try
Ident:=GetSystemDefaultLangID;
VerLanguageName(Ident, MyLang, 250);
LocaleName := StrPas(MyLang);
Finally
FreeMem(MyLang);
end;
ShowMessage(LocaleName);
end;
Can anyone guess the reason for that?
Second call to GetLocaleInfo overwrites memory, because GetLocaleInfo returns number of chars, and you are using unicode version of Delphi, then you need allocate 2 bytes per char.
You can fix it by: GetMem(Buffer, Size * SizeOf(Char)); // SizeOf(Char)==SizeOf(WideChar) on >= D2009

String to byte array in UTF-8?

How to convert a WideString (or other long string) to byte array in UTF-8?
A function like this will do what you need:
function UTF8Bytes(const s: UTF8String): TBytes;
begin
Assert(StringElementSize(s)=1);
SetLength(Result, Length(s));
if Length(Result)>0 then
Move(s[1], Result[0], Length(s));
end;
You can call it with any type of string and the RTL will convert from the encoding of the string that is passed to UTF-8. So don't be tricked into thinking you must convert to UTF-8 before calling, just pass in any string and let the RTL do the work.
After that it's a fairly standard array copy. Note the assertion that explicitly calls out the assumption on string element size for a UTF-8 encoded string.
If you want to get the zero-terminator you would write it so:
function UTF8Bytes(const s: UTF8String): TBytes;
begin
Assert(StringElementSize(s)=1);
SetLength(Result, Length(s)+1);
if Length(Result)>0 then
Move(s[1], Result[0], Length(s));
Result[high(Result)] := 0;
end;
You can use TEncoding.UTF8.GetBytes in SysUtils.pas
If you're using Delphi 2009 or later (the Unicode versions), converting a WideString to a UTF8String is a simple assignment statement:
var
ws: WideString;
u8s: UTF8String;
u8s := ws;
The compiler will call the right library function to do the conversion because it knows that values of type UTF8String have a "code page" of CP_UTF8.
In Delphi 7 and later, you can use the provided library function Utf8Encode. For even earlier versions, you can get that function from other libraries, such as the JCL.
You can also write your own conversion function using the Windows API:
function CustomUtf8Encode(const ws: WideString): UTF8String;
var
n: Integer;
begin
n := WideCharToMultiByte(cp_UTF8, 0, PWideChar(ws), Length(ws), nil, 0, nil, nil);
Win32Check(n <> 0);
SetLength(Result, n);
n := WideCharToMultiByte(cp_UTF8, 0, PWideChar(ws), Length(ws), PAnsiChar(Result), n, nil, nil);
Win32Check(n = Length(Result));
end;
A lot of the time, you can simply use a UTF8String as an array, but if you really need a byte array, you can use David's and Cosmin's functions. If you're writing your own character-conversion function, you can skip the UTF8String and go directly to a byte array; just change the return type to TBytes or array of Byte. (You may also wish to increase the length by one, if you want the array to be null-terminated. SetLength will do that to the string implicitly, but to an array.)
If you have some other string type that's neither WideString, UnicodeString, nor UTF8String, then the way to convert it to UTF-8 is to first convert it to WideString or UnicodeString, and then convert it back to UTF-8.
var S: UTF8String;
B: TBytes;
begin
S := 'Șase sași în șase saci';
SetLength(B, Length(S)); // Length(s) = 26 for this 22 char string.
CopyMemory(#B[0], #S[1], Length(S));
end.
Depending on what you need the bytes for, you might want to include an NULL terminator.
For production code make sure you test for empty string. Adding the 3-4 LOC required would just make the sample harder to read.
I have the following two routines (source code can be downloaded here - http://www.csinnovations.com/framework_utilities.htm):
function CsiBytesToStr(const pInData: TByteDynArray; pStringEncoding: TECsiStringEncoding; pIncludesBom: Boolean): string;
function CsiStrToBytes(const pInStr: string; pStringEncoding: TECsiStringEncoding;
pIncludeBom: Boolean): TByteDynArray;
widestring -> UTF8:
http://www.freepascal.org/docs-html/rtl/system/utf8decode.html
the opposite:
http://www.freepascal.org/docs-html/rtl/system/utf8encode.html
Note that assigning a widestring to an ansistring in a pre D2009 system (including current Free Pascal) will convert to the local ansi encoding, garbling characters.
For the TBytes part, see the remark of Rob Kennedy above.

saving a records containing a member of type string to a file (Delphi, Windows)

I have a record that looks similar to:
type
TNote = record
Title : string;
Note : string;
Index : integer;
end;
Simple. The reason I chose to set the variables as string (as opposed to an array of chars) is that I have no idea how long those strings are going to be. They can be 1 char long, 200 or 2000.
Of course when I try to save the record to a type file (file of...) the compiler complains that I have to give a size to string.
Is there a way to overcome this? or a way to save those records to an untyped file and still maintain a sort of searchable way?
Please do not point me to possible solutions, if you know the solution please post code.
Thank you
You can't do it with a typed file. Try something like this, with a TFileStream:
type
TStreamEx = class helper for TStream
public
procedure writeString(const data: string);
function readString: string;
procedure writeInt(data: integer);
function readInt: integer;
end;
function TStreamEx.readString: string;
var
len: integer;
iString: UTF8String;
begin
self.readBuffer(len, 4);
if len > 0 then
begin
setLength(iString, len);
self.ReadBuffer(iString[1], len);
result := string(iString);
end;
end;
procedure TStreamEx.writeString(const data: string);
var
len: cardinal;
oString: UTF8String;
begin
oString := UTF8String(data);
len := length(oString);
self.WriteBuffer(len, 4);
if len > 0 then
self.WriteBuffer(oString[1], len);
end;
function TStreamEx.readInt: integer;
begin
self.readBuffer(result, 4);
end;
procedure TStreamEx.writeInt(data: integer);
begin
self.WriteBuffer(data, 4);
end;
type
TNote = record
Title : string;
Note : string;
Index : integer;
procedure Save(stream: TStream);
end;
procedure TNote.Save(stream: TStream);
var
temp: TMemoryStream;
begin
temp := TMemoryStream.Create;
try
temp.writeString(Title);
temp.writeString(Note);
temp.writeInt(Index);
temp.seek(0, soFromBeginning);
stream.writeInt(temp.size);
stream.copyFrom(temp, temp.size);
finally
temp.Free;
end;
end;
I'll leave the Load procedure to you. Same basic idea, but it shouldn't need a temp stream. With the record size in front of each entry, you can read it and know how far to skip if you're looking for a certain record # instead of reading the whole thing.
EDIT: This was written specifically for versions of Delphi that use Unicode strings. On older versions, you could simplify it quite a bit.
Why not write this out as XML? See my session "Practical XML with Delphi" on how to get started with this.
Another possibility would be to make your records into classes descending form TComponent and store/retreive your data in DFM files.
This Stackoverflow entry shows you how to do that.
--jeroen
PS: Sorry my XML answer was a bit dense; I'm actually on the road for two conferences (BASTA! and DelphiLive! Germany).
Basically what you need to do is very simple: create a sample XML file, then start the Delphi XML Data Binding Wizard (available in Delphi since version 6).
This wizard will generate a unit for you that has the interfaces and classes mapping XML to Delphi objects, and a few helper functions for reading them from file, creating a new object, etc. My session (see the first link above) actually contains most of the details for this process.
The above link is a video demonstrating the usage of the Delphi XML Data Binding Wizard.
You could work with two different files, one that just stores the strings in some convenient way, the other stores the records with a reference to the strings. That way you will still have a file of records for easy access even though you don't know the size of the actual content.
(Sorry no code.)
TNote = record
Title : string;
Note : string;
Index : integer;
end;
could be translated as
TNote = record
Title : string[255];
Note : string[255];
Index : integer;
end;
and use Stream.writebuffer(ANodeVariable, sizeof(TNode), but you said that strings get go over 255 chars in this case IF a string goes over 65535 chars then change WORD to INTEGER
type
TNodeHeader=Record
TitleLen,
NoteLen: Word;
end;
(* this is for writing a TNode *)
procedure saveNodetoStream(theNode: TNode; AStream: TStream);
var
header: TNodeHeader;
pStr: PChar;
begin
...
(* writing to AStream which should be initialized before this *)
Header.TitleLen := Length(theNode.Title);
header.NodeLen := Length(theNode.Note);
AStream.WriteBuffer(Header, sizeof(TNodeHeader);
(* save strings *)
PStr := PChar(theNode.Title);
AStream.writeBuffer(PStr^, Header.TitleLen);
PStr := PChar(theNode.Note);
AStream.writebuffer(PStr^, Header.NoteLen);
(* save index *)
AStream.writebuffer(theNode.Index, sizeof(Integer));
end;
(* this is for reading a TNode *)
function readNode(AStream: TStream): TNode;
var
header: THeader
PStr: PChar;
begin
AStream.ReadBuffer(Header, sizeof(TNodeHeader);
SetLength(Result.Title, Header.TitleLen);
PStr := PChar(Result.Title);
AStream.ReadBuffer(PStr^, Header.TitleLen);
SetLength(Result.Note, Header.NoteLen);
PStr := PChar(Result.Note);
AStream.ReadBuffer(PStr^, Header.NoteLen);
AStream.ReadBuffer(REsult.Index, sizeof(Integer)(* 4 bytes *);
end;
You can use the functions available in this Open Source unit.
It allows you to serialize any record content into binary, including even dynamic arrays within:
type
TNote = record
Title : string;
Note : string;
Index : integer;
end;
var
aSave: TRawByteString;
aNote, aNew: TNote;
begin
// create some content
aNote.Title := 'Title';
aNote.Note := 'Note';
aNote.Index := 10;
// serialize the content
aSave := RecordSave(aNote,TypeInfo(TNote));
// unserialize the content
RecordLoad(aNew,pointer(aSave),TypeInfo(TNote));
// check the content
assert(aNew.Title = 'Title');
assert(aNew.Note = 'Note');
assert(aNew.Index = 10);
end;

Resources