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

{*******************************************************}

{ }

{ UWSStartupItemPanel }

{ Mail:uws2008@hotmail.com }

{ }

{ 版本：0.1.0.8 }

{ }

{ 创建日期：2009年11月5日 }

{ }

{ 功能： }

{ 1、启动项管理（完成度99%） }

{ 2、软件卸载（完成度80%） }

{*******************************************************}

{********************************************************}

{ 版本升级记录： }

{ 2009年10月20日：构思控件 }

{ 2009年10月22日：开始设计控件 }

{ 2009年10月23日：改进数项功能设计修复Bug }

{ 2009年10月24日：0.1.0.0版完成，实现启动项基本管理功能：}

{ 1、启动项查看 }

{ 2、删除 }

{ 3、禁止使用 }

{ 4、编辑 }

{ 5、新增启动项 }

{ 2009年10月27日：完成TUWSUnInstallPanel 组件开发 }

{ 2009年11月1日：为TUWSStartPanel增加两个事件： }

{ BeforReload AfterReload }

{ 2009年11月2日：TUWSUninstallPanel.DelReg完成 }

{********************************************************}

unit UWSStartItemPanel;

interface

uses

SysUtils, Classes, Controls, ExtCtrls,Graphics,StdCtrls,Forms,

StartupItemEditor,ShellAPI,Messages,Registry,Windows,Dialogs,

StrUtils,U_ViewCMDInfos;

const

KeyRun= '\SOFTWARE\Microsoft\Windows\CurrentVersion\Run';

KUninstallRegPath = 'Software\Microsoft\Windows\CurrentVersion\Uninstall';

KUninstallString = 'UninstallString';

KDisplayName = 'DisplayName';

KDisplayVersion='DisplayVersion';

KInstallDate='InstallDate';

KInstallLocation='InstallLocation';

KModifyPath='ModifyPath';

KPublisher='Publisher';

KURLInfoAbout='URLInfoAbout';

KDisplayIcon='DisplayIcon';

KQuietUninstallString='QuietUninstallString';

KISAP='Inno Setup: App Path';

{TUWSStartupItem}

type

TUWSStartupItem = class(TPanel)

private

{ Private declarations }

BtnDel:TButton;

BtnForbidden:TButton;

BtnEdit:TButton ;

BtnViewCMDInfo:TButton ;

LabelCaption:TLabel ;

ImageIcon:TImage;

RealCommandLine:string;

FStartItemCaption:String;

FCmdLine:String;

FStartItemPostion:string;

FItemIndex:Integer ;

Forbiddened:Boolean ;

procedure UpateItem;

procedure BuildItemPropeties;

procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

protected

{ Protected declarations }

procedure DsItem;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

property CmdLine:string read FCmdLine write FCmdLine;

property StartItemPostion :string read FStartItemPostion write FStartItemPostion;

procedure DelStartupItem;

procedure ForbiddenStartupItem;

procedure EditStartupItem;

procedure ViewCMDLineInfo;

procedure SetupStartupItem(ItemCaption,ItemCmd,ItemPostion:string);

property StartItemCapTion: string read FStartItemCaption write FStartItemCaption;

property ItemIndex:integer read FItemIndex write FItemIndex;

published

{ Published declarations }

end;

{TUWSUnInstallItem}

TUWSUnInstallItem = class(TPanel)

private

{ Private declarations }

BtnStandardUnInstall:TButton ;

BtnDelRegString:TButton ;

BtnForceUnInstall:TButton ;

BtnModify:TButton ;

BtnQuitUnInstall:TButton ;

IconImage:TImage ;

FInstallPath:String;

FUnInstallCmd:String;

FDisplayName:String;

FInstallLocation:String;

FQuietUninstallCmd:String;

FModifyPath:string;

FRegKeyName:string;

FIsWindowsUpData:Boolean ;

procedure SetupItemPropeties;

procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

protected

{ Protected declarations }

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

property InstallPath : string read FInstallPath write FInstallPath;

property UnInstallCmd : string read FUnInstallCmd write FUnInstallCmd;

property DisplayName : string read FDisplayName write FDisplayName;

property IsWindowsUpdata : Boolean read FIsWindowsUpdata write FIsWindowsUpdata;

property RegKeyName : string read FRegKeyName write FRegKeyName;

property InstallLocation : string read FInstallLocation write FInstallLocation;

property QuietUninstallCmd : string read FQuietUninstallCmd write FQuietUninstallCmd;

property ModifyPath : string read FModifyPath write FModifyPath;

published

{ Published declarations }

procedure DoStandardUnInstall;

procedure DoDelUnInstallRegInfo;

procedure DoUnInstallAndClearn;

procedure DoModify;

procedure DoQuietUninstall;

end;

{TUWSStartItemPanel}

TUWSStartItemPanel = class(TScrollBox)

private

{ Private declarations }

ItemList:TStringList;

WatchTime:TTimer;

ItemChangedTime:TTimer;

FMyWatchTime:Cardinal;

FAllowautorefresh:Boolean ;

FBeforeReload:TNotifyEvent;

FAfterReload:TNotifyEvent;

function GetItemCount:Integer ;

function FindAndBuildStartup(const ADirectoryName: string;SubDirs: TStrings): Boolean;

function SearchStartup(const ADirectoryName: string): Boolean;

