Fixed some problems win32 version. GTK and others still do not work.

Fixed some DOM events. Added new OnCloseWindow event.
Added possibility to disable JavaScript.
The interface is not fixed and some events could change shortly.
Tested with XULRuuner from 1.9.0.16 to 1.9.1.11.
XULRunner 1.9.2.x does not work due JavaScript problems, quite sure located in the XULRunner.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1231 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
Joshy
2010-05-28 21:53:08 +00:00
parent 739b3a43cb
commit 55a0067ad1
17 changed files with 508 additions and 280 deletions

View File

@ -37,7 +37,7 @@ unit BrowserSupports;
interface interface
uses uses
nsConsts, nsGeckoStrings, nsTypes, nsXPCOM; nsGeckoStrings, nsTypes, nsXPCOM;
const const
GFXIFORMATS_IID: TGUID = '{96d086e6-1dd1-11b2-b6b2-b77b59390247}'; GFXIFORMATS_IID: TGUID = '{96d086e6-1dd1-11b2-b6b2-b77b59390247}';
@ -114,7 +114,7 @@ type
*) *)
gfx_format = PRInt32; gfx_format = PRInt32;
nscoord = PRInt32; nscoord = PRInt32;
nativeWindow = Pointer; nativeWindow = THANDLE;
gfxIFormats = interface gfxIFormats = interface
['{96d086e6-1dd1-11b2-b6b2-b77b59390247}'] ['{96d086e6-1dd1-11b2-b6b2-b77b59390247}']
end; end;

View File

@ -67,6 +67,13 @@ type
function SafeCallException(Obj: TObject; Addr: Pointer): HResult; override; function SafeCallException(Obj: TObject; Addr: Pointer): HResult; override;
end; end;
{$PUSH}
{$HINTS OFF}
procedure UseParameter(var X);
begin
end;
{$POP}
function FindTarget(chrome: nsIWebBrowserChrome): IGeckoCreateWindowTarget; function FindTarget(chrome: nsIWebBrowserChrome): IGeckoCreateWindowTarget;
var var
chrome2: IGeckoBrowserChrome; chrome2: IGeckoBrowserChrome;
@ -131,12 +138,14 @@ begin
if Assigned(target) then if Assigned(target) then
Result := target.DoCreateChromeWindow(chromeFlags); Result := target.DoCreateChromeWindow(chromeFlags);
if not Assigned(Result) then if not Assigned(Result) then
raise EGeckoError.Create('�V�����u���E�U���J�����Ƃ��o���܂����B'); raise EGeckoHint.CreateFmt('Attempt to create a new Chrome window but handler does not create a new one. Chrome flags: %8X',[chromeFlags]);
end; end;
end; end;
function TWindowCreator.SafeCallException(Obj: TObject; Addr: Pointer): HResult; function TWindowCreator.SafeCallException(Obj: TObject; Addr: Pointer): HResult;
begin begin
UseParameter(Obj);
UseParameter(Addr);
Result := HRESULT(NS_ERROR_FAILURE); Result := HRESULT(NS_ERROR_FAILURE);
end; end;

View File

