/newStructBase/tangram framework/SysModuleMgr.pas
Pascal | 582 lines | 525 code | 41 blank | 16 comment | 18 complexity | d5d4729041eb678d25ed861412d333c0 MD5 | raw file
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.