Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Succeed - XPCom in Delphi 7

164 views
Skip to first unread message

vol...@gmail.com

unread,
Apr 8, 2007, 5:10:02 PM4/8/07
to
Hi all,

Few minutes ago I was finished first XPCOM test build in Delphi 7 so
Object Pascal can be now listed with C++ and JScript as XPCom enabled
language.

Current status is XPCom called from XUL from XULRunner. XULRunner
is started as host app so you can debug xpcom component right from
IDE.

I am looking forward for next development, now I am support just Int
as
parametr (string not supported now, pointers to DOM not tested now)


source code will be published somewhere after while, stay tuned


see ya
Radek

huang

unread,
Apr 19, 2007, 1:43:45 AM4/19/07
to

Can you present some hints of your works?

I am interesting in writing Delphi app talking to Firefox and
Thunderbird through XPCOM interfaces.

Cheers

vol...@gmail.com

unread,
May 10, 2007, 10:05:34 AM5/10/07
to
> Can you present some hints of your works?

We finished complete application (http://dnl.crawler.com/dnl/config/23/
WebSecurityGuardSetup.exe) so we know that there is just one
limitation - widget element is not interfaced, if you need hwnd from
ff you need small helper compiled in C++


You can source code attached bellow , it is one of our first tests and
is probably bugged (I am sorry but I can't publish applications source
code) . nsXXXX units are based on Delphi GeckoSDK published on
SourceForge.

XPCOM is very, very easy think - nothink special, just one calling
function and few interfaces.


see ya
Radek


library test;

uses
SysUtils,
Classes,
windows,
nsXPCOM, nsXPCOMGlue,nsTypes, nsError, nsConsts,
nsGeckoStrings,nsInit;

const
Sample_CONTRACTID = '@starkravingfinkle.org/specialthing;1';
Sample_cid: TGUID = '{00245626-5cc1-11db-9673-00e08161165f}';

type

ISpecialThing = interface(nsISupports)
['{263ed1ba-5cc1-11db-9673-00e08161165f}']
function Add(a: PRInt32; b: PRInt32; out _retval: PRInt32):
nsresult; stdcall;
function GetName(aName: nsAString): Longword; stdcall;
function SetName(const aName: nsAString): Longword; stdcall;
function SendnsIDOMWindow(IDOMWin: nsIDOMWindow; out _retval:
PRInt32): nsresult; stdcall;
end;

TSpecialThing = class(TInterfacedObject, ISpecialThing)
Name: IInterfacedString;
public
procedure AfterConstruction; override;
function Add(a: PRInt32; b: PRInt32; out _retval: PRInt32):
nsresult; stdcall;
function GetName(aName: nsAString): Longword; stdcall;
function SetName(const aName: nsAString): Longword; stdcall;
function SendnsIDOMWindow(IDOMWin: nsIDOMWindow; out _retval:
PRInt32): nsresult; stdcall;
end;

TSampleFactory = class(TInterfacedObject, nsIFactory)
protected
{ IUnknown }
(* function nsIFactory.QueryInterface = ObjQueryInterface;
function nsIFactory._AddRef = ObjAddRef;
function nsIFactory._Release = ObjRelease;*)
public
// function ObjQueryInterface(const IID: TGUID; out Obj):
HResult; override; stdcall;

function CreateInstance(aOuter: nsISupports; const iid: TGUID; out
_result): nsresult; stdcall;
function LockFactory(lock: PRBool): nsresult; stdcall;
end;

TSampleModule = class(TInterfacedObject, nsIModule)
public
function GetClassObject(aCompMgr: nsIComponentManager; const
aClass: TGUID; const aIID: TGUID; out aResult): nsresult; stdcall;
function RegisterSelf(aCompMgr: nsIComponentManager; aLocation:
nsIFile; const aLoaderStr: PAnsiChar; const aType: PAnsiChar):
nsresult; stdcall;
function UnregisterSelf(aCompMgr: nsIComponentManager; aLocation:
nsIFile; const aLoaderStr: PAnsiChar): nsresult; stdcall;
function CanUnload(aCompMgr: nsIComponentManager): PRBool;
safecall;
end;

(*function TNSISupports.ObjQueryInterface(const IID: TGUID; out
Obj): HResult;
begin
if IsEqualGUID(IID, NS_ISUPPORTS_IID) then
begin
nsISupports(Obj) := Self;
ObjAddRef;
Result := NS_OK;
end
else
Result := NS_ERROR_NO_INTERFACE;
end;

function TNSISupports.ObjAddRef: Integer;
begin
Result := InterlockedIncrement(FRefCount);
end;

function TNSISupports.ObjRelease: Integer;
begin
// InterlockedDecrement returns only 0 or 1 on Win95 and NT 3.51
// returns actual result on NT 4.0
Result := InterlockedDecrement(FRefCount);
if Result = 0 then Destroy;
end;

{ TNSISupports }*)

{ TSampleFactory }

function TSampleFactory.CreateInstance(aOuter: nsISupports;
const iid: TGUID; out _result): nsresult;
var NSI: TSpecialThing;
begin
OutputDebugString(pchar(GUIDToString(IID)));

NSI := TSpecialThing.Create;
if not assigned(NSI) then
Result := NS_ERROR_OUT_OF_MEMORY
else
Result := IInterface(NSI).QueryInterface(iid, _result);

if NS_FAILED(Result) then
try
FreeAndNil(NSI);
pointer(_result) := nil;
except
end;

end;

function TSampleFactory.LockFactory(lock: PRBool): nsresult;
begin
result := NS_ERROR_NOT_IMPLEMENTED;
end;

