FastMM4 says "The block footer has been corrupted" - delphi

I have this function in our Delphi 7 application, which worked very well until I included FastMM4 v4.99 into the project. Once included, FastMM4 raised the following error message: "FastMM has detected an error during a FreeMem operation. The block footer has been corrupted." The execution halts in the FreeMem line.
function BinaryFieldToArrayOfWord( aBinaryField : TVarBytesField;
out aArrValues : TArrWord ) : Boolean;
var
p : Pointer;
begin
if not aBinaryField.IsBlob then
begin
GetMem( p, aBinaryField.DataSize );
try
if aBinaryField.GetData( p ) then
begin
// do something
end;
finally
FreeMem( p, aBinaryField.DataSize );
end;
end; // if
end;
First I thought that there must be a bug in the function, but it is practically the same as this TField.GetData method example in the Delphi 7 help:
{ Retrieve the "raw" data from Field1 }
with Field1 do
begin
if not IsBlob { this does not work for BLOB fields }
begin
{ Allocate space }
GetMem(MyBuffer, DataSize);
try
if not GetData(MyBuffer) then
MessageDlg(DisplayName + ' is NULL', mtInformation, [mbOK], 0)
else
{ Do something with the data };
finally
{ Free the space }
FreeMem(MyBuffer, DataSize);
end;
end;
end;
I found on the internet that the above error message is often because there is not enough space for the data. So I increased the size of the memory block and the error message vanished and the function worked as expected. After some experiment, I figured out that 2 bytes is required and enough:
GetMem( p, aBinaryField.DataSize + 2 );
FreeMem( p, aBinaryField.DataSize + 2 );
Although it solved my problem, I am not completely relaxed with this solution as I don't know its background. It would be nice to know the reason of this message. Does FastMM4 needs additional 2 bytes for its own footer?
UPDATE: After spending a day with debugging, I am now believe that there is a bug in the Delphi 7 TField.GetData method. It writes 2 zero bytes beyond the allocated memory block. I tried it with and without FastMM4, and it overwrites in both cases (so it is not a FastMM4 error). I also tried with typecasting the field as TVarBytesField, no difference.
Here is the code I used with detailed comments, containing the results.
My only remaining question: have they corrected this bug in later Delphis?
procedure TfrmMain_PBC_TH.btnDEBUGClick(Sender: TObject);
type
TArrBytes = array of Byte;
var
p : Pointer;
qryTest : TADOQuery;
begin
qryTest := TADOQuery.Create( Application );
try
// The type of the TQM_BinaryData.BinData column in the MSSQL database is a varbinary(7900).
// Load the #168 binary data record. It contains exactly 7900 bytes, and the value of each byte is 255
qryTest.Connection := MainConn;
qryTest.SQL.Add('SELECT [BinData] FROM [TQM_BinaryData] WHERE [Id] = 168');
qryTest.Open;
// Allocate the memory block for this.
GetMem( p, qryTest.FieldByName('BinData').DataSize );
// DataSize is 7902 because all TVarBytesFields have 2 byte prefix in Delphi, containing the data length.
// So the size of the allocated memory block is 7902 bytes - we are correct so far.
try
// Values of the first four bytes beyond the end of the memory block (memory thrash at this point) before GetData:
// TArrBytes(p)[7902] = 96
// TArrBytes(p)[7903] = 197
// TArrBytes(p)[7904] = 219
// TArrBytes(p)[7905] = 43
// Critical point: get the data from the field with the Delphi GetData method
qryTest.FieldByName('BinData').GetData( p );
// Values after GetData:
// TArrBytes(p)[0] = 220 TArrBytes(p)[0] and TArrBytes(p)[1] contains the length of the binary data
// TArrBytes(p)[1] = 30 it is correct as 30 * 256 + 220 = 7900
// TArrBytes(p)[2] = 255 actual data starts
// TArrBytes(p3[2] = 255
// ...
// TArrBytes(p)[7900] = 255
// TArrBytes(p)[7901] = 255 actual data ends
// TArrBytes(p)[7902] = 0 changed from 96!
// TArrBytes(p)[7903] = 0 changed from 197!
// TArrBytes(p)[7904] = 219 no change
// TArrBytes(p)[7905] = 43 no change
finally
// Here FastMM4 throws the block footer corrupt error because GetData modified the 2 bytes after the allocated memory block
FreeMem( p );
end;
qryTest.Close;
finally
qryTest.Free;
end;
end;
After adding a Data Breakpoint, the call stack is:
#FillChar(???,???,???)
TDataSet.DataConvert($7D599770,$12F448,$7D51F7F0,True)
VarToBuffer
TCustomADODataSet.GetFieldData($7D599770,$7D51F7F0,True)
TField.GetData($7D51F7F0,True)
TfrmMain_PBC_TH.btnDEBUGClick($7FF7A380)
TControl.Click
TButton.Click

