Стартовый пул

gecko/.svn/pristine/f6/f6ca153cfb7e8a6f5a875b350a2315157071c99b.svn-base

@@ -0,0 +1,241 @@
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1/GPL 2.0/LGPL 2.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is GeckoComponents for Delphi.
+ *
+ * The Initial Developer of the Original Code is Takanori Ito.
+ * Portions created by the Initial Developer are Copyright (C) 2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ *
+ * Alternatively, the contents of this file may be used under the terms of
+ * either the GNU General Public License Version 2 or later (the "GPL"), or
+ * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
+ * in which case the provisions of the GPL or the LGPL are applicable instead
+ * of those above. If you wish to allow use of your version of this file only
+ * under the terms of either the GPL or the LGPL, and not to allow others to
+ * use your version of this file under the terms of the MPL, indicate your
+ * decision by deleting the provisions above and replace them with the notice
+ * and other provisions required by the GPL or the LGPL. If you do not delete
+ * the provisions above, a recipient may use your version of this file under
+ * the terms of any one of the MPL, the GPL or the LGPL.
+ *
+ * ***** END LICENSE BLOCK ***** *)
+unit GeckoSimpleProfile;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Classes;
+
+type
+  TGeckoSimpleProfile = class(TComponent)
+  private
+    { Private <20>錾 }
+    procedure SetProfileBaseDirectory(Value: String);
+    function GetProfileBaseDirectory: String;
+  protected
+    { Protected <20>錾 }
+  public
+    { Public <20>錾 }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    { Published <20>錾 }
+    property ProfileBaseDirectory: String
+        read GetProfileBaseDirectory
+        write SetProfileBaseDirectory;
+  end;
+
+procedure Register;
+
+implementation
+
+uses
+  nsXPCOM, nsXPCOMGlue, nsError, nsGeckoStrings, nsProfile, nsTypes, nsInit,
+  GeckoInit;
+
+procedure Register;
+begin
+  RegisterComponents('Gecko', [TGeckoSimpleProfile]);
+end;
+
+var
+  sProfileDirServiceProvider: nsProfileDirServiceProvider;
+  sProfileBaseDirectory: String;
+  sRefCnt: Integer = 0;
+
+procedure ChangeProfileBaseDirectory; forward;
+procedure SavePreferences; forward;
+procedure LoadPreferences; forward;
+
+constructor TGeckoSimpleProfile.Create(AOwner: TComponent);
+var
+  provider: nsProfileDirServiceProvider;
+begin
+  inherited Create(AOwner);
+
+  if not (csDesigning in ComponentState) then
+  begin
+    GeckoComponentsStartup;
+
+    if not Assigned(sProfileDirServiceProvider) then
+    begin
+      provider := NS_NewProfileDirServiceProvider(True);
+
+      sProfileDirServiceProvider := provider;
+
+      //if Length(sProfileBaseDirectory)>0 then
+      ChangeProfileBaseDirectory;
+      sProfileDirServiceProvider.Register;
+    end;
+    Inc(sRefCnt);
+  end;
+end;
+
+destructor TGeckoSimpleProfile.Destroy;
+begin
+  if not (csDesigning in ComponentState) then
+  begin
+    SavePreferences;
+
+    Dec(sRefCnt);
+    if sRefCnt=0 then
+      sProfileDirServiceProvider := nil;
+
+    GeckoComponentsShutdown;
+  end;
+
+  inherited;
+end;
+
+procedure TGeckoSimpleProfile.SetProfileBaseDirectory(Value: String);
+begin
+  if Value = sProfileBaseDirectory then Exit;
+
+  sProfileBaseDirectory := Value;
+
+  if not (csDesigning in ComponentState) then
+  begin
+    ChangeProfileBaseDirectory;
+    LoadPreferences;
+  end;
+end;
+
+function TGeckoSimpleProfile.GetProfileBaseDirectory: String;
+begin
+  Result := sProfileBaseDirectory;
+end;
+
+procedure ChangeProfileBaseDirectory;
+var
+  rv: nsresult;
+  localFile: nsILocalFile;
+{$ifndef UNICODE}
+  localFileStr: IInterfacedCString;
+{$else}
+  localFileStr: IInterfacedString;
+{$endif}
+  modulePath: array[0..MAX_PATH] of Char;
+  targetPath, relativePath: String;
+begin
+  GetModuleFileName(0, modulePath, MAX_PATH);
+
+  if (Length(sProfileBaseDirectory)>0) and
+     (sProfileBaseDirectory[1] = '\') then
+  begin
+    // case of Path from root or network path
+    if (Length(sProfileBaseDirectory)>=2) and
+       (sProfileBaseDirectory[2] <> '\') then
+    begin
+      // case of Path from root
+      targetPath := ExtractFileDrive(modulePath) + sProfileBaseDirectory;
+    end else
+    begin
+      // case of network path
+      targetPath := sProfileBaseDirectory;
+    end;
+  end else
+  if (Length(sProfileBaseDirectory)<3) or
+     (sProfileBaseDirectory[2] <> ':') then
+  begin
+    // case of relative path
+    targetPath := ExtractFileDir(modulePath);
+    if Length(sProfileBaseDirectory)>0 then
+      relativePath := sProfileBaseDirectory;
+  end else
+  begin
+    // case of full path
+    targetPath := sProfileBaseDirectory;
+  end;
+
+  try
+{$ifndef UNICODE}
+    localFileStr := NewCString(targetPath);
+{$else}
+    localFileStr := NewString(targetPath);
+{$endif}
+  except
+    Exit;
+  end;
+{$ifndef UNICODE}
+  rv := NS_NewNativeLocalFile(localFileStr.ACString, True, localFile);
+{$else}
+  rv := NS_NewLocalFile(localFileStr.AString, True, localFile);
+{$endif}
+  if NS_FAILED(rv) then Exit;
+
+  if Length(relativePath)>0 then
+  begin
+    localFileStr.Assign(relativePath);
+{$ifndef UNICODE}
+    localFile.AppendRelativeNativePath(localFileStr.ACString);
+{$else}
+    localFile.AppendRelativePath(localFileStr.AString);
+{$endif}
+  end;
+
+  sProfileDirServiceProvider.SetProfileDir(localFile);
+end;
+
+procedure SavePreferences;
+var
+  prefSrv: nsIPrefService;
+  prefFile: nsIFile;
+begin
+  NS_GetService(NS_PREFSERVICE_CID, nsIPrefService, prefSrv);
+  prefFile := NS_GetSpecialDirectory(NS_APP_PREFS_50_FILE);
+  prefSrv.SavePrefFile(prefFile);
+end;
+
+procedure LoadPreferences;
+var
+  prefSrv: nsIPrefService;
+  prefFile, prefDir: nsIFile;
+begin
+  NS_GetService(NS_PREFSERVICE_CID, nsIPrefService, prefSrv);
+  prefDir := NS_GetSpecialDirectory(NS_APP_PREFS_50_DIR);
+  if not prefDir.Exists then
+  begin
+    prefDir.Create(NS_IFILE_DIRECTORY_TYPE, 7*64+5*8+5);
+  end;
+  prefFile := NS_GetSpecialDirectory(NS_APP_PREFS_50_FILE);
+  prefSrv.ResetPrefs;
+  if prefFile.Exists then
+  begin
+    prefSrv.ReadUserPrefs(prefFile);
+  end;
+end;
+
+end.