论坛: 菜鸟乐园 标题: 请问这是什么语言写的,怎么看有点像PASCAL? 复制本贴地址    
作者: caesar1106 [caesar1106]    论坛用户   登录
unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Timer1: TTimer;

Button1: TButton;

Edit1: TEdit;

Label1: TLabel;

Button2: TButton;

procedure Timer1Timer(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

// 获得窗口文本

function GetWndText(hWnd: HWND): String;

Var

Ret:LongInt;

mText:PChar;

Buf:Integer;

begin

Ret:=SendMessage(hWnd,WM_GETTEXTLENGTH,0,0)+1;

GetMem(mText,Ret);

try

Buf:=LongInt(mText);

SendMessage(hWnd,WM_GETTEXT,Ret,Buf);

Result:=StrPas(mText);

finally

FreeMem(mText,Ret);

end;

end;

// 发送文本到窗口

procedure SetWndText(hWnd: HWND; Text: String);

Var

Ret:LongInt;

mText:PChar;

Buf:Integer;

begin

GetMem(mText,Length(Text));

StrCopy(mText,PChar(Text));

try

Buf:=LongInt(mText);

SendMessage(hWnd,WM_SETTEXT,0,Buf);

finally

FreeMem(mText,Length(Text));

end;

end;

// 取得QQ的发送消息窗口

function GetQQWnd: HWND;

var

hCurrentWindow: HWnd;

WndText:String;

begin

hCurrentWindow := GetWindow(Application.Handle, GW_HWNDFIRST);

while hCurrentWindow <> 0 do

begin

WndText:=GetWndText(hCurrentWindow);

if (Pos('聊天中',WndText)>0) or (Pos('发送消息',WndText)>0) then

begin

Result:=hCurrentWindow;

Exit;

end;

hCurrentWindow := GetWindow(hCurrentWindow, GW_HWNDNEXT);

end;

Result:=0;

end;

// 定时处理

procedure TimerProc;

var

qqWnd,txtWnd,btnWnd:HWND;

Msg:String;

begin

qqWnd:=GetQQWnd;

if qqWnd=0 then Exit;

btnWnd:=GetDlgItem(qqWnd,1); // 发送按钮

txtWnd:=GetWindow(GetDlgItem(qqWnd,0),GW_CHILD); // 文本框

if (btnWnd=0) or (txtWnd=0) then Exit;

Msg:=GetWndText(txtWnd);

Msg:=Msg+#13+#10+'欢迎光临绿荫网络http://www.lvyin.net';

SetWndText(txtWnd,Msg);

SendMessage(btnWnd,WM_LBUTTONDOWN,MK_LBUTTON,0);

SendMessage(btnWnd,WM_LBUTTONUP,0,0);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

TimerProc;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Timer1.Enabled :=not Timer1.Enabled;

if Timer1.Enabled then

Button1.Caption :='停 止'

else

Button1.Caption :='开 始';

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Timer1.Interval :=StrToInt(Edit1.Text);

end;

end.


地主 发表时间: 05-01-03 02:11

论坛: 菜鸟乐园

20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写:NetDemon

粤ICP备05087286号