home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MSI_Startup.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-20  |  10.5 KB  |  414 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {           Startup Runs Detection Part                 }
  6. {           version 5.6 for Delphi 3,4,5                }
  7. {                                                       }
  8. {       Copyright ⌐ 1997,2001 Michal Mutl               }
  9. {                                                       }
  10. {*******************************************************}
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14. unit MSI_Startup;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes;
  20.  
  21. type
  22.   TRunType = (rtHKCU, rtHKLM, rtOnce, rtUser, rtCommon, rtWinINI);
  23.  
  24.   TStartup = class(TPersistent)
  25.   private
  26.     FHKCU_Runs: TStringList;
  27.     FHKLM_Runs: TStringList;
  28.     FOnce_Runs: TStringList;
  29.     FUser_Runs: TStringList;
  30.     FCommon_Runs: TStringList;
  31.     FWININI_Runs: TStringList;
  32.  
  33.     function GetCommonRun(Index: integer): string;
  34.     function GetHKCU(Index: integer): string;
  35.     function GetHKLM(Index: integer): string;
  36.     function GetRunOnce(Index: integer): string;
  37.     function GetUserRun(Index: integer): string;
  38.     function GetCount: integer;
  39.     procedure SetCount(const Value: integer);
  40.     function GetCommonCount: integer;
  41.     function GetHKCUCount: integer;
  42.     function GetHKLMCount: integer;
  43.     function GetOnceCount: integer;
  44.     function GetUserCount: integer;
  45.     function GetWININICount: integer;
  46.     function GetWININIRun(Index: integer): string;
  47.  
  48.     procedure ClearList(var L: TStringList);
  49.   public
  50.     constructor Create;
  51.     destructor Destroy; override;
  52.     procedure GetInfo;
  53.     procedure Report(var sl :TStringList);
  54.  
  55.     property HKCU_Runs[Index: integer]: string read GetHKCU;
  56.     property HKCU_Count: integer read GetHKCUCount;
  57.     property HKLM_Runs[Index: integer]: string read GetHKLM;
  58.     property HKLM_Count: integer read GetHKLMCount;
  59.     property Once_Runs[Index: integer]: string read GetRunOnce;
  60.     property Once_Count: integer read GetOnceCount;
  61.     property User_Runs[Index: integer]: string read GetUserRun;
  62.     property User_Count: integer read GetUserCount;
  63.     property Common_Runs[Index: integer]: string read GetCommonRun;
  64.     property Common_Count: integer read GetCommonCount;
  65.     property WinINI_Runs[Index: integer]: string read GetWININIRun;
  66.     property WinINI_Count: integer read GetWININICount;
  67.  
  68.     function GetRunCommand(AType: TRunType; Index: integer): string;
  69.   published
  70.     property RunsCount: integer read GetCount write SetCount stored False;
  71.   end;
  72.  
  73.  
  74. implementation
  75.  
  76. uses Registry, MiTeC_Routines, ShlObj, INIFiles;
  77.  
  78. { TStartup }
  79.  
  80. procedure TStartup.ClearList(var L: TStringList);
  81. var
  82.   p :PChar;
  83. begin
  84.   while L.count>0 do begin
  85.    p:=PChar(L.Objects[L.count-1]);
  86.    Freemem(p);
  87.    L.Delete(L.count-1);
  88.   end;
  89. end;
  90.  
  91. constructor TStartup.Create;
  92. begin
  93.   FHKCU_Runs:=TStringList.Create;
  94.   FHKLM_Runs:=TStringList.Create;
  95.   FOnce_Runs:=TStringList.Create;
  96.   FUser_Runs:=TStringList.Create;
  97.   FCommon_Runs:=TStringList.Create;
  98.   FWININI_Runs:=TStringList.Create;
  99. end;
  100.  
  101. destructor TStartup.Destroy;
  102. begin
  103.   ClearList(FHKCU_Runs);
  104.   ClearList(FHKLM_Runs);
  105.   ClearList(FOnce_Runs);
  106.   ClearList(FUser_Runs);
  107.   ClearList(FCommon_Runs);
  108.   ClearList(FWININI_Runs);
  109.  
  110.   FHKCU_Runs.Free;
  111.   FHKLM_Runs.Free;
  112.   FOnce_Runs.Free;
  113.   FUser_Runs.Free;
  114.   FCommon_Runs.Free;
  115.   FWININI_Runs.Free;
  116.   inherited;
  117. end;
  118.  
  119. function TStartup.GetCommonCount: integer;
  120. begin
  121.   Result:=FCommon_Runs.Count;
  122. end;
  123.  
  124. function TStartup.GetCommonRun(Index: integer): string;
  125. begin
  126.   try
  127.     Result:=FCommon_Runs[Index];
  128.   except
  129.     Result:='';
  130.   end;
  131. end;
  132.  
  133. function TStartup.GetCount: integer;
  134. begin
  135.   Result:=FHKCU_Runs.Count+
  136.           FHKLM_Runs.Count+
  137.           FOnce_Runs.Count+
  138.           FUser_Runs.Count+
  139.           FCommon_Runs.Count+
  140.           FWININI_Runs.Count;
  141. end;
  142.  
  143. function TStartup.GetHKCU(Index: integer): string;
  144. begin
  145.   try
  146.     Result:=FHKCU_Runs[Index];
  147.   except
  148.     Result:='';
  149.   end;
  150. end;
  151.  
  152. function TStartup.GetHKCUCount: integer;
  153. begin
  154.   Result:=FHKCU_Runs.Count;
  155. end;
  156.  
  157. function TStartup.GetHKLM(Index: integer): string;
  158. begin
  159.   try
  160.     Result:=FHKLM_Runs[Index];
  161.   except
  162.     Result:='';
  163.   end;
  164. end;
  165.  
  166. function TStartup.GetHKLMCount: integer;
  167. begin
  168.   Result:=FHKLM_Runs.Count;
  169. end;
  170.  
  171. procedure TStartup.GetInfo;
  172. const
  173.   rk_Run = 'Software\Microsoft\Windows\CurrentVersion\Run';
  174.   rk_Once = 'Software\Microsoft\Windows\CurrentVersion\RunOnce';
  175. var
  176.   i: integer;
  177.   sl: TStringList;
  178.   s,f,a: string;
  179.   p: PChar;
  180.   WinH: HWND;
  181.   fi: TSearchRec;
  182. begin
  183.   try
  184.  
  185.   ClearList(FHKCU_Runs);
  186.   ClearList(FHKLM_Runs);
  187.   ClearList(FOnce_Runs);
  188.   ClearList(FUser_Runs);
  189.   ClearList(FCommon_Runs);
  190.   ClearList(FWININI_Runs);
  191.  
  192.   with TRegistry.Create do
  193.     try
  194.       sl:=TStringList.Create;
  195.  
  196.       sl.Clear;
  197.       RootKey:=HKEY_CURRENT_USER;
  198.       if OpenKey(rk_Run,False) then begin
  199.         GetValueNames(sl);
  200.         for i:=0 to sl.Count-1 do begin
  201.           s:=ReadString(sl[i]);
  202.           p:=AllocMem(Length(s)+1);
  203.           StrPCopy(p,s);
  204.           FHKCU_Runs.AddObject(sl[i],@p^);
  205.         end;
  206.         CloseKey;
  207.       end;
  208.  
  209.       sl.Clear;
  210.       RootKey:=HKEY_LOCAL_MACHINE;
  211.       if OpenKey(rk_Run,False) then begin
  212.         GetValueNames(sl);
  213.         for i:=0 to sl.Count-1 do begin
  214.           s:=ReadString(sl[i]);
  215.           p:=AllocMem(Length(s)+1);
  216.           StrPCopy(p,s);
  217.           FHKLM_Runs.AddObject(sl[i],@p^);
  218.         end;
  219.         CloseKey;
  220.       end;
  221.  
  222.       sl.Clear;
  223.       RootKey:=HKEY_CURRENT_USER;
  224.       if OpenKey(rk_Once,False) then begin
  225.         GetValueNames(sl);
  226.         for i:=0 to sl.Count-1 do begin
  227.           s:=ReadString(sl[i]);
  228.           p:=AllocMem(Length(s)+1);
  229.           StrPCopy(p,s);
  230.           FOnce_Runs.AddObject(sl[i],@p^);
  231.         end;
  232.         CloseKey;
  233.       end;
  234.       sl.Clear;
  235.       RootKey:=HKEY_LOCAL_MACHINE;
  236.       if OpenKey(rk_Once,False) then begin
  237.         GetValueNames(sl);
  238.         for i:=0 to sl.Count-1 do begin
  239.           s:=ReadString(sl[i]);
  240.           p:=AllocMem(Length(s)+1);
  241.           StrPCopy(p,s);
  242.           FOnce_Runs.AddObject(sl[i],@p^);
  243.         end;
  244.         CloseKey;
  245.       end;
  246.  
  247.       WinH:=GetDesktopWindow;
  248.  
  249.       s:=GetSpecialFolder(WinH,CSIDL_COMMON_STARTUP);
  250.       if (s<>'') and (s[Length(s)]='\') then
  251.         SetLength(s,Length(s)-1);
  252.       if FindFirst(s+'\*.lnk',faArchive,fi)=0 then begin
  253.         ResolveLink(s+'\'+fi.Name,f,a);
  254.         f:=f+' '+a;
  255.         p:=AllocMem(Length(f)+1);
  256.         StrPCopy(p,f);
  257.         FCommon_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  258.         while FindNext(fi)=0 do begin
  259.           ResolveLink(s+'\'+fi.Name,f,a);
  260.           f:=f+' '+a;
  261.           p:=AllocMem(Length(f)+1);
  262.           StrPCopy(p,f);
  263.           FCommon_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  264.         end;
  265.       end;
  266.  
  267.       s:=GetSpecialFolder(WinH,CSIDL_STARTUP);
  268.       if (s<>'') and (s[Length(s)]='\') then
  269.         SetLength(s,Length(s)-1);
  270.       if FindFirst(s+'\*.lnk',faArchive,fi)=0 then begin
  271.         ResolveLink(s+'\'+fi.Name,f,a);
  272.         f:=f+' '+a;
  273.         p:=AllocMem(Length(f)+1);
  274.         StrPCopy(p,f);
  275.         FUser_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  276.         while FindNext(fi)=0 do begin
  277.           ResolveLink(s+'\'+fi.Name,f,a);
  278.           f:=f+' '+a;
  279.           p:=AllocMem(Length(f)+1);
  280.           StrPCopy(p,f);
  281.           FUser_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  282.         end;
  283.       end;
  284.  
  285.       with TINIFile.Create('WIN.INI') do begin
  286.         ReadSectionValues('windows',sl);
  287.         for i:=0 to sl.Count-1 do
  288.           if (LowerCase(sl.Names[i])='run') or (LowerCase(sl.Names[i])='load') then begin
  289.             f:=TrimAll(ReadString('windows',sl.Names[i],''));
  290.             if f<>'' then begin
  291.               p:=AllocMem(Length(f)+1);
  292.               StrPCopy(p,f);
  293.               FWININI_Runs.AddObject(sl.Names[i],@p^);
  294.             end;
  295.           end;
  296.         Free;
  297.       end;
  298.  
  299.     finally
  300.       SysUtils.FindClose(fi);
  301.       if Assigned(sl) then
  302.         sl.Free;
  303.       Free;
  304.     end;
  305.  
  306.   except
  307.     on e:Exception do begin
  308.       MessageBox(0,PChar(e.message),PChar(Self.ClassName+'.GetInfo'),MB_OK or MB_ICONERROR);
  309.     end;
  310.   end;
  311. end;
  312.  
  313. function TStartup.GetOnceCount: integer;
  314. begin
  315.   Result:=FOnce_Runs.Count;
  316. end;
  317.  
  318. function TStartup.GetRunCommand(AType: TRunType; Index: integer): string;
  319. begin
  320.   try
  321.     case AType of
  322.       rtHKCU: Result:=StrPas(PChar(FHKCU_Runs.Objects[Index]));
  323.       rtHKLM: Result:=StrPas(PChar(FHKLM_Runs.Objects[Index]));
  324.       rtOnce: Result:=StrPas(PChar(FOnce_Runs.Objects[Index]));
  325.       rtUser: Result:=StrPas(PChar(FUser_Runs.Objects[Index]));
  326.       rtCommon: Result:=StrPas(PChar(FCommon_Runs.Objects[Index]));
  327.       rtWININI: Result:=StrPas(PChar(FWININI_Runs.Objects[Index]));
  328.     end;
  329.   except
  330.     Result:='';
  331.   end;
  332. end;
  333.  
  334. function TStartup.GetRunOnce(Index: integer): string;
  335. begin
  336.   try
  337.     Result:=FOnce_Runs[Index];
  338.   except
  339.     Result:='';
  340.   end;
  341. end;
  342.  
  343. function TStartup.GetUserCount: integer;
  344. begin
  345.   Result:=FUser_Runs.Count;
  346. end;
  347.  
  348. function TStartup.GetUserRun(Index: integer): string;
  349. begin
  350.   try
  351.     Result:=FUser_Runs[Index];
  352.   except
  353.     Result:='';
  354.   end;
  355. end;
  356.  
  357. function TStartup.GetWININICount: integer;
  358. begin
  359.   Result:=FWININI_Runs.Count;
  360. end;
  361.  
  362. function TStartup.GetWININIRun(Index: integer): string;
  363. begin
  364.   try
  365.     Result:=FWININI_Runs[Index];
  366.   except
  367.     Result:='';
  368.   end;
  369. end;
  370.  
  371. procedure TStartup.Report(var sl: TStringList);
  372. var
  373.   i,n: integer;
  374. begin
  375.   with sl do begin
  376.     Add('[User Startup]');
  377.     n:=User_Count;
  378.     Add(Format('Count=%d',[n]));
  379.     for i:=0 to n-1 do
  380.       Add(Format('%s=%s',[User_Runs[i],GetRunCommand(rtUser,i)]));
  381.  
  382.     Add('[Common Startup]');
  383.     n:=Common_Count;
  384.     Add(Format('Count=%d',[n]));
  385.     for i:=0 to n-1 do
  386.       Add(Format('%s=%s',[Common_Runs[i],GetRunCommand(rtCommon,i)]));
  387.  
  388.     Add('[HKLM Run]');
  389.     n:=HKLM_Count;
  390.     Add(Format('Count=%d',[n]));
  391.     for i:=0 to n-1 do
  392.       Add(Format('%s=%s',[HKLM_Runs[i],GetRunCommand(rtHKLM,i)]));
  393.  
  394.     Add('[HKCU Run]');
  395.     n:=HKCU_Count;
  396.     Add(Format('Count=%d',[n]));
  397.     for i:=0 to n-1 do
  398.       Add(Format('%s=%s',[HKCU_Runs[i],GetRunCommand(rtHKCU,i)]));
  399.  
  400.     Add('[Run Once]');
  401.     n:=Once_Count;
  402.     Add(Format('Count=%d',[n]));
  403.     for i:=0 to n-1 do
  404.       Add(Format('%s=%s',[Once_Runs[i],GetRunCommand(rtOnce,i)]));
  405.   end;
  406. end;
  407.  
  408. procedure TStartup.SetCount(const Value: integer);
  409. begin
  410.  
  411. end;
  412.  
  413. end.
  414.