FastMM allocates some memory at the end of the block that you allocate and writes known values there. Then, when you deallocate, FastMM checks that those values are as expected. If not, then the error that you see is raised because FastMM knows that your code is writing beyond the end of the memory block.
So, something inside the try/finally block is writing beyond the end of the block of memory. And that's why increasing its size removes the FastMM error. Without seeing that code, we cannot tell what exactly is wrong and you will need to do some debugging to solve the problem.
You are quite right to be concerned by your "solution". Trial and error is never a reasonable way to program. You must find out why your program is writing beyond the end of the block.
One way to do that is to set a data breakpoint for the address immediately beyond the end of this block. That would force the debugger to break on the code that writes beyond the end of the block.
As an aside, you don't need to pass the second parameter to FreeMem. Doing so makes your code harder to maintain and serves absolutely no purpose. Pass just the pointer to FreeMem.

Related

I can not correctly translate the code from MSDN to Delphi. Section DirectShow Step 6. Add Support for COM

Please help me to translate the code. I don't know C++ well, but I know Delphi syntax well. I want to translate code from MSDN:
Step 6. Add Support for COM.
static WCHAR g_wszName[] = L"My RLE Encoder";
CFactoryTemplate g_Templates[] =
{
{
g_wszName,
&CLSID_RLEFilter,
CRleFilter::CreateInstance,
NULL,
NULL
}
};
and
int g_cTemplates = sizeof(g_Templates) / sizeof(g_Templates[0]);
I realized that the first line is a variable. But when translated, it does not work. Error:
This is a string and you defined it as WCHAR.
Next comes the description of the structure, but I do not know such a form.
The last line is also a variable, but it has a / and two values.
In general, I kind of understood the meaning, but do not understand how to write it.
The code roughly translates to Delphi as follows:
const
g_wszName: PWideChar = 'My RLE Encoder';
var
g_Templates: array[0..0] of CFactoryTemplate;
...
g_Templates[0].m_Name := g_wszName;
g_Templates[0].m_ClsID := #CLSID_RLEFilter;
g_Templates[0].m_lpfnNew := #CRleFilter.CreateInstance;
g_Templates[0].m_lpfnInit := nil;
g_Templates[0].m_pAMovieSetup_Filter := nil;
and
var
g_cTemplates: Integer;
...
//g_cTemplates := SizeOf(g_Templates) div SizeOf(g_Templates[0]);
g_cTemplates := Length(g_Templates);

Copying an address from a pointer to a different memory address

