lasarus_compotents/gecko/Components/GeckoDirectoryService.pas

unit GeckoDirectoryService;

{$MACRO on}

{$IFDEF Windows}
  {$DEFINE extdecl:=stdcall}
{$ELSE Windows}
  {$DEFINE extdecl:=cdecl}
{$ENDIF}

interface

uses
  SysUtils, Classes, nsXPCOM;

type
  TGeckoDirectoryServiceOnGetFile = function (
    const AProp: AnsiString): String of object;
  TGeckoDirectoryServiceOnGetFileList = function (
    const AProp: AnsiString; AList: TStrings): Boolean of Object;

  TCustomDirectoryServiceProvider = class(TComponent)
  private
    { Private declarations }
    FOnGetFile: TGeckoDirectoryServiceOnGetFile;
    FOnGetFileList: TGeckoDirectoryServiceOnGetFileList;
    FProxy: nsIDirectoryServiceProvider;

    function ProcessGetFile(const AProp: AnsiString; var APersistent: Boolean)
      : String;
    function ProcessGetFileList(const AProp: AnsiString;
                                AFileList: TStrings): Boolean;
    property OnGetFile: TGeckoDirectoryServiceOnGetFile read FOnGetFile
      write FOnGetFile;
    property OnGetFileList: TGeckoDirectoryServiceOnGetFileList
      read FOnGetFileList write FOnGetFileList;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
  end;

  TGeckoDirectoryServiceProvider = class(TCustomDirectoryServiceProvider)
  private
    { Private declarations }
    FRegDir: AnsiString;
    FRegFile: AnsiString;
    FDefaultsDir: AnsiString;
    FPrefDefaultsDir: AnsiString;
    FProfileDefaultsDir: AnsiString;
    FProfileDefaultsNlocDir: AnsiString;

  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    property OnGetFile;
  end;

procedure Register;

implementation

uses
  nsTypes, nsInit, nsError, nsGeckoStrings, nsXPCOMGlue, nsCID, GeckoInit,
  nsXPCOM_std19, nsEnumerators, Windows;

type
  TDirectoryServiceProviderProxy = class(TInterfacedObject,
                                         nsIDirectoryServiceProvider_std19,
                                         nsIDirectoryServiceProvider2_std19)
    FOwner: TCustomDirectoryServiceProvider;
    constructor Create(AOwner: TCustomDirectoryServiceProvider);
    function GetFile(const prop: PAnsiChar; out persistent: PRBool;
      out _retval: nsIFile_std19): nsresult; extdecl;
    function GetFiles(const prop: PAnsiChar;
      out _retval: nsISimpleEnumerator_std19): nsresult; extdecl;
  end;

procedure Register;
begin
  RegisterComponents('Gecko', [TGeckoDirectoryServiceProvider]);
end;

constructor TDirectoryServiceProviderProxy.Create(
  AOwner: TCustomDirectoryServiceProvider);
begin
  inherited Create;
  FOwner := AOwner;
end;

var
  sModulePath: array[0..MAX_PATH] of Char;
  sModulePathInitialized: Boolean = False;

function GetModulePath: String;
begin
  if not sModulePathInitialized then
  begin
    GetModuleFileName(0, sModulePath, MAX_PATH);
    sModulePathInitialized := True;
  end;
  Result := PChar(@sModulePath);
end;

function MakeILocalFile(const AFilename: String;
  out ALocalFile: nsILocalFile): nsresult;
var
  localFile: nsILocalFile;
{$ifndef UNICODE}
  localFileStr: IInterfacedCString;
{$else}
  localFileStr: IInterfacedString;
{$endif}
  modulePath: String;
  targetPath, relativePath: String;
