root/lang/pascal/GeckoSDK/nsProfile.pas @ 4182

Revision 4180, 16.7 kB (checked in by plus7, 7 years ago)

lang/pascal/GeckoSDK: start project

  • Property svn:executable set to *
Line 
1(* ***** BEGIN LICENSE BLOCK *****
2 * Version: MPL 1.1/GPL 2.0/LGPL 2.1
3 *
4 * The contents of this file are subject to the Mozilla Public License Version
5 * 1.1 (the "License"); you may not use this file except in compliance with
6 * the License. You may obtain a copy of the License at
7 * http://www.mozilla.org/MPL/
8 *
9 * Software distributed under the License is distributed on an "AS IS" basis,
10 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11 * for the specific language governing rights and limitations under the
12 * License.
13 *
14 * The Original Code is mozilla.org.
15 *
16 * The Initial Developer of the Original Code is
17 * Netscape Communications Corpotation.
18 * Portions created by the Initial Developer are Copyright (C) 1998
19 * the Initial Developer. All Rights Reserved.
20 *
21 * Contributor(s):
22 *   Takanori Itou <necottie@nesitive.net>
23 *
24 * Alternatively, the contents of this file may be used under the terms of
25 * either the GNU General Public License Version 2 or later (the "GPL"), or
26 * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
27 * in which case the provisions of the GPL or the LGPL are applicable instead
28 * of those above. If you wish to allow use of your version of this file only
29 * under the terms of either the GPL or the LGPL, and not to allow others to
30 * use your version of this file under the terms of the MPL, indicate your
31 * decision by deleting the provisions above and replace them with the notice
32 * and other provisions required by the GPL or the LGPL. If you do not delete
33 * the provisions above, a recipient may use your version of this file under
34 * the terms of any one of the MPL, the GPL or the LGPL.
35 *
36 * ***** END LICENSE BLOCK ***** *)
37unit nsProfile;
38
39interface
40
41uses
42  nsXPCOM, nsTypes, nsXPCOMGlue;
43
44type
45  nsProfileDirServiceProvider = interface(nsIDirectoryServiceProvider)
46    procedure SetProfileDir(AProfileDir: nsIFile);
47    procedure Register;
48    procedure Shutdown;
49  end;
50
51  EGeckoProfileError = class(EGeckoError);
52
53function NS_NewProfileDirServiceProvider(aNotifyObservers: PRBool): nsProfileDirServiceProvider;
54
55resourcestring
56  SProfileRegisterError = '�v���t�@�C���̓o�^�Ɏ��s���܂����B';
57  SProfileShutdownError = '�v���t�@�C���̏I���Ɏ��s���܂����B';
58  SSetProfileDirError = '�v���t�@�C���f�B���N�g���̓o�^�Ɏ��s���܂����B';
59  SNotADirectory = '�w�肳�ꂽ�t�@�C���̓f�B���N�g���ł͂�������;
60  SProfileInitError = '�v���t�@�C���̏������s���܂����B';
61  SEnsureProfileDirError = '�v���t�@�C���f�B���N�g������邱�Ƃ��o���܂���;
62
63implementation
64
65uses
66  Windows, SysUtils, nsConsts, nsError, nsGeckoStrings, nsCID;
67
68type
69  TProfileDirLock = class(TObject)
70    FHaveLock: Boolean;
71    FLockFileHandle: THandle;
72
73    constructor Create; overload;
74    constructor Create(src: TProfileDirLock); overload;
75    destructor Destroy; override;
76
77    procedure Assign(rhs: TProfileDirLock);
78    function Lock(aFile: nsILocalFile): nsresult;
79    function Unlock: nsresult;
80  end;
81
82  TProfileDirServiceProvider = class(TInterfacedObject,
83                                     nsProfileDirServiceProvider,
84                                     nsIDirectoryServiceProvider)
85    FProfileDir: nsIFile;
86    FProfileDirLock: TProfileDirLock;
87    FNotifyObservers: PRBool;
88    FSharingEnabled: Boolean;
89    FNonSharedDirName: IInterfacedString;
90    FNonSharedProfileDir: nsIFile;
91    function GetFile(const prop: PAnsiChar; out persistent: PRBool): nsIFile; safecall;
92    procedure SetProfileDir(AProfileDir: nsIFile);
93    procedure Register;
94    procedure Shutdown;
95
96    constructor Create(aNotifyObservers: PRBool = True);
97    destructor Destroy; override;
98
99    procedure Initialize;
100    procedure InitProfileDir(profileDir: nsIFile);
101    procedure InitNonSharedProfileDir;
102    procedure EnsureProfileFileExists(aFile: nsIFile; destDir: nsIFile);
103    procedure UndefineFileLocations;
104
105    function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
106  end;
107
108constructor TProfileDirLock.Create;
109begin
110  inherited Create;
111
112  FHaveLock := False;
113  FLockFileHandle := INVALID_HANDLE_VALUE;
114end;
115
116constructor TProfileDirLock.Create(src: TProfileDirLock);
117begin
118  inherited Create;
119
120  Assign(src);
121end;
122
123procedure TProfileDirLock.Assign(rhs: TProfileDirLock);
124begin
125  Unlock();
126
127  FHaveLock := rhs.FHaveLock;
128  rhs.FHaveLock := False;
129
130  FLockFileHandle := rhs.FLockFileHandle;
131  rhs.FLockFileHandle := INVALID_HANDLE_VALUE;
132end;
133
134destructor TProfileDirLock.Destroy;
135begin
136  Unlock();
137  inherited;
138end;
139
140function TProfileDirLock.Lock(aFile: nsILocalFile): nsresult;
141const
142  LOCKFILE_NAME = 'parent.lock';
143var
144  isDir: PRBool;
145  lockFile: nsIFile;
146  lockFileName: IInterfacedString;
147  filePath: IInterfacedCString;
148begin
149  try
150    lockFileName := NewString(LOCKFILE_NAME);
151    filePath := NewCString;
152
153    if not FHaveLock then
154    begin
155      Result := NS_ERROR_UNEXPECTED;
156      Exit;
157    end;
158
159    isDir := aFile.IsDirectory();
160
161    if not isDir then
162    begin
163      Result := NS_ERROR_FILE_NOT_DIRECTORY;
164      Exit;
165    end;
166
167    lockFile := aFile.Clone();
168    lockFile.Append(lockFileName.AString);
169    lockFile.GetNativePath(filePath.ACString);
170
171    FLockFileHandle := CreateFile(PAnsiChar(filePath.ToString),
172                                  GENERIC_READ or GENERIC_WRITE,
173                                  0,
174                                  nil,
175                                  OPEN_ALWAYS,
176                                  FILE_FLAG_DELETE_ON_CLOSE,
177                                  0);
178    if FLockFileHandle = INVALID_HANDLE_VALUE then
179    begin
180      Result := NS_ERROR_FILE_ACCESS_DENIED;
181      Exit;
182    end;
183    FHaveLock := True;
184    Result := NS_OK;
185  except
186    on EOutOfMemory do
187      Result := NS_ERROR_OUT_OF_MEMORY;
188    on ESafeCallException do
189      Result := NS_ERROR_FAILURE;
190  else
191    Result := NS_ERROR_UNEXPECTED;
192  end;
193end;
194
195function TProfileDirLock.Unlock: nsresult;
196begin
197  Result := NS_OK;
198
199  if FHaveLock then
200  begin
201    if FLockFileHandle <> INVALID_HANDLE_VALUE then
202    begin
203      CloseHandle(FLockFileHandle);
204      FLockFileHandle := INVALID_HANDLE_VALUE;
205    end;
206    FHaveLock := False;
207  end;
208end;
209
210constructor TProfileDirServiceProvider.Create(aNotifyObservers: PRBool);
211begin
212  inherited Create;
213  FNotifyObservers := aNotifyObservers;
214end;
215
216destructor TProfileDirServiceProvider.Destroy;
217begin
218  FProfileDirLock.Free;
219  inherited;
220end;
221
222procedure TProfileDirServiceProvider.SetProfileDir(aProfileDir: nsIFile);
223var
224{$IFDEF MOZ_PROFILELOCKING}
225  dirToLock: nsILocalFile;
226{$ENDIF}
227  observerService: nsIObserverService;
228begin
229  try
230    if Assigned(FProfileDir) then
231    begin
232      if Assigned(aProfileDir) and
233         aProfileDir.Equals(FProfileDir) then
234        begin
235          Exit;
236        end;
237{$IFDEF MOZ_PROFILELOCKING}
238      FProfileDirLock.Unlock();
239{$ENDIF}
240      UndefineFileLocations;
241    end;
242    FProfileDir := aProfileDir;
243    if not Assigned(FProfileDir) then
244    begin
245      Exit;
246    end;
247
248{$IFDEF MOZ_PROFILELOCKING}
249    Result := InitProfileDir(FProfileDir);
250    if NS_FAILED(Result) then Exit;
251
252    if FSharingEnabled then
253      Result := FNonSharedProfileDir.QueryInterface(nsILocalFile, dirToLock)
254    else
255      Result := FNonSharedProfileDir.QueryInterface(nsILocalFile, dirToLock);
256    if NS_FAILED(Result) then Exit;
257    Result := FProfileDirLock.Lock(dirToLock);
258    if NS_FAILED(Result) then Exit;
259{$ENDIF}
260
261    if FNotifyObservers then
262    begin
263      NS_GetService('@mozilla.org/observer-service;1', nsIObserverService, observerService);
264
265      observerService.NotifyObservers(nil, 'profile-do-change', 'startup');
266      observerService.NotifyObservers(nil, 'profile-after-change', 'startup');
267    end;
268
269  except
270    raise EGeckoProfileError.CreateRes(PResStringRec(@SSetProfileDirError));
271  end;
272end;
273
274procedure TProfileDirServiceProvider.Register;
275var
276  directoryService: nsIDirectoryService;
277begin
278  NS_GetService(NS_DIRECTORY_SERVICE_CONTRACTID,
279                nsIDirectoryService,
280                directoryService);
281  try
282    directoryService.RegisterProvider(Self);
283  except
284    raise EGeckoProfileError.CreateRes(PResStringRec(@SProfileRegisterError));
285  end;
286end;
287
288procedure TProfileDirServiceProvider.Shutdown;
289var
290  observerService: nsIObserverService;
291begin
292  NS_GetService('@mozilla.org/observer-service;1',
293                nsIObserverService,
294                observerService);
295  try
296    observerService.NotifyObservers(nil, 'profile-before-change', 'shutdown-persist');
297  except
298    raise EGeckoProfileError.CreateRes(PResStringRec(@SProfileShutdownError));
299  end;
300end;
301
302function TProfileDirServiceProvider.GetFile(const prop: PAnsiChar; out persistent: PRBool): nsIFile;
303var
304  localFile: nsIFile;
305  domainDir: nsIFile;
306  appendStr: IInterfacedCString;
307const
308  PREFS_FILE_50_NAME =' prefs.js';
309  USER_CHROME_DIR_50_NAME = 'chrome';
310  LOCAL_STORE_FILE_50_NAME = 'localstore.rdf';
311  HISTORY_FILE_50_NAME = 'history.dat';
312  PANELS_FILE_50_NAME = 'panels.rdf';
313  MIME_TYPES_FILE_50_NAME = 'mimeTypes.rdf';
314  BOOKMARKS_FILE_50_NAME = 'bookmark.html';
315  DOWNLOADS_FILE_50_NAME = 'downloads.rdf';
316  SEARCH_FILE_50_NAME = 'search.rdf';
317  MAIL_DIR_50_NAME = 'Mail';
318  IMAP_MAIL_DIR_50_NAME = 'ImapMail';
319  NEWS_DIR_50_NAME = 'News';
320  MSG_FOLDER_CACHE_DIR_50_NAME = 'panacea.dat';
321begin
322  appendStr := NewCString;
323
324  persistent := True;
325  domainDir := FProfileDir;
326
327  if prop = NS_APP_PREFS_50_DIR then
328  begin
329    localFile := domainDir.Clone();
330  end else
331  if prop = NS_APP_PREFS_50_FILE then
332  begin
333    localFile := domainDir.Clone();
334    appendStr.Assign(PREFS_FILE_50_NAME);
335    localFile.AppendNative(appendStr.ACString);
336  end else
337  if prop = NS_APP_USER_PROFILE_50_DIR then
338  begin
339    localFile := domainDir.Clone();
340  end else
341  if prop = NS_APP_USER_CHROME_DIR then
342  begin
343    localFile := domainDir.Clone();
344    appendStr.Assign(USER_CHROME_DIR_50_NAME);
345    localFile.AppendNative(appendStr.ACString);
346  end else
347  if prop = NS_APP_LOCALSTORE_50_FILE then
348  begin
349    localFile := domainDir.Clone();
350    appendStr.Assign(LOCAL_STORE_FILE_50_NAME);
351    localFile.AppendNative(appendStr.ACString);
352    EnsureProfileFileExists(localFile, domainDir);
353  end else
354  if prop = NS_APP_HISTORY_50_FILE then
355  begin
356    localFile := domainDir.Clone();
357    appendStr.Assign(HISTORY_FILE_50_NAME);
358    localFile.AppendNative(appendStr.ACString);
359  end else
360  if prop = NS_APP_USER_PANELS_50_FILE then
361  begin
362    localFile := domainDir.Clone();
363    appendStr.Assign(PANELS_FILE_50_NAME);
364    localFile.AppendNative(appendStr.ACString);
365    EnsureProfileFileExists(localFile, domainDir);
366  end else
367  if prop = NS_APP_USER_MIMETYPES_50_FILE then
368  begin
369    localFile := domainDir.Clone();
370    appendStr.Assign(MIME_TYPES_FILE_50_NAME);
371    localFile.AppendNative(appendStr.ACString);
372    EnsureProfileFileExists(localFile, domainDir);
373  end else
374  if prop = NS_APP_BOOKMARKS_50_FILE then
375  begin
376    localFile := domainDir.Clone();
377    appendStr.Assign(BOOKMARKS_FILE_50_NAME);
378    localFile.AppendNative(appendStr.ACString);
379  end else
380  if prop = NS_APP_DOWNLOADS_50_FILE then
381  begin
382    localFile := domainDir.Clone();
383    appendStr.Assign(DOWNLOADS_FILE_50_NAME);
384    localFile.AppendNative(appendStr.ACString);
385  end else
386  if prop = NS_APP_SEARCH_50_FILE then
387  begin
388    localFile := domainDir.Clone();
389    appendStr.Assign(SEARCH_FILE_50_NAME);
390    localFile.AppendNative(appendStr.ACString);
391    EnsureProfileFileExists(localFile, domainDir);
392  end else
393  if prop = NS_APP_MAIL_50_DIR then
394  begin
395    localFile := domainDir.Clone();
396    appendStr.Assign(MAIL_DIR_50_NAME);
397    localFile.AppendNative(appendStr.ACString);
398  end else
399  if prop = NS_APP_IMAP_MAIL_50_DIR then
400  begin
401    localFile := domainDir.Clone();
402    appendStr.Assign(IMAP_MAIL_DIR_50_NAME);
403    localFile.AppendNative(appendStr.ACString);
404  end else
405  if prop = NS_APP_NEWS_50_DIR then
406  begin
407    localFile := domainDir.Clone();
408    appendStr.Assign(NEWS_DIR_50_NAME);
409    localFile.AppendNative(appendStr.ACString);
410  end else
411  if prop = NS_APP_MESSENGER_FOLDER_CACHE_50_DIR then
412  begin
413    localFile := domainDir.Clone();
414    appendStr.Assign(MSG_FOLDER_CACHE_DIR_50_NAME);
415    localFile.AppendNative(appendStr.ACString);
416  end;
417
418  if Assigned(localFile) then
419    Result := localFile as nsIFile;
420end;
421
422procedure TProfileDirServiceProvider.Initialize;
423begin
424{$IFDEF MOZ_PROFILELOCKING}
425  FProfileDir := TProfileDirServiceProvider.Create(FNotifyObservers);
426{$ENDIF}
427end;
428
429procedure TProfileDirServiceProvider.InitProfileDir(profileDir: nsIFile);
430var
431  exists: PRBool;
432  profileDefaultsDir: nsIFile;
433  profileDirParent: nsIFile;
434  profileDirName: IInterfacedCString;
435  isDir: PRBool;
436begin
437  try
438    profileDirName := NewCString;
439
440    exists := profileDir.Exists();
441
442    if not exists then
443    begin
444      profileDirParent := profileDir.Parent;
445      profileDir.GetNativeLeafName(profileDirName.ACString);
446
447      try
448        profileDefaultsDir := NS_GetSpecialDirectory(NS_APP_PROFILE_DEFAULTS_50_DIR);
449      except
450        profileDefaultsDir := NS_GetSpecialDirectory(NS_APP_PROFILE_DEFAULTS_NLOC_50_DIR);
451      end;
452      try
453        profileDefaultsDir.CopyToNative(profileDirParent, profileDirName.ACString);
454      except
455        profileDirParent.AppendNative(profileDirName.ACString);
456        profileDirParent.Create(NS_IFILE_DIRECTORY_TYPE, 7 shl 6);
457      end;
458    end else
459    begin
460      isDir := profileDir.IsDirectory();
461      if not isDir then
462        raise EGeckoProfileError.CreateRes(PResStringRec(@SNotADirectory));
463    end;
464
465    if FNonSharedDirName.Length > 0 then
466      InitNonSharedProfileDir;
467  except
468    on EGeckoError do raise
469    else raise EGeckoProfileError.CreateRes(PResStringRec(@SProfileInitError));
470  end;
471end;
472
473procedure TProfileDirServiceProvider.InitNonSharedProfileDir;
474var
475  localDir: nsIFile;
476  exists: PRBool;
477  isDir: PRBool;
478begin
479  try
480    localDir := FProfileDir.Clone();
481    localDir.Append(FNonSharedDirName.AString);
482    exists := localDir.Exists();
483    if not exists then
484    begin
485      localDir.Create(NS_IFILE_DIRECTORY_TYPE, 7 shl 6);
486    end else
487    begin
488      isDir := localDir.IsDirectory();
489      if not isDir then
490        raise EGeckoProfileError.CreateRes(PResStringRec(@SNotADirectory));
491    end;
492    FNonSharedProfileDir := localDir;
493  except
494    on EGeckoError do raise
495    else raise EGeckoProfileError.CreateRes(PResStringRec(@SProfileInitError));
496  end;
497end;
498
499procedure TProfileDirServiceProvider.EnsureProfileFileExists(aFile: nsIFile; destDir: nsIFile);
500var
501  exists: PRBool;
502  defaultsFile: nsIFile;
503  leafName: IInterfacedCString;
504begin
505  try
506    exists := aFile.Exists;
507    if exists then
508    begin
509      Exit;
510    end;
511
512    try
513      defaultsFile := NS_GetSpecialDirectory(NS_APP_PROFILE_DEFAULTS_50_DIR);
514    except
515      defaultsFile := NS_GetSpecialDirectory(NS_APP_PROFILE_DEFAULTS_NLOC_50_DIR);
516    end;
517
518    leafName := NewCString;
519
520    aFile.GetNativeLeafName(leafName.ACString);
521    defaultsFile.AppendNative(leafName.ACString);
522
523    leafName.Assign('');
524    defaultsFile.CopyToNative(destDir, leafName.ACString);
525  except
526    on EGeckoError do raise
527    else raise EGeckoProfileError.CreateRes(PResStringRec(@SEnsureProfileDirError));
528  end;
529end;
530
531procedure TProfileDirServiceProvider.UndefineFileLocations;
532var
533  directoryService : nsIProperties;
534  i: Integer;
535const
536  NUM_OF_DIRS = 15;
537  Dirs: array [1..15] of PChar = (
538    NS_APP_PREFS_50_DIR,
539    NS_APP_PREFS_50_FILE,
540    NS_APP_USER_PROFILE_50_DIR,
541    NS_APP_USER_CHROME_DIR,
542    NS_APP_LOCALSTORE_50_FILE,
543    NS_APP_HISTORY_50_FILE,
544    NS_APP_USER_PANELS_50_FILE,
545    NS_APP_USER_MIMETYPES_50_FILE,
546    NS_APP_BOOKMARKS_50_FILE,
547    NS_APP_DOWNLOADS_50_FILE,
548    NS_APP_SEARCH_50_FILE,
549    NS_APP_MAIL_50_DIR,
550    NS_APP_IMAP_MAIL_50_DIR,
551    NS_APP_NEWS_50_DIR,
552    NS_APP_MESSENGER_FOLDER_CACHE_50_DIR
553  );
554begin
555  NS_GetService(NS_DIRECTORY_SERVICE_CONTRACTID,
556                nsIProperties,
557                directoryService);
558
559  for I:=1 to NUM_OF_DIRS do
560    try
561      directoryService.Undefine(Dirs[I]);
562    except
563    end;
564end;
565
566function TProfileDirServiceProvider.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
567begin
568  Result := HResult(NS_ERROR_FAILURE);
569end;
570
571function NS_NewProfileDirServiceProvider(aNotifyObservers: PRBool): nsProfileDirServiceProvider;
572var
573  prov: TProfileDirServiceProvider;
574begin
575  prov := TProfileDirServiceProvider.Create(aNotifyObservers);
576
577  prov.Initialize;
578  Result := prov;
579  prov.FNotifyObservers := aNotifyObservers;
580end;
581
582end.
Note: See TracBrowser for help on using the browser.