I have a C DLL with a number of functions I'm calling from Delphi. One of the functions (say Func1) returns a pointer to a struct - this all works fine. The structs created by calling Func1 are stored in a global pool within the DLL. Using a second function (Func2) I get a pointer to a block of memory containing an array of pointers, and I can access the array elements using an offset.
I need to be able copy the address in the returned pointer for a struct (from Func1) to any of the memory locations in the array (from Func2). The idea is that I can build arrays of pointers to pre-defined structs and access the elements directly from Delphi using pointer offsets.
I tried using:
CopyMemory(Pointer(NativeUInt(DataPointer) + offset), PStruct, DataSize);
where DataPointer is the start of my array and PStruct is returned from Func1, but that doesn't copy the address I need.
In .NET it works using Marshal.WriteIntPtr and looking at the underlying code for this using Reflector I think I need something trickier than CopyMemory. Anyone got any ideas for doing this in Delphi?
Edit: This is part of a wrapper around vector structures returned from the R language DLL. I have a base vector class from which I derive specific vector types. I've got the wrapper for the numeric vector working, so my base class looks fine and this is where I get DataPointer:
function TRVector<T>.GetDataPointer: PSEXPREC;
var
offset: integer;
h: PSEXPREC;
begin
// TVECTOR_SEXPREC is the vector header, with the actual data behind it.
offset := SizeOf(TVECTOR_SEXPREC);
h := Handle;
result := PSEXPREC(NativeUInt(h) + offset);
end;
Setting a value in a numeric vector is easy (ignoring error handling):
procedure TNumericVector.SetValue(ix: integer; value: double);
var
PData: PDouble;
offset: integer;
begin
offset := GetOffset(ix); // -- Offset from DataPointer
PData := PDouble(NativeUInt(DataPointer) + offset);
PData^ := value;
end;
For a string vector I need to (i) create a base vector of pointers with a pre-specified length as for the numeric vector (ii) convert each string in my input array to an R internal character string (CHARSXP) using the R mkChar function (iii) assign the address of the character string struct to the appropriate element in the base vector. The string array gets passed into the constructor of my vector class (TCharacterVector) and I then call SetValue (see below) for each string in the array.
I should have thought of PPointer as suggested by Remy but neither that or the array approach seem to work either. Below is the code using the array approach from Remy and with some pointer vars for checking addresses. I'm just using old-fashioned pointer arithmetic and have shown addresses displayed for a run when debugging:
procedure TCharacterVector.SetValue(ix: integer; value: string);
var
PData: PSEXPREC;
offset: integer;
offset2: integer;
PTest: PSEXPREC;
PPtr: Pointer;
PPtr2: Pointer;
begin
offset := GetOffset(ix);
PPtr := PPointer(NativeUInt(DataPointer) + offset); // $89483D8
PData := mkChar(value); // $8850258
// -- Use the following code to check that mkChar is working.
offset2 := SizeOf(TVECTOR_SEXPREC);
PTest := PSEXPREC(NativeUInt(PData) + offset);
FTestString := FTestString + AnsiString(PAnsiChar(PTest));
//PPointerList(DataPointer)^[ix] := PData;
//PPtr2 := PPointer(NativeUInt(DataPointer) + offset); // Wrong!
PPointerArray(DataPointer)^[ix] := PData;
PPtr2 := PPointerArray(DataPointer)^[ix]; // $8850258 - correct
end;
I'd have thought the address in PData ($8850258) would now be in PPtr2 but I've been staring at this so long I'm sure I'm missing something obvious.
Edit2: The code for SetValue used in R.NET is as follows (ignoring test for null string):
private void SetValue(int index, string value)
{
int offset = GetOffset(index);
IntPtr stringPointer = mkChar(value);
Marshal.WriteIntPtr(DataPointer, offset, stringPointer);
}
From reflector, Marshal.WriteIntPtr uses the following C:
public static unsafe void WriteInt32(IntPtr ptr, int ofs, int val)
{
try
{
byte* numPtr = (byte*) (((void*) ptr) + ofs);
if ((((int) numPtr) & 3) == 0)
{
*((int*) numPtr) = val;
}
else
{
byte* numPtr2 = (byte*) &val;
numPtr[0] = numPtr2[0];
numPtr[1] = numPtr2[1];
numPtr[2] = numPtr2[2];
numPtr[3] = numPtr2[3];
}
}
catch (NullReferenceException)
{
throw new AccessViolationException();
}
}
You say you want to copy the struct pointer itself into the array, but the code you have shown is trying to copy the struct data that the pointer is pointing at. If you really want to copy just the pointer itself, don't use CopyMemory() at all. Just assign the pointer as-is:
const
MaxPointerList = 255; // whatever max array count that Func2() allocates
type
TPointerList = array[0..MaxPointerList-1] of Pointer;
PPointerList = ^TPointerList;
PPointerList(DataPointer)^[index] := PStruct;
Your use of NativeUInt reveals that you are using a version of Delphi that likely supports the {$POINTERMATH} directive, so you can take advantage of that instead, eg:
{$POINTERMATH ON}
PPointer(DataPointer)[index] := PStruct;
Or, use the pre-existing PPointerArray type in the System unit:
{$POINTERMATH ON}
PPointerArray(DataPointer)[index] := PStruct;