(*function TSampleFactory.ObjQueryInterface(const IID: TGUID;
out Obj): HResult;
begin
Result := inherited ObjQueryInterface(IID, Obj);
if Result = NS_ERROR_NO_INTERFACE then
if IsEqualGUID(IID, NS_IFACTORY_IID) then
begin
nsIFactory(Obj) := Self;
ObjAddRef;
Result := NS_OK;
end;
end;*)

{ TSampleModule }

function TSampleModule.CanUnload(aCompMgr: nsIComponentManager):
PRBool;
begin
Result := False;
end;

function TSampleModule.GetClassObject(aCompMgr: nsIComponentManager;
const aClass, aIID: TGUID; out aResult): nsresult;
var Fac: TSampleFactory;
begin
OutputDebugString(pchar(GUIDToString(aClass)));
OutputDebugString(pchar(GUIDToString(aIID)));

if not IsEqualGUID(aClass, Sample_cid) then
begin
Result := NS_ERROR_FACTORY_NOT_REGISTERED;
exit;
end;

Fac := TSampleFactory.Create;
if not assigned(Fac) then
begin
Result := NS_ERROR_OUT_OF_MEMORY;
exit;
end;

Result := Fac.QueryInterface(aIID, aResult);

if NS_FAILED(Result) then
try
FreeAndNil(Fac);
pointer(aresult) := nil;
except
end;

end;

function TSampleModule.RegisterSelf(aCompMgr: nsIComponentManager;
aLocation: nsIFile; const aLoaderStr, aType: PAnsiChar): nsresult;
var CompReg: nsIComponentRegistrar;
begin
Result := NS_ERROR_INVALID_ARG;
if not assigned(aCompMgr) then exit;

Result := aCompMgr.QueryInterface(NS_ICOMPONENTREGISTRAR_IID,
CompReg);
if NS_FAILED(Result) then
exit;

Result := CompReg.RegisterFactoryLocation(Sample_cid, 'Sample
class', Sample_CONTRACTID, aLocation, aLoaderStr, aType);

CompReg := nil;

end;

function TSampleModule.UnregisterSelf(aCompMgr: nsIComponentManager;
aLocation: nsIFile; const aLoaderStr: PAnsiChar): nsresult;
var CompReg: nsIComponentRegistrar;
begin
Result := NS_ERROR_INVALID_ARG;
if not assigned(aCompMgr) then exit;

Result := aCompMgr.QueryInterface(NS_ICOMPONENTREGISTRAR_IID,
CompReg);
if NS_FAILED(Result) then
exit;

Result := CompReg.UnregisterFactoryLocation(Sample_cid, aLocation);

CompReg := nil;

end;

function NSGetModule(servMgr: nsIComponentManager; location: nsIFile;
out return_cobj: nsIModule): nsresult; cdecl; export;
var SModule: TSampleModule;
begin
Result := NS_OK;
try

SModule := TSampleModule.Create;
if not assigned(SModule) then
begin
Result := NS_ERROR_OUT_OF_MEMORY;
exit;
end;

Result := SModule.QueryInterface(NS_IMODULE_IID, return_cobj);
if NS_FAILED(Result) then
FreeAndNil(SModule);
except
end;
end;

exports
NSGetModule;

{ TSpecialThing }

function TSpecialThing.Add(a, b: PRInt32; out _retval: PRInt32):
nsresult;
begin
_retval := (A + B) * 2;
Result:=NS_OK;
end;


procedure TSpecialThing.AfterConstruction;
begin
inherited;
GRE_DLLStartup;
Name := NewString;
end;

function TSpecialThing.GetName(aName: nsAString): Longword;
begin
OutputDebugString(pchar(string(name.ToString)));
NS_StringSetData(aName, PWideChar(name.ToString));
Result:=NS_OK;
end;

function TSpecialThing.SetName(const aName: nsAString): Longword;
begin
Name.Assign(aName);
Name.Append('_added');
OutputDebugString(pchar(string(name.ToString)));
Result:=NS_OK;
end;

function TSpecialThing.SendnsIDOMWindow(IDOMWin: nsIDOMWindow; out
_retval: PRInt32): nsresult;
begin
IDOMWin.ScrollByLines(20);
result := NS_OK;
end;

begin
end.


2pha...@gmail.com

unread,
May 29, 2007, 8:26:37 AM5/29/07
to
On May 10, 6:05 pm, volt...@gmail.com wrote:
> > Can you present some hints of your works?
>
> We finished complete application (http://dnl.crawler.com/dnl/config/23/
> WebSecurityGuardSetup.exe) so we know that there is just one
> limitation - widget element is not interfaced, if you need hwnd from
> ff you need small helper compiled in C++
>
> You can source code attached bellow , it is one of our first tests and
> is probably bugged (I am sorry but I can't publish applications source
> code) . nsXXXX units are based on Delphi GeckoSDK published on
> SourceForge.
>
> XPCOM is very, very easy think - nothink special, just one calling
> function and few interfaces.

Great work! But I'm can't find unit nsInit in GeckoSDK and method
GRE_DLLStartup.
What to do? =)

2pha...@gmail.com

unread,
Jun 5, 2007, 8:07:35 AM6/5/07
to
> Great work! But I'm can't find unit nsInit in GeckoSDK and method
> GRE_DLLStartup.

Ok, I have found newer version SDK at SF (http://sourceforge.net/
projects/d-gecko). In this version there is a module nsInit, but there
is no function GRE_DLLStartup. At creation of a component I tried to
cause function GRE_Startup instead of GRE_DLLStartup, but thus
NS_InitXPCOM2 gives out an error 0080004005 (NS_ERROR_FAILURE).
Strange, but the component is created and works. However, attempt to
call its methods from Java-script terminates in an error. There can be
somebody can send working example XPCOM on Delphi?

0 new messages