myexeu.pas

一百个病毒的源代码 包括熊猫烧香等 极其具有研究价值

(*
作者简介：
官本和 襄樊206信箱 email:[e-mail]
主页：delphivb.8u8.com

本程序仅作网友共享，不得用于商业目的
*)
unit myexeu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls,shellapi,Clipbrd, ExtCtrls, ToolWin, ComCtrls;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    ListBox1: TListBox;
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Image1: TImage;
    Button1: TButton;
    Splitter1: TSplitter;
    BitBtn1: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
  public
  end;
  var
  Form1: TForm1;
  s:string;
  j:integer;

implementation

{$R *.DFM}
 //如果存在文件myexefd.txt,则载入到列表框
procedure TForm1.FormCreate(Sender: TObject);
var i,k:integer;
begin
s:='c:\myexefd.txt';
with image1.Canvas  do begin
    brush.Style:=bssolid;
    brush.Color:=clwhite;
    fillrect(rect(0,0,320,192));
end;
if FileExists(s) then begin
listbox1.items.LoadFromFile(s);
i:=listbox1.Items.Count;
for k:=0 to i-1 do
DrawIcon(image1.Canvas.Handle,32*(k mod 10),32*(k div 10),extracticon(application.Handle,pchar(listbox1.Items.Strings[k]),0));
end;
end;

//在列表框中增加新文件
procedure TForm1.SpeedButton1Click(Sender: TObject);
var i:integer;
begin
i:=listbox1.Items.Count;
if opendialog1.Execute then begin
listbox1.Items.Add(opendialog1.filename);
DrawIcon(image1.Canvas.Handle,32*(i mod 10),32*(i div 10),extracticon(application.Handle,pchar(opendialog1.filename),0));
image1.Refresh;
end;
end;
//将列表框保存到文件myexefd.txt
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
listbox1.items.SaveToFile(s);
end;

//清除列表框和图标
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
listbox1.Clear;
image1.Canvas.fillrect(rect(0,0,320,192));
end;

//版权信息
procedure TForm1.FormClick(Sender: TObject);
begin
application.messagebox(pchar('制作：官本和   2000/4/15'+#13+'  Copyright  2000,2001'),pchar('我的程序夹'),MB_OK);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var i:integer;
begin
i:=listbox1.Items.Count;
j:=(x div 32)+10*(y div 32);
if j>i-1 then form1.Caption:='按右键清除一个文件，双击运行文件'
else  form1.Caption:=listbox1.Items.Strings[j];
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i,k:integer;
begin
i:=listbox1.Items.Count;
j:=(x div 32)+10*(y div 32);
if (button=mbright) and (j<=i-1) then begin
listbox1.Items.Delete(j);
image1.Canvas.fillrect(rect(0,0,320,192));
for k:=0 to i-2 do
DrawIcon(image1.Canvas.Handle,32*(k mod 10),32*(k div 10),extracticon(application.Handle,pchar(listbox1.Items.Strings[k]),0));
end;
end;

procedure TForm1.Image1DblClick(Sender: TObject);
var i:integer;
begin
i:=listbox1.Items.Count;
if (j<=i-1) then begin
close;
winexec(pchar(listbox1.Items.strings[j]),SW_SHOWNORMAL);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var icon:Hicon;
begin
icon:=extracticon(hinstance,pchar('myexe.exe'),0);
shellabout(form1.Handle, pchar('我的程序夹'),pchar('程序编写:官本和  2000年8月'
+#10+#13+'E-mail:[e-mail]'
+#10+#13+'主页：http://delphivb.8u8.com/'
+#10+#13+'本程序仅用于共享，不得用于商业目的')
,icon);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
Var St:Array[0..255] of char;
begin
  ShellExecute(Handle,'open',StrPCopy(St,'http://delphivb.8u8.com/'),nil,nil,SW_SHOW);
end;

end.