Unable to read final few Kb of logical drives on Windows 7 64-bit

I'm having some problems addressing logical drives. For clarity, my definition of 'Physical Disk' (PD) is the raw disk regardless of partitioning. 'Logical Drive' (LD) refers to a volume such as Drive E:, Drive F: etc.
Using the examples from RRUZ (my hero SO member) and implementing the WMI Class I have created a Freepascal program for reading disks. I address PD by \.\PhyscialDiskX and that works fine by the examples created by RRUZ (here). I can read all the bytes no problem for PD's.
I use the same handle technique for logical volumes, which are \?\E: or \?\F: etc. I then use IOCTL_DISK_GET_LENGTH_INFO to get the length of the PD or LV and then read the byte range until ReadBytes = TotalLength. I read on the MSDN website that it will automatically retrieve the size of whatever device handle it is passed - PD or LD alike. And indeed I have checked the szie values returned by my program againzt WinHex, FTK Imager, HxD and several other low level disk tools. With the exception of 1 byte variances caused by zero or 1 starting positions, they match.
However, for some reason, my program is failing to acquire the final 32Kb on Windows 7 Pro 64-bit, despite running the program as administrator. It reads the whole disk and then on the final buffer read (which is done as 64Kb buffers) BytesRead returns -1. Using the debugger I worked out the following values :
493,846,527 exact LV size of Drive F:
493,813,760 total bytes read at time of failure
32,767 bytes missing
The result of the following
BytesRead := FileRead(hDiskHandle, Buffer, (DiskSize - TotalBytesRead));
is -1 on the final buffer read. THis the line that tests for the end of the disk by saying "if the amount left to read is less than the size of the buffer size, only try to read what is left". So, the value of bytes being asked to be stored by FileRead at the end is 32,767 (because DiskSize - TotalBytesRead at that point is 32,767, meaning that's how many bytes are left to read of the disk). The designated size of buffer is 64Kb. My understanding is that you can put less in a buffer than it is capable of holding but not more (FileRead states : "Buffer must be at least Count bytes long. No checking on this is performed"? IS that correct? If it is not then this may be (and probably is) the issue.
I don't know if it's due to IOCTL_DISK_GET_LENGTH_INFO, the buffer storage or something else? Hoping someone can help? I have also posted along with some screenshot at the Lazarus Freepascal forum. Here is my relevant code sections:
The handle:
// Create handle to source disk. Abort if fails
hSelectedDisk := CreateFileW(PWideChar(SourceDevice), FILE_READ_DATA,
FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0);
if hSelectedDisk = INVALID_HANDLE_VALUE then
begin
RaiseLastOSError;
end
Compute the size ion bytes of the given device:
ExactDiskSize := GetDiskLengthInBytes(hSelectedDisk);
Now read the device and store the input as a flat file
ImageResult := WindowsImageDisk(hSelectedDisk, ExactDiskSize, HashChoice, hImageName);
Functions for the above:
function GetDiskLengthInBytes(hSelectedDisk : THandle) : Int64;
const
// These are defined at the MSDN.Microsoft.com website for DeviceIOControl
// and https://forum.tuts4you.com/topic/22361-deviceiocontrol-ioctl-codes/
{
IOCTL_DISK_GET_DRIVE_GEOMETRY = $0070000
IOCTL_DISK_GET_PARTITION_INFO = $0074004
IOCTL_DISK_SET_PARTITION_INFO = $007C008
IOCTL_DISK_GET_DRIVE_LAYOUT = $007400C
IOCTL_DISK_SET_DRIVE_LAYOUT = $007C010
IOCTL_DISK_VERIFY = $0070014
IOCTL_DISK_FORMAT_TRACKS = $007C018
IOCTL_DISK_REASSIGN_BLOCKS = $007C01C
IOCTL_DISK_PERFORMANCE = $0070020
IOCTL_DISK_IS_WRITABLE = $0070024
IOCTL_DISK_LOGGING = $0070028
IOCTL_DISK_FORMAT_TRACKS_EX = $007C02C
IOCTL_DISK_HISTOGRAM_STRUCTURE = $0070030
IOCTL_DISK_HISTOGRAM_DATA = $0070034
IOCTL_DISK_HISTOGRAM_RESET = $0070038
IOCTL_DISK_REQUEST_STRUCTURE = $007003C
IOCTL_DISK_REQUEST_DATA = $0070040
IOCTL_DISK_CONTROLLER_NUMBER = $0070044
IOCTL_DISK_GET_PARTITION_INFO_EX = $0070048
IOCTL_DISK_SET_PARTITION_INFO_EX = $007C04C
IOCTL_DISK_GET_DRIVE_LAYOUT_EX = $0070050
IOCTL_DISK_SET_DRIVE_LAYOUT_EX = $007C054
IOCTL_DISK_CREATE_DISK = $007C058
IOCTL_DISK_GET_LENGTH_INFO = $007405C // Our constant...
SMART_GET_VERSION = $0074080
SMART_SEND_DRIVE_COMMAND = $007C084
SMART_RCV_DRIVE_DATA = $007C088
IOCTL_DISK_GET_DRIVE_GEOMETRY_EX = $00700A0
IOCTL_DISK_UPDATE_DRIVE_SIZE = $007C0C8
IOCTL_DISK_GROW_PARTITION = $007C0D0
IOCTL_DISK_GET_CACHE_INFORMATION = $00740D4
IOCTL_DISK_SET_CACHE_INFORMATION = $007C0D8
IOCTL_DISK_GET_WRITE_CACHE_STATE = $00740DC
IOCTL_DISK_DELETE_DRIVE_LAYOUT = $007C100
IOCTL_DISK_UPDATE_PROPERTIES = $0070140
IOCTL_DISK_FORMAT_DRIVE = $007C3CC
IOCTL_DISK_SENSE_DEVICE = $00703E0
IOCTL_DISK_INTERNAL_SET_VERIFY = $0070403
IOCTL_DISK_INTERNAL_CLEAR_VERIFY = $0070407
IOCTL_DISK_INTERNAL_SET_NOTIFY = $0070408
IOCTL_DISK_CHECK_VERIFY = $0074800
IOCTL_DISK_MEDIA_REMOVAL = $0074804
IOCTL_DISK_EJECT_MEDIA = $0074808
IOCTL_DISK_LOAD_MEDIA = $007480C
IOCTL_DISK_RESERVE = $0074810
IOCTL_DISK_RELEASE = $0074814
IOCTL_DISK_FIND_NEW_DEVICES = $0074818
IOCTL_DISK_GET_MEDIA_TYPES = $0070C00
}
IOCTL_DISK_GET_LENGTH_INFO = $0007405C;
type
TDiskLength = packed record
Length : Int64;
end;
var
BytesReturned: DWORD;
DLength: TDiskLength;
ByteSize: int64;
begin
BytesReturned := 0;
// Get the length, in bytes, of the physical disk
if not DeviceIOControl(hSelectedDisk, IOCTL_DISK_GET_LENGTH_INFO, nil, 0,
#DLength, SizeOf(TDiskLength), BytesReturned, nil) then
raise Exception.Create('Unable to determine byte capacity of disk.');
ByteSize := DLength.Length;
ShowMessage(IntToStr(ByteSize));
result := ByteSize;
end;
The disk reader function
function WindowsImageDisk(hDiskHandle : THandle; DiskSize : Int64; HashChoice : Integer; hImageName : THandle) : Int64;
var
Buffer : array [0..65535] of Byte; // 1048576 (1Mb) or 262144 (240Kb) or 131072 (120Kb buffer) or 65536 (64Kb buffer)
BytesRead : integer;
NewPos, SectorCount,
TotalBytesRead, BytesWritten, TotalBytesWritten : Int64;
...
// Now to seek to start of device
FileSeek(hDiskHandle, 0, 0);
repeat
// Read device in buffered segments. Hash the disk and image portions as we go
if (DiskSize - TotalBytesRead) < SizeOf(Buffer) then
begin
// Read 65535 or less bytes
BytesRead := FileRead(hDiskHandle, Buffer, (DiskSize - TotalBytesRead));
BytesWritten := FileWrite(hImageName, Buffer, BytesRead);
end
else
begin
// Read 65536 (64kb) at a time
BytesRead := FileRead(hDiskHandle, Buffer, SizeOf(Buffer));
BytesWritten := FileWrite(hImageName, Buffer, BytesRead);
end;
if BytesRead = -1 then
begin
ShowMessage('There was a read error encountered. Aborting');
// ERROR IS THROWN AT THIS POINT ONLY WITH LD's - not PD's
exit;
end
else
begin
inc(TotalBytesRead, BytesRead);
inc(TotalBytesWritten, BytesWritten);
NewPos := NewPos + BytesRead;
...
until (TotalBytesRead = DiskSize);
Probably, it is a boundary check error. Quote from MSDN (CreateFile, note on opening physical drives and volumes, which you call logical drives):
To read or write to the last few sectors of the volume, you must call DeviceIoControl and specify FSCTL_ALLOW_EXTENDED_DASD_IO
I suspect that the problem stems from the use of 64-bit integers and arithmetic to calculate a value passed as a 32-bit Integer:
FileRead(hDiskHandle, Buffer, (DiskSize - TotalBytesRead));
I cannot explain with certainty why this might affect only LD's and not PD's, except to speculate that there may be some difference in the reported DiskSize that somehow avoids the Int64 arithmetic/32-bit problem in that case.
e.g. If the 32-bit truncated result of the Int64 arithmetic is NEGATIVE (which requires only that the high bit be set, i.e. 1 not 0) then FileRead() will return -1 since a negative value for "bytes to read" is invalid.
But if the high-bit in the result is NOT set, resulting in a positive value, then even if that value is significantly greater than 64KB this will not cause an error since this invocation is called only when you have already determined that there are fewer than 64K bytes to be read. The 32-bit truncated Int64 arithmetic may result in a request to read 2 BILLION bytes but FileRead() is only going to read the actual 32K bytes that remain anyway.
However, this very fact points to a solution (assuming that this diagnosis is correct).
As noted, FileRead() (which is just a wrapper around ReadFile(), on Windows) will read either the number of bytes specified or as many bytes remain to be read, whichever is lower.
So if you specify 64KB but only 32KB remain, then only 32KB will be read.
You can replace all of this code:
if (DiskSize - TotalBytesRead) < SizeOf(Buffer) then
begin
// Read 65535 or less bytes
BytesRead := FileRead(hDiskHandle, Buffer, (DiskSize - TotalBytesRead));
BytesWritten := FileWrite(hImageName, Buffer, BytesRead);
end
else
begin
// Read 65536 (64kb) at a time
BytesRead := FileRead(hDiskHandle, Buffer, SizeOf(Buffer));
BytesWritten := FileWrite(hImageName, Buffer, BytesRead);
end;
With simply:
BytesRead := FileRead(hDiskHandle, Buffer, SizeOf(Buffer));
BytesWritten := FileWrite(hImageName, Buffer, BytesRead);
This eliminates the 64-bit arithmetic and any possibility for errors resulting from 64-bit results being passed in 32-bit values. If the final segment contains only 32KB, then only 32KB will be read.
You can also simplify your loop termination (removing the 64-bit arithmetic, unless you need the accumulated values for other purposes). Instead of accumulating the total bytes read, you can terminate your loop simply when your FileRead() reads less than the number of bytes specified. i.e. BytesRead < 64KB:
Even if your disk is an exact multiple of 64KB blocks, your penultimate FileRead() will return a full buffer of 64KB, and the very next FileRead() will read 0 bytes, which is < 64KB, terminating the loop. :)
32,767 is an odd number and not a multiple of the sector size. That means that the final part sector is simply not readable.
OK, I've done it.
Credit to user2024154 as that was the first major thing. So based on that I've granted the answer there.
However, what was not clear was how to properly assign its const value. After many hours of Googling I stumbled across this . It was the only Delphi example I could find where it actually shows FSCTL_ALLOW_EXTENDED_DASD_IO defined, allbeit one had to look through much of it to pull the values together.
For the benefit of anyone else, the values that I needed, which now work, is :
const
FILE_DEVICE_FILE_SYSTEM = $00000009;
FILE_ANY_ACCESS = 0;
METHOD_NEITHER = 3;
FSCTL_ALLOW_EXTENDED_DASD_IO = ((FILE_DEVICE_FILE_SYSTEM shl 16)
or (FILE_ANY_ACCESS shl 14)
or (32 shl 2) or METHOD_NEITHER);
I then used FSCTL_ALLOW_EXTENDED_DASD_IO after first creating the handle and then :
if not DeviceIOControl(hSelectedDisk, FSCTL_ALLOW_EXTENDED_DASD_IO, nil, 0,
nil, 0, BytesReturned, nil) then
raise Exception.Create('Unable to initiate FSCTL_ALLOW_EXTENDED_DASD_IO disk access.');
This works with freepascal and with some minor adjustment should work with Delphi.
Thanks to you all for your continued help, especially user2024154 and, as always, David, for his continued assistance.
UPDATE : Except now physcial disk access doesn't work at all! But I'll work something out.

WinAPI: GetFontUnicodeRanges - I do not understand the result

I am trying to get Unicode font glyph ranges (Delphi 6):
var GS:PGlyphSet;
GSSize:LongWord;
rng:TWCRange;
begin
GSSize := GetFontUnicodeRanges(Canvas.Handle, nil);
GetMem(Pointer(GS), GSSize);
try
GS.cbThis:=GSSize;
GS.flAccel:=0;
GS.cGlyphsSupported:=0;
GS.cRanges:=0;
if GetFontUnicodeRanges(Canvas.Handle, GS)<>0 then begin
for i:=0 to GS.cRanges-1 do begin
rng := GS.ranges[i];
The strange thing is that Length(GS.ranges) is 1, but GS.cRanges is 309 and when I try to access the second range GS.ranges[1] I get, of course, a range check error. Before I turned range checking on it has worked in some magical way.
Types for reference (from Windows module):
PWCRange = ^TWCRange;
{$EXTERNALSYM tagWCRANGE}
tagWCRANGE = packed record
wcLow: WCHAR;
cGlyphs: SHORT;
end;
TWCRange = tagWCRANGE;
PGlyphSet = ^TGlyphSet;
{$EXTERNALSYM tagGLYPHSET}
tagGLYPHSET = packed record
cbThis: DWORD;
flAccel: DWORD;
cGlyphsSupported: DWORD;
cRanges: DWORD;
ranges: array[0..0] of TWCRange;
end;
TGlyphSet = tagGLYPHSET;
This struct makes use of the so-called struct hack:
http://c-faq.com/struct/structhack.html
http://tonywearme.wordpress.com/2011/07/26/c-struct-hack/
The ranges member is a variable length array, placed inline in the struct. But you cannot actually encode that in a static C type. That's why you call the function to find out how much memory to allocate, and then heap allocate the struct. If you allocated it on the stack, or using SizeOf(...) then the struct would be too small.
The simplest thing to do is to disable range checking for the code that accesses ranges. Although the type declaration says that only 0 is a valid index for ranges, in fact 0..cRanges-1 are valid.
If you don't want to disable range checking for the relevant code, then take a pointer the element 0, and then use pointer arithmetic in your loop.
var
rng: PWCRange;
....
rng := #GS.ranges[0];
for i:=0 to GS.cRanges-1 do begin
// use rng^
inc(rng);
end;
This is, in my view, the cleanest way to write code for sequential access. For random access, and with range checking in force, you'd be compelled to declare some extra types to defeat range checking:
type
TWCRangeArray = array [0..(MaxInt div SizeOf(TWCRange))-1] of TWCRange;
PWCRangeArray = ^TWCRangeArray;
And then use type casting to access individual elements:
rng := PWCRangeArray(#GS.ranges)[i];

Scan entire process memory with ReadProcessMemory

I'm tryin to scan an entire process memory but no success... What I'm doing is: for tests I'm using notepad, so I write there %B and this values in HEX are: 25(%) and 42(B). So the code is:
while (VirtualQueryEx(PIDHandle, Pointer(MemStart), MemInfo, SizeOf(MemInfo)) <> 0) do
begin
if ((MemInfo.State = MEM_COMMIT) and (not (MemInfo.Protect = PAGE_GUARD)
or (MemInfo.Protect = PAGE_NOACCESS)) and (MemInfo.Protect = PAGE_READWRITE)) then
begin
SetLength(Buff, MemInfo.RegionSize);
if (ReadProcessMemory(PIDHandle, MemInfo.BaseAddress, Buff,
MemInfo.RegionSize, ReceivedBytes)) then
begin
for I := 0 to SizeOf(Buff) do
begin
if (IntToHex(Buff[i], 1) = '25') and (IntToHex(Buff[i+2], 1) = '42') then
Form1.Memo1.Lines.Append(IntToHex(Buff[i], 1));
end;
end;
end;
MemStart:= MemStart + MemInfo.RegionSize;
end;
CloseHandle(PIDHandle);
end;
The var 'Buff' is TBytes (I read about TBytes and think it's same as array of byte). So I'm converting the bytes to Hex, and searching for values: 25 and 42 respectively. The code is like:
if (IntToHex(Buff[i], 1) = '25') and (IntToHex(Buff[i+2], 1) = '42') then
Because have 00 between the hex values. So I need to add '+2'. How can I scan the entire memory for this values??
Notepad uses Unicode so you'll need to look for UTF-16 encoded data, $0025 and $0042.
I don't understand why you feel the need to convert into hex strings before comparing. There's nothing special about hex that requires the use of strings. Hexadecimal is just a number system with base-16. So, decimal 32 is the same as hexadecimal 20, i.e. 32=$20. Do your comparison directly with integral values:
if (Buff[i]=$25) and (Buff[i+2]=$42) then
That said, taking into account the $00 bytes your test should really be something like this:
var
Target: string;
....
Target := '%B';
if CompareMem(#Buff[i], #Target[1], Length(Target)*SizeOf(Char)) then
....
I don't want to get too deep into the rest of your code, but this line
for I := 0 to SizeOf(Buff) do
is wrong on many different levels.
SizeOf(Buff) returns the size of a pointer since a dynamic array variable is essentially just a pointer. A useful thing to remember is that SizeOf is evaluated at compile time.
If you used Length instead of SizeOf then you would be iterating over the end of the list. To loop over a dynamic array, loop from 0 to Length(...)-1.
But in this case you are accessing index i+2 inside the loop, so you should loop from 0 to Length(...)-3.
But in fact you need to compare against 4 consecutive bytes to find a match. Perhaps like this:
TargetByteLength = Length(Target)*SizeOf(Char);
for i := 0 to Length(Buff)-TargetByteLength do
if CompareMem(#Buff[i], #Target[1], TargetByteLength) then
....

Resources