/newStructBase/tangram framework/SysModuleMgr.pas

  1{ ------------------------------------
  2  ?????????
  3  ?????2010/05/11
  4  ???wzw
  5  ???wzw
  6  ------------------------------------- }
  7unit SysModuleMgr;
  8
  9interface
 10
 11uses SysUtils, Classes, Windows, Contnrs, RegIntf, SplashFormIntf,
 12  ModuleInfoIntf, SvcInfoIntf, SysModule,ModuleLoaderIntf,StrUtils,
 13  uIntfObj,ModuleInstallerIntf,SysNotifyService,NotifyServiceIntf;
 14
 15Type
 16  TGetModuleClassPro = function :TModuleClass;
 17
 18  TModuleType=(mtUnknow,mtBPL,mtDLL);
 19
 20  TTangramModule = Class(TObject)
 21  private
 22    FLoadBatch:String;
 23    FModuleHandle: HMODULE;
 24    FModuleFileName: String;
 25    FModuleObj: TModule;
 26    FModuleCls:TModuleClass;
 27    FValidModule: Boolean;
 28    function GetModuleType: TModuleType;
 29    function LoadModule:THandle;
 30    procedure UnLoadModule;
 31    function GetModuleName: String;
 32  protected
 33
 34  public
 35    Constructor Create(const mFile: String;
 36      LoadBatch:String='';CreateModuleObjInstance:Boolean=True);
 37    Destructor Destroy; override;
 38
 39    property ModuleFileName: String Read FModuleFileName;
 40    property ModuleType:TModuleType Read GetModuleType;
 41    property ModuleName:String Read GetModuleName;
 42
 43    procedure ModuleNotify(Flags: Integer; Intf: IInterface);
 44    procedure ModuleInit(const LoadBatch:String);
 45    procedure ModuleFinal;
 46
 47    procedure Install;
 48    procedure UnInstall;
 49
 50    property IsValidModule:Boolean Read FValidModule;
 51  End;
 52
 53  TModuleMgr = Class(TIntfObj, IModuleInfo,
 54    IModuleLoader,IModuleInstaller, ISvcInfoEx)
 55  private
 56    SplashForm: ISplashForm;
 57    Tick: Cardinal;
 58    FModuleList: TObjectList;
 59    FLoadBatch:String;
 60    FNotifyService:TNotifyService;
 61    procedure WriteErrFmt(const err: String; const Args: array of const );
 62    function FormatPath(const s: string): string;
 63    procedure GetModuleList(RegIntf: IRegistry; ModuleList: TStrings;
 64      const Key: String);
 65    function FindModule(const ModuleFile:string):TTangramModule;
 66  protected
 67    {IModuleLoader}
 68    procedure LoadBegin;
 69    procedure LoadModuleFromFile(const ModuleFile: string);
 70    procedure LoadModulesFromDir(const Dir:String='');
 71    procedure LoadFinish;
 72    procedure UnLoadModule(const ModuleFile:string);
 73    function ModuleLoaded(const ModuleFile:string):Boolean;
 74    { IModuleInfo }
 75    procedure GetModuleInfo(ModuleInfoGetter: IModuleInfoGetter);
 76    { ISvcInfoEx }
 77    procedure GetSvcInfo(Intf:ISvcInfoGetter);
 78    {IModuleInstaller}
 79    procedure InstallModule(const ModuleFile:String);
 80    procedure UninstallModule(const ModuleFile:string);
 81  public
 82    Constructor Create;
 83    Destructor Destroy; override;
 84
 85    procedure LoadModules;
 86    procedure Init;
 87    procedure final;
 88  end;
 89
 90implementation
 91
 92uses SysSvc, LogIntf, LoginIntf, StdVcl, AxCtrls, SysFactoryMgr,
 93     SysFactory,SysFactoryEx,IniFiles,RegObj,uSvcInfoObj,SysMsg;
 94
 95{$WARN SYMBOL_DEPRECATED OFF}
 96{$WARN SYMBOL_PLATFORM OFF}
 97
 98const
 99  Value_Module='Module';
