I've got a function that returns a SYSTEMTIME.
function GetFileDate : SYSTEMTIME; //Stdcall;
var
CheckFile: Long;
FileTime: LPFILETIME;
FileTimeReturn: LPFILETIME;
SystemTimeReturn: LPSYSTEMTIME;
begin
CheckFile := CreateFile(PChar('main.dll'), GENERIC_READ, FILE_SHARE_READ, NIL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
GetFileTime(CheckFile, #FileTime, NIL, NIL);
FileTimeToLocalFileTime(#FileTime, #FileTimeReturn);
FileTimeToSystemTime(#FileTime, #SystemTimeReturn);
GetFileDate := SystemTimeReturn^;
end;
It always returns 97 for the year, for both files from 2012 and 2006 and anything else.
Why?
That code is nonsense, and I'm surprised it compiles at all. You declare three pointer variables, but you never make them point to anything. You pass pointers to those variables to the API functions, but those API functions do not expect pointers to the types you give them.
FileTimeToLocalFileTime expects to receive two FILETIME pointers. You've declared FileTime and FileTimeReturn as pointers to FILETIME values, but when you apply the # operator to them, you get pointers to pointers to FILETIME values. Better code should look like this:
function GetFileDate : SYSTEMTIME; //Stdcall;
var
CheckFile: Long;
FileTime: FILETIME;
FileTimeReturn: FILETIME;
SystemTimeReturn: SYSTEMTIME;
begin
CheckFile := CreateFile(PChar('main.dll'), GENERIC_READ, FILE_SHARE_READ, NIL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
GetFileTime(CheckFile, #FileTime, NIL, NIL);
FileTimeToLocalFileTime(#FileTime, #FileTimeReturn);
FileTimeToSystemTime(#FileTime, #SystemTimeReturn);
GetFileDate := SystemTimeReturn;
end;
Note that I've removed the LP prefixes from the type names, and I've removed the dereference from the final line.
Correct code would check each API function's return value to make sure it succeeded before calling the next one.
Here's why you get the unexpected results you see. A FILETIME is a 64-bit value. If you're using a 32-bit system, then your LPFILETIME variables are only 32 bits wide. The API expects a pointer to a 64-bit-wide buffer, but you're giving it a pointer to a 32-bit space. When the API writes 64 bits of information into a 32-bit space, we can't be sure where the extra 32 bits are being stored.
You passed a pointer to SystemTimeReturn, which was an LPSYSTEMTIME. The API wrote into that space as though it were a SYSTEMTIME. Then, your function dereferenced what it assumed to be an LPSYSTEMTIME, but which actually held a value of type SYSTEMTIME. You dereferenced a time instead of a pointer. The time you got happens to look like a valid address, and the value residing at that "address" happens to be 97.
Related
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.
I read the input buffer from a console application (CMD) like this:
var
pBuffer : array [0..2400] of Widechar;
dBuffer : array [0..2400] of WideChar;
CReadBuffer : Cardinal;
BytesRead : Cardinal;
begin
// ....
ReadFile(BuffHandle, pBuffer[0], CReadBuffer, BytesRead, nil);
pBuffer[BytesRead] := #0; // Finish/End the WideString
OemToCharW(pBuffer, dBuffer);
MessageBoxW (0, dBuffer, '', 0);
// ....
end;
For some reason I get weird chars...
CMD should have the oem charset. I used OEMtoCharA before and it worked fine.
What do I do wrong?
Thanks for help.
EDIT:
I use Delphi7
As you said, CMD has the OEM charset, which means the pBuffer should be declared as
pBuffer: array[0..2400] of AnsiChar;
Now try again (can't check this right now myself).
It transpires that the declaration of OemToCharW is incorrect in Delphi 7. In Delphi 7 the first parameter is incorrectly declared as PWideChar when it should be PAnsiChar. You should redeclare OemToCharW correctly in your code and possibly consider using OemToCharBuffW instead.
This is my Working Code
DriftMul:=99;
WriteProcessMemory(HandleWindow, ptr($4E709C), #DriftMul, 2, Write);
I want to Convert it without using a variable but it wont work
Below is just an Example of what i want to do.
WriteProcessMemory(HandleWindow, ptr($4E709C), ptr(99), 2, Write);
Does anyone know a way to make this work with using a variable???
I am able to program in a few languages and every language i use their is a
way to to do this. The reason i want to do this is because i am gonna be making a big program that does alot of writing of different values and it will save me around 300+ lines. Below is an Example in c++ i was using.
WriteProcessMemory(hProcess, (void*)0x4E709C, (void*)(PBYTE)"\x20", 1, NULL);
Update:
Solved it
Im using 4 Procedures that i call depending on how many bytes i want to write.
procedure Wpm(Address: Cardinal; ChangeValues: Byte);
Begin
WriteProcessMemory(HandleWindow, Pointer(Address), #ChangeValues, 1, Write);
End;
procedure Wpm2(Address: Cardinal; ChangeValues: Word);
Begin
WriteProcessMemory(HandleWindow, Pointer(Address), #ChangeValues, 2, Write);
End;
procedure Wpm3(Address: Cardinal; ChangeValues: Word);
Begin
WriteProcessMemory(HandleWindow, Pointer(Address), #ChangeValues, 3, Write);
End;
procedure Wpm4(Address: Cardinal; ChangeValues: Cardinal);
Begin
WriteProcessMemory(HandleWindow, Pointer(Address), #ChangeValues, 4, Write);
End;
Example writes
Wpm($477343,$EB);
Wpm2($40A889,$37EB);
Wpm3($416E34,$0086E9);
Pchar is the only method i found to compile without procedures, i dont want to use assci though.
WriteProcessMemory(HandleWindow, Pointer($449A17), PChar('90'), 1, Write);
You have to store the contents of the word that you are writing somewhere. WriteProcessMemory expects a pointer to some memory in your process space. If you don't want to use a variable, use a constant.
const
DriftMul: word=99;
....
WriteProcessMemory(HandleWindow, ptr($4E709C), #DriftMul, 2, Write);
Passing ptr(99) fails because ptr(99) is not a pointer to a word containing the value 99. It is a pointer to address 99. I think you were trying to write #Word(99) but you cannot take the address of a true constant.
You can make this more convenient by wrapping up the call to WriteProcessMemory in a helper methods. Although your question suggests that you want to write Word values, it became apparent in out lengthy chat that you actually want to write byte sequences. Writing integer data types will lead to machine endianness confusion. So instead I would do it using an open array of Byte to give the flexibility at the call site.
procedure WriteBytes(hProcess: THandle; Address: Pointer;
const Buffer: array of Byte);
var
NumberOfBytesWritten: DWORD;
begin
if not WriteProcessMemory(hProcess, Address, #Buffer[0], Length(Buffer),
NumberOfBytesWritten) then RaiseLastOSError;
end;
You can then call the code
WriteBytes(Handle, Pointer($523328), [$42]);//single byte
WriteBytes(Handle, Pointer($523328), [$CC, $90, $03]);//3 bytes
In C++, this code:
WriteProcessMemory(hProcess, (void*)0x4E709C, (void*)(PBYTE)"\x20", 1, NULL);
Is declaring a const char[] buffer in the app's memory that contains the two characters '\x20' and '\x00' in it. This is evident by the use of the " double-quote characters around the literal. They are creating a string literal, not a character literal (which uses ' single-quote character instead). The starting address of that literal's first character is being passed to the third parameter and the fourth parameter is set to 1 to tell WriteProcessMemory() to copy only 1 byte from that 2-byte buffer.
Delphi, on the other hand, uses the ' single-quote character around both single-character and string literals, and thus relies on code context to decide which type of literal needs to be created. As such, Delphi does not have a direct means of declaring a single-character literal that is the equivilent of an inlined char[] like in the C++ code. The closest equivilent I can think of right now, without declaring a constant, would be something like this:
WriteProcessMemory(hProcess, Pointer($4E709C), PAnsiChar(AnsiString(' ')), 1, nil);
Otherwise, use just an explicit constant instead. The direct equivilent of what the C++ code is doing is the following:
const
buffer: array[0..1] of AnsiChar = (#$20, #0);
WriteProcessMemory(hProcess, Pointer($4E709C), Pointer(PByte(#buffer[0])), 1, nil);
Alternatively, you can simplify it to the following:
const
space: Byte = $20;
WriteProcessMemory(hProcess, Pointer($4E709C), #space, 1, nil);
The ptr() Method converts an address to an pointer. So the value in the second method is not 99 but the value that is written at the address 99.
My dirty method, but with few lines of code:
procedure WriteBytes(hProcess: THandle; address: Pointer; buffer: Variant; count: Integer);
begin
WriteProcessMemory(hProcess, address, #buffer, count, nil);
end;
Then you can call the method with:
WriteBytes(HandleWindow, Pointer($449A17), 90, 1);
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.
I'm experiencing a memory leak when using WMI from Delphi 7 to query a (remote) pc. The memory leak only occurs on Windows 2003 (and Windows XP 64). Windows 2000 is fine, and so is Windows 2008. I'm wondering if anyone has experienced a similar problem.
The fact that the leak only occurs in certain versions of Windows implies that it might be a Windows issue, but I've been searching the web and haven't been able to locate a hotfix to resolve the issue. Also, it might be a Delphi issue, since a program with similar functionality in C# doesn't seem to have this leak. The latter fact has led me to believe that there might be another, better, way to get the information I need in Delphi without getting a memory leak.
I've included the source to a small program to expose the memory leak below. If the line sObject.Path_ below the { Leak! } comment is executed, the memory leak occurs. If I comment it out, there's no leak. (Obviously, in the "real" program, I do something useful with the result of the sObject.Path_ method call :).)
With a little quick 'n dirty Windows Task Manager profiling on my machine, I found the following:
Before N=100 N=500 N=1000
With sObject.Path_ 3.7M 7.9M 18.2M 31.2M
Without sObject.Path_ 3.7M 5.3M 5.4M 5.3M
I guess my question is: has anyone else encountered this problem? If so, is it indeed a Windows issue, and is there a hotfix? Or (more likely) is my Delphi code broken, and is there a better way to get the information I need?
You'll notice on several occasions, nil is assigned to objects, contrary to the Delphi spirit... These are COM objects that do not inherit from TObject, and have no destructor I can call. By assigning nil to them, Windows's garbage collector cleans them up.
program ConsoleMemoryLeak;
{$APPTYPE CONSOLE}
uses
Variants, ActiveX, WbemScripting_TLB;
const
N = 100;
WMIQuery = 'SELECT * FROM Win32_Process';
Host = 'localhost';
{ Must be empty when scanning localhost }
Username = '';
Password = '';
procedure ProcessObjectSet(WMIObjectSet: ISWbemObjectSet);
var
Enum: IEnumVariant;
tempObj: OleVariant;
Value: Cardinal;
sObject: ISWbemObject;
begin
Enum := (wmiObjectSet._NewEnum) as IEnumVariant;
while (Enum.Next(1, tempObj, Value) = S_OK) do
begin
sObject := IUnknown(tempObj) as SWBemObject;
{ Leak! }
sObject.Path_;
sObject := nil;
tempObj := Unassigned;
end;
Enum := nil;
end;
function ExecuteQuery: ISWbemObjectSet;
var
Locator: ISWbemLocator;
Services: ISWbemServices;
begin
Locator := CoSWbemLocator.Create;
Services := Locator.ConnectServer(Host, 'root\CIMV2',
Username, Password, '', '', 0, nil);
Result := Services.ExecQuery(WMIQuery, 'WQL',
wbemFlagReturnImmediately and wbemFlagForwardOnly, nil);
Services := nil;
Locator := nil;
end;
procedure DoQuery;
var
ObjectSet: ISWbemObjectSet;
begin
CoInitialize(nil);
ObjectSet := ExecuteQuery;
ProcessObjectSet(ObjectSet);
ObjectSet := nil;
CoUninitialize;
end;
var
i: Integer;
begin
WriteLn('Press Enter to start');
ReadLn;
for i := 1 to N do
DoQuery;
WriteLn('Press Enter to end');
ReadLn;
end.
I can reproduce the behaviour, the code leaks memory on Windows XP 64 and does not on Windows XP. Interestingly this occurs only if the Path_ property is read, reading Properties_ or Security_ with the same code does not leak any memory. A Windows-version-specific problem in WMI looks like the most probable cause of this. My system is up-to-date AFAIK, so there probably isn't a hotfix for this either.
I'd like to comment on your resetting all variant and interface variables, though. You write
You'll notice on several occasions, nil is assigned to objects, contrary to the Delphi spirit... These are COM objects that do not inherit from TObject, and have no destructor I can call. By assigning nil to them, Windows's garbage collector cleans them up.
This is not true, and consequently there is no need to set the variables to nil and Unassigned. Windows does not have a garbage collector, what you are dealing with are reference-counted objects, which are immediately destroyed once the reference count reaches 0. The Delphi compiler does insert the necessary calls to increment and decrement the reference count as necessary. Your assignments to nil and Unassigned decrement the reference count, and free the object when it reaches 0.
A new assignment to a variable, or the exiting of the procedure take care of this as well, so additional assignments are (albeit not wrong) superfluous and decrease the clarity of the code. The following code is completely equivalent and does not leak any additional memory:
procedure ProcessObjectSet(WMIObjectSet: ISWbemObjectSet);
var
Enum: IEnumVariant;
tempObj: OleVariant;
Value: Cardinal;
sObject: ISWbemObject;
begin
Enum := (wmiObjectSet._NewEnum) as IEnumVariant;
while (Enum.Next(1, tempObj, Value) = S_OK) do
begin
sObject := IUnknown(tempObj) as SWBemObject;
{ Leak! }
sObject.Path_;
end;
end;
I'd say one should explicitly reset interfaces only if this does actually free the object (so the current ref count has to be 1) and the destruction itself should really happen exactly at this point. Examples for the latter are that a large chunk of memory can be freed, or that a file needs to be closed or a synchronization object to be released.
you should store the return value of
sObject.Path_;
in a variable and make it SWbemObjectPath. This is necessary to make the reference counting right.