procedure WatchItemOnWatch(Sender:TObject);

procedure ItemChangedTimer(Sender:TObject);

procedure DelItem(Sender:TObject);

procedure EditItem(Sender:TObject);

procedure BtnViewInfoClick(Sender:TObject);

procedure ForbiddenItem(Sender:TObject);

procedure SetWatchTime(aValue:Cardinal);

procedure SetAllowautorefresh(aValue:Boolean);

protected

{ Protected declarations }

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure LoadAllStartup;

procedure DestroyAllStartupItem;

procedure AddNewItem;

procedure ReLoadStartItems;

procedure MakeForbiddenItemDir;

property ItemCount : Integer read GetItemCount;

published

{ Published declarations }

property MyWatchTime:Cardinal read FMyWatchTime write SetWatchTime;

property Allowautorefresh:Boolean read FAllowautorefresh write SetAllowautorefresh;

property BeforeReload : TNotifyEvent read FBeforeReload write FBeforeReload;

property AfterReload : TNotifyEvent read FAfterReload write FAfterReload;

end;

{TUWSUnInstallPanel}

TUWSUnInstallPanel = class(TScrollBox)

private

{ Private declarations }

ItemList:TStringList;

FShowWinUPs:Boolean ;

FShowItemHint:Boolean ;

procedure StandardUnInstall(Sender:TObject);

procedure UnInstallAndClearn(Sender:TObject);

procedure DelReg(Sender:TObject);

procedure ModifyInstall(Sender:TObject);

procedure StaticUnInstall(Sender:TObject);

protected

{ Protected declarations }

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure LoadAllUnInstallInfos(ShowWinUP:Boolean);

procedure ReLoadUnInstallInfos;

procedure DestroyUnInstallInfos;

procedure SetWinUPVisable;

procedure SetShowItemHint;

published

{ Published declarations }

property ShowWinUPs : Boolean read FShowWinUPs write FShowWinUPs;

property ShowItemHint : Boolean read FShowItemHint write FShowItemHint;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('uws Used', [TUWSStartItemPanel,TUWSUnInstallPanel]);

end;

{UWSStartupItem}

procedure TUWSStartupItem.DelStartupItem ;

var

Reg:TRegistry;

RunItemName,RunItemDir,RunItemFile:string;

begin

RunItemName:=FStartItemCaption;

RunItemDir:=FStartItemPostion;

RunItemFile:=FCmdLine;

if DirectoryExists(RunItemDir) then

begin

if not DeleteFile(PChar(RunItemFile)) then

Application.MessageBox(pchar(Format('删除%s失败！！',[RunItemName])), PChar(Application.Title),

MB_OK + MB_ICONSTOP + MB_TOPMOST);

end

else

begin

Reg:=TRegistry.Create ;

if Pos('HKEY_LOCAL_MACHINE',RunItemDir)>0 then

Reg.RootKey:=HKEY_LOCAL_MACHINE

else

Reg.RootKey:=HKEY_CURRENT_USER;

begin

if Reg.OpenKey(KeyRun,False) then

begin

if not Reg.DeleteValue(RunItemName)then

Application.MessageBox(pchar(Format('删除%s失败！！',[RunItemName])), PChar(Application.Title),

MB_OK + MB_ICONSTOP + MB_TOPMOST);

end;

Reg.CloseKey ;

Reg.Free ;

end;

procedure TUWSStartupItem.ForbiddenStartupItem;

var

Reg:TRegistry;

RealCMDLine:string;

begin

if DirectoryExists(FStartItemPostion) then

begin

if LowerCase(FStartItemPostion)=LowerCase(GetStartupFolder) then

begin