begin
  modulePath := GetModulePath;

  if (Length(AFilename)>0) and
     (AFilename[1] = '\') then
  begin
    // case of Path from root or network path
    if (Length(afilename)>=2) and
       (afilename[2] <> '\') then
    begin
      // case of Path from root
      targetPath := ExtractFileDrive(modulePath) + afilename;
    end else
    begin
      // case of network path
      targetPath := afilename;
    end;
  end else
  if (Length(afilename)<3) or
     (afilename[2] <> ':') then
  begin
    // case of relative path
    targetPath := ExtractFileDir(modulePath);
    if Length(afilename)>0 then
      relativePath := afilename;
  end else
  begin
    // case of full path
    targetPath := afilename;
  end;

  try
{$ifndef UNICODE}
    localFileStr := NewCString(targetPath);
{$else}
    localFileStr := NewString(targetPath);
{$endif}
  except
    Result := NS_ERROR_FAILURE;
    Exit;
  end;
{$ifndef UNICODE}
  Result := NS_NewNativeLocalFile(localFileStr.ACString, True, localFile);
{$else}
  Result := NS_NewLocalFile(localFileStr.AString, True, localFile);
{$endif}
  if NS_FAILED(Result) then Exit;

  if Length(relativePath)>0 then
  begin
    localFileStr.Assign(relativePath);
{$ifndef UNICODE}
    localFile.AppendRelativeNativePath(localFileStr.ACString);
{$else}
    localFile.AppendRelativePath(localFileStr.AString);
{$endif}
  end;

  Result := localFile.QueryInterface(nsILocalFile, ALocalFile);
end;

function TDirectoryServiceProviderProxy.GetFile(const prop: PAnsiChar;
  out persistent: PRBool; out _retval: nsIFile_std19): nsresult;
var
  path: String;
  localFile: nsILocalFile;
  persist: Boolean;
begin
  if Assigned(FOwner) then
  begin
    path := FOwner.ProcessGetFile(prop, persist);
    if (Length(path)=0) and Assigned(FOwner.FOnGetFile) then
    begin
      path := FOwner.FOnGetFile(prop);
    end;
  end;

  if Length(path)=0 then
  begin
    Result := NS_ERROR_FAILURE;
  end else
  begin
    Result := MakeILocalFile(path, localFile);
    if NS_SUCCEEDED(Result) then
    begin
      Result := localFile.QueryInterface(nsIFile_std19, _retval);
    end;
  end;
end;

function TDirectoryServiceProviderProxy.GetFiles(const prop: PAnsiChar;
  out _retval: nsISimpleEnumerator_std19): nsresult;
var
  enum: nsISimpleEnumerator;
  lfile: nsILocalFile;
  done: Boolean;
  list: TStringList;
  intfList: TInterfaceList;
  i: Integer;
begin
  list := TStringList.Create;
  try
    intfList := TInterfaceList.Create;
    try
      enum := NewSimpleEnumeratorFromTInterfaceList(intfList, True);
    except
      Result := NS_ERROR_FAILURE;
      intfList.Free;
      Exit;
    end;

    if Assigned(FOwner) then
    begin
      Done := FOwner.ProcessGetFileList(prop, list);
      if not Done then
      begin
        Result := NS_ERROR_FAILURE;
        Exit;
      end;
      for i:=0 to list.Count -1 do
      begin
        Result := MakeILocalFile(list[i], lfile);
        if NS_FAILED(Result) then
          Exit;
        intfList.Add(lfile);
      end;
      Result := enum.QueryInterface(nsISimpleEnumerator, _retval);
    end else
    begin
      Result := NS_ERROR_FAILURE;
    end;
  finally
    list.Free;
  end;
end;

constructor TCustomDirectoryServiceProvider.Create(AOwner: TComponent);
var
  dirSrv: nsIDirectoryService;
begin
  inherited;

  if not (csDesigning in ComponentState) then
  begin
    GeckoComponentsStartup;

    FProxy := TDirectoryServiceProviderProxy.Create(Self)
      as nsIDirectoryServiceProvider;
    NS_GetService(NS_DIRECTORY_SERVICE_CONTRACTID, nsIDirectoryService, dirSrv);
    dirSrv.RegisterProvider(FProxy);
  end;
end;

destructor TCustomDirectoryServiceProvider.Destroy;
var
  dirSrv: nsIDirectoryService;
begin
  if not (csDesigning in ComponentState) then
  begin
    NS_GetService(NS_DIRECTORY_SERVICE_CONTRACTID, nsIDirectoryService, dirSrv);
    dirSrv.UnregisterProvider(FProxy);

    GeckoComponentsShutdown;
  end;

  inherited;
end;

function TCustomDirectoryServiceProvider.ProcessGetFile(const AProp: AnsiString;
  var APersistent: Boolean): String;
begin
end;

function TCustomDirectoryServiceProvider.ProcessGetFileList(
  const AProp: AnsiString; AFileList: TStrings): Boolean;
begin
  Result := False;
end;

end.