@ -42,7 +42,7 @@ interface
uses uses
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF} {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
SysUtils, Classes, Controls, nsConsts, nsXPCOM, SysUtils, Classes, Controls, nsXPCOM,
nsGeckoStrings, CallbackInterfaces, nsTypes, nsXPCOMGlue, BrowserSupports, nsGeckoStrings, CallbackInterfaces, nsTypes, nsXPCOMGlue, BrowserSupports,
nsXPCOM_std19 nsXPCOM_std19
{$IFDEF LCLCarbon}, CarbonPrivate {$ENDIF} {$IFDEF LCLCarbon}, CarbonPrivate {$ENDIF}
@ -70,6 +70,7 @@ const
WM_GETDLGCODE = LM_GETDLGCODE; WM_GETDLGCODE = LM_GETDLGCODE;
WM_NEXTDLGCTL = $0028; WM_NEXTDLGCTL = $0028;
WM_ERASEBKGND = LM_ERASEBKGND; WM_ERASEBKGND = LM_ERASEBKGND;
WM_SHOWWINDOW = LM_SHOWWINDOW;
E_FAIL = HRESULT($80004005); E_FAIL = HRESULT($80004005);
type type
TMessage = TLMessage; TMessage = TLMessage;
@ -134,7 +135,10 @@ type
end; end;
//TODO 2 -cTCustomGeckoBrowser: DocShell �v��p�e�B���lj� //TODO 2 -cTCustomGeckoBrowser: DocShell �v��p�e�B���lj�
{ TCustomGeckoBrowser }
TCustomGeckoBrowser = class(TCustomControl, TCustomGeckoBrowser = class(TCustomControl,
IGeckoCreateWindowTarget) IGeckoCreateWindowTarget)
private private
@ -160,6 +164,14 @@ type
FOnNewWindow: TGeckoBrowserNewWindow; FOnNewWindow: TGeckoBrowserNewWindow;
FOnSetupProperties: TNotifyEvent;
//misc settings
FDisableJavaScript: Boolean;
FInitialized: Boolean;
function GetDisableJavaScript: Boolean;
procedure SetDisableJavascript(const AValue: Boolean);
procedure ShutdownWebBrowser; procedure ShutdownWebBrowser;
procedure InnerLoadURI(uri: WideString; Flags: PRUint32; procedure InnerLoadURI(uri: WideString; Flags: PRUint32;
referer: nsIURI; postData, headers: TStream); referer: nsIURI; postData, headers: TStream);
@ -169,7 +181,6 @@ type
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND; procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
function GetContentDocument: nsIDOMDocument; function GetContentDocument: nsIDOMDocument;
function GetContentWindow: nsIDOMWindow; function GetContentWindow: nsIDOMWindow;
function GetCanGoBack: Boolean; function GetCanGoBack: Boolean;
@ -270,6 +281,11 @@ type
property OnNewWindow: TGeckoBrowserNewWindow property OnNewWindow: TGeckoBrowserNewWindow
read FOnNewWindow write FOnNewWindow; read FOnNewWindow write FOnNewWindow;
property OnSetupProperties: TNotifyEvent read FOnSetupProperties write FOnSetupProperties;
// misc base settings
property DisableJavaScript: Boolean read GetDisableJavaScript write SetDisableJavascript;
property Initialized: Boolean read FInitialized;
end; end;
TCustomGeckoBrowserChrome = class(TInterfacedObject, TCustomGeckoBrowserChrome = class(TInterfacedObject,
@ -362,6 +378,9 @@ type
FOnDOMDragDrop: TGeckoBrowserDOMEventHandler; FOnDOMDragDrop: TGeckoBrowserDOMEventHandler;
FOnDOMDragExit: TGeckoBrowserDOMEventHandler; FOnDOMDragExit: TGeckoBrowserDOMEventHandler;
FOnDOMFocus: TGeckoBrowserDOMEventHandler; FOnDOMFocus: TGeckoBrowserDOMEventHandler;
FOnCloseWindow: TNotifyEvent;
// The Last focused element // The Last focused element
FLastFocused: nsIDOMElement; FLastFocused: nsIDOMElement;
@ -407,6 +426,8 @@ type
read FOnDOMDragExit write FOnDOMDragExit; read FOnDOMDragExit write FOnDOMDragExit;
property OnDOMFocus: TGeckoBrowserDOMEventHandler property OnDOMFocus: TGeckoBrowserDOMEventHandler
read FOnDOMFocus write FOnDOMFocus; read FOnDOMFocus write FOnDOMFocus;
property OnCloseWindow: TNotifyEvent
read FOnCloseWindow write FOnCloseWindow;
published published
// TWinControl // TWinControl
@ -419,8 +440,13 @@ type
property BevelKind; property BevelKind;
property BevelOuter; property BevelOuter;
property BevelWidth; property BevelWidth;
{$ELSE}
property Anchors;
property BorderSpacing;
property Constraints;
{$ENDIF} {$ENDIF}
//property BorderWidth; property BorderStyle;
property BorderWidth;
property OnLocationChange; property OnLocationChange;
property OnProgressChange; property OnProgressChange;
@ -434,6 +460,10 @@ type
property OnGoForward; property OnGoForward;
property OnGoToIndex; property OnGoToIndex;
property OnSetupProperties;
property DisableJavaScript;
public public
property ContentDocument; property ContentDocument;
property ContentWindow; property ContentWindow;
@ -449,8 +479,8 @@ type
private private
FBrowser: TGeckoBrowser; FBrowser: TGeckoBrowser;
protected protected
constructor Create(Browser: TGeckoBrowser);
public public
constructor Create(Browser: TGeckoBrowser);
destructor Destroy; override; destructor Destroy; override;
protected protected
// nsIWebBrowserChrome // nsIWebBrowserChrome
@ -495,7 +525,6 @@ type
nsISHistoryListener, nsISHistoryListener,
nsIDOMEventListener) nsIDOMEventListener)
protected protected
constructor Create(browser: TGeckoBrowser);
// nsIWebProgressListener // nsIWebProgressListener
procedure OnStateChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aStateFlags: PRUint32; aStatus: nsresult); override; procedure OnStateChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aStateFlags: PRUint32; aStatus: nsresult); override;
procedure OnProgressChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aCurSelfProgress: PRInt32; aMaxSelfProgress: PRInt32; aCurTotalProgress: PRInt32; aMaxTotalProgress: PRInt32); override; procedure OnProgressChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aCurSelfProgress: PRInt32; aMaxSelfProgress: PRInt32; aCurTotalProgress: PRInt32; aMaxTotalProgress: PRInt32); override;
@ -511,12 +540,14 @@ type
function OnHistoryPurge(aNumEntries: PRInt32): PRBool; safecall; function OnHistoryPurge(aNumEntries: PRInt32): PRBool; safecall;
// nsIDOMEventListener // nsIDOMEventListener
//procedure HandleEvent(aEvent: nsIDOMEvent); safecall; //procedure HandleEvent(aEvent: nsIDOMEvent); safecall;
public
constructor Create(browser: TGeckoBrowser);
end; end;
(*TGeckoBrowser = class(TCustomControl, (*TGeckoBrowser = class(TCustomControl,
nsISHistoryListener) nsISHistoryListener)
private private
{ Private 錾 } { Private 錾 }
FWebBrowser: nsIWebBrowser; FWebBrowser: nsIWebBrowser;
FDocTitle: WideString; FDocTitle: WideString;
@ -535,13 +566,13 @@ type
function GetHistoryPosition: Integer; function GetHistoryPosition: Integer;
function GetHistoryCount: Integer; function GetHistoryCount: Integer;
protected protected
{ Protected 錾 } { Protected 錾 }
// TControl // TControl
procedure Resize; override; procedure Resize; override;
public public
{ Public 錾 } { Public 錾 }
// �i�r�Q[�V���� // �i�r�Q[�V����
// nsIWebNavigation // nsIWebNavigation
procedure GotoIndex(aIndex: Integer); procedure GotoIndex(aIndex: Integer);
@ -549,7 +580,7 @@ type
property HistoryPosition: Integer read GetHistoryPosition; property HistoryPosition: Integer read GetHistoryPosition;
property HistoryCount: Integer read GetHistoryCount; property HistoryCount: Integer read GetHistoryCount;
published published
{ Published 錾 } { Published 錾 }
// TWinControl // TWinControl
property Align; property Align;
property TabOrder; property TabOrder;
@ -635,7 +666,7 @@ procedure Register;
implementation implementation
uses uses
nsError, nsStream, nsMemory, nsNetUtil, nsInit, GeckoInit, nsError, nsStream, nsMemory, nsNetUtil, GeckoInit,
Forms, TypInfo, Variants; Forms, TypInfo, Variants;
procedure Register; procedure Register;
@ -643,6 +674,13 @@ begin
RegisterComponents('Gecko', [TGeckoBrowser]); RegisterComponents('Gecko', [TGeckoBrowser]);
end; end;
{$PUSH}
{$HINTS OFF}
procedure UseParameter(var X);
begin
end;
{$POP}
(* (*
// nsISHistoryListener // nsISHistoryListener
function TGeckoBrowser.OnHistoryNewEntry(aNewURI: nsIURI): Longword; function TGeckoBrowser.OnHistoryNewEntry(aNewURI: nsIURI): Longword;
@ -721,7 +759,7 @@ begin
Result := NS_OK; Result := NS_OK;
end; end;
// TControl �p� // TControl �p�
procedure TGeckoBrowser.Resize; procedure TGeckoBrowser.Resize;
var var
BaseWindow: nsIBaseWindow; BaseWindow: nsIBaseWindow;
@ -813,6 +851,7 @@ end;
function TCustomGeckoBrowserChrome.SafeCallException(obj: TObject; addr: Pointer): HRESULT; function TCustomGeckoBrowserChrome.SafeCallException(obj: TObject; addr: Pointer): HRESULT;
begin begin
UseParameter(obj); UseParameter(Addr);
Result := E_FAIL; Result := E_FAIL;
end; end;
@ -839,7 +878,7 @@ begin
begin begin
with FDOMEvents[I] do with FDOMEvents[I] do
begin begin
target.AddEventListener(NewString(Name).AString, Self, False); target.AddEventListener(NewString(Name).AString, Self, true);
end; end;
Inc(I); Inc(I);
end; end;
@ -883,9 +922,10 @@ begin
{$IFNDEF FPC} {$IFNDEF FPC}
browser.AddWebBrowserListener(weak, table.Entries[i].IID); browser.AddWebBrowserListener(weak, table.Entries[i].IID);
{$ELSE} {$ELSE}
{$IFOPT R+}{$DEFINE TURNED_RANGE_CHECK_OFF}{$R-}{$ENDIF} {$PUSH}
{$R-}
browser.AddWebBrowserListener(weak, table.Entries[i].IID^); //FPC Entries is only array[0..0]! browser.AddWebBrowserListener(weak, table.Entries[i].IID^); //FPC Entries is only array[0..0]!
{$IFDEF TURNED_RANGE_CHECK_OFF}{$UNDEFINE TURNED_RANGE_CHECK_OFF}{$R+}{$ENDIF} {$POP}
{$ENDIF} {$ENDIF}
end; end;
@ -902,15 +942,17 @@ begin
{$IFNDEF FPC} {$IFNDEF FPC}
browser.RemoveWebBrowserListener(weak, table.Entries[i].IID); browser.RemoveWebBrowserListener(weak, table.Entries[i].IID);
{$ELSE} {$ELSE}
{$IFOPT R+}{$DEFINE TURNED_RANGE_CHECK_OFF}{$R-}{$ENDIF} {$PUSH}
{$R-}
browser.RemoveWebBrowserListener(weak, table.Entries[i].IID^); browser.RemoveWebBrowserListener(weak, table.Entries[i].IID^);
{$IFDEF TURNED_RANGE_CHECK_OFF}{$UNDEFINE TURNED_RANGE_CHECK_OFF}{$R+}{$ENDIF} {$POP}
{$ENDIF} {$ENDIF}
end; end;
function TCustomGeckoBrowserListener.SafeCallException( function TCustomGeckoBrowserListener.SafeCallException(
Obj: TObject; Addr: Pointer): HResult; Obj: TObject; Addr: Pointer): HResult;
begin begin
UseParameter(obj); UseParameter(Addr);
Result := HRESULT(NS_ERROR_FAILURE); Result := HRESULT(NS_ERROR_FAILURE);
end; end;
@ -994,7 +1036,7 @@ begin
baseWin.SetPositionAndSize(rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, False); baseWin.SetPositionAndSize(rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, False);
end; end;
// TWinControl �p� // TWinControl �p�
procedure TCustomGeckoBrowser.CreateWnd; procedure TCustomGeckoBrowser.CreateWnd;
begin begin
{$IFDEF DEBUG} {$IFDEF DEBUG}
@ -1005,6 +1047,13 @@ begin
if not (csDesigning in ComponentState) then if not (csDesigning in ComponentState) then
begin begin
InitWebBrowser; InitWebBrowser;
LoadURI('about:blank');
FInitialized:=true;
if Assigned(FOnSetupProperties) then begin
FOnSetupProperties(Self);
end;
//Set again the published properties
SetDisableJavascript(FDisableJavaScript);
end; end;
end; end;
@ -1056,12 +1105,12 @@ begin
baseWin := FWebBrowser as nsIBaseWindow; baseWin := FWebBrowser as nsIBaseWindow;
rc := ClientRect; rc := ClientRect;
baseWin.InitWindow({$IFDEF MSWINDOWS}Pointer(Handle),{$ENDIF} baseWin.InitWindow({$IFDEF MSWINDOWS}Handle,{$ENDIF}
{$IFDEF LCLCarbon}Pointer(TCarbonWindow(Handle).Window),{$ENDIF} {$IFDEF LCLCarbon}TCarbonWindow(Handle).Window,{$ENDIF}
// {$IFDEF LCLCocoa}Pointer(TCocoaForm(Handle).MainWindowView.superview),{$ENDIF} // {$IFDEF LCLCocoa}Pointer(TCocoaForm(Handle).MainWindowView.superview),{$ENDIF}
{$IFDEF LCLCocoa}Pointer(TCocoaWindow(Handle).contentView),{$ENDIF} {$IFDEF LCLCocoa}TCocoaWindow(Handle).contentView,{$ENDIF}
{$IFDEF LCLGtk}Pointer(Handle),{$ENDIF} //Is Handle same as GTK Window? {$IFDEF LCLGtk}Handle,{$ENDIF} //Is Handle same as GTK Window?
{$IFDEF LCLGtk2}Pointer(Handle),{$ENDIF} //Is Handle same as GTK Window? {$IFDEF LCLGtk2}Handle,{$ENDIF} //Is Handle same as GTK Window?
nil, nil,
rc.Left, rc.Left,
rc.Top, rc.Top,
@ -1151,7 +1200,7 @@ begin
InnerLoadURI(uri, Flags, ref, nil, nil); InnerLoadURI(uri, Flags, ref, nil, nil);
end; end;
procedure TCustomGeckoBrowser.LoadURIWithFlags(const uri: WideString; Flags: Cardinal; const referer: WideString); procedure TCustomGeckoBrowser.LoadURIWithFlags(const uri: WideString; Flags: PRUint32; const referer: WideString);
var var
ref: nsIURI; ref: nsIURI;
refStr: IInterfacedUTF8String; refStr: IInterfacedUTF8String;
@ -1161,7 +1210,7 @@ begin
InnerLoadURI(uri, Flags, ref, nil, nil); InnerLoadURI(uri, Flags, ref, nil, nil);
end; end;
procedure TCustomGeckoBrowser.LoadURIWithFlags(const uri: WideString; Flags: Cardinal; referer: nsIURI); procedure TCustomGeckoBrowser.LoadURIWithFlags(const uri: WideString; Flags: PRUint32; referer: nsIURI);
begin begin
InnerLoadURI(uri, Flags, referer, nil, nil); InnerLoadURI(uri, Flags, referer, nil, nil);
end; end;
@ -1194,6 +1243,29 @@ begin
end; end;
end; end;
function TCustomGeckoBrowser.GetDisableJavaScript: Boolean;
begin
Result:=FDisableJavaScript;
end;
procedure TCustomGeckoBrowser.SetDisableJavascript(const AValue: Boolean);
var
iWebSetup: nsIWebBrowserSetup;
begin
try
if FInitialized then begin
iWebSetup:=Self.FWebBrowser as nsIWebBrowserSetup;
iWebSetup.SetProperty(NS_IWEBBROWSERSETUP_SETUP_ALLOW_JAVASCRIPT,PRInt32(not AValue));
end;
FDisableJavaScript:=AValue;
except
try
Raise EGeckoHint.Create('Unable to disable JavaScript at this moment. Gecko not created?');
except
end;
end;
end;
procedure TCustomGeckoBrowser.SetChrome(aChrome: TCustomGeckoBrowserChrome); procedure TCustomGeckoBrowser.SetChrome(aChrome: TCustomGeckoBrowserChrome);
var var
old: TCustomGeckoBrowserChrome; old: TCustomGeckoBrowserChrome;
@ -1243,6 +1315,7 @@ begin
)); ));
} }
{$ENDIF} {$ENDIF}
UseParameter(statusType);
if Assigned(FBrowser.OnStatusChange) then if Assigned(FBrowser.OnStatusChange) then
FBrowser.OnStatusChange(FBrowser, status); FBrowser.OnStatusChange(FBrowser, status);
end; end;
@ -1269,11 +1342,13 @@ end;
procedure TGeckoBrowserChrome.SetChromeFlags( procedure TGeckoBrowserChrome.SetChromeFlags(
aChromeFlags: PRUint32); aChromeFlags: PRUint32);
begin begin
UseParameter(aChromeFlags);
end; end;
procedure TGeckoBrowserChrome.DestroyBrowserWindow; procedure TGeckoBrowserChrome.DestroyBrowserWindow;
begin begin
//TODO 2 -cTGeckoBrowserChrome: TGeckoBrowserChrome.OnDestroyBrowser �C�x���g�̒lj� if Assigned(FBrowser.FOnCloseWindow) then
FBrowser.FOnCloseWindow(FBrowser);
end; end;
procedure TGeckoBrowserChrome.SizeBrowserTo( procedure TGeckoBrowserChrome.SizeBrowserTo(
@ -1297,6 +1372,7 @@ end;
procedure TGeckoBrowserChrome.ExitModalEventLoop( procedure TGeckoBrowserChrome.ExitModalEventLoop(
aStatus: nsresult); aStatus: nsresult);
begin begin
UseParameter(aStatus);
end; end;
procedure TGeckoBrowserChrome.SetDimensions( procedure TGeckoBrowserChrome.SetDimensions(
@ -1376,7 +1452,15 @@ end;
procedure TGeckoBrowserChrome.SetFocus; procedure TGeckoBrowserChrome.SetFocus;
begin begin
if Assigned(FBrowser.FOnVisibleChange) then begin
//Give the browser a chance to become visible
FBrowser.FOnVisibleChange(FBrowser,true);
end;
try
FBrowser.SetFocus; FBrowser.SetFocus;
except
Raise EGeckoHint.Create('Unable to set focus to '+FBrowser.Name);
end;
end; end;
function TGeckoBrowserChrome.GetVisibility: PRBool; function TGeckoBrowserChrome.GetVisibility: PRBool;
@ -1388,6 +1472,7 @@ end;
procedure TGeckoBrowserChrome.SetVisibility( procedure TGeckoBrowserChrome.SetVisibility(
aVisibility: PRBool); aVisibility: PRBool);
begin begin
UseParameter(aVisibility);
//TODO 1 -cTGeckoBrowserChrome: TGeckoBrowserChrome.SetVisibility �̎��� //TODO 1 -cTGeckoBrowserChrome: TGeckoBrowserChrome.SetVisibility �̎���
end; end;
@ -1415,27 +1500,31 @@ end;
function TGeckoBrowserChrome.GetSiteWindow: Pointer; function TGeckoBrowserChrome.GetSiteWindow: Pointer;
begin begin
{$PUSH}
{$HINTS OFF}
Result := Pointer(FBrowser.Handle); Result := Pointer(FBrowser.Handle);
{$POP}
end; end;
constructor TGeckoBrowserListener.Create(browser: TGeckoBrowser); constructor TGeckoBrowserListener.Create(browser: TGeckoBrowser);
const const
//Most usual events at the beginning to improve handling speed.
events: array [0..15] of TGeckoDOMEventRegister = ( events: array [0..15] of TGeckoDOMEventRegister = (
(name:'mousemove'; eventType:etMouseEvent; propertyName:'OnDOMMouseMove' ),
(name:'DOMMouseScroll'; eventType: etMouseEvent;propertyName:'OnDOMMouseScroll'),
(name:'focus'; eventType:etEvent; propertyName:'OnDOMFocus'),
(name:'load'; eventType:etEvent; propertyName:'OnDOMLoad' ), (name:'load'; eventType:etEvent; propertyName:'OnDOMLoad' ),
(name:'click'; eventType:etMouseEvent; propertyName:'OnDOMClick' ), (name:'click'; eventType:etMouseEvent; propertyName:'OnDOMClick' ),
(name:'mouseup'; eventType:etMouseEvent; propertyName:'OnDOMMouseUp' ), (name:'mouseup'; eventType:etMouseEvent; propertyName:'OnDOMMouseUp' ),
(name:'mousedown'; eventType:etMouseEvent; propertyName:'OnDOMMouseDown' ), (name:'mousedown'; eventType:etMouseEvent; propertyName:'OnDOMMouseDown' ),
(name:'mousemove'; eventType:etMouseEvent; propertyName:'OnDOMMouseMove' ),
(name:'keyup'; eventType:etEvent; propertyName:'OnDOMKeyUp' ), (name:'keyup'; eventType:etEvent; propertyName:'OnDOMKeyUp' ),
(name:'keydown'; eventType:etEvent; propertyName:'OnDOMKeyDown'), (name:'keydown'; eventType:etEvent; propertyName:'OnDOMKeyDown'),
(name:'keypress'; eventType:etEvent; propertyName:'OnDOMKeyPress'), (name:'keypress'; eventType:etEvent; propertyName:'OnDOMKeyPress'),
(name:'DOMMouseScroll'; eventType: etMouseEvent; propertyName:'OnDOMMouseScroll'),
(name:'DOMLinkAdded'; eventType: etEvent; propertyName:'OnDOMLinkAdded'), (name:'DOMLinkAdded'; eventType: etEvent; propertyName:'OnDOMLinkAdded'),
(name:'dragover'; eventType:etEvent; propertyName:'OnDOMDragOver'), (name:'dragover'; eventType:etEvent; propertyName:'OnDOMDragOver'),
(name:'draggesture'; eventType:etEvent; propertyName:'OnDOMDragGesture'), (name:'draggesture'; eventType:etEvent; propertyName:'OnDOMDragGesture'),
(name:'dragdrop'; eventType:etEvent; propertyName:'OnDOMDragDrop'), (name:'dragdrop'; eventType:etEvent; propertyName:'OnDOMDragDrop'),
(name:'dragexit'; eventType:etEvent; propertyName:'OnDOMDragExit'), (name:'dragexit'; eventType:etEvent; propertyName:'OnDOMDragExit'),
(name:'focus'; eventType:etEvent; propertyName:'OnDOMFocus'),
(name:''; eventType:etNone; propertyName:'') (name:''; eventType:etNone; propertyName:'')
); );
begin begin
@ -1447,7 +1536,7 @@ procedure TGeckoBrowserListener.OnStateChange(
aWebProgress: nsIWebProgress; aWebProgress: nsIWebProgress;
aRequest: nsIRequest; aRequest: nsIRequest;
aStateFlags: PRUint32; aStateFlags: PRUint32;
aStatus: PRUint32); aStatus: nsresult);
{$IFDEF DEBUG} {$IFDEF DEBUG}
var var
uri: nsIURI; uri: nsIURI;
@ -1460,12 +1549,15 @@ const
STATE_START = NS_IWEBPROGRESSLISTENER_STATE_START; STATE_START = NS_IWEBPROGRESSLISTENER_STATE_START;
STATE_STOP = NS_IWEBPROGRESSLISTENER_STATE_STOP; STATE_STOP = NS_IWEBPROGRESSLISTENER_STATE_STOP;
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(aStatus);
if (aStateFlags and STATE_IS_DOCUMENT)<>0 then if (aStateFlags and STATE_IS_DOCUMENT)<>0 then
begin begin
// ��Ԃ̕ω��̓h�L������g�ɑ΂��Ăł��� // ��Ԃ̕ω��̓h�L������g�ɑ΂��Ăł���
if (aStateFlags and STATE_START)<>0 then if (aStateFlags and STATE_START)<>0 then
begin begin
// �h�L������g�̓ǂݍ��݂��J�n���ꂽ // �h�L������g�̓ǂݞ�݂��J�n���ꂽ
{$IFDEF DEBUG} {$IFDEF DEBUG}
{ {
OutputDebugString('GeckoBrowser.OnDocumentBegin'); OutputDebugString('GeckoBrowser.OnDocumentBegin');
@ -1474,7 +1566,7 @@ begin
end else end else
if (aStateFlags and STATE_STOP)<>0 then if (aStateFlags and STATE_STOP)<>0 then
begin begin
// �h�L������g�̓ǂݍ��݂��������� // �h�L������g�̓ǂݞ�݂���������
{$IFDEF DEBUG} {$IFDEF DEBUG}
{ {
OutputDebugString('GeckoBrowser.OnDocumentComplete'); OutputDebugString('GeckoBrowser.OnDocumentComplete');
@ -1484,10 +1576,10 @@ begin
end; end;
if (aStateFlags and STATE_IS_NETWORK)<>0 then if (aStateFlags and STATE_IS_NETWORK)<>0 then
begin begin
// ��Ԃ̕ω��̓l�b�g���[�N�ɑ΂��Ăł��� // ��Ԃ̕ω��̓l�b�g�[�N�ɑ΂��Ăł���
if (aStateFlags and STATE_START)<>0 then if (aStateFlags and STATE_START)<>0 then
begin begin
// �l�b�g���[�N�̓]�����J�n���ꂽ� // �l�b�g�[�N�̓]�����J�n���ꂽ�
{$IFDEF DEBUG} {$IFDEF DEBUG}
{ {
str := NewCString; str := NewCString;
@ -1501,7 +1593,7 @@ begin
end else end else
if (aStateFlags and STATE_STOP)<>0 then if (aStateFlags and STATE_STOP)<>0 then
begin begin
// �l�b�g���[�N�̓]����I������� // �l�b�g�[�N�̓]����I�������
{$IFDEF DEBUG} {$IFDEF DEBUG}
{ {
str := NewCString; str := NewCString;
@ -1526,6 +1618,10 @@ procedure TGeckoBrowserListener.OnProgressChange(
aCurTotalProgress: PRInt32; aCurTotalProgress: PRInt32;
aMaxTotalProgress: PRInt32); aMaxTotalProgress: PRInt32);
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(aCurSelfProgress);
UseParameter(aMaxSelfProgress);
if Assigned(FBrowser.OnProgressChange) then if Assigned(FBrowser.OnProgressChange) then
begin begin
{$IFDEF DEBUG} {$IFDEF DEBUG}
@ -1546,6 +1642,8 @@ procedure TGeckoBrowserListener.OnLocationChange(
var var
str: IInterfacedCString; str: IInterfacedCString;
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
str := NewCString; str := NewCString;
location.GetSpec(str.ACString); location.GetSpec(str.ACString);
{$IFDEF DEBUG} {$IFDEF DEBUG}
@ -1562,9 +1660,12 @@ end;
procedure TGeckoBrowserListener.OnStatusChange( procedure TGeckoBrowserListener.OnStatusChange(
aWebProgress: nsIWebProgress; aWebProgress: nsIWebProgress;
aRequest: nsIRequest; aRequest: nsIRequest;
aStatus: PRUint32; aStatus: nsresult;
const aMessage: PWideChar); const aMessage: PWideChar);
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(aStatus);
{$IFDEF DEBUG} {$IFDEF DEBUG}
{ {
OutputDebugStringW(PWideChar( OutputDebugStringW(PWideChar(
@ -1581,7 +1682,10 @@ procedure TGeckoBrowserListener.OnSecurityChange(
aRequest: nsIRequest; aRequest: nsIRequest;
state: PRUint32); state: PRUint32);
begin begin
//TODO 1 -cTGeckoBrowserListner: TGeckoBrowserListener.OnSecurityChange �̋L�q UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(State);
//TODO 1 -cTGeckoBrowserListner: TGeckoBrowserListener.OnSecurityChange �̋Lq
end; end;
constructor TGeckoBrowser.Create(AOwner: TComponent); constructor TGeckoBrowser.Create(AOwner: TComponent);
@ -1595,8 +1699,7 @@ function TGeckoBrowserChrome.NS_GetInterface(const uuid: TGUID; out _result): ns
begin begin
if IsEqualGUID(uuid, nsIDOMWindow) then if IsEqualGUID(uuid, nsIDOMWindow) then
begin begin
// nsIDOMWindow ���������Ȃ��� nsIWindowCreator.CreateChromeWindow �ŃG���[�ɂȂ� Result:= nsresult(FBrowser.GetContentWindow.QueryInterface(uuid, _result));
Result := FBrowser.FBrowser.ContainerWindow.QueryInterface(uuid, _result);
end else end else
begin begin
// FPC port: Result is PRUInt32, but QueryInterface returns Longint, // FPC port: Result is PRUInt32, but QueryInterface returns Longint,
@ -1608,6 +1711,7 @@ end;
procedure TGeckoBrowserChrome.OnShowContextMenu(aContextFlags: PRUint32; procedure TGeckoBrowserChrome.OnShowContextMenu(aContextFlags: PRUint32;
aUtils: nsIContextMenuInfo); aUtils: nsIContextMenuInfo);
(*
const const
CONTEXT_NONE = NS_ICONTEXTMENULISTENER2_CONTEXT_NONE; CONTEXT_NONE = NS_ICONTEXTMENULISTENER2_CONTEXT_NONE;
CONTEXT_LINK = NS_ICONTEXTMENULISTENER2_CONTEXT_LINK; CONTEXT_LINK = NS_ICONTEXTMENULISTENER2_CONTEXT_LINK;
@ -1615,7 +1719,7 @@ const
CONTEXT_DOCUMENT = NS_ICONTEXTMENULISTENER2_CONTEXT_DOCUMENT; CONTEXT_DOCUMENT = NS_ICONTEXTMENULISTENER2_CONTEXT_DOCUMENT;
CONTEXT_TEXT = NS_ICONTEXTMENULISTENER2_CONTEXT_TEXT; CONTEXT_TEXT = NS_ICONTEXTMENULISTENER2_CONTEXT_TEXT;
CONTEXT_INPUT = NS_ICONTEXTMENULISTENER2_CONTEXT_INPUT; CONTEXT_INPUT = NS_ICONTEXTMENULISTENER2_CONTEXT_INPUT;
CONTEXT_BACKGROUND_IMAGE = NS_ICONTEXTMENULISTENER2_CONTEXT_BACKGROUND_IMAGE; CONTEXT_BACKGROUND_IMAGE = NS_ICONTEXTMENULISTENER2_CONTEXT_BACKGROUND_IMAGE;*)
var var
cmenu: TCtxMenuInfo; cmenu: TCtxMenuInfo;
begin begin
@ -1631,10 +1735,12 @@ begin
end; end;
procedure TGeckoBrowserChrome.OnShowTooltip(aXCoords: PRInt32; aYCoords: PRInt32; const aTipText: PWideChar); safecall; procedure TGeckoBrowserChrome.OnShowTooltip(aXCoords: PRInt32; aYCoords: PRInt32; const aTipText: PWideChar); safecall;
{$IFNDEF FPC}
var var
r:TRect; r:TRect;
p,ap:TPoint; p,ap:TPoint;
// height:Integer; // height:Integer;
{$ENDIF}
begin begin
{$IFNDEF LCL} {$IFNDEF LCL}
if FBrowser.FHint = nil then if FBrowser.FHint = nil then
@ -1649,6 +1755,11 @@ begin
r.Right:=r.Right +p.x; r.Right:=r.Right +p.x;
r.Bottom:=p.y; r.Bottom:=p.y;
FBrowser.FHint.ActivateHint(r,aTipText); FBrowser.FHint.ActivateHint(r,aTipText);
{$ELSE}
UseParameter(aXCoords);
UseParameter(aYCoords);
FBrowser.Hint:=aTiptext;
FBrowser.ShowHint:=true;
{$ENDIF} {$ENDIF}
end; end;
@ -1690,7 +1801,7 @@ end;
procedure TCustomGeckoBrowser.WMEraseBkGnd(var Msg: TMessage); procedure TCustomGeckoBrowser.WMEraseBkGnd(var Msg: TMessage);
begin begin
// �����‚��h�~ // Cancel erase background actions.
Msg.Result := 0; Msg.Result := 0;
end; end;
@ -1706,7 +1817,7 @@ begin
end else end else
begin begin
baseWin := FWebBrowser as nsIBaseWindow; baseWin := FWebBrowser as nsIBaseWindow;
baseWin.Repaint(True); baseWin.Repaint(true);
end; end;
inherited; inherited;
end; end;
@ -1823,6 +1934,7 @@ end;
procedure TGeckoBrowserListener.OnHistoryNewEntry(aNewURI: nsIURI); procedure TGeckoBrowserListener.OnHistoryNewEntry(aNewURI: nsIURI);
begin begin
UseParameter(aNewURI);
end; end;
function TGeckoBrowserListener.OnHistoryGoBack(aBackURI: nsIURI): PRBool; function TGeckoBrowserListener.OnHistoryGoBack(aBackURI: nsIURI): PRBool;
@ -1830,6 +1942,7 @@ var
Handled:Boolean; Handled:Boolean;
aContinue:PRBool; aContinue:PRBool;
begin begin
Handled:=false;
if Assigned(FBrowser.FOnGoBack) then if Assigned(FBrowser.FOnGoBack) then
FBrowser.FOnGoBack(Self,aBackURI,aContinue,Handled); FBrowser.FOnGoBack(Self,aBackURI,aContinue,Handled);
if Handled then begin if Handled then begin
@ -1849,6 +1962,7 @@ var
Handled:Boolean; Handled:Boolean;
aContinue:PRBool; aContinue:PRBool;
begin begin
Handled:=false;
if Assigned(FBrowser.FOnGoForward) then if Assigned(FBrowser.FOnGoForward) then
FBrowser.FOnGoForward(Self,aForwardURI,aContinue,Handled); FBrowser.FOnGoForward(Self,aForwardURI,aContinue,Handled);
if Handled then begin if Handled then begin
@ -1865,6 +1979,8 @@ end;
function TGeckoBrowserListener.OnHistoryReload(aReloadURI: nsIURI; aReloadFlags: PRUint32): PRBool; function TGeckoBrowserListener.OnHistoryReload(aReloadURI: nsIURI; aReloadFlags: PRUint32): PRBool;
begin begin
UseParameter(aReloadURI);
UseParameter(aReloadFlags);
Result := True; Result := True;
end; end;
@ -1873,6 +1989,7 @@ var
Handled:Boolean; Handled:Boolean;
aContinue:PRBool; aContinue:PRBool;
begin begin
Handled:=false;
if Assigned(FBrowser.FOnGoToIndex) then if Assigned(FBrowser.FOnGoToIndex) then
FBrowser.FOnGoToIndex(Self,aIndex,aGotoURI,aContinue,Handled); FBrowser.FOnGoToIndex(Self,aIndex,aGotoURI,aContinue,Handled);
@ -1890,6 +2007,7 @@ end;
function TGeckoBrowserListener.OnHistoryPurge(aNumEntries: PRInt32): PRBool; function TGeckoBrowserListener.OnHistoryPurge(aNumEntries: PRInt32): PRBool;
begin begin
UseParameter(aNumEntries);
Result := True; Result := True;
end; end;

View File

@ -1,16 +1,12 @@
object GeckoChromeForm: TGeckoChromeForm object GeckoChromeForm: TGeckoChromeForm
Left = 192 Left = 192
Height = 600
Top = 107 Top = 107
Width = 800 Width = 800
Height = 600
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12 Font.Height = -12
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = []
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnResize = FormResize OnResize = FormResize
PixelsPerInch = 96 LCLVersion = '0.9.29'
end end

View File

@ -1,8 +1,8 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TGeckoChromeForm','FORMDATA',[ LazarusResources.Add('TGeckoChromeForm','FORMDATA',[
'TPF0'#16'TGeckoChromeForm'#15'GeckoChromeForm'#4'Left'#3#192#0#3'Top'#2'k'#5 'TPF0'#16'TGeckoChromeForm'#15'GeckoChromeForm'#4'Left'#3#192#0#6'Height'#3'X'
+'Width'#3' '#3#6'Height'#3'X'#2#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7#15 +#2#3'Top'#2'k'#5'Width'#3' '#3#11'Font.Height'#2#244#9'Font.Name'#6#6'Tahoma'
+'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#244#9 +#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#8'OnResize'#7#10'For'
+'Font.Name'#6#6'Tahoma'#10'Font.Style'#11#0#7'OnClose'#7#9'FormClose'#8'OnCr' +'mResize'#10'LCLVersion'#6#6'0.9.29'#0#0
+'eate'#7#10'FormCreate'#8'OnResize'#7#10'FormResize'#13'PixelsPerInch'#2'`'#0
+#0
]); ]);

View File

@ -41,7 +41,7 @@ unit GeckoChromeWindow;
interface interface
uses uses
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LResources, {$ENDIF} {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LResources, {$ENDIF}
SysUtils, Variants, Classes, Graphics, Controls, Forms, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, CallbackInterfaces, nsXPCOM, nsTypes, nsXPCOM_std19 Dialogs, CallbackInterfaces, nsXPCOM, nsTypes, nsXPCOM_std19
{$IFDEF LCLCarbon}, CarbonPrivate {$ENDIF} {$IFDEF LCLCarbon}, CarbonPrivate {$ENDIF}
@ -60,7 +60,7 @@ type
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject); procedure FormResize(Sender: TObject);
private private
{ Private 錾 } { Private 錾 }
FWebBrowser: nsIWebBrowser; FWebBrowser: nsIWebBrowser;
FChromeFlags: Longword; FChromeFlags: Longword;
@ -98,12 +98,12 @@ type
// for nsISupportsWeakReference // for nsISupportsWeakReference
function GetWeakReference(): nsIWeakReference; safecall; function GetWeakReference(): nsIWeakReference; safecall;
function GetNativeWindow : Pointer; //FPC port: added this. function GetNativeWindow : THANDLE; //FPC port: added this.
procedure InitWebBrowser; procedure InitWebBrowser;
procedure UpdateChrome; procedure UpdateChrome;
procedure ContentFinishedLoading; procedure ContentFinishedLoading;
public public
{ Public 錾 } { Public 錾 }
function SafeCallException(Obj: TObject; Addr: Pointer): HResult; override; function SafeCallException(Obj: TObject; Addr: Pointer): HResult; override;
constructor CreateWithChromeFlags(AOwner: TComponent; aChromeFlags: Longword); constructor CreateWithChromeFlags(AOwner: TComponent; aChromeFlags: Longword);
@ -126,6 +126,13 @@ implementation
uses uses
nsXPCOMGlue, nsError, BrowserSupports; nsXPCOMGlue, nsError, BrowserSupports;
{$PUSH}
{$HINTS OFF}
procedure UseParameter(var X);
begin
end;
{$POP}
constructor TGeckoChromeForm.CreateWithChromeFlags(AOwner: TComponent; AChromeFlags: Longword); constructor TGeckoChromeForm.CreateWithChromeFlags(AOwner: TComponent; AChromeFlags: Longword);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
@ -139,16 +146,16 @@ begin
Action := caFree; Action := caFree;
end; end;
function TGeckoChromeForm.GetNativeWindow : Pointer; function TGeckoChromeForm.GetNativeWindow : THANDLE;
{$IFDEF LCLCocoa} {$IFDEF LCLCocoa}
var var
ARect : NSRect; ARect : NSRect;
AView : NSView; AView : NSView;
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF MSWINDOWS}Result := Pointer(Handle);{$ENDIF} {$IFDEF MSWINDOWS}Result := Handle;{$ENDIF}
{$IFDEF LCLCarbon}Result := Pointer(TCarbonWindow(Handle).Window);{$ENDIF} {$IFDEF LCLCarbon}Result := TCarbonWindow(Handle).Window;{$ENDIF}
//Carbon doesn't work but leave in so package compiles in Carbon IDE. //Carbon doesn't work but leave in so package compiles in Carbon IDE.
// {$IFDEF LCLCocoa}Result := Pointer(TCocoaForm(Handle).MainWindowView.superview);{$ENDIF} // {$IFDEF LCLCocoa}Result := Pointer(TCocoaForm(Handle).MainWindowView.superview);{$ENDIF}
@ -163,16 +170,16 @@ begin
ARect.origin.y := 15; ARect.origin.y := 15;
AView := NSView.alloc.initWithFrame(ARect); AView := NSView.alloc.initWithFrame(ARect);
NSView(TCocoaWindow(Handle).contentView).addSubView(AView); NSView(TCocoaWindow(Handle).contentView).addSubView(AView);
Result := Pointer(AView); Result := HANDLE(AView);
{$ENDIF} {$ENDIF}
//NSLog(NSStringUtf8(FloatToStr(NSView(TCocoaWindow(Handle).contentView).frame.size.width))); //NSLog(NSStringUtf8(FloatToStr(NSView(TCocoaWindow(Handle).contentView).frame.size.width)));
// {$IFDEF LCLCocoa}Result := Pointer(TCocoaWindow(Handle).contentView);{$ENDIF} // {$IFDEF LCLCocoa}Result := Pointer(TCocoaWindow(Handle).contentView);{$ENDIF}
//New ObjC-based Cocoa widgetset. //New ObjC-based Cocoa widgetset.
{$IFDEF LCLGtk}Result := Pointer(Handle);{$ENDIF} //Is Handle same as GTK Window? {$IFDEF LCLGtk}Result := Handle;{$ENDIF} //Is Handle same as GTK Window?
{$IFDEF LCLGtk2}Result := Pointer(Handle);{$ENDIF} //Is Handle same as GTK Window? {$IFDEF LCLGtk2}Result := Handle;{$ENDIF} //Is Handle same as GTK Window?
end; end;
procedure TGeckoChromeForm.InitWebBrowser; procedure TGeckoChromeForm.InitWebBrowser;
@ -227,7 +234,8 @@ end;
function TGeckoChromeForm.DoCreateChromeWindow(chromeFlags: Longword): nsIWebBrowserChrome; function TGeckoChromeForm.DoCreateChromeWindow(chromeFlags: Longword): nsIWebBrowserChrome;
begin begin
//Result := nil; UseParameter(chromeFlags);
Result := nil;
end; end;
function TGeckoChromeForm.GetWebBrowserChrome: nsIWebBrowserChrome; function TGeckoChromeForm.GetWebBrowserChrome: nsIWebBrowserChrome;
@ -237,6 +245,7 @@ end;
procedure TGeckoChromeForm.SetStatus(statusType: Longword; const status: PWideChar); procedure TGeckoChromeForm.SetStatus(statusType: Longword; const status: PWideChar);
begin begin
UseParameter(statusType);
end; end;
function TGeckoChromeForm.GetWebBrowser: nsIWebBrowser; function TGeckoChromeForm.GetWebBrowser: nsIWebBrowser;
@ -246,6 +255,7 @@ end;
procedure TGeckoChromeForm.SetWebBrowser(aWebBrowser: nsIWebBrowser); procedure TGeckoChromeForm.SetWebBrowser(aWebBrowser: nsIWebBrowser);
begin begin
UseParameter(aWebBrowser);
end; end;
function TGeckoChromeForm.GetChromeFlags: PRUint32; function TGeckoChromeForm.GetChromeFlags: PRUint32;
@ -284,8 +294,9 @@ begin
Result := False; Result := False;
end; end;
procedure TGeckoChromeForm.ExitModalEventLoop(aStatus: PRUint32); procedure TGeckoChromeForm.ExitModalEventLoop(aStatus: nsresult); safecall;
begin begin
UseParameter(aStatus);
ModalResult := 1; ModalResult := 1;
end; end;
@ -359,6 +370,7 @@ end;
procedure TGeckoChromeForm.SetVisibility(Value: LongBool); procedure TGeckoChromeForm.SetVisibility(Value: LongBool);
begin begin
UseParameter(Value);
//Visible := Value; //Visible := Value;
end; end;
@ -374,11 +386,18 @@ end;
function TGeckoChromeForm.GetSiteWindow: Pointer; function TGeckoChromeForm.GetSiteWindow: Pointer;
begin begin
Result := GetNativeWindow; //Known "not safe" conversion.
{$PUSH}
{$HINTS OFF}
Result := Pointer(GetNativeWindow);
{$POP}
end; end;
procedure TGeckoChromeForm.OnStateChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aStateFlags: PRUint32; aStatus: nsresult); procedure TGeckoChromeForm.OnStateChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aStateFlags: PRUint32; aStatus: nsresult);
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(aStatus);
if ((aStateFlags and NS_IWEBPROGRESSLISTENER_STATE_STOP)<>0) and if ((aStateFlags and NS_IWEBPROGRESSLISTENER_STATE_STOP)<>0) and
((aStateFlags and NS_IWEBPROGRESSLISTENER_STATE_IS_DOCUMENT)<>0) then ((aStateFlags and NS_IWEBPROGRESSLISTENER_STATE_IS_DOCUMENT)<>0) then
begin begin
@ -388,21 +407,35 @@ end;
procedure TGeckoChromeForm.OnProgressChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aCurSelfProgress: PRInt32; aMaxSelfProgress: PRInt32; aCurTotalProgress: PRInt32; aMaxTotalProgress: PRInt32); procedure TGeckoChromeForm.OnProgressChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aCurSelfProgress: PRInt32; aMaxSelfProgress: PRInt32; aCurTotalProgress: PRInt32; aMaxTotalProgress: PRInt32);
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(aCurSelfProgress);
UseParameter(aMaxSelfProgress);
UseParameter(aCurTotalProgress);
UseParameter(aMaxTotalProgress);
end; end;
procedure TGeckoChromeForm.OnLocationChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; location: nsIURI); procedure TGeckoChromeForm.OnLocationChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; location: nsIURI);
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(location);
end; end;
procedure TGeckoChromeForm.OnStatusChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aStatus: nsresult; const aMessage: PWideChar); procedure TGeckoChromeForm.OnStatusChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; aStatus: nsresult; const aMessage: PWideChar);
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(aStatus);
end; end;
procedure TGeckoChromeForm.OnSecurityChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; state: PRUint32); procedure TGeckoChromeForm.OnSecurityChange(aWebProgress: nsIWebProgress; aRequest: nsIRequest; state: PRUint32);
begin begin
UseParameter(aWebProgress);
UseParameter(aRequest);
UseParameter(state);
end; end;
function TGeckoChromeForm.NS_GetInterface(const uuid: TGUID; out Intf): nsresult; function TGeckoChromeForm.NS_GetInterface(const uuid: TGUID; out Intf): nsresult;
var var
domwin: nsIDOMWindow; domwin: nsIDOMWindow;
@ -471,6 +504,7 @@ const
function TGeckoChromeForm.SafeCallException(Obj: TObject; Addr: Pointer): HResult; function TGeckoChromeForm.SafeCallException(Obj: TObject; Addr: Pointer): HResult;
begin begin
UseParameter(Addr);
if Obj is EIntfCastError then if Obj is EIntfCastError then
Result := E_NOINTERFACE Result := E_NOINTERFACE
else else

View File

@ -21,11 +21,19 @@
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<Checks> <Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/> <RangeChecks Value="True"/>
<OverflowChecks Value="True"/> <OverflowChecks Value="True"/>
<StackChecks Value="True"/> <StackChecks Value="True"/>
</Checks> </Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration> </CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other> <Other>
<WriteFPCLogo Value="False"/> <WriteFPCLogo Value="False"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>

View File

@ -3,7 +3,7 @@ unit nsXPCOM_std19;
interface interface
uses uses
nsConsts, nsGeckoStrings, nsTypes; nsGeckoStrings, nsTypes;
const const
NS_ISUPPORTS_STD19_IID: TGUID = '{00000000-0000-0000-c000-000000000046}'; NS_ISUPPORTS_STD19_IID: TGUID = '{00000000-0000-0000-c000-000000000046}';

View File

@ -37,7 +37,18 @@ unit nsConsts;
interface interface
const const
GRE_WIN_REG_LOC = 'Software\mozilla.org\GRE\'; {$IFDEF MSWINDOWS}
XPCOM_DLL = 'xpcom.dll';
XUL_DLL = 'xul.dll';
{$ENDIF}
{$IFDEF UNIX}
XPCOM_DLL = 'libxpcom.so';
XUL_DLL = 'libxul.so';
{$ENDIF}
const
GRE_MOZILLA_WIN_REG_LOC = 'Software\mozilla.org\GRE\';
GRE_FIREFOX_BASE_WIN_REG_LOC = 'SOFTWARE\Mozilla\Mozilla Firefox';
// 1.7 Release // 1.7 Release
MOZILLA_VERSION = 1.7; MOZILLA_VERSION = 1.7;

View File

@ -36,11 +36,7 @@ unit nsGeckoStrings;
interface interface
uses
nsConsts, nsTypes;
type type
nsAString = ^nsStringContainer; nsAString = ^nsStringContainer;
nsString = nsAString; nsString = nsAString;
nsStringContainer = record nsStringContainer = record

View File

@ -37,7 +37,9 @@ unit nsInit;
interface interface
uses uses
nsXPCOM, nsConsts, nsTypes, nsGeckoStrings; sysutils,Classes,LCLProc,FileUtil,nsXPCOM, nsConsts, nsTypes, nsGeckoStrings
{$IFDEF MSWINDOWS},registry{$ENDIF}
;
// XPCOM Functions // XPCOM Functions
function NS_InitXPCOM2(out servMgr: nsIServiceManager; binDir: nsIFile; appFileLocationProvider: nsIDirectoryServiceProvider): nsresult; cdecl; function NS_InitXPCOM2(out servMgr: nsIServiceManager; binDir: nsIFile; appFileLocationProvider: nsIDirectoryServiceProvider): nsresult; cdecl;
@ -51,8 +53,8 @@ function NS_NewNativeLocalFile(const Path: nsACString; FollowLinks: PRBool; out
function NS_GetDebug(out debug: nsIDebug): nsresult; cdecl; function NS_GetDebug(out debug: nsIDebug): nsresult; cdecl;
function NS_GetTraceRefcnt(out traceRefcnt: nsITraceRefcnt): nsresult; cdecl; function NS_GetTraceRefcnt(out traceRefcnt: nsITraceRefcnt): nsresult; cdecl;
type //type
PLongBool = ^LongBool; // PLongBool = ^LongBool;
function NS_StringContainerInit(var aContainer: nsStringContainer): nsresult; cdecl; function NS_StringContainerInit(var aContainer: nsStringContainer): nsresult; cdecl;
procedure NS_StringContainerFinish(var aContainer: nsStringContainer); cdecl; procedure NS_StringContainerFinish(var aContainer: nsStringContainer); cdecl;
@ -81,8 +83,8 @@ type
NS_ENCODING_UTF8 = 1, NS_ENCODING_UTF8 = 1,
NS_ENCODING_NATIVE_FILESYSTEM = 2); NS_ENCODING_NATIVE_FILESYSTEM = 2);
function NS_CStringToUTF16(const aSource: nsACString; aSrcEncoding: nsSourceEncoding; aDest: nsAString): Longword; cdecl; function NS_CStringToUTF16(const aSource: nsACString; aSrcEncoding: nsSourceEncoding; aDest: nsAString): nsresult; cdecl;
function NS_UTF16ToCString(const aSource: nsAString; aSrcEncoding: nsSourceEncoding; aDest: nsACString): Longword; cdecl; function NS_UTF16ToCString(const aSource: nsAString; aSrcEncoding: nsSourceEncoding; aDest: nsACString): nsresult; cdecl;
// Added for Gecko 1.8 // Added for Gecko 1.8
type type
@ -99,7 +101,7 @@ type
function NS_Alloc(size: PRSize): Pointer; cdecl; function NS_Alloc(size: PRSize): Pointer; cdecl;
function NS_Realloc(ptr: Pointer; size: PRSize): Pointer; cdecl; function NS_Realloc(ptr: Pointer; size: PRSize): Pointer; cdecl;
procedure NS_Free(ptr: Pointer); cdecl; procedure NS_Free(ptr: Pointer); cdecl;
function NS_InitXPCOM3(out servMgr: nsIServiceManager; binDir: nsIFile; appFileLocationProvider: nsIDirectoryServiceProvider; const staticComponents: nsStaticModuleInfoArray; componentCount: PRUint32): nsresult; cdecl; function NS_InitXPCOM3(out servMgr: nsIServiceManager; binDir: nsIFile; appFileLocationProvider: nsIDirectoryServiceProvider; var staticComponents: nsStaticModuleInfoArray; componentCount: PRUint32): nsresult; cdecl;
function NS_StringContainerInit2(var aContainer: nsStringContainer; const aStr: PWideChar; aOffset, aLength: PRUint32): nsresult; cdecl; function NS_StringContainerInit2(var aContainer: nsStringContainer; const aStr: PWideChar; aOffset, aLength: PRUint32): nsresult; cdecl;
procedure NS_StringSetIsVoid(aStr: nsAString; const aIsVoid: PRBool); cdecl; procedure NS_StringSetIsVoid(aStr: nsAString; const aIsVoid: PRBool); cdecl;
@ -230,7 +232,6 @@ type
upper: PAnsiChar; upper: PAnsiChar;
upperInclusive: PRBool; upperInclusive: PRBool;
end; end;
PGREVersionRangeArray = ^TGREVersionRangeArray;
TGREVersionRangeArray = array [0..MaxInt div SizeOf(TGREVersionRange)-1] of TGREVersionRange; TGREVersionRangeArray = array [0..MaxInt div SizeOf(TGREVersionRange)-1] of TGREVersionRange;
PGREProperty = ^TGREProperty; PGREProperty = ^TGREProperty;
@ -238,7 +239,6 @@ type
property_: PAnsiChar; property_: PAnsiChar;
value: PAnsiChar; value: PAnsiChar;
end; end;
PGREPropertyArray = ^TGREPropertyArray;
TGREPropertyArray = array [0..MaxInt div SizeOf(TGREProperty)-1] of TGREProperty; TGREPropertyArray = array [0..MaxInt div SizeOf(TGREProperty)-1] of TGREProperty;
PNSFuncPtr = ^NSFuncPtr; PNSFuncPtr = ^NSFuncPtr;
@ -269,8 +269,8 @@ function XPCOMGlueStartup(xpcomFile: PAnsiChar): nsresult;
function XPCOMGlueShutdown: nsresult; function XPCOMGlueShutdown: nsresult;
function XPCOMGlueLoadXULFunctions(aSymbols: PDynamicFunctionLoad): nsresult; function XPCOMGlueLoadXULFunctions(aSymbols: PDynamicFunctionLoad): nsresult;
function GRE_Startup: Longword; function GRE_Startup: nsresult;
function GRE_Shutdown: Longword; function GRE_Shutdown: nsresult;
// PChar functions // PChar functions
@ -290,14 +290,42 @@ function NS_StrLCat(Dest: PWideChar; const Source: PWideChar; maxLen: Cardinal):
function NS_StrComp(const Str1, Str2: PWideChar): Integer; overload; function NS_StrComp(const Str1, Str2: PWideChar): Integer; overload;
function NS_StrRScan(const Str: PWideChar; Chr: WideChar): PWideChar; overload; function NS_StrRScan(const Str: PWideChar; Chr: WideChar): PWideChar; overload;
{$IFDEF MSWINDOWS}
function NS_CurrentProcessDirectory(buf: PAnsiChar; bufLen: Cardinal): Boolean; function NS_CurrentProcessDirectory(buf: PAnsiChar; bufLen: Cardinal): Boolean;
{$ENDIF}
type
TAnsiCharArray = array [0..High(Word) div SizeOf(AnsiChar)] of AnsiChar;
TMaxPathChar = array[0..MAX_PATH] of AnsiChar;
// HINST = TLibHandle;
PDependentLib = ^TDependentLib;
TDependentLib = record
libHandle: HMODULE;
next: PDependentLib;
end;
type
nsIDirectoryServiceProvider_stdcall = interface(nsISupports)
['{bbf8cab0-d43a-11d3-8cc2-00609792278c}']
function GetFile(const prop: PAnsiChar; out persistent: PRBool; out AFile: nsIFile): nsresult; stdcall;
end;
nsGREDirServiceProvider = class(TInterfacedObject,
nsIDirectoryServiceProvider_stdcall)
public
FPathEnvString: TMaxPathChar;
class function NewInstance: TObject; override;
procedure FreeInstance; override;
function GetFile(const prop: PAnsiChar; out persistent: PRBool; out AFile: nsIFile): nsresult; stdcall;
function GetGreDirectory(out AFile: nsILocalFile): nsresult;
end;
procedure ZeroArray(out AArray; const ASize: SizeInt);
implementation implementation
uses uses
{$IFDEF MSWINDOWS} Windows, {$ELSE} DynLibs, {$ENDIF} nsError, nsMemory, SysUtils; {$IFDEF MSWINDOWS} Windows, {$ELSE} DynLibs, {$ENDIF} nsError, nsMemory;
type type
XPCOMExitRoutine = function : Longword; stdcall; XPCOMExitRoutine = function : Longword; stdcall;
@ -316,7 +344,7 @@ type
AllocFunc = function (size: PRSize): Pointer; cdecl; AllocFunc = function (size: PRSize): Pointer; cdecl;
ReallocFunc = function (ptr: Pointer; size: PRSize): Pointer; cdecl; ReallocFunc = function (ptr: Pointer; size: PRSize): Pointer; cdecl;
FreeFunc = procedure (ptr: Pointer); cdecl; FreeFunc = procedure (ptr: Pointer); cdecl;
Init3Func = function (out servMgr: nsIServiceManager; binDir: nsIFile; provider: nsIDirectoryServiceProvider; const staticComponents: nsStaticModuleInfoArray; componentCount: PRUint32): nsresult; cdecl; Init3Func = function (out servMgr: nsIServiceManager; binDir: nsIFile; provider: nsIDirectoryServiceProvider; var staticComponents: nsStaticModuleInfoArray; componentCount: PRUint32): nsresult; cdecl;
GetDebugFunc = function (out debug: nsIDebug): Longword; cdecl; GetDebugFunc = function (out debug: nsIDebug): Longword; cdecl;
GetTraceRefcntFunc = function (out traceRefcnt: nsITraceRefcnt): Longword; cdecl; GetTraceRefcntFunc = function (out traceRefcnt: nsITraceRefcnt): Longword; cdecl;
@ -439,7 +467,7 @@ var
function NS_InitXPCOM2(out servMgr: nsIServiceManager; function NS_InitXPCOM2(out servMgr: nsIServiceManager;
binDir: nsIFile; binDir: nsIFile;
appFileLocationProvider: nsIDirectoryServiceProvider): Longword; appFileLocationProvider: nsIDirectoryServiceProvider): nsresult;
begin begin
if Assigned(xpcomFunc.init) then if Assigned(xpcomFunc.init) then
Result := xpcomFunc.init(servMgr, binDir, appFileLocationProvider) Result := xpcomFunc.init(servMgr, binDir, appFileLocationProvider)
@ -447,7 +475,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
function NS_ShutdownXPCOM(servMgr: nsIServiceManager): Longword; function NS_ShutdownXPCOM(servMgr: nsIServiceManager): nsresult;
begin begin
if Assigned(xpcomFunc.shutdown) then if Assigned(xpcomFunc.shutdown) then
Result := xpcomFunc.shutdown(servMgr) Result := xpcomFunc.shutdown(servMgr)
@ -455,7 +483,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
function NS_GetServiceManager(out servMgr: nsIServiceManager): Longword; function NS_GetServiceManager(out servMgr: nsIServiceManager): nsresult;
begin begin
if Assigned(xpcomFunc.getServiceManager) then if Assigned(xpcomFunc.getServiceManager) then
Result := xpcomFunc.getServiceManager(servMgr) Result := xpcomFunc.getServiceManager(servMgr)
@ -508,7 +536,7 @@ begin
end; end;
function NS_RegisterXPCOMExitRoutine(exitRoutine: XPCOMExitRoutine; function NS_RegisterXPCOMExitRoutine(exitRoutine: XPCOMExitRoutine;
priority: Longword): Longword; priority: Longword): nsresult;
begin begin
if Assigned(xpcomFunc.registerXPCOMExitRoutine) then if Assigned(xpcomFunc.registerXPCOMExitRoutine) then
Result := xpcomFunc.registerXPCOMExitRoutine(exitRoutine, priority) Result := xpcomFunc.registerXPCOMExitRoutine(exitRoutine, priority)
@ -516,7 +544,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
function NS_UnregisterXPCOMExitRoutine(exitRoutine: XPCOMExitRoutine): Longword; function NS_UnregisterXPCOMExitRoutine(exitRoutine: XPCOMExitRoutine): nsresult;
begin begin
if Assigned(xpcomFunc.unregisterXPCOMExitRoutine) then if Assigned(xpcomFunc.unregisterXPCOMExitRoutine) then
Result := xpcomFunc.unregisterXPCOMExitRoutine(exitRoutine) Result := xpcomFunc.unregisterXPCOMExitRoutine(exitRoutine)
@ -524,7 +552,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
function NS_GetDebug(out debug: nsIDebug): Longword; function NS_GetDebug(out debug: nsIDebug): nsresult;
begin begin
if Assigned(xpcomFunc.getDebug) then if Assigned(xpcomFunc.getDebug) then
Result := xpcomFunc.getDebug(debug) Result := xpcomFunc.getDebug(debug)
@ -532,7 +560,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
function NS_GetTraceRefcnt(out traceRefcnt: nsITraceRefcnt): Longword; function NS_GetTraceRefcnt(out traceRefcnt: nsITraceRefcnt): nsresult;
begin begin
if Assigned(xpcomFunc.getTraceRefCnt) then if Assigned(xpcomFunc.getTraceRefCnt) then
Result := xpcomFunc.getTraceRefCnt(traceRefcnt) Result := xpcomFunc.getTraceRefCnt(traceRefcnt)
@ -540,7 +568,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
function NS_StringContainerInit(var aContainer: nsStringContainer): Longword; function NS_StringContainerInit(var aContainer: nsStringContainer): nsresult;
begin begin
if Assigned(xpcomFunc.stringContainerInit) then if Assigned(xpcomFunc.stringContainerInit) then
Result := xpcomFunc.stringContainerInit(aContainer) Result := xpcomFunc.stringContainerInit(aContainer)
@ -554,7 +582,7 @@ begin
xpcomFunc.stringContainerFinish(aContainer); xpcomFunc.stringContainerFinish(aContainer);
end; end;
function NS_StringGetData(const aStr: nsAString; out aData: PWideChar; aTerminated: PLongBool): Longword; function NS_StringGetData(const aStr: nsAString; out aData: PWideChar; aTerminated: PLongBool): nsresult;
begin begin
if Assigned(xpcomFunc.stringGetData) then if Assigned(xpcomFunc.stringGetData) then
Result := xpcomFunc.stringGetData(aStr, aData, aTerminated) Result := xpcomFunc.stringGetData(aStr, aData, aTerminated)
@ -595,7 +623,7 @@ begin
NS_StringSetDataRange(aStr, aCutOffset, aCutLength, nil, 0); NS_StringSetDataRange(aStr, aCutOffset, aCutLength, nil, 0);
end; end;
function NS_CStringContainerInit(var aContainer: nsCStringContainer): Longword; function NS_CStringContainerInit(var aContainer: nsCStringContainer): nsresult;
begin begin
if Assigned(xpcomFunc.cstringContainerInit) then if Assigned(xpcomFunc.cstringContainerInit) then
Result := xpcomFunc.cstringContainerInit(aContainer) Result := xpcomFunc.cstringContainerInit(aContainer)
@ -650,7 +678,7 @@ begin
NS_CStringSetDataRange(aStr, aCutOffset, aCutLength, nil, 0); NS_CStringSetDataRange(aStr, aCutOffset, aCutLength, nil, 0);
end; end;
function NS_CStringToUTF16(const aSource: nsACString; aSrcEncoding: nsSourceEncoding; aDest: nsAString): Longword; function NS_CStringToUTF16(const aSource: nsACString; aSrcEncoding: nsSourceEncoding; aDest: nsAString): nsresult;
begin begin
if Assigned(xpcomFunc.cstringToUTF16) then if Assigned(xpcomFunc.cstringToUTF16) then
Result := xpcomFunc.cstringToUTF16(aSource, aSrcEncoding, aDest) Result := xpcomFunc.cstringToUTF16(aSource, aSrcEncoding, aDest)
@ -658,7 +686,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
function NS_UTF16ToCString(const aSource: nsAString; aSrcEncoding: nsSourceEncoding; aDest: nsACString): Longword; function NS_UTF16ToCString(const aSource: nsAString; aSrcEncoding: nsSourceEncoding; aDest: nsACString): nsresult;
begin begin
if Assigned(xpcomFunc.UTF16ToCString) then if Assigned(xpcomFunc.UTF16ToCString) then
Result := xpcomFunc.UTF16ToCString(aSource, aSrcEncoding, aDest) Result := xpcomFunc.UTF16ToCString(aSource, aSrcEncoding, aDest)
@ -705,7 +733,7 @@ begin
xpcomFunc.free(ptr); xpcomFunc.free(ptr);
end; end;
function NS_InitXPCOM3(out servMgr: nsIServiceManager; binDir: nsIFile; appFileLocationProvider: nsIDirectoryServiceProvider; const staticComponents: nsStaticModuleInfoArray; componentCount: PRUint32): nsresult; cdecl; function NS_InitXPCOM3(out servMgr: nsIServiceManager; binDir: nsIFile; appFileLocationProvider: nsIDirectoryServiceProvider; var staticComponents: nsStaticModuleInfoArray; componentCount: PRUint32): nsresult; cdecl;
//FPC port: added const to staticComponents and changed componentCount from //FPC port: added const to staticComponents and changed componentCount from
// PRInt32 to PRUInt32 so they match init3 - wouldn't assemble otherwise on PowerPC. // PRInt32 to PRUInt32 so they match init3 - wouldn't assemble otherwise on PowerPC.
begin begin
@ -849,6 +877,7 @@ function GRE_GetPathFromRegKey(
properties: PGREPropertyArray; properties: PGREPropertyArray;
propertiesLength: PRUint32; propertiesLength: PRUint32;
buf: PAnsiChar; buflen: PRUint32): PRBool; forward; buf: PAnsiChar; buflen: PRUint32): PRBool; forward;
{$ENDIF}
function GRE_GetGREPathWithProperties( function GRE_GetGREPathWithProperties(
aVersions: PGREVersionRange; aVersions: PGREVersionRange;
@ -857,11 +886,39 @@ function GRE_GetGREPathWithProperties(
propertiesLength: PRUint32; propertiesLength: PRUint32;
buf: PAnsiChar; buflen: PRUint32): nsresult; buf: PAnsiChar; buflen: PRUint32): nsresult;
var var
env: array[0..MAX_PATH] of AnsiChar; env: string;
hRegKey: HKEY; hRegKey: HKEY;
ok: PRBool; ok: PRBool;
versions: PGREVersionRangeArray; versions: PGREVersionRangeArray;
properties: PGREPropertyArray; properties: PGREPropertyArray;
GeckoVersion: String;
function GRE_FireFox(): string;
var
Reg: TRegistry;
FF: string;
begin
Reg:=TRegistry.Create(KEY_ALL_ACCESS);
Reg.RootKey:=HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly(GRE_FIREFOX_BASE_WIN_REG_LOC) then begin
FF:=Reg.ReadString('CurrentVersion');
FF:=LeftStr(FF,Pos(' ',FF)-1);
Reg.CloseKey;
FF:=format('%s %s',[GRE_FIREFOX_BASE_WIN_REG_LOC,FF]);
if Reg.OpenKeyReadOnly(FF) then begin
GeckoVersion:=Reg.ReadString('GeckoVer');
if GeckoVersion<>'' then begin
Reg.CloseKey;
FF:=FF+'\bin';
if Reg.OpenKeyReadOnly(FF) then begin
Result:=Reg.ReadString('PathToExe');
Result:=ExtractFilePath(Result)+XPCOM_DLL;
end;
end;
end;
end;
Reg.CloseKey;
Reg.Free;
end;
begin begin
versions := PGREVersionRangeArray(aVersions); versions := PGREVersionRangeArray(aVersions);
properties := PGREPropertyArray(aProperties); properties := PGREPropertyArray(aProperties);
@ -876,15 +933,18 @@ begin
end; end;
*) *)
if GetEnvironmentVariableA('USE_LOCAL_GRE', env, MAX_PATH)>0 then env:=sysutils.GetEnvironmentVariable('USE_LOCAL_GRE');
if env<>''then
begin begin
buf[0] := #0; strlcopy(Buf,pchar(env+PathDelim+XPCOM_DLL),buflen);
Result := NS_OK; Result := NS_OK;
Exit; Exit;
end; end;
{$IFDEF MSWINDOWS}
//Check for default mozilla GRE
hRegKey := 0; hRegKey := 0;
if RegOpenKeyEx(HKEY_CURRENT_USER, GRE_WIN_REG_LOC, 0, if RegOpenKeyEx(HKEY_CURRENT_USER, GRE_MOZILLA_WIN_REG_LOC, 0,
KEY_READ, hRegKey) = ERROR_SUCCESS then KEY_READ, hRegKey) = ERROR_SUCCESS then
begin begin
ok := GRE_GetPathFromRegKey(hRegkey, ok := GRE_GetPathFromRegKey(hRegkey,
@ -899,7 +959,7 @@ begin
end; end;
end; end;
if RegOpenKeyEx(HKEY_LOCAL_MACHINE, GRE_WIN_REG_LOC, 0, if RegOpenKeyEx(HKEY_LOCAL_MACHINE, GRE_MOZILLA_WIN_REG_LOC, 0,
KEY_READ, hRegKey) = ERROR_SUCCESS then KEY_READ, hRegKey) = ERROR_SUCCESS then
begin begin
ok := GRE_GetPathFromRegKey(hRegKey, ok := GRE_GetPathFromRegKey(hRegKey,
@ -913,10 +973,16 @@ begin
Exit; Exit;
end; end;
end; end;
//Check for Firefox GRE
(*GrePath:=GRE_FireFox();
if GrePath<>'' then begin
strlcopy(buf,pchar(GrePath),bufLen);
Result:=NS_OK;
exit;
end;*)
{$ENDIF}
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
end; end;
{$ENDIF}
function CheckVersion(toCheck: PAnsiChar; function CheckVersion(toCheck: PAnsiChar;
const versions: PGREVersionRangeArray; const versions: PGREVersionRangeArray;
@ -980,8 +1046,6 @@ function GRE_GetPathFromRegKey(
properties: PGREPropertyArray; properties: PGREPropertyArray;
propertiesLength: PRUint32; propertiesLength: PRUint32;
buf: PAnsiChar; buflen: PRUint32): PRBool; buf: PAnsiChar; buflen: PRUint32): PRBool;
const
XPCOM_DLL = 'xpcom.dll';
var var
i, j: DWORD; i, j: DWORD;
name: array [0..MAX_PATH] of AnsiChar; name: array [0..MAX_PATH] of AnsiChar;
@ -1058,23 +1122,6 @@ begin
end; end;
{$ENDIF} {$ENDIF}
type
TAnsiCharArray = array [0..High(Word) div SizeOf(AnsiChar)] of AnsiChar;
PAnsiCharArray = ^TAnsiCharArray;
TMaxPathChar = array[0..MAX_PATH] of AnsiChar;
{$IFNDEF MSWINDOWS}
HINST = TLibHandle;
{$ENDIF}
PDependentLib = ^TDependentLib;
TDependentLib = record
libHandle: HINST;
next: PDependentLib;
end;
const
XPCOM_DLL = 'xpcom.dll';
XUL_DLL = 'xul.dll';
var var
sDependentLibs: PDependentLib = nil; sDependentLibs: PDependentLib = nil;
sXULLibrary: HINST = 0; sXULLibrary: HINST = 0;
@ -1084,37 +1131,34 @@ type
function XPCOMGlueLoad(xpcomFile: PAnsiChar): GetFrozenFunctionsFunc; forward; function XPCOMGlueLoad(xpcomFile: PAnsiChar): GetFrozenFunctionsFunc; forward;
procedure XPCOMGlueUnload(); forward; procedure XPCOMGlueUnload(); forward;
{$IFDEF MSWINDOWS}
function fullpath(absPath, relPath: PAnsiChar; maxLength: PRUint32): PAnsiChar; forward; function fullpath(absPath, relPath: PAnsiChar; maxLength: PRUint32): PAnsiChar; forward;
{$ENDIF}
const const
BUFFEREDFILE_BUFSIZE = 256; BUFFEREDFILE_BUFSIZE = 256;
type type
TBufferedFile = record TBufferedFile = record
f: THandle; fs: TFileStream;
buf: array [0..BUFFEREDFILE_BUFSIZE-1] of AnsiChar; buf: array [0..BUFFEREDFILE_BUFSIZE-1] of AnsiChar;
bufPos: Integer; bufPos: Integer;
bufMax: Integer; bufMax: Integer;
end; end;
{$IFDEF MSWINDOWS} function BufferedFile_Open(name: PAnsiChar; out ret: TBufferedFile): Boolean;
function BufferedFile_Open(name: PAnsiChar; var ret: TBufferedFile): Boolean;
begin begin
Result := False; try
ret.f := CreateFileA(name, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); ret.fs:=TFileStream.Create(name,fmOpenRead, fmShareDenyWrite);
if ret.f <> INVALID_HANDLE_VALUE then result:=true;
begin
Result := True;
end;
ret.bufPos := 0; ret.bufPos := 0;
ret.bufMax := -1; ret.bufMax := -1;
except
ret.fs:=nil;
end;
end; end;
procedure BufferedFile_Close(var aFile: TBufferedFile); procedure BufferedFile_Close(var aFile: TBufferedFile);
begin begin
CloseHandle(aFile.f); afile.fs.Free;
aFile.f := 0; afile.fs:=nil;
aFile.bufPos := 0; aFile.bufPos := 0;
aFile.bufMax := -1; aFile.bufMax := -1;
end; end;
@ -1123,7 +1167,7 @@ procedure BufferedFile_ReadBuffer(var aFile: TBufferedFile);
var var
readSize: DWORD; readSize: DWORD;
begin begin
if ReadFile(aFile.f, aFile.buf, BUFFEREDFILE_BUFSIZE, readSize, nil) then readSize:=aFile.fs.Read(aFile.buf, BUFFEREDFILE_BUFSIZE);
begin begin
aFile.bufPos := 0; aFile.bufPos := 0;
aFile.bufMax := readSize; aFile.bufMax := readSize;
@ -1207,7 +1251,6 @@ begin
BufferedFile_Close(f); BufferedFile_Close(f);
end; end;
end; end;
{$ENDIF}
procedure AppendDependentLib(libHandle: HINST); procedure AppendDependentLib(libHandle: HINST);
var var
@ -1224,14 +1267,20 @@ end;
procedure ReadDependentCB(aDependentLib: PAnsiChar); procedure ReadDependentCB(aDependentLib: PAnsiChar);
var var
h: HINST; h: HINST;
OldDir: string;
NewDir: string;
begin begin
{$IFDEF MSWINDOWS} //Changes directory temporaly to resolve automatic modules loading
h := LoadLibraryExA(aDependentLib, 0, LOAD_WITH_ALTERED_SEARCH_PATH); //in a crossplatform way.
{$ELSE} OldDir:=GetCurrentDir;
NewDir:=ExtractFilePath(aDependentLib);
SetCurrentDir(NewDir);
h := LoadLibrary(aDependentLib); h := LoadLibrary(aDependentLib);
{$ENDIF} SetCurrentDir(OldDir);
if h <> 0 then if h <> 0 then
AppendDependentLib(h); AppendDependentLib(h)
else
Raise Exception.Create('Missing Gecko runtime library: '+aDependentLib);
end; end;
function XPCOMGlueLoad(xpcomFile: PAnsiChar): GetFrozenFunctionsFunc; function XPCOMGlueLoad(xpcomFile: PAnsiChar): GetFrozenFunctionsFunc;
@ -1240,7 +1289,6 @@ var
idx: PRInt32; idx: PRInt32;
h: HINST; h: HINST;
begin begin
{$IFDEF MSWINDOWS}
if (xpcomFile[0]='.') and (xpcomFile[1]=#0) then if (xpcomFile[0]='.') and (xpcomFile[1]=#0) then
begin begin
xpcomFile := XPCOM_DLL; xpcomFile := XPCOM_DLL;
@ -1254,14 +1302,11 @@ begin
xpcomDir[idx] := #0; xpcomDir[idx] := #0;
XPCOMGlueLoadDependentLibs(xpcomDir, ReadDependentCB); XPCOMGlueLoadDependentLibs(xpcomDir, ReadDependentCB);
NS_StrLCat(xpcomdir, '\'+xul_dll, sizeof(xpcomdir)); NS_StrLCat(xpcomdir, '\'+xul_dll, sizeof(xpcomdir));
sXULLibrary := LoadLibraryExA(xpcomdir, 0, LOAD_WITH_ALTERED_SEARCH_PATH); sXULLibrary := LoadLibrary(xpcomdir);
end; end;
end; end;
h := LoadLibraryExA(xpcomFile, 0, LOAD_WITH_ALTERED_SEARCH_PATH);
{$ELSE}
h := LoadLibrary(xpcomFile); h := LoadLibrary(xpcomFile);
{$ENDIF}
if h <> 0 then if h <> 0 then
begin begin
@ -1294,9 +1339,8 @@ begin
end; end;
end; end;
function XPCOMGlueStartup(xpcomFile: PAnsiChar): Longword; function XPCOMGlueStartup(xpcomFile: PAnsiChar): nsresult;
const const
XPCOM_DLL = 'xpcom.dll';
XPCOM_GLUE_VERSION = 1; XPCOM_GLUE_VERSION = 1;
var var
func: GetFrozenFunctionsFunc; func: GetFrozenFunctionsFunc;
@ -1320,7 +1364,7 @@ begin
XPCOMGlueUnload(); XPCOMGlueUnload();
end; end;
function XPCOMGlueShutdown: Longword; function XPCOMGlueShutdown: nsresult;
begin begin
XPCOMGlueUnload(); XPCOMGlueUnload();
@ -1333,8 +1377,6 @@ function XPCOMGlueLoadXULFunctions(aSymbols: PDynamicFunctionLoad): nsresult;
var var
i: Integer; i: Integer;
symbols: PDynamicFunctionLoadArray; symbols: PDynamicFunctionLoadArray;
type
PPointer = ^Pointer;
begin begin
symbols := PDynamicFunctionLoadArray(aSymbols); symbols := PDynamicFunctionLoadArray(aSymbols);
@ -1394,7 +1436,7 @@ var
dot: Integer; dot: Integer;
begin begin
idx := 0; idx := 0;
FillChar(vers, sizeof(vers), 0); ZeroArray(vers, sizeof(vers));
for i:=0 to 2 do for i:=0 to 2 do
begin begin
dot := idx; dot := idx;
@ -1501,35 +1543,21 @@ begin
Result := GREVersionCompare(lhsVer, rhsVer); Result := GREVersionCompare(lhsVer, rhsVer);
end; end;
{$IFDEF MSWINDOWS} {$IFDEF GECKO_EXPERIMENTAL}
// �����t�@�C����GRE�̕K�v�o[�W�����ɒB���Ă��邩�𒲂ׂ�B // �����t�@�C����GRE�̕K�v�o[�W�����ɒB���Ă��邩�𒲂ׂ�B
function CheckGeckoVersion(path: PAnsiChar; const reqVer: TGREVersion): Boolean; function GetPathFromConfigDir(dirname: PAnsiChar; buf: PAnsiChar): Boolean;
const
BUFSIZE = 4096;
var
buf: array[0..BUFSIZE-1] of Char;
fileVer: PAnsiChar;
dwSize: DWORD;
dw: DWORD;
greVer: TGREVersion;
begin begin
//TODO 1: GetPathFromConfigDir �̎���
Result := False; Result := False;
dwSize := GetFileVersionInfoSizeA(path, dw);
if (dwSize<=0) or (dwSize>BUFSIZE) then Exit;
Result := GetFileVersionInfoA(path, 0, dwSize, @buf);
if not Result then Exit;
// �o�[�W���������̌���ID�͌��ߑł�
Result := VerQueryValueA(@buf, '\StringFileInfo\000004b0\FileVersion', Pointer(fileVer), dw);
if not Result then Exit;
greVer := GetGREVersion(fileVer);
if GREVersionCompare(greVer, reqVer)>=0 then Result := True;
end; end;
function GetPathFromConfigFile(const filename: PAnsiChar; buf: PAnsiChar): Boolean;
begin
//TODO 1: GetPathFromConfigFile �̎���
Result := False;
end;
{$ENDIF GECKO_EXPERIMENTAL}
function IsXpcomDll(const filename: PAnsiChar): Boolean; function IsXpcomDll(const filename: PAnsiChar): Boolean;
var var
module: HMODULE; module: HMODULE;
@ -1545,10 +1573,38 @@ begin
FreeLibrary(module); FreeLibrary(module);
end; end;
function CheckGeckoVersion(path: PAnsiChar; const reqVer: TGREVersion): Boolean;
const
BUFSIZE = 4096;
var
buf: array[0..BUFSIZE-1] of Char;
fileVer: PAnsiChar;
dwSize: DWORD;
dw: DWORD;
greVer: TGREVersion;
begin
Result := False;
dw:=1; //Non zero
dwSize := GetFileVersionInfoSizeA(path, dw);
if (dwSize<=0) or (dwSize>BUFSIZE) then Exit;
Result := GetFileVersionInfoA(path, 0, dwSize, @buf);
if not Result then Exit;
// �o[�W��������̌���ID�͌��ߑł�
fileVer:=nil;
Result := VerQueryValueA(@buf, '\StringFileInfo\000004b0\FileVersion', Pointer(fileVer), dw);
if not Result then Exit;
greVer := GetGREVersion(fileVer);
if GREVersionCompare(greVer, reqVer)>=0 then Result := True;
end;
function GetLatestGreFromReg(regBase: HKEY; const reqVer: TGREVersion; function GetLatestGreFromReg(regBase: HKEY; const reqVer: TGREVersion;
grePath: PAnsiChar; var greVer: TGREVersion): Boolean; grePath: PAnsiChar; var greVer: TGREVersion): Boolean;
var var
curKey: HKEY; curKey: HKEY = 0;
dwSize: DWORD; dwSize: DWORD;
i: Integer; i: Integer;
keyName: TMaxPathChar; keyName: TMaxPathChar;
@ -1574,7 +1630,7 @@ begin
(GREVersionCompare(ver, greVer)>=0) then (GREVersionCompare(ver, greVer)>=0) then
begin begin
dllPath := path; dllPath := path;
NS_StrCat(dllPath, '\xpcom.dll'); NS_StrCat(dllPath, '\'+XPCOM_DLL);
//if IsXpcomDll(dllPath) then //if IsXpcomDll(dllPath) then
// if CheckGeckoVersion(dllPath, reqVer) and // if CheckGeckoVersion(dllPath, reqVer) and
// IsXpcomDll(@dllPath) then // IsXpcomDll(@dllPath) then
@ -1600,7 +1656,7 @@ const
nameBase: PAnsiChar = 'Software\mozilla.org\GRE'; nameBase: PAnsiChar = 'Software\mozilla.org\GRE';
var var
rv: HRESULT; rv: HRESULT;
base: HKEY; base: HKEY = 0;
cuPath, lmPath: TMaxPathChar; cuPath, lmPath: TMaxPathChar;
cuVer, lmVer: TGREVersion; cuVer, lmVer: TGREVersion;
reqVer: TGREVersion; reqVer: TGREVersion;
@ -1609,8 +1665,8 @@ label
NoLocalMachine, NoLocalMachine,
NoCurrentUser; NoCurrentUser;
begin begin
FillChar(cuVer, SizeOf(cuVer), 0); ZeroArray(cuVer, SizeOf(cuVer));
FillChar(lmVer, SizeOf(lmVer), 0); ZeroArray(lmVer, SizeOf(lmVer));
reqVer := GetGREVersion(GRE_BUILD_ID); reqVer := GetGREVersion(GRE_BUILD_ID);
rv := RegOpenKeyA(HKEY_LOCAL_MACHINE, nameBase, base); rv := RegOpenKeyA(HKEY_LOCAL_MACHINE, nameBase, base);
@ -1632,27 +1688,13 @@ NoCurrentUser:;
end; end;
end; end;
function GetPathFromConfigDir(dirname: PAnsiChar; buf: PAnsiChar): Boolean;
begin
//TODO 1: GetPathFromConfigDir �̎���
Result := False;
end;
function GetPathFromConfigFile(const filename: PAnsiChar; buf: PAnsiChar): Boolean;
begin
//TODO 1: GetPathFromConfigFile �̎���
Result := False;
end;
{$ENDIF}
var var
GRELocation: TMaxPathChar; GRELocation: TMaxPathChar;
function GetGREDirectoryPath(buf: PAnsiChar): Boolean; function GetGREDirectoryPath(buf: PAnsiChar): Boolean;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
const //const
GRE_REGISTRY_KEY = GRE_WIN_REG_LOC + GRE_BUILD_ID; // GRE_REGISTRY_KEY = GRE_MOZILLA_WIN_REG_LOC + GRE_BUILD_ID;
var var
cpd:TMaxPathChar; cpd:TMaxPathChar;
dllPath: TMaxPathChar; dllPath: TMaxPathChar;
@ -1668,7 +1710,7 @@ begin
if NS_CurrentProcessDirectory(cpd, MAX_PATH) then if NS_CurrentProcessDirectory(cpd, MAX_PATH) then
begin begin
dllPath := cpd; dllPath := cpd;
NS_StrCat(dllPath, '\xpcom.dll'); NS_StrCat(dllPath, '\'+XPCOM_DLL);
if IsXpcomDll(dllPath) then if IsXpcomDll(dllPath) then
begin begin
//buf := cpd; //buf := cpd;
@ -1727,22 +1769,6 @@ begin
{$ENDIF} {$ENDIF}
end; end;
type
nsIDirectoryServiceProvider_stdcall = interface(nsISupports)
['{bbf8cab0-d43a-11d3-8cc2-00609792278c}']
function GetFile(const prop: PAnsiChar; out persistent: PRBool; out AFile: nsIFile): nsresult; stdcall;
end;
nsGREDirServiceProvider = class(TInterfacedObject,
nsIDirectoryServiceProvider_stdcall)
public
FPathEnvString: TMaxPathChar;
class function NewInstance: TObject; override;
procedure FreeInstance; override;
function GetFile(const prop: PAnsiChar; out persistent: PRBool; out AFile: nsIFile): nsresult; stdcall;
function GetGreDirectory(out AFile: nsILocalFile): nsresult;
end;
function nsGREDirServiceProvider.GetGreDirectory(out AFile: nsILocalFile): nsresult; function nsGREDirServiceProvider.GetGreDirectory(out AFile: nsILocalFile): nsresult;
var var
GreDir: TMaxPathChar; GreDir: TMaxPathChar;
@ -1752,6 +1778,7 @@ begin
Result := NS_ERROR_FAILURE; Result := NS_ERROR_FAILURE;
if not GetGREDirectoryPath(GreDir) then Exit; if not GetGREDirectoryPath(GreDir) then Exit;
ZeroArray(leaf,sizeof(leaf));
Result := NS_CStringContainerInit(leaf); Result := NS_CStringContainerInit(leaf);
if NS_FAILED(Result) then Exit; if NS_FAILED(Result) then Exit;
NS_CStringSetData(@leaf, GreDir); NS_CStringSetData(@leaf, GreDir);
@ -1836,7 +1863,7 @@ end;
var var
sStartupCount: Integer = 0; sStartupCount: Integer = 0;
function GRE_Startup: Longword; function GRE_Startup: nsresult;
var var
xpcomLocation: TMaxPathChar; xpcomLocation: TMaxPathChar;
provider: nsGREDirServiceProvider; provider: nsGREDirServiceProvider;
@ -1876,7 +1903,7 @@ begin
Inc(sStartupCount); Inc(sStartupCount);
end; end;
function GRE_Shutdown: Longword; function GRE_Shutdown: nsresult;
begin begin
Dec(sStartupCount); Dec(sStartupCount);
@ -2123,12 +2150,11 @@ begin
Result := (Append^ = #0); Result := (Append^ = #0);
end; end;
{$IFDEF MSWINDOWS}
function fullpath(absPath, relPath: PAnsiChar; maxLength: PRUint32): PAnsiChar; function fullpath(absPath, relPath: PAnsiChar; maxLength: PRUint32): PAnsiChar;
var
filePart: PAnsiChar;
begin begin
GetFullPathNameA(relPath, maxLength, absPath, filePart); //Path here must arrive already absolute :-?
strlcopy(abspath,relpath,maxLength);
// GetFullPathNameA(relPath, maxLength, absPath, filePart);
Result := absPath; Result := absPath;
end; end;
@ -2137,8 +2163,7 @@ var
lastSlash: PAnsiChar; lastSlash: PAnsiChar;
begin begin
Result := False; Result := False;
if SUCCEEDED(GetModuleFileNameA(0, buf, bufLen)) then move(ParamStr(0)[1],buf^,min(bufLen,Length(ParamStr(0))));
begin
lastSlash := NS_StrRScan(buf, '\'); lastSlash := NS_StrRScan(buf, '\');
if Assigned(lastSlash) then if Assigned(lastSlash) then
begin begin
@ -2146,8 +2171,13 @@ begin
Result := True; Result := True;
end; end;
end; end;
procedure ZeroArray(out AArray; const ASize: SizeInt);
begin
{$PUSH}{$HINTS OFF}
FillByte(AArray,ASize,0);
{$POP}
end; end;
{$ENDIF}
end. end.

View File

@ -81,7 +81,7 @@ end;
function GlueStartupMemory: Longword; function GlueStartupMemory: Longword;
begin begin
Result := NS_ERROR_FAILURE; Result := LongWord(NS_ERROR_FAILURE);
if Assigned(gMemory) then Exit; if Assigned(gMemory) then Exit;
nsInit.NS_GetMemoryManager(gMemory); nsInit.NS_GetMemoryManager(gMemory);
if not Assigned(gMemory) then Exit; if not Assigned(gMemory) then Exit;
@ -124,13 +124,13 @@ end;
function HeapMinimize(aImmediate: Boolean): Longword; function HeapMinimize(aImmediate: Boolean): Longword;
begin begin
Result := NS_ERROR_FAILURE; Result := LongWord(NS_ERROR_FAILURE);
if ENSURE_ALLOCATOR then if ENSURE_ALLOCATOR then
try try
Result := NS_OK; Result := NS_OK;
gMemory.HeapMinimize(aImmediate); gMemory.HeapMinimize(aImmediate);
except except
Result := NS_ERROR_FAILURE; Result := LongWord(NS_ERROR_FAILURE);
end; end;
end; end;

View File

@ -39,16 +39,16 @@ unit nsStream;
interface interface
uses uses
nsXPCOM, Classes; nsXPCOM, Classes,nsTypes;
function NS_NewByteArrayInputStream(out stream: nsIInputStream; const Buffer: Pointer; Size: Longword): Longword; function NS_NewByteArrayInputStream(out stream: nsIInputStream; const Buffer: Pointer; Size: Longword): nsresult;
function NS_NewInputStreamFromTStream(input: TStream; own: Boolean=False): nsIInputStream; function NS_NewInputStreamFromTStream(input: TStream; own: Boolean=False): nsIInputStream;
function NS_NewOutputStreamFromTStream(output: TStream; own: Boolean=False): nsIOutputStream; function NS_NewOutputStreamFromTStream(output: TStream; own: Boolean=False): nsIOutputStream;
implementation implementation
uses uses
Math, nsMemory, nsError, nsTypes, SysUtils; Math, nsMemory, nsError, SysUtils;
type type
nsByteArrayInputStream = class(TInterfacedObject, nsByteArrayInputStream = class(TInterfacedObject,
@ -163,7 +163,7 @@ begin
raise Exception.Create('nsIInputStream.Close') raise Exception.Create('nsIInputStream.Close')
end; end;
function NS_NewByteArrayInputStream(out stream: nsIInputStream; const Buffer: Pointer; Size: Longword): Longword; function NS_NewByteArrayInputStream(out stream: nsIInputStream; const Buffer: Pointer; Size: Longword): nsresult;
begin begin
try try
stream := nsByteArrayInputStream.Create(Buffer, Size); stream := nsByteArrayInputStream.Create(Buffer, Size);

View File

@ -38,9 +38,6 @@ unit nsTypes;
interface interface
uses
nsConsts;
type type
PRBool = LongBool; PRBool = LongBool;
PRUint8 = Byte; PRUint8 = Byte;
@ -53,10 +50,12 @@ type
PRInt32 = Longint; PRInt32 = Longint;
PRInt64 = Int64; PRInt64 = Int64;
nsresult = PRUint32; nsresult = PRint32;
nsrefcnt = PRUint32; nsrefcnt = PRint32;
size_t = PRUint32; {$IFNDEF FPC}
size_t = SizeUint;
{$ENDIF}
PRSize = PRUint32; PRSize = PRUint32;

View File

@ -3,7 +3,7 @@ unit nsXPCOM;
interface interface
uses uses
nsConsts, nsGeckoStrings, nsTypes; nsGeckoStrings, nsTypes;
const const
NS_ISUPPORTS_IID: TGUID = '{00000000-0000-0000-c000-000000000046}'; NS_ISUPPORTS_IID: TGUID = '{00000000-0000-0000-c000-000000000046}';

View File

@ -39,7 +39,7 @@ unit nsXPCOMGlue;
interface interface
uses uses
nsXPCOM, nsGeckoStrings, nsConsts, nsTypes, SysUtils; nsXPCOM, nsTypes, SysUtils;
const const
(* (*
@ -281,8 +281,8 @@ type
TWeakReference = class(TInterfacedObject, nsIWeakReference) TWeakReference = class(TInterfacedObject, nsIWeakReference)
private private
FSupports: TSupportsWeakReference; FSupports: TSupportsWeakReference;
constructor Create(supports: TSupportsWeakReference);
public public
constructor Create(supports: TSupportsWeakReference);
destructor Destroy; override; destructor Destroy; override;
procedure QueryReferent(const uuid: TGUID; out Intf); safecall; procedure QueryReferent(const uuid: TGUID; out Intf); safecall;
end; end;
@ -295,7 +295,9 @@ type
function GetWeakReference: nsIWeakReference; safecall; function GetWeakReference: nsIWeakReference; safecall;
end; end;
EGeckoError = class(Exception); EGeckoException = class (Exception);
EGeckoError = class(EGeckoException); //Gecko error. It is an error.
EGeckoHint = class(EGeckoException); //Gecko Hint. It does not necessary means an error. They could be hidden.
function NS_NewSupportsWeakReferenceDelegate(aTarget: nsISupports): nsISupportsWeakReference; function NS_NewSupportsWeakReferenceDelegate(aTarget: nsISupports): nsISupportsWeakReference;
@ -311,7 +313,7 @@ resourcestring
implementation implementation
uses uses
nsMemory, nsError, nsInit, {$IFDEF MSWINDOWS} Windows, {$ENDIF} StrUtils; nsMemory, nsError, nsInit {$IFDEF MSWINDOWS} ,Windows {$ELSE} ,{$ENDIF};
var var
sCompMgr: nsIComponentManager = nil; sCompMgr: nsIComponentManager = nil;

View File

@ -80,7 +80,7 @@ function XRE_InitEmbedding(aLibXulDirectory: nsILocalFile;
aAppDirectory: nsILocalFile; aAppDirectory: nsILocalFile;
aAppDirProvider: nsIDirectoryServiceProvider; aAppDirProvider: nsIDirectoryServiceProvider;
const aStaticComponents: PStaticModuleInfoArray; const aStaticComponents: PStaticModuleInfoArray;
aStaticComponentCount: PRUint32): nsresult; cdecl; aStaticComponentCount: PRUint32): nsresult;
procedure XRE_NotifyProfile(); cdecl; procedure XRE_NotifyProfile(); cdecl;
procedure XRE_TermEmbedding(); cdecl; procedure XRE_TermEmbedding(); cdecl;
function XRE_CreateAppData(aINIFile: nsILocalFile; function XRE_CreateAppData(aINIFile: nsILocalFile;
@ -92,7 +92,7 @@ procedure XRE_FreeAppData(aAppData: PXREAppData); cdecl;
implementation implementation
uses uses
nsConsts, nsError, nsGeckoStrings, nsError, nsGeckoStrings,
{$IFDEF MSWINDOWS} Windows, {$ELSE} DynLibs, {$ENDIF} SysUtils; {$IFDEF MSWINDOWS} Windows, {$ELSE} DynLibs, {$ENDIF} SysUtils;
var var
@ -129,8 +129,6 @@ var
freeAppDataFunc : freeAppDataFunc :
procedure (aAppData: PXREAppData); cdecl; procedure (aAppData: PXREAppData); cdecl;
sInitialized : Boolean = False;
function strrpbrk(src: PAnsiChar; const charSet: PAnsiChar): PAnsiChar; function strrpbrk(src: PAnsiChar; const charSet: PAnsiChar): PAnsiChar;
var var
ptr: PAnsiChar; ptr: PAnsiChar;
@ -172,6 +170,7 @@ begin
vers.upper := upperVer; vers.upper := upperVer;
vers.upperInclusive := upperInclusive; vers.upperInclusive := upperInclusive;
(*
Result := GRE_GetGREPathWithProperties(@vers, 1, nil, 0, xpcomPath, MAX_PATH); Result := GRE_GetGREPathWithProperties(@vers, 1, nil, 0, xpcomPath, MAX_PATH);
//FPC port: previous call doesn't find Firefox's GRE, so just force it. //FPC port: previous call doesn't find Firefox's GRE, so just force it.
if NS_FAILED(result) then if NS_FAILED(result) then
@ -184,6 +183,31 @@ begin
//FPC port //FPC port
if NS_FAILED(result) then if NS_FAILED(result) then
Exit; Exit;
*)
//Changed checking order. Preference is xulrunner in application folder
if ParamStr(1)<>'' then begin
NS_StrLCopy(xpcomPath, PChar(ParamStr(1) + '\xpcom.dll'), MAX_PATH);
Result:=NS_OK;
end else begin
NS_StrLCopy(xpcomPath, PChar(ExtractFilePath(ParamStr(0)) + 'xpcom.dll'), MAX_PATH);
if FileExists(xpcomPath) then begin
Result := NS_OK;
end else begin
NS_StrLCopy(xpcomPath, PChar(ExtractFilePath(ParamStr(0)) + 'xulrunner\xpcom.dll'), MAX_PATH);
if FileExists(xpcomPath) then begin
Result := NS_OK;
end else begin
Result := GRE_GetGREPathWithProperties(@vers, 1, nil, 0, xpcomPath, MAX_PATH);
if not FileExists(xpcomPath) then begin
Result:=NS_ERROR_FILE_ACCESS_DENIED
end else begin
result:=NS_OK;
end;
end;
end;
end;
if NS_FAILED(result) then
Exit;
lastSlash := strrpbrk(xpcomPath, '/\'); lastSlash := strrpbrk(xpcomPath, '/\');
if not Assigned(lastSlash) then if not Assigned(lastSlash) then
@ -286,7 +310,7 @@ begin
Result := NS_ERROR_NOT_INITIALIZED; Result := NS_ERROR_NOT_INITIALIZED;
Exit; Exit;
end; end;
FreeLibrary(sXulModule); XPCOMGlueShutdown;
sXulModule := 0; sXulModule := 0;
Result := NS_OK; Result := NS_OK;
end; end;
@ -369,8 +393,9 @@ begin
XRE_UnloadGRE(); XRE_UnloadGRE();
Exit; Exit;
end; end;
// NS_LogInit();
Result := XRE_InitEmbedding(xulDir, appDir, nil, nil, 0); Result := XRE_InitEmbedding(xulDir, appDir, nil, nil, 0);
// NS_LogTerm();
end; end;
function XRE_Shutdown(): nsresult; function XRE_Shutdown(): nsresult;