CopyFile(PChar(FCmdLine),

PChar(ExtractFileDir(Application.ExeName)+'\fss\1\'+ExtractFileName(FCmdLine)),

False);

DeleteFile(PChar(FCmdLine));

end

else if LowerCase(FStartItemPostion)=LowerCase(GetCommonStartupFolder) then

begin

CopyFile(PChar(FCmdLine),

PChar(ExtractFileDir(Application.ExeName)+'\fss\2\'+ExtractFileName(FCmdLine)),

False);

DeleteFile(PChar(FCmdLine));

end

else if LowerCase(FStartItemPostion)=LowerCase(ExtractFileDir(Application.ExeName)+'\fss\1') then

begin

CopyFile(PChar(FCmdLine),

PChar(GetStartupFolder+'\'+ExtractFileName(FCmdLine)),

False);

DeleteFile(PChar(FCmdLine));

end

else

begin

CopyFile(PChar(FCmdLine),

PChar(GetcommonStartupFolder+'\'+ExtractFileName(FCmdLine)),

False);

DeleteFile(PChar(FCmdLine));

end;

end

else

begin

Reg:=TRegistry.Create ;

if Pos('HKEY_LOCAL_MACHINE',FStartItemPostion)>0 then

Reg.RootKey:=HKEY_LOCAL_MACHINE

else

Reg.RootKey:=HKEY_CURRENT_USER;

if Pos(';',FCmdLine)=1 then

RealCMDLine:=StringReplace(FCmdLine,';','',[])

else

RealCMDLine:=';'+FCmdLine;

if Reg.OpenKey(KeyRun,False) then

Reg.WriteString(FStartItemCaption,RealCMDLine);

Reg.CloseKey ;

Reg.Free ;

end;

procedure TUWSStartupItem.EditStartupItem;

begin

EditRunItem(FStartItemCaption,FCmdLine,FStartItemPostion);

end;

procedure TUWSStartupItem.ViewCMDLineInfo;

var

Infos,VersionInfo:TStringList;

FS:Double ;

begin

if RealCommandLine='' then Exit ;

if not FileExists(RealCommandLine) then

begin

Application.MessageBox('抱歉，找不到对应文件！！！',

PChar(Application.Title), MB_OK + MB_ICONSTOP + MB_TOPMOST);

Exit ;

end;

Infos:=TStringList.Create ;

Infos.Add('命令行:'+FCmdLine);

Infos.Add('对应文件:'+realcommandLine);

FS:=FileSizeByName(realcommandLine)/1048576;

if FS<1 then

Infos.Add('文件大小：'+FormatFloat('.###',FS*1024)+' KB')

else

Infos.Add('文件大小：'+FormatFloat('.###',FS)+' MB');

VersionInfo:=TStringList.Create ;

GetExeFileVersions(VersionInfo,RealCommandLine,False);

Infos.AddStrings(VersionInfo);

ViewCommandLineInfo(Infos,ImageIcon.Picture.Icon);

Infos.Free ;

VersionInfo.Free ;

end;

procedure TUWSStartupItem.DsItem;

begin

BtnDel.Free;

BtnForbidden.Free ;

BtnEdit.Free ;

BtnViewCMDInfo.Free ;

LabelCaption.Free ;

ImageIcon.Free ;

end;

procedure TUWSStartupItem.UpateItem;

begin

LabelCaption.Caption:=FStartItemCaption ;

LabelCaption.AutoSize:=True ;

end;

procedure TUWSStartupItem.BuildItemPropeties;

var

RealCMDLine:string;

ExePos:Integer;

IconIndex:Word ;

begin

ImageIcon:=TImage.Create(Self);

ImageIcon.Parent:=Self ;

ImageIcon.Align:=alLeft ;

ImageIcon.Width:=32;

RealCMDLine:=LowerCase(FCmdLine) ;

RealCMDLine:=StringReplace(RealCMDLine,'"','',[rfReplaceAll, rfIgnoreCase]);

RealCMDLine:=StringReplace(RealCMDLine,';','',[]);

ExePos:=Pos('.exe',RealCMDLine);

if ExePos>0 then

begin

if RightStr(RealCMDLine,4)<>'.exe' then

RealCMDLine:=LeftStr(RealCMDLine,ExePos+3);

ImageIcon.Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(RealCMDLine),0);

end

else

begin

ExePos:=Pos('.lnk',RealCMDLine);

if ExePos>0 then

begin

if(RightStr(RealCMDLine,4)<>'.lnk') then

RealCMDLine:=LeftStr(RealCMDLine,ExePos+3);

RealCMDLine:=ResolveLink(RealCMDLine);

if Pos('.exe',RealCMDLine)>0 then

ImageIcon.Picture.Icon.Handle:=ExtractIcon(HInstance,

PChar(RealCMDLine),0)

else

ImageIcon.Picture.Icon.Handle:=ExtractAssociatedIcon(HInstance,

PChar(RealCMDLine),IconIndex);

end

else

begin

ImageIcon.Picture.Icon.Handle:=ExtractAssociatedIcon(HInstance,

PChar(RealCMDLine),IconIndex);

end;

RealCommandLine:=RealCMDLine;

LabelCaption:=TLabel.Create(Self);

LabelCaption.Parent:=Self;

LabelCaption.Align:=alLeft ;

LabelCaption.Width:=800;

UpateItem ;

BtnDel:=TButton.Create(Self);

BtnDel.Parent:=Self;

BtnDel.Height:=26;

BtnDel.Width:=60;

BtnDel.Top:=3;

BtnDel.Anchors:=[akTop,akRight];

BtnDel.Caption:='删除';

BtnDel.Left:=Self.Width-65;

BtnDel.Hint:='删除该启动项';

BtnDel.ShowHint:=True ;

BtnForbidden:=TButton.Create(Self);

BtnForbidden.Parent:=Self;

BtnForbidden.Height:=26;

BtnForbidden.Width:=60;

BtnForbidden.Top:=3;

BtnForbidden.Anchors:=[akTop,akRight];

BtnForbidden.Caption:='禁用';

BtnForbidden.Left:=Self.Width-126;

BtnForbidden.Hint:='禁用/激活该启动项，禁用后可以恢复';

BtnForbidden.ShowHint:=True ;

BtnEdit:=TButton.Create(Self);

BtnEdit.Parent:=Self;

BtnEdit.Height:=26;

BtnEdit.Width:=60;

BtnEdit.Top:=3;

BtnEdit.Anchors:=[akTop,akRight];

BtnEdit.Caption:='编辑';

BtnEdit.Left:=Self.Width-187;

BtnEdit.Hint:='点击对该启动项进行编辑';

BtnEdit.ShowHint:=True ;

BtnViewCMDInfo:=TButton.Create(Self);

BtnViewCMDInfo.Parent:=Self;

BtnViewCMDInfo.Height:=26;

BtnViewCMDInfo.Width:=60;

BtnViewCMDInfo.Top:=3;

BtnViewCMDInfo.Anchors:=[akTop,akRight];

BtnViewCMDInfo.Caption:='信息';

BtnViewCMDInfo.Left:=Self.Width-248;

BtnViewCMDInfo.Hint:='点击查看启动文件相关信息';

BtnViewCMDInfo.ShowHint:=True ;

ImageIcon.Left:=0;

BtnForbidden.Hide;

BtnEdit.Hide ;

BtnDel.Hide;

BtnViewCMDInfo.Hide ;

Refresh ;

end;

procedure TUWSStartupItem.SetupStartupItem(ItemCaption,ItemCmd,ItemPostion:string);

begin

FStartItemCaption:=ItemCaption;

FCmdLine:=ItemCmd ;

FStartItemPostion:=ItemPostion ;

ShowHint:=True;

BuildItemPropeties;

if DirectoryExists(ItemPostion) then

begin

if (LowerCase(ItemPostion)=LowerCase(GetStartupFolder)) or

(LowerCase(ItemPostion)=LowerCase(GetCommonStartupFolder)) then

begin

BtnForbidden.Caption:='禁止';

BtnForbidden.Hint:='禁止使用该启动项';

LabelCaption.Font.Color:=clBlue;

Hint:='名称：'+ItemCaption+#13+#13+'命令行：'+ItemCmd+#13+#13+'位置：'+ItemPostion;

Forbiddened:=False ;

end

else

begin

BtnForbidden.Caption:='恢复';

BtnForbidden.Hint:='恢复使用该启动项';

LabelCaption.Font.Color:=clRed;

Hint:='名称：'+ItemCaption+#13+#13+'已被禁用';

Forbiddened:=True;

end;

end

else

begin

if Pos(';',ItemCmd)=1 then

begin

BtnForbidden.Caption:='恢复';

BtnForbidden.Hint:='恢复使用该启动项';

LabelCaption.Font.Color:=clRed;

Hint:='名称：'+ItemCaption+#13+#13+'已被禁用';

Forbiddened:=True ;

end

else

begin

BtnForbidden.Caption:='禁止';

BtnForbidden.Hint:='禁止使用该启动项';

LabelCaption.Font.Color:=clBlue;

Hint:='名称：'+ItemCaption+#13+#13+'命令行：'+ItemCmd+#13+#13+'位置：'+ItemPostion;

Forbiddened:=False ;

end;

LabelCaption.Font.Size:=14;

LabelCaption.Width:=1000;

LabelCaption.AutoSize:=True ;

Refresh;

end;

procedure TUWSStartupItem.CMMouseEnter(var Message: TMessage);

begin

inherited;

BtnForbidden.Show ;

BtnDel.Show ;

BtnViewCMDInfo.Show;

if not Forbiddened then

begin

BtnEdit.Show ;

end;

procedure TUWSStartupItem.CMMouseLeave(var Message: TMessage);

begin

inherited;

BtnForbidden.Hide;

BtnEdit.Hide ;

BtnDel.Hide;

BtnViewCMDInfo.Hide ;

end;

constructor TUWSStartupItem.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

ParentBackground:=True;

Align:=alTop;

Height:=33;

Caption:='';

ShowHint:=True ;

end;

destructor TUWSStartupItem.Destroy;

begin

DsItem ;

inherited Destroy;

end;

{TUWSUnInstallItem}

procedure TUWSUnInstallItem.SetupItemPropeties;

begin

IconImage:=TImage.Create(Self);

IconImage.Parent:=Self ;

IconImage.Align:=alLeft ;

IconImage.Left:=0;

IconImage.Width:=32;

IconImage.Height:=32;

BtnStandardUnInstall:=TButton.Create(Self);

BtnStandardUnInstall.Parent:=Self;

BtnStandardUnInstall.Height:=26;

BtnStandardUnInstall.Width:=75;

BtnStandardUnInstall.Top:=3;

BtnStandardUnInstall.Anchors:=[akTop,akRight];

BtnStandardUnInstall.Caption:='标准卸载';

BtnStandardUnInstall.Left:=Self.Width-81;

BtnStandardUnInstall.Hint:='点击进行标准卸载';

BtnStandardUnInstall.ShowHint:=True ;

BtnDelRegString:=TButton.Create(Self);

BtnDelRegString.Parent:=Self;

BtnDelRegString.Height:=26;

BtnDelRegString.Width:=110;

BtnDelRegString.Top:=3;

BtnDelRegString.Anchors:=[akTop,akRight];

BtnDelRegString.Caption:='删除安装信息';

BtnDelRegString.Left:=Self.Width-192;

BtnDelRegString.Hint:='点击删除注册表安装信息，但不进行卸载';

BtnDelRegString.ShowHint:=True ;

BtnForceUnInstall:=TButton.Create(Self);

BtnForceUnInstall.Parent:=Self;

BtnForceUnInstall.Height:=26;

BtnForceUnInstall.Width:=75;

BtnForceUnInstall.Top:=3;

BtnForceUnInstall.Anchors:=[akTop,akRight];

BtnForceUnInstall.Caption:='清理卸载';

BtnForceUnInstall.Left:=Self.Width-268;

BtnForceUnInstall.Hint:='先进性标准卸载，然后进行相关清理';

BtnForceUnInstall.ShowHint:=True ;

BtnModify:=TButton.Create(Self);

BtnModify.Parent:=Self;

BtnModify.Height:=26;

BtnModify.Width:=42;

BtnModify.Top:=3;

BtnModify.Anchors:=[akTop,akRight];

BtnModify.Caption:='修改';

BtnModify.Left:=Self.Width-311;

BtnModify.Hint:='修改';

BtnModify.ShowHint:=True ;

BtnQuitUnInstall:=TButton.Create(Self);

BtnQuitUnInstall.Parent:=Self;

BtnQuitUnInstall.Height:=26;

BtnQuitUnInstall.Width:=42;

BtnQuitUnInstall.Top:=3;

BtnQuitUnInstall.Anchors:=[akTop,akRight];

BtnQuitUnInstall.Caption:='静卸';

BtnQuitUnInstall.Left:=Self.Width-355;

BtnQuitUnInstall.Hint:='静态卸载';

BtnQuitUnInstall.ShowHint:=True ;

BtnStandardUnInstall.Hide;

BtnDelRegString.Hide ;

BtnForceUnInstall.Hide ;

BtnModify.Hide ;

BtnQuitUnInstall.Hide ;

end;

procedure TUWSUnInstallItem.CMMouseEnter(var Message: TMessage);

begin

BtnStandardUnInstall.Visible:=FUnInstallCmd<>'';

BtnDelRegString.Show ;

BtnForceUnInstall.Visible:=FUnInstallCmd<>'';

BtnModify.Visible:=FModifyPath<>'';

BtnQuitUnInstall.Visible:=FQuietUninstallCmd<>'';

end;

procedure TUWSUnInstallItem.CMMouseLeave(var Message: TMessage);

begin

{$IF DELPHI12_UP}

Exit;

{$IFEND}

BtnStandardUnInstall.Hide ;

BtnDelRegString.Hide ;

BtnForceUnInstall.Hide ;

BtnModify.Hide ;

BtnQuitUnInstall.Hide ;

end;

procedure TUWSUnInstallItem.DoStandardUnInstall ;

begin

WinExec(PAnsiChar(FUnInstallCmd),SW_SHOWNORMAL);

end;

procedure TUWSUnInstallItem.DoDelUnInstallRegInfo ;

var

Reg:TRegistry ;

begin

if FRegKeyName='' then Exit ;

Reg:=TRegistry.Create ;

Reg.RootKey:=HKEY_LOCAL_MACHINE ;

if Reg.OpenKey(KUninstallRegPath,False) then

begin

if Reg.DeleteKey(FRegKeyName) then

Application.MessageBox('删除成功。', PChar(Application.Title), MB_OK +

MB_ICONINFORMATION + MB_TOPMOST)

else

Application.MessageBox('删除失败。', PChar(Application.Title), MB_OK +

MB_ICONSTOP + MB_TOPMOST);

end;

Reg.CloseKey ;

Reg.Free ;

end;

procedure TUWSUnInstallItem.DoUnInstallAndClearn ;

begin

end;

procedure TUWSUnInstallItem.DoModify;

begin

if FModifyPath<>'' then

WinExec(PAnsiChar(FModifyPath),SW_SHOWNORMAL);

end;

procedure TUWSUnInstallItem.DoQuietUninstall;

begin

if FQuietUninstallCmd<>'' then

WinExec(PAnsiChar(FQuietUninstallCmd),SW_SHOWNORMAL);

end;

constructor TUWSUnInstallItem.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

ParentBackground:=True;

Align:=alTop;

Height:=33;

Caption:='';

ShowHint:=True ;

Alignment:=taLeftJustify;

end;

destructor TUWSUnInstallItem.Destroy;

begin

BtnStandardUnInstall.Free ;

BtnDelRegString.Free;

BtnForceUnInstall.Free ;

IconImage.Free ;

BtnModify.Free ;

BtnQuitUnInstall.Free ;

inherited Destroy;

end;

{TUWSStartItemPanel}

procedure TUWSStartItemPanel.LoadAllStartup;

var

Reg:TRegistry;

RunNames:TStringList;

I,Idx:Integer;

Item:TUWSStartupItem ;

begin

Reg :=TRegistry.Create ;

RunNames:=TStringList.Create ;

Reg.RootKey:=HKEY_LOCAL_MACHINE;

if Reg.OpenKey(KeyRun,False) then

begin

Reg.GetValueNames(RunNames);

begin

for I:=0 to RunNames.Count-1 do

begin

Item:=TUWSStartupItem.Create(Self);

Item.Parent:=Self ;

Item.SetupStartupItem(RunNames[I],Reg.ReadString(RunNames[I]),

'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run');

Idx:=ItemList.AddObject(RunNames[I],Item);

Item.ItemIndex:=Idx;

Item.BtnDel.OnClick:=DelItem;

Item.BtnEdit.OnClick:=EditItem;

Item.BtnForbidden.OnClick:=ForbiddenItem;

Item.BtnViewCMDInfo.OnClick:=BtnViewInfoClick;

end;

Reg.CloseKey;

Reg.RootKey:=HKEY_CURRENT_USER;

if Reg.OpenKey(KeyRun,False) then

begin

Reg.GetValueNames(RunNames);

begin

for I:=0 to RunNames.Count-1 do

begin

Item:=TUWSStartupItem.Create(Self);

Item.Parent:=Self ;

Item.SetupStartupItem(RunNames[I],Reg.ReadString(RunNames[I]),

'HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run');

Idx:=ItemList.AddObject(RunNames[I],Item);

Item.ItemIndex:=Idx;

Item.BtnDel.OnClick:=DelItem;

Item.BtnEdit.OnClick:=EditItem;

Item.BtnForbidden.OnClick:=ForbiddenItem;

Item.BtnViewCMDInfo.OnClick:=BtnViewInfoClick;

end;

Reg.CloseKey;

Reg.Free ;

RunNames.Free ;

SearchStartup(GetStartupFolder);

SearchStartup(GetCommonStartupFolder);

SearchStartup(ExtractFileDir(Application.ExeName)+'\fss');

end;

procedure TUWSStartItemPanel.DestroyAllStartupItem ;

var

I:Integer;

begin

for I:= 0 to ItemList.Count-1 do

begin

TUWSStartupItem(ItemList.Objects[I]).Free;

end;

ItemList.Clear ;

end;

procedure TUWSStartItemPanel.AddNewItem ;

begin

AddNewStartRun;

ReLoadStartItems ;

end;

function TUWSStartItemPanel.GetItemCount:Integer ;

begin

Result:=ItemList.Count ;

end;

function IsDotOrDotDot(P: PChar): Boolean;

begin

// check if a string is '.' (self) or '..' (parent)

if P^ = '.' then

begin

Inc(P);

Result := (P^ = #0) or ((P^ = '.') and ((P+1)^ = #0));

end

else

Result := False;

end;

function TUWSStartItemPanel.FindAndBuildStartup(const ADirectoryName: string;SubDirs: TStrings): Boolean;

var

Handle: THandle;

Finished: Boolean;

FFindData: TWin32FindData;

AFile:string;

Ext:string;

Idx:Integer ;

ItemPanel:TUWSStartupItem;

begin

Handle := FindFirstFile(PChar(ADirectoryName + '*'), FFindData);

Result := Handle <> INVALID_HANDLE_VALUE;

if not Result then

begin

Result := GetLastError in [ERROR_FILE_NOT_FOUND, ERROR_ACCESS_DENIED];;

Exit;

end;

Finished := False;

try

while not Finished do

begin

with FFindData do

begin

if (not IsDotOrDotDot(cFileName)) and (LowerCase(cFileName)<>'desktop.ini') then

begin

AFile:=ADirectoryName+cFileName;

if FileExists(AFile) then

begin

ItemPanel:=TUWSStartupItem.Create(Self);

ItemPanel.Parent:=Self ;

Ext:=ExtractFileExt(AFile);

ItemPanel.SetupStartupItem(StringReplace(ExtractFileName(AFile),Ext,'',[]),

AFile,ExtractFileDir(AFile));

Idx:=ItemList.AddObject(StringReplace(ExtractFileName(AFile),Ext,'',[]),ItemPanel);

ItemPanel.ItemIndex:=Idx;

ItemPanel.BtnDel.OnClick:=DelItem;

ItemPanel.BtnEdit.OnClick:=EditItem;

ItemPanel.BtnForbidden.OnClick:=ForbiddenItem;

ItemPanel.BtnViewCMDInfo.OnClick:=BtnViewInfoClick;

end

else if DirectoryExists(AFile) then

begin

SubDirs.Add(AFile);

end;

if not FindNextFile(Handle, FFindData) then

begin

Finished := True;

Result := GetLastError = ERROR_NO_MORE_FILES;

end;

finally

Result := Windows.FindClose(Handle) and Result;

end;

function TUWSStartItemPanel.SearchStartup(const ADirectoryName: string): Boolean;

var

DirSep: string;

I: Integer;

List1:TStringList;

begin

List1 := TStringList.Create;

try

DirSep := IncludeTrailingPathDelimiter(ADirectoryName);

Result := FindAndBuildStartup(DirSep, List1) ;

for I := 0 to List1.Count - 1 do

begin

Result := SearchStartup(List1.Strings[I]);

end;

finally

List1.Free;

end;

procedure TUWSStartItemPanel.ReLoadStartItems;

begin

if (csDesigning in ComponentState) then Exit ;

Hide ;

if Assigned(FBeforeReload) then

FBeforeReload(Self);

WatchTime.Enabled:=False;

DestroyAllStartupItem;

LoadAllStartup ;

WatchTime.Enabled:=FAllowautorefresh ;

Show ;

if Assigned(FAfterReload) then

FAfterReload(self);

end;

procedure TUWSStartItemPanel.WatchItemOnWatch(Sender:TObject);

begin

ReLoadStartItems;

end;

procedure TUWSStartItemPanel.ItemChangedTimer(Sender:TObject);

begin

ReLoadStartItems;

ItemChangedTime.Enabled:=False ;

end;

procedure TUWSStartItemPanel.DelItem(Sender:TObject);

begin

WatchTime.Enabled:=False ;

With Sender as TButton do

begin

TUWSStartupItem(Parent).DelStartupItem;

end;

ItemChangedTime.Enabled:=True ;

WatchTime.Enabled:=FAllowautorefresh ;

end;

procedure TUWSStartItemPanel.BtnViewInfoClick(Sender:TObject);

begin

WatchTime.Enabled:=False ;

With Sender as TButton do

begin

TUWSStartupItem(Parent).ViewCMDLineInfo;

end;

WatchTime.Enabled:=FAllowautorefresh ;

end;

procedure TUWSStartItemPanel.EditItem(Sender:TObject);

begin

WatchTime.Enabled:=False ;

With Sender as TButton do

begin

TUWSStartupItem(Parent).EditStartupItem;

end;

ItemChangedTime.Enabled:=True ;

WatchTime.Enabled:=FAllowautorefresh ;

end;

procedure TUWSStartItemPanel.ForbiddenItem(Sender:TObject);

begin

WatchTime.Enabled:=False ;

With Sender as TButton do

begin

TUWSStartupItem(Parent).ForbiddenStartupItem;

end;

ItemChangedTime.Enabled:=True ;

WatchTime.Enabled:=FAllowautorefresh ;

end;

procedure TUWSStartItemPanel.SetWatchTime(aValue:Cardinal);

begin

if FMyWatchTime<>aValue then

FMyWatchTime:=aValue ;

WatchTime.Interval:=FMyWatchTime;

end;

procedure TUWSStartItemPanel.SetAllowautorefresh(aValue:Boolean);

begin

if FAllowautorefresh<>aValue then

FAllowautorefresh:=aValue ;

WatchTime.Enabled:=FAllowautorefresh ;

end;

procedure TUWSStartItemPanel.MakeForbiddenItemDir ;

begin

if not DirectoryExists(ExtractFileDir(Application.ExeName)+'\fss') then

MkDir(ExtractFileDir(Application.ExeName)+'\fss');

if not DirectoryExists(ExtractFileDir(Application.ExeName)+'\fss\1') then

MkDir(ExtractFileDir(Application.ExeName)+'\fss\1\');

if not DirectoryExists(ExtractFileDir(Application.ExeName)+'\fss\2') then

MkDir(ExtractFileDir(Application.ExeName)+'\fss\2\');

end;

constructor TUWSStartItemPanel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

Width:=500;

ItemList:=TStringList.Create;

WatchTime:=TTimer.Create(self);

FMyWatchTime:=30000;

ItemChangedTime:=TTimer.Create(Self);

ItemChangedTime.Interval:=5;

ItemChangedTime.Enabled:=False ;

ItemChangedTime.OnTimer:=ItemChangedTimer;

WatchTime.Interval:=FMyWatchTime;

FAllowautorefresh:=True ;

WatchTime.Enabled:=FAllowautorefresh ;

WatchTime.OnTimer:=WatchItemOnWatch;

LoadAllStartup ;

AutoSize:=False ;

AutoScroll:=True ;

if not (csDesigning in ComponentState) then

MakeForbiddenItemDir ;

end;

destructor TUWSStartItemPanel.Destroy;

begin

DestroyAllStartupItem ;

ItemList.Free ;

WatchTime.Free;

ItemChangedTime.Free ;

inherited Destroy;

end;

{TUWSUnInstallPanel}

procedure TUWSUnInstallPanel.StandardUnInstall(Sender:TObject);

begin

TUWSUnInstallItem ((Sender as TButton).Parent).DoStandardUnInstall ;

end;

procedure TUWSUnInstallPanel.UnInstallAndClearn(Sender:TObject);

begin

TUWSUnInstallItem ((Sender as TButton).Parent).DoUnInstallAndClearn;

end;

procedure TUWSUnInstallPanel.DelReg(Sender:TObject);

begin

TUWSUnInstallItem ((Sender as TButton).Parent).DoDelUnInstallRegInfo;

end;

procedure TUWSUnInstallPanel.ModifyInstall(Sender:TObject);

begin

TUWSUnInstallItem ((Sender as TButton).Parent).DoModify;

end;

procedure TUWSUnInstallPanel.StaticUnInstall(Sender:TObject);

begin

TUWSUnInstallItem ((Sender as TButton).Parent).DoQuietUninstall ;

end;

procedure TUWSUnInstallPanel.LoadAllUnInstallInfos(ShowWinUP:Boolean);

var

UnInstallList:TStringList ;

I,PN,IconIdx:Integer ;

UnInstallItm:TUWSUnInstallItem;

IconFile,Tmp,Ext,Tmp1,InstallDate:string;

Reg:TRegistry ;

begin

Reg:=TRegistry.Create ;

Reg.RootKey:=HKEY_LOCAL_MACHINE;

if not Reg.OpenKey(KUninstallRegPath,False) then

begin

Application.MessageBox('读取注册表错误！！', PChar(Application.Title),

MB_OK + MB_ICONSTOP + MB_TOPMOST);

Reg.Free ;

Exit;

end;

UnInstallList:=TStringList.Create ;

Reg.GetKeyNames(UnInstallList);

Reg.CloseKey ;

for I:=0 to UnInstallList.Count-1 do

begin

if Reg.OpenKey((KUninstallRegPath+'\'+UnInstallList.Strings[I]),False) then

begin

if Reg.ReadString(KDisplayName)<>'' then

begin

UnInstallItm:=TUWSUnInstallItem.Create(Self);

UnInstallItm.Parent:=Self ;

UnInstallItm.SetupItemPropeties ;

UnInstallItm.InstallPath:=Reg.ReadString(KInstallLocation);

if UnInstallItm.InstallPath='' then

UnInstallItm.InstallPath:=Reg.ReadString(KISAP);

UnInstallItm.UnInstallCmd:=Reg.ReadString(KUninstallString);

UnInstallItm.RegKeyName:=UnInstallList.Strings[I];

UnInstallItm.QuietUninstallCmd:=Reg.ReadString(KQuietUninstallString);

UnInstallItm.ModifyPath:=Reg.ReadString(KModifyPath);

UnInstallItm.DisplayName:=Reg.ReadString(KDisplayName);

UnInstallItm.Caption:=' '+UnInstallItm.DisplayName;

IconFile:=Reg.ReadString(KDisplayIcon);

if IconFile<>'' then

begin

IconFile:=StringReplace(IconFile,'"','',[rfIgnoreCase,rfReplaceAll]);

PN:=Pos(';',IconFile);

if PN>0 then

begin

IconIdx:=StrToInt(RightStr(IconFile,Length(IconFile)-PN));

Tmp:=RightStr(IconFile,Length(IconFile)-PN+1);

IconFile:=StringReplace(IconFile,Tmp,'',[]);

end

else

IconIdx:=0;

if FileExists(IconFile) then

begin

Ext:=ExtractFileExt(IconFile);

if LowerCase(Ext)='.ico' then

UnInstallItm.IconImage.Picture.Icon.LoadFromFile(IconFile)

else

UnInstallItm.IconImage.Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(IconFile),IconIdx);

end;

end

else

begin

IconFile:=LowerCase(UnInstallItm.UnInstallCmd) ;

IconFile:=StringReplace(IconFile,'"','',[rfIgnoreCase,rfReplaceAll]);

PN:=Pos('.exe',IconFile);

if PN>0 then

begin

IconFile:=LeftStr(IconFile,(PN+3));

UnInstallItm.IconImage.Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(IconFile),0);

end

else

UnInstallItm.IconImage.Picture.Icon:=Application.Icon ;

end;

if UnInstallItm.IconImage.Picture.Icon.Handle=0 then

UnInstallItm.IconImage.Picture.Icon.Handle:=Application.Icon.Handle ;

Tmp1:=Reg.ReadString(KInstallDate);

if Tmp1<>'' then

InstallDate:=LeftStr(Tmp1,4)+'年'+MidStr(Tmp1,5,2)+'月'+RightStr(Tmp1,2)+'日'

else

InstallDate:='未知';

UnInstallItm.Hint:='名称：'+UnInstallItm.DisplayName+#13+

'版本：'+Reg.ReadString(KDisplayVersion)+#13+

'安装路径：'+UnInstallItm.InstallPath+#13+

'卸载路径：'+UnInstallItm.UnInstallCmd+#13+

'安装日期：'+InstallDate+#13+

'发行公司：'+Reg.ReadString(KPublisher)+#13+

'其他信息：'+Reg.ReadString(KURLInfoAbout)+#13+

'注册表位置：'+'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall\'+UnInstallItm.RegKeyName;

UnInstallItm.IsWindowsUpdata:=Reg.ReadString('ParentKeyName')<>'';

if UnInstallItm.IsWindowsUpdata then

UnInstallItm.Visible:=FShowWinUPs;

UnInstallItm.BtnStandardUnInstall.OnClick:=StandardUnInstall;

UnInstallItm.BtnDelRegString.OnClick:=DelReg;

UnInstallItm.BtnForceUnInstall.OnClick:=UnInstallAndClearn;

UnInstallItm.BtnModify.OnClick:=ModifyInstall;

UnInstallItm.BtnQuitUnInstall.OnClick:=StaticUnInstall;

ItemList.AddObject(UnInstallItm.DisplayName,UnInstallItm) ;

end;

Reg.CloseKey ;

end;

UnInstallList.Free ;

Reg.Free ;

Refresh ;

end;

procedure TUWSUnInstallPanel.ReLoadUnInstallInfos;

begin

Hide;

DestroyUnInstallInfos;

LoadAllUnInstallInfos(FShowWinUPs);

Show ;

end;

procedure TUWSUnInstallPanel.DestroyUnInstallInfos;

var

I:Integer ;

begin

for I:=0 to ItemList.Count -1 do

begin

TUWSUnInstallItem(ItemList.Objects[I]).Free;

end;

ItemList.Clear ;

end;

procedure TUWSUnInstallPanel.SetWinUPVisable;

var

I:Integer ;

Item:TUWSUnInstallItem;

begin

for I:=0 to ItemList.Count -1 do

begin

Item:=TUWSUnInstallItem(ItemList.Objects[I]);

if Item.IsWindowsUpdata then

begin

Item.Visible:=FShowWinUPs ;

end;

procedure TUWSUnInstallPanel.SetShowItemHint;

var

I:Integer ;

Item:TUWSUnInstallItem;

begin

for I:=0 to ItemList.Count -1 do

begin

Item:=TUWSUnInstallItem(ItemList.Objects[I]);

Item.ShowHint:=FShowItemHint;

end;

constructor TUWSUnInstallPanel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FShowWinUPs:=False ;

ItemList:=TStringList.Create ;

LoadAllUnInstallInfos(FShowWinUPs);

AutoScroll:=True ;

AutoSize:=False ;

Constraints.MinWidth:=600;

end;

destructor TUWSUnInstallPanel.Destroy;

begin

DestroyUnInstallInfos;

ItemList.Free;

inherited Destroy;

end;

end.

来源：http://www.cnblogs.com/uws2056/archive/2010/06/26/1765740.html

推荐分享

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

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