I am having a problem passing a class reference as the parameter to the ThreadProc in a call to CreateThread. Here is a sample program that demonstrates the problem I am having:
program test;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Dialogs;
type
TBlah = class
public
fe: Integer;
end;
function ThreadProc(param: Pointer) : DWORD;
begin
ShowMessage(IntToStr(TBlah(param).fe));
Result := 0;
end;
var
tID: DWORD;
handle: THandle;
b: TBlah;
begin
b := TBlah.Create;
b.fe := 54;
handle := CreateThread(nil, 0, #ThreadProc, Pointer(b), 0, tID);
WaitForSingleObject(handle, INFINITE);
end.
The call to ShowMessage pops up a message box that has something like 245729105 in it, not 54 like I expect.
This is probably just a basic misunderstanding of how Delphi works, so could someone please tell me how to get this working properly?
The problem here is that your thread function has the wrong calling convention. You need to declare it with the stdcall convention:
function ThreadProc(param: Pointer) : DWORD; stdcall;
Having said that, it would be more idiomatic to just use a TThread descendant which handles the OOP to C function back to OOP transitioning for you. That would look like this:
type
TBlah = class(TThread)
protected
procedure Execute; override;
public
fe: Integer;
end;
procedure TBlah.Execute;
begin
ShowMessage(IntToStr(fe));
end;
var
b: TBlah;
begin
b := TBlah.Create(True);
b.fe := 42;
b.Start;
b.WaitFor;
end.
Incidentally, does anyone know why Windows.pas declares TFNThreadStartRoutine as TFarProc rather than a proper typed function pointer?
You're forgetting the stdcall directive.
function ThreadProc(param: Pointer) : DWORD; stdcall;
And don't use Pointer cast in:
handle := CreateThread(nil, 0, #ThreadProc, **Pointer**(b), 0, tID);
b is already a Pointer (a Class, which is an Object Pointer)
Related
I want to write my own DirectShow filter to pull out packets of information for my own purposes. To do this, I used the guide to creating filters.
I did steps 1 to 5, and am stuck at step 6: failed to implement CreateInstance(). Can't instantiate the class because the MSDN example doesn't pass parameters, but code in Pascal requires (ObjectName: string; unk: IUnKnown; const clsid: TGUID). I used regsvr32, unfortunately I don’t know how to connect my DLL and I can’t think of it. The DSFMgr program also does not see my filter.
I read how filters are connected, tried to implement various searches, it's useless. Tried to connect manually via CLSID. Everything is useless. I know the answer is somewhere on the surface, but I don't see it. I can't figure out how DirectShow should see my library if it didn't exist in the first place. It's not logical. I've been trying to implement this for a very long time, but it doesn't work, I'm stuck.
Please don't recommend FFmpeg and the like. I don't want to use third party libraries. In DirectX, as far as I know it's built-in.
Step 6 example:
CUnknown * WINAPI CRleFilter::CreateInstance(LPUNKNOWN pUnk, HRESULT *pHr)
{
CRleFilter *pFilter = new CRleFilter();
if (pFilter== NULL)
{
*pHr = E_OUTOFMEMORY;
}
return pFilter;
}
I Implemented/converted it like this, but it doesn't work. Errors:
no variables sent
function TCRleFilter.CreateInstance(pUnk: PPUnknown; pHr: HRESULT): PUnknown;
var
pFilter: TCRleFilter;
begin
pFilter:= TCRleFilter.Create();
if pFilter = nil then pHr:= E_OUTOFMEMORY;
Result:= pFilter;
end;
I think at least a logical explanation should suffice.
The whole class:
unit Unit1;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, ActiveX, Classes, ComObj, DirectShow9, BaseClass, Dialogs;
type
TCRleFilter = class(TBCTransformFilter)
public
function CheckInputType(mtIn: PAMMediaType): HRESULT;
function GetMediaType (IPosition: Integer; pMediaType: PAMMediaType): HRESULT;
function CheckTransform(mtln: PAMMediaType; mt0ut: PAMMediaType): HRESULT;
function DecideBufferSize(pAlloc: IMemAllocator; pProp: PAllocatorProperties): HRESULT;
function Transform(pSource, pDest: IMediaSample): HRESULT;
function CreateInstance(pUnk: PPUnknown; pHr: HRESULT): PUnknown;
end;
const
CLSID_CRleFilter: TGUID = '{FBA9B97F-505B-49C7-A6C2-D1EFC34B2C0D}';
implementation
uses ComServ;
{ TCRleFilter }
function TCRleFilter.CheckInputType(mtIn: PAMMediaType): HRESULT;
begin
Result := S_OK;
ShowMessage('CheckInputType: âåðíóë "S_OK"');
end;
function TCRleFilter.CheckTransform(mtln, mt0ut: PAMMediaType): HRESULT;
begin
Result := S_OK;
ShowMessage('CheckTransform: âåðíóë "S_OK"');
end;
function TCRleFilter.CreateInstance(pUnk: PPUnknown;
pHr: HRESULT): PUnknown;
var
pFilter: TCRleFilter;
begin
try
pFilter:= TCRleFilter.Create('');
Result := pFilter;
except
pHr:= E_OUTOFMEMORY;
Result:= nil;
end;
end;
function TCRleFilter.DecideBufferSize(pAlloc: IMemAllocator; pProp: PAllocatorProperties): HRESULT;
begin
Result := S_OK;
ShowMessage('DecideBufferSize: âåðíóë "S_OK"');
end;
function TCRleFilter.GetMediaType(IPosition: Integer; pMediaType: PAMMediaType): HRESULT;
begin
Result := S_OK;
ShowMessage('GetMediaType: âåðíóë "S_OK"');
end;
function TCRleFilter.Transform(pSource, pDest: IMediaSample): HRESULT;
begin
Result := S_OK;
ShowMessage('Transform: âåðíóë "S_OK"');
end;
initialization
{.Create(ComServer, TCRleFilter, Class_CRleFilter, 'CRleFilter', 'CRle_Filter', ciMultiInstance, tmApartment); }
TBCClassFactory.CreateFilter(TCRleFilter,'CRle_Filter', CLSID_CRleFilter, CLSID_LegacyAmFilterCategory, MERIT_DO_NOT_USE, 0, nil );
end.
Your class inherites from TBCTransformFilter and the needed parameters are defined as:
constructor TBCTransformFilter.Create(ObjectName: string; unk: IUnKnown; const clsid: TGUID);
Untested, but it should be much more correct than your attempt:
function TCRleFilter.CreateInstance
( pUnk: IUnknown // LPUNKNOWN
; var pHr: HRESULT // Pointer to variable = VAR
): PUnknown; // Pointer
var
oFilter: TCRleFilter; // Object, not pointer
begin
try // Failing constructors throw exceptions
oFilter:= TCRleFilter.Create( 'my RLE encoder', pUnk, CLSID_CRleFilter );
result:= oFilter; // In doubt cast via "PUnknown(oFilter)"
except // Constructor failed, oFilter is undefined
pHr:= E_OUTOFMEMORY;
result:= nil;
end;
end;
The var parameter ensures that assigned values inside the function also live on outside the function - otherwise you'd only have a local variable. Which is also the point (haha) of pointers in C++ parameters.
I'm getting a IEnumVariant from a .NET class library and I am trying to use a generic class to convert this to a IEnumerator
There is a compiler error, "Operator not applicable to this operand type" when attempting to cast an IInterface to the generic type T
I've seen workarounds when attempting to type cast to a class, but these don't work for an interface.
Using Supports as suggested by Rob seems to have problems as well as TypeInfo returns nil for the parameterized type.
uses WinApi.ActiveX, Generics.Collections;
type
TDotNetEnum<T: IInterface> = class(TInterfacedObject, IEnumerator<T>)
strict private
FDotNetEnum: IEnumVariant;
FCurrent: T;
function MoveNext: Boolean;
procedure Reset;
function GetCurrent: TObject;
function IEnumerator<T>.GetCurrent = GenericGetCurrent;
function GenericGetCurrent: T;
public
constructor Create(const ADotNetObject: OleVariant);
//// I can get it to work using this constructor
// constructor Create(const ADotNetObject: OleVariant; const AGUID: TGUID);
end;
implementation
uses System.Rtti, SysUtils, mscorlib_TLB, ComObj;
constructor TDotNetEnum<T>.Create(const ADotNetObject: OleVariant);
var
netEnum: IEnumerable;
begin
netEnum := IUnknown(ADotNetObject) as mscorlib_TLB.IEnumerable;
FDotNetEnum := netEnum.GetEnumerator();
end;
function TDotNetEnum<T>.GenericGetCurrent: T;
begin
result := FCurrent;
end;
function TDotNetEnum<T>.GetCurrent: TObject;
begin
result := nil;
end;
function TDotNetEnum<T>.MoveNext: Boolean;
var
rgvar: OleVariant;
fetched: Cardinal;
ti: TypeInfo;
guid: TGUID;
begin
OleCheck(FDotNetEnum.Next(1, rgvar, fetched));
result := fetched = 1;
if not result then
FCurrent := nil
else
begin
FCurrent := IUnknown(rgvar) as T; // <-- Compiler error here
//// Doesn't work using Supports either
// ti := TypeInfo(T); // <-- returns nil
// guid := GetTypeData(#ti)^.Guid;
// Supports(IUnknown(rgvar), guid, FCurrent);
end;
end;
procedure TDotNetEnum<T>.Reset;
begin
OleCheck(FDotNetEnum.Reset);
end;
Am I missing something in order to get that case to the generic interface type to work ?
I do have the alternative constructor which I CAN get the guid from so that
TDotNetEnum<IContact>.Create(vContactList, IContact);
works but the ideal
TDotNetEnum<IContact>.Create(vContactList);
doesn't
Using as to cast interfaces is only valid for interfaces that have GUIDs. The compiler cannot assume that T has a GUID when it's compiling your generic class, so it cannot accept an expression of the form val as T.
This has been covered before, but in reference to the Supports function, which has the same limitation as the as operator.
The solution is to use RTTI to fetch the interface's GUID, and then use that to type-cast the interface value. You could use Supports:
guid := GetTypeData(TypeInfo(T))^.Guid;
success := Supports(IUnknown(rgvar), guid, FCurrent);
Assert(success);
You could also call QueryInterface directly:
guid := GetTypeData(TypeInfo(T))^.Guid;
OleCheck(IUnknown(rgvar).QueryInterface(guid, FCurrent));
program Project15;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Rtti, System.TypInfo;
type
TRecord = record
public
AField: integer;
constructor Init(test: integer);
end;
TOldObject = object
public
AField: integer;
constructor Init(test: integer);
procedure Fancy; virtual; <<--- compiles
class operator Implicit(test: TRecord): TOldObject; <<-- does not compile.
end;
procedure IsObjectARecord;
var
ARecord: TRecord;
AObject: TOldObject;
v: TValue;
s: String;
begin
v:= TValue.From(ARecord);
case v.Kind of
tkRecord: WriteLn('it''s a Record');
end;
ARecord:= TRecord.Init(10);
AObject.Init(10);
v:= TValue.From(AObject);
case v.Kind of
tkRecord: begin
WriteLn('object is a record?');
if v.IsObject then s:= 'true'
else s:= 'false';
WriteLn('isObject = ' + s);
WriteLn('ToString says: '+v.ToString);
end;
end;
end;
{ TOldSkool }
constructor TOldObject.Init(test: integer);
begin
AField:= 10;
end;
constructor TRecord.Init(test: integer);
begin
AField:= 10;
end;
begin
IsObjectARecord;
Readln;
end.
The outcome of the test proc reads:
ARecord is a Record
AObject is a record?
isObject(AObject) = false
AObject.ToString says: (record)
However object <> record from a functionality point of view.
Object supports inheritance and virtual calls.
Record supports class operators.
Is there a way to tell TP5.5-objects and records apart using RTTI?
Is there even a need to tell them apart -ever-?
Note that I'm not planning to use object, I'm just enumerating types using RTTI so that my generic HashTable with pointers can clean up after itself properly.
Yes I know that object lives on the stack by default (or the heap with special effort) and do not normally need to be freed.
Bonus points if someone knows why virtual calls with TP5.5-objects no longer work, they used to work in Delphi 2007
To the very best of my knowledge, in the eyes of Delphi's RTTI framework, an old-style object cannot be distinguished from a record. This program
{$APPTYPE CONSOLE}
uses
System.Rtti;
type
TOldObject = object
end;
var
ctx: TRttiContext;
RttiType: TRttiType;
begin
RttiType := ctx.GetType(TypeInfo(TOldObject));
Writeln(TValue.From(RttiType.TypeKind).ToString);
Writeln(RttiType.IsRecord);
Readln;
end.
outputs
tkRecord
TRUE
Old object is deprecated.
So you should not use it in conjunction with the new rtti.
First step of deprecation was to disallow virtual methods. Due I suppose to compiler regressions.
This is the Embarcadero decision to mimic C# and his struct / class paradigm. Wrong decision imho.
I am absolutely new at calling functions from DLLs (call it bad programming habits, but I never needed to).
I have this C++ dll (CidGen32.dll at https://skydrive.live.com/redir?resid=4FA1892BF2106B62!1066) that is supposed to export a function with the following signature:
extern "C" __declspec(dllexport) int GetCid(const char* pid, char* cid);
What it should do is to get a 13 char string such as '1111111111118' and return a 20 char hash.
I have tried for the last couple of days to call this function in Delphi 6 but to no avail. I have desperately tried I guess 50+ combinations and I got quite close on one occasion but my computer froze and I lost all my effort. Since it was based on luck, I could not redo it anymore.
I am also aiming not to register the DLL, but rather place it in the same folder.
Anyway, the plan was to have something like this:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
function GenerateCID(Prm: string): string;
var
aCID: PAnsiChar;
uCID: AnsiString;
i: integer;
Hbar: Thandle;
GetCID: function (X: PAnsiChar; Y: PAnsiChar): integer; {$IFDEF WIN32} stdcall; {$ENDIF}
begin
ucid := '';
hbar := LoadLibrary('CidGen32.dll');
if Hbar >= 32 then
begin
#GetCID := GetProcAddress(HBar, 'GetCID');
if Assigned(GetCID) then
begin
i := GetCID(pAnsiChar(prm), aCID);
uCID := aCID;
end;
FreeLibrary(HBar);
end
else
begin
//ShowMessage('Error: could not find dll');
end;
result := uCID;
end;
begin
ShowMessage(GenerateCID('1111111111118'));
end;
end.
But it seems I am dead wrong.
You are using the wrong name to import the function. Its name is GetCid but you are trying to import GetCID. Letter case matters when you call GetProcAddress. If that still doesn't result in the GetProcAddress call succeeding, double check the name with which the function is exported using a tool like Dependency Walker.
The function is cdecl so you should declare it like this:
GetCID: function(pid, cid: PAnsiChar): Integer; cdecl;
And the other problem is that you are responsible for allocating the buffer behind cid. You did not do that. Do it like this:
SetLength(uCID, 20);
i := GetCID(pAnsiChar(prm), pAnsiChar(uCID));
And delete the aCID variable. And that >32 error check is wrong, compare against 0.
I want to create a TObjectList<T> descendant to handle common functionality between object lists in my app. Then I want to further descend from that new class to introduce additional functionality when needed. I cannot seem to get it working using more than 1 level of inheritance. I probably need to understand generics a little bit more, but I've search high and low for the correct way to do this without success. Here is my code so far:
unit edGenerics;
interface
uses
Generics.Collections;
type
TObjectBase = class
public
procedure SomeBaseFunction;
end;
TObjectBaseList<T: TObjectBase> = class(TObjectList<T>)
public
procedure SomeOtherBaseFunction;
end;
TIndexedObject = class(TObjectBase)
protected
FIndex: Integer;
public
property Index: Integer read FIndex write FIndex;
end;
TIndexedObjectList<T: TIndexedObject> = class(TObjectBaseList<T>)
private
function GetNextAutoIndex: Integer;
public
function Add(AObject: T): Integer;
function ItemByIndex(AIndex: Integer): T;
procedure Insert(AIndex: Integer; AObject: T);
end;
TCatalogueItem = class(TIndexedObject)
private
FID: integer;
public
property ID: integer read FId write FId;
end;
TCatalogueItemList = class(TIndexedObjectList<TCatalogueItem>)
public
function GetRowById(AId: Integer): Integer;
end;
implementation
uses
Math;
{ TObjectBase }
procedure TObjectBase.SomeBaseFunction;
begin
end;
{ TObjectBaseList<T> }
procedure TObjectBaseList<T>.SomeOtherBaseFunction;
begin
end;
{ TIndexedObjectList }
function TIndexedObjectList<T>.Add(AObject: T): Integer;
begin
AObject.Index := GetNextAutoIndex;
Result := inherited Add(AObject);
end;
procedure TIndexedObjectList<T>.Insert(AIndex: Integer; AObject: T);
begin
AObject.Index := GetNextAutoIndex;
inherited Insert(AIndex, AObject);
end;
function TIndexedObjectList<T>.ItemByIndex(AIndex: Integer): T;
var
I: Integer;
begin
Result := Default(T);
while (Count > 0) and (I < Count) and (Result = Default(T)) do
if Items[I].Index = AIndex then
Result := Items[I]
else
Inc(I);
end;
function TIndexedObjectList<T>.GetNextAutoIndex: Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to Count - 1 do
Result := Max(Result, Items[I].Index);
Inc(Result);
end;
{ TCatalogueItemList }
function TCatalogueItemList.GetRowById(AId: Integer): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to Pred(Self.Count) do
if Self.Items[I].Id = AId then
begin
Result := I;
Break;
end;
end;
end.
/////// ERROR HAPPENS HERE ////// ???? why is beyond me
It appears that the following declaration:
>>> TCatalogueItemList = class(TIndexedObjectList<TCatalogueItem>) <<<<
causes the following compiler error:
[DCC Error] edGenerics.pas(106): E2010 Incompatible types:
'TCatalogueItem' and 'TIndexedObject'
However the compiler shows the error at the END of the compiled unit (line 106), not on the declaration itself, which does not make any sense to me...
Basically the idea is that I have a generic list descending from TObjectList that I can extend with new functionality on an as needs basis. Any help with this would be GREAT!!!
I should add, using Delphi 2010.
Thanks.
Your error is in the type casting, and the compiler error is OK (but it fails to locate the correct file in my Delphi XE3).
Your ItemByIndex method is declared:
TIndexedObjectList<T>.ItemByIndex(AIndex: Integer): T;
But then you have the line:
Result := TIndexedObject(nil);
This is fine for the parent class TIndexedObjectList, where the result of the function is of type TIndexedObject, but is not OK for the descendant class TCatalogueItemList, where the result of the function is of the type TCatalogueItem.
As you may know, a TCatalogueItem instance is assignment compatible with a TIndexedObject variable, but the opposite is not true. It translates to something like this:
function TCatalogueItemList.ItemByIndex(AIndex: Integer): TCatalogueItem;
begin
Result := TIndexedObject(nil); //did you see the problem now?
To initialize the result to a nil value, you can call the Default() pseudo-function, like this:
Result := Default(T);
In Delphi XE or greater, the solution is also generic. Rather than type-casting the result as a fixed TIndexedObjectList class, you apply a generic type casting use the T type
Result := T(nil);
//or
Result := T(SomeOtherValue);
But, in this specific case, type-casting a nil constant is not needed, since nil is a special value that is assignment compatible with any reference, so you just have to replace the line with:
Result := nil;
And it will compile, and hopefully work as you expect.