unit1.pas

本程序主要功能是把所的可执行文件(.exe)都归纳到一样来

unit Unit1;

interface

uses
  Windows, Messages, SysUtils,shellapi, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls, StdCtrls, DB, ADODB;

type
  Tfrmexe = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    Button1: TButton;
    Button2: TButton;
    opd: TOpenDialog;
    ADODataSet1: TADODataSet;
    Button3: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function clvexe(path,byname:string):boolean;
  end;
const
  ConnStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Jet OLEDB:Database Password=%s';

var
  frmexe: Tfrmexe;
  Function Get_ShellInfo(Const Filename:String;Const SmallIcon:Boolean=false):TSHFILEINFO;
  //函数用于获得文件图标
implementation

{$R *.dfm}

Function Get_ShellInfo(Const Filename:String;Const SmallIcon:Boolean=false):TSHFILEINFO;
var        //函数用于获得文件图标
Flags : Integer;
begin
Flags := SHGFI_DISPLAYNAME or SHGFI_TYPENAME or SHGFI_ICON or SHGFI_ATTRIBUTES;
if SmallIcon then Flags := Flags or SHGFI_SMALLICON
else Flags := Flags or SHGFI_LARGEICON;

FillChar(Result,SizeOf(TSHFILEINFO),0);
SHGetFileInfo(Pchar(Filename),0,Result,Sizeof(Result),Flags);
end;

function Tfrmexe.clvexe(path,byname:string):boolean; //增加文件名和图标，并存放文件的路径，
var
Icon_h: hIcon;
Icon: TIcon;
s:PString;
begin
new(s);  //申请空间
result:=false;
try
s^:= path;  //存放这个数据
Icon := TIcon.Create;   //创建一个存放图标的ICon
Icon.Handle := Get_ShellInfo(path ,false).hIcon;//得到文件的图标
listview1.Items.Add.Caption :=byname;//listview1新增文件名
if icon.Empty then
  listview1.Items.Item[listview1.Items.Count-1].ImageIndex :=0   //对应文件名的图标\
else
  begin
   ImageList1.AddIcon (Icon); //把图标存放到imagelist1
   listview1.Items.Item[listview1.Items.Count-1].ImageIndex :=ImageList1.Count-1;   //对应文件名的图标\
 end;
listview1.Items.Item[listview1.Items.Count-1].Data :=s;  //指向这个前地址
result:=true;
except
messagedlg('文件破坏不能载入',mterror,[mbok],0);
end;
end;

procedure Tfrmexe.Button1Click(Sender: TObject);
var s:string;
begin
opd.Title :='载入可执行文件..';
if opd.Execute then      //打开文件
  begin
   s:=Extractfilename(opd.FileName );
   inputquery('输入框 ','请输入文件的别名： ',s) ;
   if clvexe(opd.FileName,s) then         //增加成功，
       adodataset1.InsertRecord([s,opd.FileName]);    //把数据载入到数据
  end
end;

procedure Tfrmexe.FormCreate(Sender: TObject);
var strlocal:string;
begin
strlocal:=ExtractFilePath(Application.ExeName);  //得到文件执行的路径
ListView1.Items.Clear ;
try
  ADODataSet1.Close ;
  ADODataSet1.ConnectionString := Format(ConnStr, [strlocal+'lv.dat', '8686']);//得到数据库的连接路径
  ADODataSet1.CommandText :='select * from exe ';
  ADODataSet1.Open;
  adodataset1.First ;
  while not adodataset1.Eof do      //读出所有的数据
   begin
     clvexe(adodataset1.FieldValues['path'],adodataset1.FieldValues['filename']);//增加到listview
     adodataset1.Next ;
   end;
except
 messagedlg('数据库连接失败',mterror,[mbOK],0);
 exit;
end;
end;

procedure Tfrmexe.Button2Click(Sender: TObject);
begin
if listview1.ItemIndex <0 then
begin
messagedlg('请选择图标在删除',mtinformation,[mbok],0);
listview1.SetFocus ;
exit;
end;
if messagedlg('确定要删除此文件吗？？',mtinformation,[mbyes,mbno],7)=mryes then
    begin
      adodataset1.Filter :='filename='''+ListView1.Selected.Caption+'''';
      adodataset1.Filtered :=true;       //过滤数据删除
      adodataset1.Delete ;
      listview1.DeleteSelected ;
   end;
end;

procedure Tfrmexe.ListView1DblClick(Sender: TObject);
var
s:PString;
begin
new(s);
s:=listview1.Items[listview1.ItemIndex].Data ; //得到对应数据的前地址
try
ShellExecute(handle,nil,PChar(s^),nil,nil, SW_SHOWNORMAL); //s^是对应的数据,并执行文件
except
messagedlg('文件破坏不能载入',mterror,[mbok],0);
exit;
end;
end;

procedure Tfrmexe.Button3Click(Sender: TObject);
begin
close;
end;

end.