Delphi中启动项管理 已安装程序卸载简单组件

主要代码如下：

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