100  Value_Load='LOAD';
101  SplashFormWaitTime=1500;
102  key_LoadModule='SYSTEM\LOADMODULE';
103
104procedure CreateRegObj(out anInstance: IInterface);
105var RegFile,IniFile,AppPath:String;
106    Ini:TIniFile;
107begin
108  AppPath:=ExtractFilePath(ParamStr(0));
109  IniFile:=AppPath+'Root.ini';
110  ini:=TIniFile.Create(IniFile);
111  try
112    RegFile:=AppPath+ini.ReadString('Default','Reg','Tangram.xml');
113    anInstance:=TRegObj.Create;
114    (anInstance as ILoadRegistryFile).LoadRegistryFile(RegFile);
115  finally
116    ini.Free;
117  end;
118end;
119
120procedure Create_SvcInfoObj(out anInstance: IInterface);
121begin
122  anInstance:=TSvcInfoObj.Create;
123end;
124
125{ TTangramModule }
126
127constructor TTangramModule.Create(const mFile: String;LoadBatch:String='';
128  CreateModuleObjInstance:Boolean=True);
129var
130  GetModuleClassPro: TGetModuleClassPro;
131begin
132  FValidModule:=False;
133  FModuleObj := nil;
134  FModuleCls :=nil;
135  FLoadBatch:=LoadBatch;
136  FModuleFileName := mFile;
137  FModuleHandle := self.LoadModule;
138  @GetModuleClassPro := GetProcAddress(FModuleHandle, 'GetModuleClass');
139  if Assigned(GetModuleClassPro) then
140  begin
141    FModuleCls:=GetModuleClassPro;
142    FValidModule:=FModuleCls<>nil;
143    if (FModuleCls<>nil) and (CreateModuleObjInstance) then
144      FModuleObj:=FModuleCls.Create;
145  end;
146end;
147
148destructor TTangramModule.Destroy;
149begin
150  if Assigned(FModuleObj) then
151    FModuleObj.Free;
152
153  self.UnLoadModule;
154  inherited;
155end;
156
157function TTangramModule.GetModuleName: String;
158begin
159  Result:=ExtractFileName(FModuleFileName);
160end;
161
162function TTangramModule.GetModuleType: TModuleType;
163var ext:String;
164begin
165  ext:=ExtractFileExt(self.FModuleFileName);
166  if SameText(ext,'.bpl') then
167    Result:=mtBPL
168  else Result:=mtDLL;
169end;
170
171function TTangramModule.LoadModule: THandle;
172begin
173  Result:=0;
174  case GetModuleType of
175    mtBPL:Result:=SysUtils.LoadPackage(self.FModuleFileName);
176    mtDLL:Result:=Windows.LoadLibrary(Pchar(self.FModuleFileName));
177  end;
178end;
179
180procedure TTangramModule.ModuleFinal;
181begin
182  if FModuleObj<>nil then
183    FModuleObj.final;
184end;
185
186procedure TTangramModule.ModuleInit(const LoadBatch: String);
187begin
188  if FModuleObj<>nil then
189  begin
190    if self.FLoadBatch=LoadBatch then
191      FModuleObj.Init;
192  end;
193end;
194
195procedure TTangramModule.Install;
196var Reg:IRegistry;
197begin
198  if FModuleCls<>nil then
199  begin
200    Reg:=SysService as IRegistry;
201    FModuleCls.RegisterModule(Reg);
202  end;
203end;
204
205procedure TTangramModule.ModuleNotify(Flags: Integer; Intf: IInterface);
206begin
207  if FModuleObj<>nil then
208    FModuleObj.Notify(Flags,Intf);
209end;
210
211procedure TTangramModule.UnInstall;
212var Reg:IRegistry;
213begin
214  if FModuleCls<>nil then
215  begin
216    Reg:=SysService as IRegistry;
217    FModuleCls.UnRegisterModule(Reg);
218  end;
219end;
220
221procedure TTangramModule.UnLoadModule;
222begin
223  case GetModuleType of
224    mtBPL:SysUtils.UnloadPackage(self.FModuleHandle);
225    mtDLL:Windows.FreeLibrary(self.FModuleHandle);
226  end;
227end;
228
229{ TModuleMgr }
230
231procedure TModuleMgr.GetSvcInfo(Intf: ISvcInfoGetter);
232var SvrInfo:TSvcInfoRec;
233begin
234  SvrInfo.ModuleName:=ExtractFileName(SysUtils.GetModuleName(HInstance));
235  SvrInfo.GUID:=GUIDToString(IModuleInfo);
236  SvrInfo.Title:='??????(IModuleInfo)';
237  SvrInfo.Version:='20100512.001';
238  SvrInfo.Comments:= '????????????????????';
239  Intf.SvcInfo(SvrInfo);
240
241  SvrInfo.GUID:=GUIDToString(IModuleLoader);
242  SvrInfo.Title:='??????(IModuleLoader)';
243  SvrInfo.Version:='20110225.001';
244  SvrInfo.Comments:= '??????????????????????????????';
245  Intf.SvcInfo(SvrInfo);
246
247  SvrInfo.GUID:=GUIDToString(IModuleInstaller);
248  SvrInfo.Title:='??????(IModuleInstaller)';
249  SvrInfo.Version:='20110420.001';
250  SvrInfo.Comments:= '?????????';
251  Intf.SvcInfo(SvrInfo);
252end;
253
254constructor TModuleMgr.Create;
255begin
256  FLoadBatch:='';
257  FModuleList := TObjectList.Create(True);
258  FNotifyService:=TNotifyService.Create;
259
260  TSingletonFactory.Create(IRegistry,@CreateRegObj);
261  TObjFactoryEx.Create([IModuleInfo,IModuleLoader,IModuleInstaller], self);
262  TIntfFactory.Create(ISvcInfoEx,@Create_SvcInfoObj);
263end;
264
265destructor TModuleMgr.Destroy;
266begin
267  FNotifyService.Free;
268  FModuleList.Free;
269  inherited;
270end;
271
272function TModuleMgr.FindModule(const ModuleFile: string): TTangramModule;
273var
274  i: Integer;
275  Module: TTangramModule;
276begin
277  Result:=nil;
278  for i := 0 to FModuleList.Count - 1 do
279  begin
280    Module := TTangramModule(FModuleList[i]);
281    if SameText(Module.ModuleFileName,ModuleFile) then
282    begin
283      Result:=Module;
284      Break;
285    end;
286  end;
287end;
288
289function TModuleMgr.FormatPath(const s: string): string;
290const
291  Var_AppPath = '($APP_PATH)';
292begin
293  Result := StringReplace(s, Var_AppPath, ExtractFilePath(Paramstr(0)),
294    [rfReplaceAll, rfIgnoreCase]);
295end;
296
297procedure TModuleMgr.GetModuleList(RegIntf: IRegistry; ModuleList: TStrings;
298  const Key: String);
299var
300  SubKeyList, ValueList, aList: TStrings;
301  i: Integer;
302  valueStr: string;
303  valueName, vStr, ModuleFile, Load: WideString;
304begin
305  SubKeyList := TStringList.Create;
306  ValueList := TStringList.Create;
307  aList := TStringList.Create;
308  try
309    RegIntf.OpenKey(Key, False);
310    // ???
311    RegIntf.GetValueNames(ValueList);
312    for i := 0 to ValueList.Count - 1 do
313    begin
314      aList.Clear;
315      valueName := ValueList[i];
316      if RegIntf.ReadString(valueName, vStr) then
317      begin
318        valueStr := AnsiUpperCase(vStr);
319        ExtractStrings([';'], [], pchar(valueStr), aList);
320        ModuleFile := FormatPath(aList.Values[Value_Module]);
321        Load := aList.Values[Value_Load];
322        if (ModuleFile <> '') and (CompareText(Load, 'TRUE') = 0) then
323          ModuleList.Add(ModuleFile);
324      end;
325    end;
326    // ????
327    RegIntf.GetKeyNames(SubKeyList);
328    for i := 0 to SubKeyList.Count - 1 do
329      GetModuleList(RegIntf, ModuleList, Key + '\' + SubKeyList[i]); // ??
330  finally
331    SubKeyList.Free;
332    ValueList.Free;
333    aList.Free;
334  end;
335end;
336
337function TModuleMgr.ModuleLoaded(const ModuleFile: string): Boolean;
338begin
339  Result:=FindModule(ModuleFile)<>nil;
340end;
341
342procedure TModuleMgr.GetModuleInfo(ModuleInfoGetter: IModuleInfoGetter);
343var
344  i: Integer;
345  Module: TTangramModule;
346  MInfo: TModuleInfo;
347begin
348  if ModuleInfoGetter = nil then
349    exit;
350  for i := 0 to FModuleList.Count - 1 do
351  begin
352    Module            := TTangramModule(FModuleList[i]);
353    MInfo.PackageName := Module.ModuleFileName;
354    MInfo.Description := GetPackageDescription(pchar(MInfo.PackageName));
355    ModuleInfoGetter.ModuleInfo(MInfo);
356  end;
357end;
358
359procedure TModuleMgr.Init;
360var
361  CurTick, UseTime,WaitTime: Cardinal;
362  LoginIntf: ILogin;
363  Module: TTangramModule;
364  i:Integer;
365begin
366  Module := nil;
367  for i := 0 to FModuleList.Count - 1 do
368  begin
369    Try
370      Module := TTangramModule(FModuleList.Items[i]);
371
372      if Assigned(SplashForm) then
373        SplashForm.loading(Format(Msg_InitingModule,[Module.ModuleName]));
374
375      Module.ModuleInit(self.FLoadBatch);
376    Except
377      on E: Exception do
378      begin
379        WriteErrFmt(Err_InitModule,[Module.ModuleName,E.Message]);
380      end;
381    End;
382  end;
383  // ??Splash??
384  if Assigned(SplashForm) then
385  begin
386    CurTick := GetTickCount;
387    UseTime := CurTick - Tick;
388    WaitTime:=SplashForm.GetWaitTime;
389    if WaitTime=0 then
390      WaitTime:=SplashFormWaitTime;
391    if UseTime < WaitTime then
392    begin
393      SplashForm.loading(Msg_WaitingLogin);
394      sleep(WaitTime - UseTime);
395    end;
396
397    SplashForm.Hide;
398    //FactoryManager.FindFactory(ISplashForm).Free;
399    SplashForm := nil;
400  end;
401  // ????
402  if SysService.QueryInterface(ILogin, LoginIntf) = S_OK then
403    LoginIntf.CheckLogin;
404end;
405
406procedure TModuleMgr.LoadModules;
407var
408  aList: TStrings;
409  i: Integer;
410  RegIntf: IRegistry;
411  ModuleFile: String;
412begin
413  aList := TStringList.Create;
414  try
415    SplashForm := nil;
416    RegIntf := SysService as IRegistry;
417    GetModuleList(RegIntf, aList, key_LoadModule);
418    for i := 0 to aList.Count - 1 do
419    begin
420      ModuleFile := aList[i];
421
422      if Assigned(SplashForm) then
423        SplashForm.loading(Format(Msg_LoadingModule,
424            [ExtractFileName(ModuleFile)]));
425      // ???
426      if FileExists(ModuleFile) then
427        LoadModuleFromFile(ModuleFile)
428      else
429        WriteErrFmt(Err_ModuleNotExists, [ModuleFile]);
430
431      // ??Falsh??
432      if SplashForm = nil then
433      begin
434        if SysService.QueryInterface(ISplashForm, SplashForm) = S_OK then
435        begin
436          Tick := GetTickCount;
437          SplashForm.Show;
438        end;
439      end;
440    end;
441  finally
442    aList.Free;
443  end;
444end;
445
446procedure TModuleMgr.LoadBegin;
447var BatchID:TGUID;
448begin
449  if CreateGUID(BatchID)=S_OK then
450    self.FLoadBatch:=GUIDToString(BatchID);
451end;
452
453procedure TModuleMgr.LoadFinish;
454begin
455  self.Init;
456end;
457
458procedure TModuleMgr.LoadModulesFromDir(const Dir: String);
459var DR: TSearchRec;
460    ZR: Integer;
461    TmpPath,FileExt,FullFileName:String;
462begin
463  if Dir='' then
464    TmpPath:=ExtractFilePath(ParamStr(0))
465  else begin
466    if RightStr(Dir,1)='\' then
467      TmpPath:=Dir
468    else tmpPath:=Dir+'\';
469  end;
470  ZR:=SysUtils.FindFirst(TmpPath+ '*.*', FaAnyfile, DR);
471  try
472    while ZR = 0 do
473    begin
474      if ((DR.Attr and FaDirectory <> FaDirectory)
475         and (DR.Attr and FaVolumeID <> FaVolumeID))
476         and (DR.Name <> '.') and (DR.Name <> '..') then
477      begin
478        FullFileName:=tmpPath+DR.Name;
479        FileExt:=ExtractFileExt(FullFileName);
480
481        if SameText(FileExt,'.dll') or
482           SameText(FileExt,'.bpl') then
483          self.LoadModuleFromFile(FullFileName);
484      end;
485      ZR := SysUtils.FindNext(DR);
486    end;//end while
487  finally
488    SysUtils.FindClose(DR);
489  end;
490end;
491
492procedure TModuleMgr.LoadModuleFromFile(const ModuleFile: string);
493var Module:TTangramModule;
494begin
495  try
496    Module:=TTangramModule.Create(ModuleFile,self.FLoadBatch);
497    if Module.IsValidModule then
498      FModuleList.Add(Module)
499    else Module.Free;
500  Except
501    on E: Exception do
502    begin
503      WriteErrFmt(Err_LoadModule, [ExtractFileName(ModuleFile), E.Message]);
504    end;
505  end;
506end;
507
508procedure TModuleMgr.UnLoadModule(const moduleFile: string);
509var Module:TTangramModule;
510begin
511  Module:=self.FindModule(ModuleFile);
512  if Module<>nil then
513    FModuleList.Remove(Module);
514end;
515
516procedure TModuleMgr.final;
517var
518  i: Integer;
519  Module: TTangramModule;
520begin
521  for i := 0 to FModuleList.Count - 1 do
522  begin
523    Module := TTangramModule(FModuleList.Items[i]);
524    try
525      Module.ModuleFinal;
526    Except
527      on E:Exception do
528        self.WriteErrFmt(Err_finalModule,[Module.ModuleName,E.Message]);
529    end;
530  end;
531
532  FactoryManager.ReleaseInstances;
533end;
534
535procedure TModuleMgr.WriteErrFmt(const err: String;
536  const Args: array of const );
537var
538  Log: ILog;
539begin
540  if SysService.QueryInterface(ILog, Log) = S_OK then
541    Log.WriteLogFmt(err, Args);
542end;
543
544procedure TModuleMgr.InstallModule(const ModuleFile: String);
545var Module:TTangramModule;
546begin
547  Module:=self.FindModule(ModuleFile);
548  if Module=nil then
549  begin
550    Module:=TTangramModule.Create(ModuleFile,'',False);
551    if Module.IsValidModule then
552      FModuleList.Add(Module)
553    else begin
554      Module.Free;
555      exit;
556    end;
557  end;
558  Module.Install;
559end;
560
561procedure TModuleMgr.UninstallModule(const ModuleFile: string);
562var Module:TTangramModule;
563begin
564  Module:=self.FindModule(ModuleFile);
565  if Module=nil then
566  begin
567    Module:=TTangramModule.Create(ModuleFile,'',False);
568    if Module.IsValidModule then
569      FModuleList.Add(Module)
570    else begin
571      Module.Free;
572      exit;
573    end;
574  end;
575  Module.UnInstall;
576end;
577
578initialization
579
580finalization
581
582end.