home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Source / MSI_Startup.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-24  |  10.4 KB  |  406 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {           Startup Runs Detection Part                 }
  6. {           version 6.0 for Delphi 5,6                  }
  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 {$IFNDEF D6PLUS} write SetCount {$ENDIF} 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.   ClearList(FHKCU_Runs);
  184.   ClearList(FHKLM_Runs);
  185.   ClearList(FOnce_Runs);
  186.   ClearList(FUser_Runs);
  187.   ClearList(FCommon_Runs);
  188.   ClearList(FWININI_Runs);
  189.  
  190.   sl:=TStringList.Create;
  191.  
  192.   with TRegistry.Create do
  193.     try
  194.       sl.Clear;
  195.       RootKey:=HKEY_CURRENT_USER;
  196.       if OpenKey(rk_Run,False) then begin
  197.         GetValueNames(sl);
  198.         for i:=0 to sl.Count-1 do begin
  199.           s:=ReadString(sl[i]);
  200.           p:=AllocMem(Length(s)+1);
  201.           StrPCopy(p,s);
  202.           FHKCU_Runs.AddObject(sl[i],@p^);
  203.         end;
  204.         CloseKey;
  205.       end;
  206.  
  207.       sl.Clear;
  208.       RootKey:=HKEY_LOCAL_MACHINE;
  209.       if OpenKey(rk_Run,False) then begin
  210.         GetValueNames(sl);
  211.         for i:=0 to sl.Count-1 do begin
  212.           s:=ReadString(sl[i]);
  213.           p:=AllocMem(Length(s)+1);
  214.           StrPCopy(p,s);
  215.           FHKLM_Runs.AddObject(sl[i],@p^);
  216.         end;
  217.         CloseKey;
  218.       end;
  219.  
  220.       sl.Clear;
  221.       RootKey:=HKEY_CURRENT_USER;
  222.       if OpenKey(rk_Once,False) then begin
  223.         GetValueNames(sl);
  224.         for i:=0 to sl.Count-1 do begin
  225.           s:=ReadString(sl[i]);
  226.           p:=AllocMem(Length(s)+1);
  227.           StrPCopy(p,s);
  228.           FOnce_Runs.AddObject(sl[i],@p^);
  229.         end;
  230.         CloseKey;
  231.       end;
  232.       sl.Clear;
  233.       RootKey:=HKEY_LOCAL_MACHINE;
  234.       if OpenKey(rk_Once,False) then begin
  235.         GetValueNames(sl);
  236.         for i:=0 to sl.Count-1 do begin
  237.           s:=ReadString(sl[i]);
  238.           p:=AllocMem(Length(s)+1);
  239.           StrPCopy(p,s);
  240.           FOnce_Runs.AddObject(sl[i],@p^);
  241.         end;
  242.         CloseKey;
  243.       end;
  244.  
  245.       WinH:=GetDesktopWindow;
  246.  
  247.       s:=GetSpecialFolder(WinH,CSIDL_COMMON_STARTUP);
  248.       if (s<>'') and (s[Length(s)]='\') then
  249.         SetLength(s,Length(s)-1);
  250.       if FindFirst(s+'\*.lnk',faArchive,fi)=0 then begin
  251.         ResolveLink(s+'\'+fi.Name,f,a);
  252.         f:=f+' '+a;
  253.         p:=AllocMem(Length(f)+1);
  254.         StrPCopy(p,f);
  255.         FCommon_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  256.         while FindNext(fi)=0 do begin
  257.           ResolveLink(s+'\'+fi.Name,f,a);
  258.           f:=f+' '+a;
  259.           p:=AllocMem(Length(f)+1);
  260.           StrPCopy(p,f);
  261.           FCommon_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  262.         end;
  263.       end;
  264.  
  265.       s:=GetSpecialFolder(WinH,CSIDL_STARTUP);
  266.       if (s<>'') and (s[Length(s)]='\') then
  267.         SetLength(s,Length(s)-1);
  268.       if FindFirst(s+'\*.lnk',faArchive,fi)=0 then begin
  269.         ResolveLink(s+'\'+fi.Name,f,a);
  270.         f:=f+' '+a;
  271.         p:=AllocMem(Length(f)+1);
  272.         StrPCopy(p,f);
  273.         FUser_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  274.         while FindNext(fi)=0 do begin
  275.           ResolveLink(s+'\'+fi.Name,f,a);
  276.           f:=f+' '+a;
  277.           p:=AllocMem(Length(f)+1);
  278.           StrPCopy(p,f);
  279.           FUser_Runs.AddObject(Copy(fi.Name,1,Length(fi.Name)-4),@p^);
  280.         end;
  281.       end;
  282.  
  283.       with TINIFile.Create('WIN.INI') do begin
  284.         ReadSectionValues('windows',sl);
  285.         for i:=0 to sl.Count-1 do
  286.           if (LowerCase(sl.Names[i])='run') or (LowerCase(sl.Names[i])='load') then begin
  287.             f:=TrimAll(ReadString('windows',sl.Names[i],''));
  288.             if f<>'' then begin
  289.               p:=AllocMem(Length(f)+1);
  290.               StrPCopy(p,f);
  291.               FWININI_Runs.AddObject(sl.Names[i],@p^);
  292.             end;
  293.           end;
  294.         Free;
  295.       end;
  296.  
  297.     finally
  298.       SysUtils.FindClose(fi);
  299.       if Assigned(sl) then
  300.         sl.Free;
  301.       Free;
  302.     end;
  303. end;
  304.  
  305. function TStartup.GetOnceCount: integer;
  306. begin
  307.   Result:=FOnce_Runs.Count;
  308. end;
  309.  
  310. function TStartup.GetRunCommand(AType: TRunType; Index: integer): string;
  311. begin
  312.   try
  313.     case AType of
  314.       rtHKCU: Result:=StrPas(PChar(FHKCU_Runs.Objects[Index]));
  315.       rtHKLM: Result:=StrPas(PChar(FHKLM_Runs.Objects[Index]));
  316.       rtOnce: Result:=StrPas(PChar(FOnce_Runs.Objects[Index]));
  317.       rtUser: Result:=StrPas(PChar(FUser_Runs.Objects[Index]));
  318.       rtCommon: Result:=StrPas(PChar(FCommon_Runs.Objects[Index]));
  319.       rtWININI: Result:=StrPas(PChar(FWININI_Runs.Objects[Index]));
  320.     end;
  321.   except
  322.     Result:='';
  323.   end;
  324. end;
  325.  
  326. function TStartup.GetRunOnce(Index: integer): string;
  327. begin
  328.   try
  329.     Result:=FOnce_Runs[Index];
  330.   except
  331.     Result:='';
  332.   end;
  333. end;
  334.  
  335. function TStartup.GetUserCount: integer;
  336. begin
  337.   Result:=FUser_Runs.Count;
  338. end;
  339.  
  340. function TStartup.GetUserRun(Index: integer): string;
  341. begin
  342.   try
  343.     Result:=FUser_Runs[Index];
  344.   except
  345.     Result:='';
  346.   end;
  347. end;
  348.  
  349. function TStartup.GetWININICount: integer;
  350. begin
  351.   Result:=FWININI_Runs.Count;
  352. end;
  353.  
  354. function TStartup.GetWININIRun(Index: integer): string;
  355. begin
  356.   try
  357.     Result:=FWININI_Runs[Index];
  358.   except
  359.     Result:='';
  360.   end;
  361. end;
  362.  
  363. procedure TStartup.Report(var sl: TStringList);
  364. var
  365.   i,n: integer;
  366. begin
  367.   with sl do begin
  368.     Add('[User Startup]');
  369.     n:=User_Count;
  370.     Add(Format('Count=%d',[n]));
  371.     for i:=0 to n-1 do
  372.       Add(Format('%s=%s',[User_Runs[i],GetRunCommand(rtUser,i)]));
  373.  
  374.     Add('[Common Startup]');
  375.     n:=Common_Count;
  376.     Add(Format('Count=%d',[n]));
  377.     for i:=0 to n-1 do
  378.       Add(Format('%s=%s',[Common_Runs[i],GetRunCommand(rtCommon,i)]));
  379.  
  380.     Add('[HKLM Run]');
  381.     n:=HKLM_Count;
  382.     Add(Format('Count=%d',[n]));
  383.     for i:=0 to n-1 do
  384.       Add(Format('%s=%s',[HKLM_Runs[i],GetRunCommand(rtHKLM,i)]));
  385.  
  386.     Add('[HKCU Run]');
  387.     n:=HKCU_Count;
  388.     Add(Format('Count=%d',[n]));
  389.     for i:=0 to n-1 do
  390.       Add(Format('%s=%s',[HKCU_Runs[i],GetRunCommand(rtHKCU,i)]));
  391.  
  392.     Add('[Run Once]');
  393.     n:=Once_Count;
  394.     Add(Format('Count=%d',[n]));
  395.     for i:=0 to n-1 do
  396.       Add(Format('%s=%s',[Once_Runs[i],GetRunCommand(rtOnce,i)]));
  397.   end;
  398. end;
  399.  
  400. procedure TStartup.SetCount(const Value: integer);
  401. begin
  402.  
  403. end;
  404.  
  405. end.
  406.