主要代码如下：
1 {*******************************************************}
2 { }
3 { UWSStartupItemPanel }
4 { Mail:uws2008@hotmail.com }
5 { 版权所有 (C) 2009 Unruly Wolf Soft }
6 { }
7 { 版本：0.1.0.8 }
8 { }
9 { 创建日期：2009年11月5日 }
10 { }
11 { 功能： }
12 { 1、启动项管理（完成度99%） }
13 { 2、软件卸载（完成度80%） }
14 {*******************************************************}
15
16 {********************************************************}
17 { 版本升级记录： }
18 { 2009年10月20日：构思控件 }
19 { 2009年10月22日：开始设计控件 }
20 { 2009年10月23日：改进数项功能设计 修复Bug }
21 { 2009年10月24日：0.1.0.0版完成，实现启动项基本管理功能：}
22 { 1、启动项查看 }
23 { 2、删除 }
24 { 3、禁止使用 }
25 { 4、编辑 }
26 { 5、新增启动项 }
27 { 2009年10月27日：完成TUWSUnInstallPanel 组件开发 }
28 { 2009年11月1日：为TUWSStartPanel增加两个事件： }
29 { BeforReload AfterReload }
30 { 2009年11月2日：TUWSUninstallPanel.DelReg完成 }
31 {********************************************************}
32
33 unit UWSStartItemPanel;
34
35 interface
36
37 uses
38 SysUtils, Classes, Controls, ExtCtrls,Graphics,StdCtrls,Forms,
39 StartupItemEditor,ShellAPI,Messages,Registry,Windows,Dialogs,
40 StrUtils,U_ViewCMDInfos;
41
42 const
43 KeyRun= '\SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
44 KUninstallRegPath = 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
45 KUninstallString = 'UninstallString';
46 KDisplayName = 'DisplayName';
47 KDisplayVersion='DisplayVersion';
48 KInstallDate='InstallDate';
49 KInstallLocation='InstallLocation';
50 KModifyPath='ModifyPath';
51 KPublisher='Publisher';
52 KURLInfoAbout='URLInfoAbout';
53 KDisplayIcon='DisplayIcon';
54 KQuietUninstallString='QuietUninstallString';
55 KISAP='Inno Setup: App Path';
56
57 {TUWSStartupItem}
58
59 type
60 TUWSStartupItem = class(TPanel)
61 private
62 { Private declarations }
63 BtnDel:TButton;
64 BtnForbidden:TButton;
65 BtnEdit:TButton ;
66 BtnViewCMDInfo:TButton ;
67 LabelCaption:TLabel ;
68 ImageIcon:TImage;
69 RealCommandLine:string;
70 FStartItemCaption:String;
71 FCmdLine:String;
72 FStartItemPostion:string;
73 FItemIndex:Integer ;
74 Forbiddened:Boolean ;
75 procedure UpateItem;
76 procedure BuildItemPropeties;
77 procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
78 procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
79 protected
80 { Protected declarations }
81 procedure DsItem;
82 public
83 { Public declarations }
84 constructor Create(AOwner: TComponent); override;
85 destructor Destroy; override;
86 property CmdLine:string read FCmdLine write FCmdLine;
87 property StartItemPostion :string read FStartItemPostion write FStartItemPostion;
88 procedure DelStartupItem;
89 procedure ForbiddenStartupItem;
90 procedure EditStartupItem;
91 procedure ViewCMDLineInfo;
92 procedure SetupStartupItem(ItemCaption,ItemCmd,ItemPostion:string);
93 property StartItemCapTion: string read FStartItemCaption write FStartItemCaption;
94 property ItemIndex:integer read FItemIndex write FItemIndex;
95 published
96 { Published declarations }
97 end;
98
99 {TUWSUnInstallItem}
100
101 TUWSUnInstallItem = class(TPanel)
102 private
103 { Private declarations }
104 BtnStandardUnInstall:TButton ;
105 BtnDelRegString:TButton ;
106 BtnForceUnInstall:TButton ;
107 BtnModify:TButton ;
108 BtnQuitUnInstall:TButton ;
109 IconImage:TImage ;
110 FInstallPath:String;
111 FUnInstallCmd:String;
112 FDisplayName:String;
113 FInstallLocation:String;
114 FQuietUninstallCmd:String;
115 FModifyPath:string;
116 FRegKeyName:string;
117 FIsWindowsUpData:Boolean ;
118 procedure SetupItemPropeties;
119 procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
120 procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
121 protected
122 { Protected declarations }
123 public
124 { Public declarations }
125 constructor Create(AOwner: TComponent); override;
126 destructor Destroy; override;
127 property InstallPath : string read FInstallPath write FInstallPath;
128 property UnInstallCmd : string read FUnInstallCmd write FUnInstallCmd;
129 property DisplayName : string read FDisplayName write FDisplayName;
130 property IsWindowsUpdata : Boolean read FIsWindowsUpdata write FIsWindowsUpdata;
131 property RegKeyName : string read FRegKeyName write FRegKeyName;
132 property InstallLocation : string read FInstallLocation write FInstallLocation;
133 property QuietUninstallCmd : string read FQuietUninstallCmd write FQuietUninstallCmd;
134 property ModifyPath : string read FModifyPath write FModifyPath;
135 published
136 { Published declarations }
137 procedure DoStandardUnInstall;
138 procedure DoDelUnInstallRegInfo;
139 procedure DoUnInstallAndClearn;
140 procedure DoModify;
141 procedure DoQuietUninstall;
142 end;
143
144 {TUWSStartItemPanel}
145
146 TUWSStartItemPanel = class(TScrollBox)
147 private
148 { Private declarations }
149 ItemList:TStringList;
150 WatchTime:TTimer;
151 ItemChangedTime:TTimer;
152 FMyWatchTime:Cardinal;
153 FAllowautorefresh:Boolean ;
154 FBeforeReload:TNotifyEvent;
155 FAfterReload:TNotifyEvent;
156 function GetItemCount:Integer ;
157 function FindAndBuildStartup(const ADirectoryName: string;SubDirs: TStrings): Boolean;
158 function SearchStartup(const ADirectoryName: string): Boolean;
159 procedure WatchItemOnWatch(Sender:TObject);
160 procedure ItemChangedTimer(Sender:TObject);
161 procedure DelItem(Sender:TObject);
162 procedure EditItem(Sender:TObject);
163 procedure BtnViewInfoClick(Sender:TObject);
164 procedure ForbiddenItem(Sender:TObject);
165 procedure SetWatchTime(aValue:Cardinal);
166 procedure SetAllowautorefresh(aValue:Boolean);
167 protected
168 { Protected declarations }
169 public
170 { Public declarations }
171 constructor Create(AOwner: TComponent); override;
172 destructor Destroy; override;
173 procedure LoadAllStartup;
174 procedure DestroyAllStartupItem;
175 procedure AddNewItem;
176 procedure ReLoadStartItems;
177 procedure MakeForbiddenItemDir;
178 property ItemCount : Integer read GetItemCount;
179 published
180 { Published declarations }
181 property MyWatchTime:Cardinal read FMyWatchTime write SetWatchTime;
182 property Allowautorefresh:Boolean read FAllowautorefresh write SetAllowautorefresh;
183 property BeforeReload : TNotifyEvent read FBeforeReload write FBeforeReload;
184 property AfterReload : TNotifyEvent read FAfterReload write FAfterReload;
185 end;
186
187 {TUWSUnInstallPanel}
188
189 TUWSUnInstallPanel = class(TScrollBox)
190 private
191 { Private declarations }
192 ItemList:TStringList;
193 FShowWinUPs:Boolean ;
194 FShowItemHint:Boolean ;
195 procedure StandardUnInstall(Sender:TObject);
196 procedure UnInstallAndClearn(Sender:TObject);
197 procedure DelReg(Sender:TObject);
198 procedure ModifyInstall(Sender:TObject);
199 procedure StaticUnInstall(Sender:TObject);
200 protected
201 { Protected declarations }
202 public
203 { Public declarations }
204 constructor Create(AOwner: TComponent); override;
205 destructor Destroy; override;
206 procedure LoadAllUnInstallInfos(ShowWinUP:Boolean);
207 procedure ReLoadUnInstallInfos;
208 procedure DestroyUnInstallInfos;
209 procedure SetWinUPVisable;
210 procedure SetShowItemHint;
211 published
212 { Published declarations }
213 property ShowWinUPs : Boolean read FShowWinUPs write FShowWinUPs;
214 property ShowItemHint : Boolean read FShowItemHint write FShowItemHint;
215 end;
216
217 procedure Register;
218
219 implementation
220
221 procedure Register;
222 begin
223 RegisterComponents('uws Used', [TUWSStartItemPanel,TUWSUnInstallPanel]);
224 end;
225
226 {UWSStartupItem}
227
228 procedure TUWSStartupItem.DelStartupItem ;
229 var
230 Reg:TRegistry;
231 RunItemName,RunItemDir,RunItemFile:string;
232 begin
233 begin
234 RunItemName:=FStartItemCaption;
235 RunItemDir:=FStartItemPostion;
236 RunItemFile:=FCmdLine;
237 if DirectoryExists(RunItemDir) then
238 begin
239 if not DeleteFile(PChar(RunItemFile)) then
240 Application.MessageBox(pchar(Format('删除%s失败！！',[RunItemName])), PChar(Application.Title),
241 MB_OK + MB_ICONSTOP + MB_TOPMOST);
242 end
243 else
244 begin
245 Reg:=TRegistry.Create ;
246 if Pos('HKEY_LOCAL_MACHINE',RunItemDir)>0 then
247 Reg.RootKey:=HKEY_LOCAL_MACHINE
248 else
249 Reg.RootKey:=HKEY_CURRENT_USER;
250 begin
251 if Reg.OpenKey(KeyRun,False) then
252 begin
253 if not Reg.DeleteValue(RunItemName)then
254 Application.MessageBox(pchar(Format('删除%s失败！！',[RunItemName])), PChar(Application.Title),
255 MB_OK + MB_ICONSTOP + MB_TOPMOST);
256 end;
257 end;
258 Reg.CloseKey ;
259 Reg.Free ;
260 end;
261 end;
262 end;
263
264 procedure TUWSStartupItem.ForbiddenStartupItem;
265 var
266 Reg:TRegistry;
267 RealCMDLine:string;
268 begin
269 if DirectoryExists(FStartItemPostion) then
270 begin
271 if LowerCase(FStartItemPostion)=LowerCase(GetStartupFolder) then
272 begin
273 CopyFile(PChar(FCmdLine),
274 PChar(ExtractFileDir(Application.ExeName)+'\fss\1\'+ExtractFileName(FCmdLine)),
275 False);
276 DeleteFile(PChar(FCmdLine));
277 end
278 else if LowerCase(FStartItemPostion)=LowerCase(GetCommonStartupFolder) then
279 begin
280 CopyFile(PChar(FCmdLine),
281 PChar(ExtractFileDir(Application.ExeName)+'\fss\2\'+ExtractFileName(FCmdLine)),
282 False);
283 DeleteFile(PChar(FCmdLine));
284 end
285 else if LowerCase(FStartItemPostion)=LowerCase(ExtractFileDir(Application.ExeName)+'\fss\1') then
286 begin
287 CopyFile(PChar(FCmdLine),
288 PChar(GetStartupFolder+'\'+ExtractFileName(FCmdLine)),
289 False);
290 DeleteFile(PChar(FCmdLine));
291 end
292 else
293 begin
294 CopyFile(PChar(FCmdLine),
295 PChar(GetcommonStartupFolder+'\'+ExtractFileName(FCmdLine)),
296 False);
297 DeleteFile(PChar(FCmdLine));
298 end;
299 end
300 else
301 begin
302 Reg:=TRegistry.Create ;
303 if Pos('HKEY_LOCAL_MACHINE',FStartItemPostion)>0 then
304 Reg.RootKey:=HKEY_LOCAL_MACHINE
305 else
306 Reg.RootKey:=HKEY_CURRENT_USER;
307 if Pos(';',FCmdLine)=1 then
308 RealCMDLine:=StringReplace(FCmdLine,';','',[])
309 else
310 RealCMDLine:=';'+FCmdLine;
311 if Reg.OpenKey(KeyRun,False) then
312 Reg.WriteString(FStartItemCaption,RealCMDLine);
313 Reg.CloseKey ;
314 Reg.Free ;
315 end;
316 end;
317
318 procedure TUWSStartupItem.EditStartupItem;
319 begin
320 EditRunItem(FStartItemCaption,FCmdLine,FStartItemPostion);
321 end;
322
323 procedure TUWSStartupItem.ViewCMDLineInfo;
324 var
325 Infos,VersionInfo:TStringList;
326 FS:Double ;
327 begin
328 if RealCommandLine='' then Exit ;
329 if not FileExists(RealCommandLine) then
330 begin
331 Application.MessageBox('抱歉，找不到对应文件！！！',
332 PChar(Application.Title), MB_OK + MB_ICONSTOP + MB_TOPMOST);
333 Exit ;
334 end;
335 Infos:=TStringList.Create ;
336 Infos.Add('命令行:'+FCmdLine);
337 Infos.Add('对应文件:'+realcommandLine);
338 FS:=FileSizeByName(realcommandLine)/1048576;
339 if FS<1 then
340 Infos.Add('文件大小：'+FormatFloat('.###',FS*1024)+' KB')
341 else
342 Infos.Add('文件大小：'+FormatFloat('.###',FS)+' MB');
343 VersionInfo:=TStringList.Create ;
344 GetExeFileVersions(VersionInfo,RealCommandLine,False);
345 Infos.AddStrings(VersionInfo);
346 ViewCommandLineInfo(Infos,ImageIcon.Picture.Icon);
347 Infos.Free ;
348 VersionInfo.Free ;
349 end;
350
351 procedure TUWSStartupItem.DsItem;
352 begin
353 BtnDel.Free;
354 BtnForbidden.Free ;
355 BtnEdit.Free ;
356 BtnViewCMDInfo.Free ;
357 LabelCaption.Free ;
358 ImageIcon.Free ;
359 end;
360
361 procedure TUWSStartupItem.UpateItem;
362 begin
363 LabelCaption.Caption:=FStartItemCaption ;
364 LabelCaption.AutoSize:=True ;
365 end;
366
367 procedure TUWSStartupItem.BuildItemPropeties;
368 var
369 RealCMDLine:string;
370 ExePos:Integer;
371 IconIndex:Word ;
372 begin
373 ImageIcon:=TImage.Create(Self);
374 ImageIcon.Parent:=Self ;
375 ImageIcon.Align:=alLeft ;
376 ImageIcon.Width:=32;
377 RealCMDLine:=LowerCase(FCmdLine) ;
378 RealCMDLine:=StringReplace(RealCMDLine,'"','',[rfReplaceAll, rfIgnoreCase]);
379 RealCMDLine:=StringReplace(RealCMDLine,'"','',[rfReplaceAll, rfIgnoreCase]);
380 RealCMDLine:=StringReplace(RealCMDLine,';','',[]);
381 ExePos:=Pos('.exe',RealCMDLine);
382 if ExePos>0 then
383 begin
384 if RightStr(RealCMDLine,4)<>'.exe' then
385 RealCMDLine:=LeftStr(RealCMDLine,ExePos+3);
386 ImageIcon.Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(RealCMDLine),0);
387 end
388 else
389 begin
390 ExePos:=Pos('.lnk',RealCMDLine);
391 if ExePos>0 then
392 begin
393 if(RightStr(RealCMDLine,4)<>'.lnk') then
394 RealCMDLine:=LeftStr(RealCMDLine,ExePos+3);
395 RealCMDLine:=ResolveLink(RealCMDLine);
396 if Pos('.exe',RealCMDLine)>0 then
397 ImageIcon.Picture.Icon.Handle:=ExtractIcon(HInstance,
398 PChar(RealCMDLine),0)
399 else
400 ImageIcon.Picture.Icon.Handle:=ExtractAssociatedIcon(HInstance,
401 PChar(RealCMDLine),IconIndex);
402 end
403 else
404 begin
405 ImageIcon.Picture.Icon.Handle:=ExtractAssociatedIcon(HInstance,
406 PChar(RealCMDLine),IconIndex);
407 end;
408 end;
409 RealCommandLine:=RealCMDLine;
410 LabelCaption:=TLabel.Create(Self);
411 LabelCaption.Parent:=Self;
412 LabelCaption.Align:=alLeft ;
413 LabelCaption.Width:=800;
414 UpateItem ;
415 BtnDel:=TButton.Create(Self);
416 BtnDel.Parent:=Self;
417 BtnDel.Height:=26;
418 BtnDel.Width:=60;
419 BtnDel.Top:=3;
420 BtnDel.Anchors:=[akTop,akRight];
421 BtnDel.Caption:='删除';
422 BtnDel.Left:=Self.Width-65;
423 BtnDel.Hint:='删除该启动项';
424 BtnDel.ShowHint:=True ;
425 BtnForbidden:=TButton.Create(Self);
426 BtnForbidden.Parent:=Self;
427 BtnForbidden.Height:=26;
428 BtnForbidden.Width:=60;
429 BtnForbidden.Top:=3;
430 BtnForbidden.Anchors:=[akTop,akRight];
431 BtnForbidden.Caption:='禁用';
432 BtnForbidden.Left:=Self.Width-126;
433 BtnForbidden.Hint:='禁用/激活该启动项，禁用后可以恢复';
434 BtnForbidden.ShowHint:=True ;
435 BtnEdit:=TButton.Create(Self);
436 BtnEdit.Parent:=Self;
437 BtnEdit.Height:=26;
438 BtnEdit.Width:=60;
439 BtnEdit.Top:=3;
440 BtnEdit.Anchors:=[akTop,akRight];
441 BtnEdit.Caption:='编辑';
442 BtnEdit.Left:=Self.Width-187;
443 BtnEdit.Hint:='点击对该启动项进行编辑';
444 BtnEdit.ShowHint:=True ;
445 BtnViewCMDInfo:=TButton.Create(Self);
446 BtnViewCMDInfo.Parent:=Self;
447 BtnViewCMDInfo.Height:=26;
448 BtnViewCMDInfo.Width:=60;
449 BtnViewCMDInfo.Top:=3;
450 BtnViewCMDInfo.Anchors:=[akTop,akRight];
451 BtnViewCMDInfo.Caption:='信息';
452 BtnViewCMDInfo.Left:=Self.Width-248;
453 BtnViewCMDInfo.Hint:='点击查看启动文件相关信息';
454 BtnViewCMDInfo.ShowHint:=True ;
455 ImageIcon.Left:=0;
456 BtnForbidden.Hide;
457 BtnEdit.Hide ;
458 BtnDel.Hide;
459 BtnViewCMDInfo.Hide ;
460 Refresh ;
461 end;
462
463 procedure TUWSStartupItem.SetupStartupItem(ItemCaption,ItemCmd,ItemPostion:string);
464 begin
465 FStartItemCaption:=ItemCaption;
466 FCmdLine:=ItemCmd ;
467 FStartItemPostion:=ItemPostion ;
468 ShowHint:=True;
469 BuildItemPropeties;
470 if DirectoryExists(ItemPostion) then
471 begin
472 if (LowerCase(ItemPostion)=LowerCase(GetStartupFolder)) or
473 (LowerCase(ItemPostion)=LowerCase(GetCommonStartupFolder)) then
474 begin
475 BtnForbidden.Caption:='禁止';
476 BtnForbidden.Hint:='禁止使用该启动项';
477 LabelCaption.Font.Color:=clBlue;
478 Hint:='名 称：'+ItemCaption+#13+#13+'命令行：'+ItemCmd+#13+#13+'位 置：'+ItemPostion;
479 Forbiddened:=False ;
480 end
481 else
482 begin
483 BtnForbidden.Caption:='恢复';
484 BtnForbidden.Hint:='恢复使用该启动项';
485 LabelCaption.Font.Color:=clRed;
486 Hint:='名 称：'+ItemCaption+#13+#13+'已被禁用';
487 Forbiddened:=True;
488 end;
489 end
490 else
491 begin
492 if Pos(';',ItemCmd)=1 then
493 begin
494 BtnForbidden.Caption:='恢复';
495 BtnForbidden.Hint:='恢复使用该启动项';
496 LabelCaption.Font.Color:=clRed;
497 Hint:='名 称：'+ItemCaption+#13+#13+'已被禁用';
498 Forbiddened:=True ;
499 end
500 else
501 begin
502 BtnForbidden.Caption:='禁止';
503 BtnForbidden.Hint:='禁止使用该启动项';
504 LabelCaption.Font.Color:=clBlue;
505 Hint:='名 称：'+ItemCaption+#13+#13+'命令行：'+ItemCmd+#13+#13+'位 置：'+ItemPostion;
506 Forbiddened:=False ;
507 end;
508 end;
509 LabelCaption.Font.Size:=14;
510 LabelCaption.Width:=1000;
511 LabelCaption.AutoSize:=True ;
512 Refresh;
513 end;
514
515 procedure TUWSStartupItem.CMMouseEnter(var Message: TMessage);
516 begin
517 inherited;
518 BtnForbidden.Show ;
519 BtnDel.Show ;
520 BtnViewCMDInfo.Show;
521 if not Forbiddened then
522 begin
523 BtnEdit.Show ;
524 end;
525 end;
526
527 procedure TUWSStartupItem.CMMouseLeave(var Message: TMessage);
528 begin
529 inherited;
530 BtnForbidden.Hide;
531 BtnEdit.Hide ;
532 BtnDel.Hide;
533 BtnViewCMDInfo.Hide ;
534 end;
535
536 constructor TUWSStartupItem.Create(AOwner: TComponent);
537 begin
538 inherited Create(AOwner);
539 ParentBackground:=True;
540 Align:=alTop;
541 Height:=33;
542 Caption:='';
543 ShowHint:=True ;
544 end;
545
546 destructor TUWSStartupItem.Destroy;
547 begin
548 DsItem ;
549 inherited Destroy;
550 end;
551
552 {TUWSUnInstallItem}
553
554 procedure TUWSUnInstallItem.SetupItemPropeties;
555 begin
556 IconImage:=TImage.Create(Self);
557 IconImage.Parent:=Self ;
558 IconImage.Align:=alLeft ;
559 IconImage.Left:=0;
560 IconImage.Width:=32;
561 IconImage.Height:=32;
562 BtnStandardUnInstall:=TButton.Create(Self);
563 BtnStandardUnInstall.Parent:=Self;
564 BtnStandardUnInstall.Height:=26;
565 BtnStandardUnInstall.Width:=75;
566 BtnStandardUnInstall.Top:=3;
567 BtnStandardUnInstall.Anchors:=[akTop,akRight];
568 BtnStandardUnInstall.Caption:='标准卸载';
569 BtnStandardUnInstall.Left:=Self.Width-81;
570 BtnStandardUnInstall.Hint:='点击进行标准卸载';
571 BtnStandardUnInstall.ShowHint:=True ;
572 BtnDelRegString:=TButton.Create(Self);
573 BtnDelRegString.Parent:=Self;
574 BtnDelRegString.Height:=26;
575 BtnDelRegString.Width:=110;
576 BtnDelRegString.Top:=3;
577 BtnDelRegString.Anchors:=[akTop,akRight];
578 BtnDelRegString.Caption:='删除安装信息';
579 BtnDelRegString.Left:=Self.Width-192;
580 BtnDelRegString.Hint:='点击删除注册表安装信息，但不进行卸载';
581 BtnDelRegString.ShowHint:=True ;
582 BtnForceUnInstall:=TButton.Create(Self);
583 BtnForceUnInstall.Parent:=Self;
584 BtnForceUnInstall.Height:=26;
585 BtnForceUnInstall.Width:=75;
586 BtnForceUnInstall.Top:=3;
587 BtnForceUnInstall.Anchors:=[akTop,akRight];
588 BtnForceUnInstall.Caption:='清理卸载';
589 BtnForceUnInstall.Left:=Self.Width-268;
590 BtnForceUnInstall.Hint:='先进性标准卸载，然后进行相关清理';
591 BtnForceUnInstall.ShowHint:=True ;
592 BtnModify:=TButton.Create(Self);
593 BtnModify.Parent:=Self;
594 BtnModify.Height:=26;
595 BtnModify.Width:=42;
596 BtnModify.Top:=3;
597 BtnModify.Anchors:=[akTop,akRight];
598 BtnModify.Caption:='修改';
599 BtnModify.Left:=Self.Width-311;
600 BtnModify.Hint:='修改';
601 BtnModify.ShowHint:=True ;
602 BtnQuitUnInstall:=TButton.Create(Self);
603 BtnQuitUnInstall.Parent:=Self;
604 BtnQuitUnInstall.Height:=26;
605 BtnQuitUnInstall.Width:=42;
606 BtnQuitUnInstall.Top:=3;
607 BtnQuitUnInstall.Anchors:=[akTop,akRight];
608 BtnQuitUnInstall.Caption:='静卸';
609 BtnQuitUnInstall.Left:=Self.Width-355;
610 BtnQuitUnInstall.Hint:='静态卸载';
611 BtnQuitUnInstall.ShowHint:=True ;
612 BtnStandardUnInstall.Hide;
613 BtnDelRegString.Hide ;
614 BtnForceUnInstall.Hide ;
615 BtnModify.Hide ;
616 BtnQuitUnInstall.Hide ;
617 end;
618
619 procedure TUWSUnInstallItem.CMMouseEnter(var Message: TMessage);
620 begin
621 BtnStandardUnInstall.Visible:=FUnInstallCmd<>'';
622 BtnDelRegString.Show ;
623 BtnForceUnInstall.Visible:=FUnInstallCmd<>'';
624 BtnModify.Visible:=FModifyPath<>'';
625 BtnQuitUnInstall.Visible:=FQuietUninstallCmd<>'';
626 end;
627
628 procedure TUWSUnInstallItem.CMMouseLeave(var Message: TMessage);
629 begin
630 {$IF DELPHI12_UP}
631 Exit;
632 {$IFEND}
633 BtnStandardUnInstall.Hide ;
634 BtnDelRegString.Hide ;
635 BtnForceUnInstall.Hide ;
636 BtnModify.Hide ;
637 BtnQuitUnInstall.Hide ;
638 end;
639
640 procedure TUWSUnInstallItem.DoStandardUnInstall ;
641 begin
642 WinExec(PAnsiChar(FUnInstallCmd),SW_SHOWNORMAL);
643 end;
644
645 procedure TUWSUnInstallItem.DoDelUnInstallRegInfo ;
646 var
647 Reg:TRegistry ;
648 begin
649 if FRegKeyName='' then Exit ;
650 Reg:=TRegistry.Create ;
651 Reg.RootKey:=HKEY_LOCAL_MACHINE ;
652 if Reg.OpenKey(KUninstallRegPath,False) then
653 begin
654 if Reg.DeleteKey(FRegKeyName) then
655 Application.MessageBox('删除成功。', PChar(Application.Title), MB_OK +
656 MB_ICONINFORMATION + MB_TOPMOST)
657 else
658 Application.MessageBox('删除失败。', PChar(Application.Title), MB_OK +
659 MB_ICONSTOP + MB_TOPMOST);
660 end;
661 Reg.CloseKey ;
662 Reg.Free ;
663 end;
664
665 procedure TUWSUnInstallItem.DoUnInstallAndClearn ;
666 begin
667
668 end;
669
670 procedure TUWSUnInstallItem.DoModify;
671 begin
672 if FModifyPath<>'' then
673 WinExec(PAnsiChar(FModifyPath),SW_SHOWNORMAL);
674 end;
675
676
677 procedure TUWSUnInstallItem.DoQuietUninstall;
678 begin
679 if FQuietUninstallCmd<>'' then
680 WinExec(PAnsiChar(FQuietUninstallCmd),SW_SHOWNORMAL);
681 end;
682
683 constructor TUWSUnInstallItem.Create(AOwner: TComponent);
684 begin
685 inherited Create(AOwner);
686 ParentBackground:=True;
687 Align:=alTop;
688 Height:=33;
689 Caption:='';
690 ShowHint:=True ;
691 Alignment:=taLeftJustify;
692 end;
693
694 destructor TUWSUnInstallItem.Destroy;
695 begin
696 BtnStandardUnInstall.Free ;
697 BtnDelRegString.Free;
698 BtnForceUnInstall.Free ;
699 IconImage.Free ;
700 BtnModify.Free ;
701 BtnQuitUnInstall.Free ;
702 inherited Destroy;
703 end;
704
705 {TUWSStartItemPanel}
706
707 procedure TUWSStartItemPanel.LoadAllStartup;
708 var
709 Reg:TRegistry;
710 RunNames:TStringList;
711 I,Idx:Integer;
712 Item:TUWSStartupItem ;
713 begin
714 Reg :=TRegistry.Create ;
715 RunNames:=TStringList.Create ;
716 Reg.RootKey:=HKEY_LOCAL_MACHINE;
717 if Reg.OpenKey(KeyRun,False) then
718 begin
719 Reg.GetValueNames(RunNames);
720 begin
721 for I:=0 to RunNames.Count-1 do
722 begin
723 Item:=TUWSStartupItem.Create(Self);
724 Item.Parent:=Self ;
725 Item.SetupStartupItem(RunNames[I],Reg.ReadString(RunNames[I]),
726 'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run');
727 Idx:=ItemList.AddObject(RunNames[I],Item);
728 Item.ItemIndex:=Idx;
729 Item.BtnDel.OnClick:=DelItem;
730 Item.BtnEdit.OnClick:=EditItem;
731 Item.BtnForbidden.OnClick:=ForbiddenItem;
732 Item.BtnViewCMDInfo.OnClick:=BtnViewInfoClick;
733 end;
734 end;
735 end;
736 Reg.CloseKey;
737 Reg.RootKey:=HKEY_CURRENT_USER;
738 if Reg.OpenKey(KeyRun,False) then
739 begin
740 Reg.GetValueNames(RunNames);
741 begin
742 for I:=0 to RunNames.Count-1 do
743 begin
744 Item:=TUWSStartupItem.Create(Self);
745 Item.Parent:=Self ;
746 Item.SetupStartupItem(RunNames[I],Reg.ReadString(RunNames[I]),
747 'HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run');
748 Idx:=ItemList.AddObject(RunNames[I],Item);
749 Item.ItemIndex:=Idx;
750 Item.BtnDel.OnClick:=DelItem;
751 Item.BtnEdit.OnClick:=EditItem;
752 Item.BtnForbidden.OnClick:=ForbiddenItem;
753 Item.BtnViewCMDInfo.OnClick:=BtnViewInfoClick;
754 end;
755 end;
756 end;
757 Reg.CloseKey;
758 Reg.Free ;
759 RunNames.Free ;
760 SearchStartup(GetStartupFolder);
761 SearchStartup(GetCommonStartupFolder);
762 SearchStartup(ExtractFileDir(Application.ExeName)+'\fss');
763 end;
764
765 procedure TUWSStartItemPanel.DestroyAllStartupItem ;
766 var
767 I:Integer;
768 begin
769 for I:= 0 to ItemList.Count-1 do
770 begin
771 TUWSStartupItem(ItemList.Objects[I]).Free;
772 end;
773 ItemList.Clear ;
774 end;
775
776 procedure TUWSStartItemPanel.AddNewItem ;
777 begin
778 AddNewStartRun;
779 ReLoadStartItems ;
780 end;
781
782 function TUWSStartItemPanel.GetItemCount:Integer ;
783 begin
784 Result:=ItemList.Count ;
785 end;
786
787 function IsDotOrDotDot(P: PChar): Boolean;
788 begin
789 // check if a string is '.' (self) or '..' (parent)
790 if P^ = '.' then
791 begin
792 Inc(P);
793 Result := (P^ = #0) or ((P^ = '.') and ((P+1)^ = #0));
794 end
795 else
796 Result := False;
797 end;
798
799 function TUWSStartItemPanel.FindAndBuildStartup(const ADirectoryName: string;SubDirs: TStrings): Boolean;
800 var
801 Handle: THandle;
802 Finished: Boolean;
803 FFindData: TWin32FindData;
804 AFile:string;
805 Ext:string;
806 Idx:Integer ;
807 ItemPanel:TUWSStartupItem;
808 begin
809 Handle := FindFirstFile(PChar(ADirectoryName + '*'), FFindData);
810 Result := Handle <> INVALID_HANDLE_VALUE;
811 if not Result then
812 begin
813 Result := GetLastError in [ERROR_FILE_NOT_FOUND, ERROR_ACCESS_DENIED];;
814 Exit;
815 end;
816 Finished := False;
817 try
818 while not Finished do
819 begin
820 with FFindData do
821 begin
822 if (not IsDotOrDotDot(cFileName)) and (LowerCase(cFileName)<>'desktop.ini') then
823 begin
824 AFile:=ADirectoryName+cFileName;
825 if FileExists(AFile) then
826 begin
827 ItemPanel:=TUWSStartupItem.Create(Self);
828 ItemPanel.Parent:=Self ;
829 Ext:=ExtractFileExt(AFile);
830 ItemPanel.SetupStartupItem(StringReplace(ExtractFileName(AFile),Ext,'',[]),
831 AFile,ExtractFileDir(AFile));
832 Idx:=ItemList.AddObject(StringReplace(ExtractFileName(AFile),Ext,'',[]),ItemPanel);
833 ItemPanel.ItemIndex:=Idx;
834 ItemPanel.BtnDel.OnClick:=DelItem;
835 ItemPanel.BtnEdit.OnClick:=EditItem;
836 ItemPanel.BtnForbidden.OnClick:=ForbiddenItem;
837 ItemPanel.BtnViewCMDInfo.OnClick:=BtnViewInfoClick;
838 end
839 else if DirectoryExists(AFile) then
840 begin
841 SubDirs.Add(AFile);
842 end;
843 end;
844 end;
845 if not FindNextFile(Handle, FFindData) then
846 begin
847 Finished := True;
848 Result := GetLastError = ERROR_NO_MORE_FILES;
849 end;
850 end;
851 finally
852 Result := Windows.FindClose(Handle) and Result;
853 end;
854 end;
855
856 function TUWSStartItemPanel.SearchStartup(const ADirectoryName: string): Boolean;
857 var
858 DirSep: string;
859 I: Integer;
860 List1:TStringList;
861 begin
862 List1 := TStringList.Create;
863 try
864 DirSep := IncludeTrailingPathDelimiter(ADirectoryName);
865 Result := FindAndBuildStartup(DirSep, List1) ;
866 for I := 0 to List1.Count - 1 do
867 begin
868 Result := SearchStartup(List1.Strings[I]);
869 end;
870 finally
871 List1.Free;
872 end;
873 end;
874
875 procedure TUWSStartItemPanel.ReLoadStartItems;
876 begin
877 if (csDesigning in ComponentState) then Exit ;
878 Hide ;
879 if Assigned(FBeforeReload) then
880 FBeforeReload(Self);
881 WatchTime.Enabled:=False;
882 DestroyAllStartupItem;
883 LoadAllStartup ;
884 WatchTime.Enabled:=FAllowautorefresh ;
885 Show ;
886 if Assigned(FAfterReload) then
887 FAfterReload(self);
888 end;
889
890 procedure TUWSStartItemPanel.WatchItemOnWatch(Sender:TObject);
891 begin
892 ReLoadStartItems;
893 end;
894
895 procedure TUWSStartItemPanel.ItemChangedTimer(Sender:TObject);
896 begin
897 ReLoadStartItems;
898 ItemChangedTime.Enabled:=False ;
899 end;
900
901 procedure TUWSStartItemPanel.DelItem(Sender:TObject);
902 begin
903 WatchTime.Enabled:=False ;
904 With Sender as TButton do
905 begin
906 TUWSStartupItem(Parent).DelStartupItem;
907 end;
908 ItemChangedTime.Enabled:=True ;
909 WatchTime.Enabled:=FAllowautorefresh ;
910 end;
911
912 procedure TUWSStartItemPanel.BtnViewInfoClick(Sender:TObject);
913 begin
914 WatchTime.Enabled:=False ;
915 With Sender as TButton do
916 begin
917 TUWSStartupItem(Parent).ViewCMDLineInfo;
918 end;
919 WatchTime.Enabled:=FAllowautorefresh ;
920 end;
921
922 procedure TUWSStartItemPanel.EditItem(Sender:TObject);
923 begin
924 WatchTime.Enabled:=False ;
925 With Sender as TButton do
926 begin
927 TUWSStartupItem(Parent).EditStartupItem;
928 end;
929 ItemChangedTime.Enabled:=True ;
930 WatchTime.Enabled:=FAllowautorefresh ;
931 end;
932
933 procedure TUWSStartItemPanel.ForbiddenItem(Sender:TObject);
934 begin
935 WatchTime.Enabled:=False ;
936 With Sender as TButton do
937 begin
938 TUWSStartupItem(Parent).ForbiddenStartupItem;
939 end;
940 ItemChangedTime.Enabled:=True ;
941 WatchTime.Enabled:=FAllowautorefresh ;
942 end;
943
944 procedure TUWSStartItemPanel.SetWatchTime(aValue:Cardinal);
945 begin
946 if FMyWatchTime<>aValue then
947 FMyWatchTime:=aValue ;
948 WatchTime.Interval:=FMyWatchTime;
949 end;
950
951 procedure TUWSStartItemPanel.SetAllowautorefresh(aValue:Boolean);
952 begin
953 if FAllowautorefresh<>aValue then
954 FAllowautorefresh:=aValue ;
955 WatchTime.Enabled:=FAllowautorefresh ;
956 end;
957
958 procedure TUWSStartItemPanel.MakeForbiddenItemDir ;
959 begin
960 if not DirectoryExists(ExtractFileDir(Application.ExeName)+'\fss') then
961 MkDir(ExtractFileDir(Application.ExeName)+'\fss');
962 if not DirectoryExists(ExtractFileDir(Application.ExeName)+'\fss\1') then
963 MkDir(ExtractFileDir(Application.ExeName)+'\fss\1\');
964 if not DirectoryExists(ExtractFileDir(Application.ExeName)+'\fss\2') then
965 MkDir(ExtractFileDir(Application.ExeName)+'\fss\2\');
966 end;
967
968 constructor TUWSStartItemPanel.Create(AOwner: TComponent);
969 begin
970 inherited Create(AOwner);
971 Width:=500;
972 ItemList:=TStringList.Create;
973 WatchTime:=TTimer.Create(self);
974 FMyWatchTime:=30000;
975 ItemChangedTime:=TTimer.Create(Self);
976 ItemChangedTime.Interval:=5;
977 ItemChangedTime.Enabled:=False ;
978 ItemChangedTime.OnTimer:=ItemChangedTimer;
979 WatchTime.Interval:=FMyWatchTime;
980 FAllowautorefresh:=True ;
981 WatchTime.Enabled:=FAllowautorefresh ;
982 WatchTime.OnTimer:=WatchItemOnWatch;
983 LoadAllStartup ;
984 AutoSize:=False ;
985 AutoScroll:=True ;
986 if not (csDesigning in ComponentState) then
987 MakeForbiddenItemDir ;
988 end;
989
990 destructor TUWSStartItemPanel.Destroy;
991 begin
992 DestroyAllStartupItem ;
993 ItemList.Free ;
994 WatchTime.Free;
995 ItemChangedTime.Free ;
996 inherited Destroy;
997 end;
998
999 {TUWSUnInstallPanel}
1000
1001 procedure TUWSUnInstallPanel.StandardUnInstall(Sender:TObject);
1002 begin
1003 TUWSUnInstallItem ((Sender as TButton).Parent).DoStandardUnInstall ;
1004 end;
1005
1006 procedure TUWSUnInstallPanel.UnInstallAndClearn(Sender:TObject);
1007 begin
1008 TUWSUnInstallItem ((Sender as TButton).Parent).DoUnInstallAndClearn;
1009 end;
1010
1011 procedure TUWSUnInstallPanel.DelReg(Sender:TObject);
1012 begin
1013 TUWSUnInstallItem ((Sender as TButton).Parent).DoDelUnInstallRegInfo;
1014 end;
1015
1016 procedure TUWSUnInstallPanel.ModifyInstall(Sender:TObject);
1017 begin
1018 TUWSUnInstallItem ((Sender as TButton).Parent).DoModify;
1019 end;
1020
1021 procedure TUWSUnInstallPanel.StaticUnInstall(Sender:TObject);
1022 begin
1023 TUWSUnInstallItem ((Sender as TButton).Parent).DoQuietUninstall ;
1024 end;
1025
1026 procedure TUWSUnInstallPanel.LoadAllUnInstallInfos(ShowWinUP:Boolean);
1027 var
1028 UnInstallList:TStringList ;
1029 I,PN,IconIdx:Integer ;
1030 UnInstallItm:TUWSUnInstallItem;
1031 IconFile,Tmp,Ext,Tmp1,InstallDate:string;
1032 Reg:TRegistry ;
1033 begin
1034 Reg:=TRegistry.Create ;
1035 Reg.RootKey:=HKEY_LOCAL_MACHINE;
1036 if not Reg.OpenKey(KUninstallRegPath,False) then
1037 begin
1038 Application.MessageBox('读取注册表错误！！', PChar(Application.Title),
1039 MB_OK + MB_ICONSTOP + MB_TOPMOST);
1040 Reg.Free ;
1041 Exit;
1042 end;
1043 UnInstallList:=TStringList.Create ;
1044 Reg.GetKeyNames(UnInstallList);
1045 Reg.CloseKey ;
1046 for I:=0 to UnInstallList.Count-1 do
1047 begin
1048 if Reg.OpenKey((KUninstallRegPath+'\'+UnInstallList.Strings[I]),False) then
1049 begin
1050 if Reg.ReadString(KDisplayName)<>'' then
1051 begin
1052 UnInstallItm:=TUWSUnInstallItem.Create(Self);
1053 UnInstallItm.Parent:=Self ;
1054 UnInstallItm.SetupItemPropeties ;
1055 UnInstallItm.InstallPath:=Reg.ReadString(KInstallLocation);
1056 if UnInstallItm.InstallPath='' then
1057 UnInstallItm.InstallPath:=Reg.ReadString(KISAP);
1058 UnInstallItm.UnInstallCmd:=Reg.ReadString(KUninstallString);
1059 UnInstallItm.RegKeyName:=UnInstallList.Strings[I];
1060 UnInstallItm.QuietUninstallCmd:=Reg.ReadString(KQuietUninstallString);
1061 UnInstallItm.ModifyPath:=Reg.ReadString(KModifyPath);
1062 UnInstallItm.DisplayName:=Reg.ReadString(KDisplayName);
1063 UnInstallItm.Caption:=' '+UnInstallItm.DisplayName;
1064 IconFile:=Reg.ReadString(KDisplayIcon);
1065 if IconFile<>'' then
1066 begin
1067 IconFile:=StringReplace(IconFile,'"','',[rfIgnoreCase,rfReplaceAll]);
1068 IconFile:=StringReplace(IconFile,'"','',[rfIgnoreCase,rfReplaceAll]);
1069 PN:=Pos(';',IconFile);
1070 if PN>0 then
1071 begin
1072 IconIdx:=StrToInt(RightStr(IconFile,Length(IconFile)-PN));
1073 Tmp:=RightStr(IconFile,Length(IconFile)-PN+1);
1074 IconFile:=StringReplace(IconFile,Tmp,'',[]);
1075 end
1076 else
1077 IconIdx:=0;
1078 if FileExists(IconFile) then
1079 begin
1080 Ext:=ExtractFileExt(IconFile);
1081 if LowerCase(Ext)='.ico' then
1082 UnInstallItm.IconImage.Picture.Icon.LoadFromFile(IconFile)
1083 else
1084 UnInstallItm.IconImage.Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(IconFile),IconIdx);
1085 end;
1086 end
1087 else
1088 begin
1089 IconFile:=LowerCase(UnInstallItm.UnInstallCmd) ;
1090 IconFile:=StringReplace(IconFile,'"','',[rfIgnoreCase,rfReplaceAll]);
1091 IconFile:=StringReplace(IconFile,'"','',[rfIgnoreCase,rfReplaceAll]);
1092 PN:=Pos('.exe',IconFile);
1093 if PN>0 then
1094 begin
1095 IconFile:=LeftStr(IconFile,(PN+3));
1096 UnInstallItm.IconImage.Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(IconFile),0);
1097 end
1098 else
1099 UnInstallItm.IconImage.Picture.Icon:=Application.Icon ;
1100 end;
1101 if UnInstallItm.IconImage.Picture.Icon.Handle=0 then
1102 UnInstallItm.IconImage.Picture.Icon.Handle:=Application.Icon.Handle ;
1103 Tmp1:=Reg.ReadString(KInstallDate);
1104 if Tmp1<>'' then
1105 InstallDate:=LeftStr(Tmp1,4)+'年'+MidStr(Tmp1,5,2)+'月'+RightStr(Tmp1,2)+'日'
1106 else
1107 InstallDate:='未知';
1108 UnInstallItm.Hint:='名称：'+UnInstallItm.DisplayName+#13+
1109 '版本：'+Reg.ReadString(KDisplayVersion)+#13+
1110 '安装路径：'+UnInstallItm.InstallPath+#13+
1111 '卸载路径：'+UnInstallItm.UnInstallCmd+#13+
1112 '安装日期：'+InstallDate+#13+
1113 '发行公司：'+Reg.ReadString(KPublisher)+#13+
1114 '其他信息：'+Reg.ReadString(KURLInfoAbout)+#13+
1115 '注册表位置：'+'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall\'+UnInstallItm.RegKeyName;
1116 UnInstallItm.IsWindowsUpdata:=Reg.ReadString('ParentKeyName')<>'';
1117 if UnInstallItm.IsWindowsUpdata then
1118 UnInstallItm.Visible:=FShowWinUPs;
1119 UnInstallItm.BtnStandardUnInstall.OnClick:=StandardUnInstall;
1120 UnInstallItm.BtnDelRegString.OnClick:=DelReg;
1121 UnInstallItm.BtnForceUnInstall.OnClick:=UnInstallAndClearn;
1122 UnInstallItm.BtnModify.OnClick:=ModifyInstall;
1123 UnInstallItm.BtnQuitUnInstall.OnClick:=StaticUnInstall;
1124 ItemList.AddObject(UnInstallItm.DisplayName,UnInstallItm) ;
1125 end;
1126 end;
1127 Reg.CloseKey ;
1128 end;
1129 UnInstallList.Free ;
1130 Reg.Free ;
1131 Refresh ;
1132 end;
1133
1134 procedure TUWSUnInstallPanel.ReLoadUnInstallInfos;
1135 begin
1136 Hide;
1137 DestroyUnInstallInfos;
1138 LoadAllUnInstallInfos(FShowWinUPs);
1139 Show ;
1140 end;
1141
1142 procedure TUWSUnInstallPanel.DestroyUnInstallInfos;
1143 var
1144 I:Integer ;
1145 begin
1146 for I:=0 to ItemList.Count -1 do
1147 begin
1148 TUWSUnInstallItem(ItemList.Objects[I]).Free;
1149 end;
1150 ItemList.Clear ;
1151 end;
1152
1153 procedure TUWSUnInstallPanel.SetWinUPVisable;
1154 var
1155 I:Integer ;
1156 Item:TUWSUnInstallItem;
1157 begin
1158 for I:=0 to ItemList.Count -1 do
1159 begin
1160 Item:=TUWSUnInstallItem(ItemList.Objects[I]);
1161 if Item.IsWindowsUpdata then
1162 begin
1163 Item.Visible:=FShowWinUPs ;
1164 end;
1165 end;
1166 end;
1167
1168 procedure TUWSUnInstallPanel.SetShowItemHint;
1169 var
1170 I:Integer ;
1171 Item:TUWSUnInstallItem;
1172 begin
1173 for I:=0 to ItemList.Count -1 do
1174 begin
1175 Item:=TUWSUnInstallItem(ItemList.Objects[I]);
1176 Item.ShowHint:=FShowItemHint;
1177 end;
1178 end;
1179
1180 constructor TUWSUnInstallPanel.Create(AOwner: TComponent);
1181 begin
1182 inherited Create(AOwner);
1183 FShowWinUPs:=False ;
1184 ItemList:=TStringList.Create ;
1185 LoadAllUnInstallInfos(FShowWinUPs);
1186 AutoScroll:=True ;
1187 AutoSize:=False ;
1188 Constraints.MinWidth:=600;
1189 end;
1190
1191 destructor TUWSUnInstallPanel.Destroy;
1192 begin
1193 DestroyUnInstallInfos;
1194 ItemList.Free;
1195 inherited Destroy;
1196 end;
1197
1198 end.
1199
下载：https://files.cnblogs.com/uws2056/UWSStartupItemPanel.rar