WinAPI: GetFontUnicodeRanges - I do not understand the result - delphi

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];

Related

What is the correct way to copy the dictionary?

I need to check if there has been a change in a certain part of the application and therefore I make "copies" of the data after loading them and then compare them. One part of the comparison function involves checking keys in dictionaries like lDict1.Keys.EqualsTo(lDict2.Keys).
Although the dictionaries do not rely on the order of the elements, I didn't realize that even if I fill two dictionaries with the same data, they won't be created the same and the order of elements may change, so the previous function does not work properly because it relies on the elements order that may not match when using any of the following methods. (I'm not sure why)
var
lDict1, lDict2 : IDictionary<Integer, TObject>;
lKey : Integer;
begin
lDict1 := TCollections.CreateDictionary<Integer, TObject>;
lDict1.Add(5, nil); // Keys.First = 5, Keys.Last = 5
lDict1.Add(6, nil); // Keys.First = 5, Keys.Last = 6
lDict2 := TCollections.CreateDictionary<Integer, TObject>;
lDict2.AddRange(lDict1); // Keys.First = 6, Keys.Last = 5
lDict2.Clear;
for lKey in lDict1.Keys do // Keys.First = 6, Keys.Last = 5
lDict2.Add(lKey, nil);
end;
Is there any way to make an exact copy of the dictionary so I can compare them? One way to work around this problem is to create my own comparison function, but I'd like to avoid that.
function ContainsSameValues<T>(AEnumerable1, AEnumerable2: IEnumerable<T>): Boolean;
var
lValue : T;
begin
Result := AEnumerable1.Count = AEnumerable2.Count;
if Result then
begin
for lValue in AEnumerable1 do
begin
Result := AEnumerable2.Contains(lValue);
if not Result then
Exit;
end;
end;
end;
usage
ContainsSameValues<Integer>(lDict1.Keys, lDict2.Keys);
Checking for equality of a unordered dictionaries is a relatively simple algorithm. I will outline it here. Suppose we have two dictionaries, A and B.
Compare the number of elements of A and B. If this differs, the dictionaries are not equal.
Enumerate each key/value pair k,v in A. If k is not in B, or B[k] is not equal to v, then the dictionaries are not equal.
If you reach the end of the enumeration, then you know that the dictionaries are equal.

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;

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
....

Enumeration inheritance delphi

I am looking to inherite a enumaration in other one:
for example:
Type TMyTypeKind = (TTypeKind, enBoolean, enPath);
You can not. Compiler does not know how to interpret this. From the wiki :
An enumerated type defines an ordered set of values by simply listing identifiers that denote these values. The values have no inherent meaning.
Something similar is possible in the reverse order. If you know all the possible values, define it as a base type and declare subrange types of it. The subranges will be assignement compatible with the base type and with each other. It may or may not be a benefit.
type
TEnumAll = (enFirst, enSecond, enThird, enFourth, enFifth);
TEnumLower = enFirst..enThird;
TEnumMore = enFirst..enFourth;
procedure TForm1.Test1;
var
All: TEnumAll;
Lower: TEnumLower;
begin
for All := Low(TEnumAll) to High(TEnumAll) do begin
Lower := All;
end;
for Lower := Low(TEnumLower) to High(TEnumLower) do begin
All := Lower;
end;
end;
It can be done with an trick, using Include files. Example:
AdCommonAttributes.inc
canonicalName,
cn,
whenCreated,
description,
displayName,
distinguishedName,
instanceType,
memberOf,
modifyTimeStamp,
name,
objectCategory,
objectClass,
objectGuid,
showInAdvancedViewOnly
AdUserGroupCommonAttributes.inc:
msDSPrincipalName,
objectSid,
sAMAccountName
AdUserAttributers.inc:
accountExpires,
badPasswordTime,
badPwdCount,
c,
comment,
company,
department,
division,
employeeID,
givenName,
homeDirectory,
homeDrive,
lastLogon,
lockoutTime,
logonCount,
pwdLastSet,
sn,
telephoneNumber,
tokenGroups,
userAccountControl,
userPrincipalName
unit AdUserGroupCommonAttributes;
TAdUserGroupCommonAttributes = (
{$I AdCommonAttribs.inc}, {$I AdUserGroupCommonAttributes.inc}
);
unit AdGroupAttributes;
type
TAdGroupAttributes = (
{$I AdCommonAttribs.inc},
{$I AdUserGroupCommonAttributes.inc},
{$I AdGroupAttributes.inc}
);
unit AdUserAttributes;
type
TAdUserAttributes = (
{$I AdCommonAttribs.inc},
{$I AdUserGroupCommonAttributes.inc},
{$I AdUserAttributes.inc}
);
This is not possible because the enumerated names should be unique.
You cannot use the values of TTypeKind in another enumeration, it generates conflict.
However in Delphi 2009 there is a feature called scoped enums.
You can say TMyTypeKind.enBoolean.
But this does not solve the inheritance.
One way is to assign integer constants to the enum values:
Type TMyTypeKind = (enBoolean = High(TTypeKind) + 1, enPath = High(TTypeKind) + 2);
So you can have an index number that begins in Low(TTypeKind) and ends in High(TMyTypeKind)
See it for yourself: Ord(enBoolean)
I am afraid this is not possible at all. Theres nothing you can do about it, I am sorry,
When you type:
Type TMyTypeKind = (TTypeKind, enBoolean, enPath);
Delphi will see that TTypeKind is already a type and it will give you the follow error:
[DCC Error] xxx.pas(41): E2004 Identifier redeclared: 'TTypeKind'
As it was already said, you can't.
But you may do this way:
TBaseState = class
public const
stNone = 1;
stSingle = 2;
end;
TMyState = class(TBaseState)
public const
stNewState = 3;
end;
var
state: TMyState;
begin
ShowMessage(IntToStr(s.stNewState));
end;
It isn't the same with enums, but sometimes it helps.

Enums vs Const vs Class Const in Delphi programming

I have an integer field in a ClientDataSet and I need to compare to some values, something like this:
I can use const
const
mvValue1 = 1;
mvValue2 = 2;
if ClientDataSet_Field.AsInteger = mvValue1 then
or enums
TMyValues = (mvValue1 = 1, mvValue2 = 2);
if ClientDataSet_Field.AsInteger = Integer(mvValue1) then
or class const
TMyValue = class
const
Value1 = 1;
Value2 = 2;
end;
if ClientDataSet_Field.AsInteger = TMyValues.Value1 then
I like the class const approach but it seems that is not the delphi way, So I want to know what do you think
Declaration:
type
TMyValues = class
type TMyEnum = (myValue1, myValue2, myValue3, myValue4);
const MyStrVals: array [TMyEnum] of string =
('One', 'Two', 'Three', 'Four');
const MyIntVals: array [TMyEnum] of integer =
(1, 2, 3, 4);
end;
Usage:
if ClientDataSet_Field.AsInteger = TMyValues.MyIntVals[myValue1] then
A cast would generally be my last choice.
I wouldn't say that class consts are not the Delphi way. It's just they have been introduced to Delphi quite recently, and a lot of books and articles you'll find on the internet were written before their introduction, and thus you won't see them widely used. Many Delphi developers (I'd say the majority) will have started using Delphi before they were made available, and thus they're not the first thing that one thinks about.
One thing to consider is backwards compatibility - class constants are relatively new to Delphi so if your code has to be sharable with previous versions than they are out.
I typically use enumerated types, with the difference from yours is that my first enumeration is usually an 'undefined' item to represent NULL or 0 in an int field.
TmyValues = (myvUndefined, myvDescription1, myvDescription2)
if ClientDataSet_Field.AsInteger = Ord(myvDescription1) then...
To use a little bit of Jim McKeeth's answer - if you need to display to the user a text viewable version, or if you need to convert their selected text into the enumerated type, then an array comes in handy in conjuction with the type:
const MYVALS: array [TmyValues ] of string = ('', 'Description1', 'Description2');
You can then have utility functions to set/get the enumerated type to/from a string:
Function MyValString(const pMyVal:TmyValues):string;
begin
result := MYVALS[Ord(pMyVal)];
end;
Function StringToMyVal(const pMyVal:String):TMyValues;
var i:Integer;
begin
result := myvUndefined;
for i := Low(MYVALS) to High(MYVALS) do
begin
if SameText(pMyVal, MYVALS[i]) then
begin
result := TMyValues(i);
break;
end;
end;
end;
Continuing on... you can have scatter routine to set a combo/list box:
Procedure SetList(const DestList:TStrings);
begin
DestList.Clear;
for i := Low(MYVALS) to High(MYVALS) do
begin
DestList.Insert(MYVALS[i]);
end;
end;
In code: SetList(Combo1.Items) or SetList(ListBox1.Items)..
Then if you are seeing the pattern here... useful utility functions surrounding your enumeration, then you add everything to it's own class and put this class into it's own unit named MyValueEnumeration or whaterver. You end up with all the code surrounding this enumeration in one place and keep adding the utility functions as you need them. If you keep the unit clean - don't mix in other unrelated functionality then it will stay very handy for all projects related to that enumeration.
You'll see more patterns as time goes and you use the same functionality over and over again and you'll build a better mousetrap again.
When using constants I recommend assigning the type when the data type is a numeric float.
Delphi and other languages will not always evaluate values correctly if the types do not match...
TMyValue = class
const
// will not compare correctly to float values.
Value1 = 1; // true constant can be used to supply any data type value
Value2 = 2; // but should only be compared to similar data type
// will not compare correctly to a single or double.
Value3 = 3.3; // default is extended in debugger
// will not compare correctly to a single or extended.
Value1d : double = Value1; // 1.0
Value2d : double = Value2; // 2.0
end;
Compared float values in if () and while () statements should be compared to values of the same data type, so it is best to define a temporary or global variable of the float type used for any comparison statements (=<>).
When compared to the same float data type this format is more reliable for comparison operators in any programming language, not just in Delphi, but in any programming language where the defined float types vary from variable to constant.
Once you assign a type, Delphi will not allow you to use the variable to feed another constant, so true constants are good to feed any related data type, but not for comparison in loops and if statements, unless they are assigned and compared to integer values.
***Note: Casting a value from one float type to another may alter the stored value from what you entered for comparison purposes, so verify with a unit test that loops when doing this.
It is unfortunate that Delphi doesn't allow an enumeration format like...
TController : Integer = (NoController = 0, ncpod = 1, nextwave = 2);
or enforce the type name for access to the enumeration values.
or allow a class constant to be used as a parameter default in a call like...
function getControllerName( Controller : TController = TController.NoController) : string;
However, a more guarded approach that provides both types of access would be to place the enumeration inside a class.
TController = class
//const
//NoController : Integer = 1;
//ncpod : Integer = 2;
//nextwave : Integer = 3;
type
Option = (NoController = 0, ncpod = 1, nextwave = 2);
public
Class function Name( Controller : Option = NoController) : string; static;
end;
implementation
class function TController.Name( Controller : Option = NoController) : string;
begin
Result := 'CNC';
if (Controller = Option.nextwave) then
Result := Result + ' Piranha'
else if (Controller = Option.ncpod) then
Result := Result + ' Shark';
Result := Result + ' Control Panel';
end;
This approach will effectively isolate the values, provide the static approach and allow access to the values using a for () loop.
The access to the values from a floating function would be like this...
using TControllerUnit;
function getName( Controller : TController.Option = TController.Option.NoController) : string;
implementation
function getName( Controller : TController.Option = TController.Option.NoController) : string;
begin
Result := 'CNC';
if (Controller = TController.Option.nextwave) then
Result := Result + ' Piranha'
else if (Controller = TController.Option.ncpod) then
Result := Result + ' Shark';
Result := Result + ' Control Panel';
end;
so many options! :-) i prefer enums and routinely use them as you describe. one of the parts i like is that i can use them with a "for" loop. i do use class constants as well but prefer enums (even private enums) depending on what i'm trying to achieve.
TMyType=class
private const // d2007 & later i think
iMaxItems=1; // d2007 & later i think
private type // d2007 & later i think
TMyValues = (mvValue1 = 1, mvValue2 = 2); // d2007 & later i think
private
public
end;
An option you haven't thought of is to use a lookup table in the database and then you can check against the string in the database.
eg.
Select value, Description from tbl_values inner join tbl_lookup_values where tbl_values.Value = tbl_lookup_values.value
if ClientDataSet_Field.AsString = 'ValueIwant' then

Resources