🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: cn.bbs.comp.lang.delphi
Article #181

̸Delphi�����"��"��Ӧ��

#181
From: lovpro
Date: Tue, 13 Dec 2005 10:51
1605 lines
46297 bytes
��̸Delphi�����"��"��Ӧ��

����ʲô��������,����˵���ǽ��������������ϵ�һ�ֳ���Ĵ�����ݵĹ�
�ߡ������У�������һЩ������ݵĻ���������ȡ��ݣ�д����ݵȣ�����Ա
�Ƕ����������в����ģ����ù���������һͷ��ݵ������������������Դ���
�ļ��������Դ��?̬�ڴ桢������ݵȶ��������ʽ�����������IJ����dz���
�����ڳ������������ķ����ԣ�д�����������Ч�ʵġ�

���棬����ͨ���ĸ�ʵ��:EXE�ļ������������Ӻؿ�������OICQ��������Ļ������
˵��Delphi�����"��"�����á���Щ�����е�һЩ�������Ǻܶ���������ܶ�
�����ģ����ڴ�ҿ����޳���ֱ���������еĴ����ˡ�

"���ɸ�¥ƽ����"���ڷ���ʵ��֮ǰ�����������˽�һ�����Ļ����ͺ���ֻ
�����������Щ��Ķ��������Dz��ܽ�����һ������������������Щ����
����Ȼ�������������Ѿ�����Ϥ�ˣ�����������һ����

һ��Delphi�����Ļ�����������

��Delphi�У�����������Ļ���ΪTstream�࣬���ж������������Ĺ�ͬ���Ժͷ���
��

Tstream���ж�������Խ������£�

1��Size:���������ֽڷ���������ݴ�С��

2��Position:�����Կ������д�ȡָ���λ�á�

Tstream�ж�����鷽�����ĸ���

1��Read:�˷���ʵ�ֽ���ݴ����ж���������ԭ��Ϊ��

Function Read(var Buffer;Count:Longint):Longint;virtual;abstract;

����BufferΪ��ݶ���ʱ���õĻ�����CountΪ��Ҫ��������ݵ��ֽ���÷���
����ֵΪʵ�ʶ������ֽ��������С�ڻ����Count��ָ����ֵ��

2��Write:�˷���ʵ�ֽ����д�����С�����ԭ��Ϊ��

Function Write(var Buffer;Count:Longint):Longint;virtual;abstract;

����BufferΪ��Ҫд�����е���ݵĻ�����CountΪ��ݵij����ֽ���÷�����
��ֵΪʵ��д�����е��ֽ���

3��Seek:�˷���ʵ�����ж�ȡָ����ƶ�������ԭ��Ϊ��

Function Seek(Offset:Longint;Origint:Word):Longint;virtual;abstract;

����OffsetΪƫ���ֽ���,����Origintָ��Offset��ʵ�����壬����ܵ�ȡֵ����
��

soFromBeginning:OffsetΪ�ƶ���ָ�������ݿ�ʼ��λ�á���ʱOffset�������
���ߵ����㡣

soFromCurrent:OffsetΪ�ƶ���ָ���뵱ǰָ������λ�á�

soFromEnd:OffsetΪ�ƶ���ָ�������ݽ����λ�á���ʱOffset����С�ڻ��ߵ�
���㡣�÷�������ֵΪ�ƶ���ָ���λ�á�

4��Setsize:�˷���ʵ�ָı���ݵĴ�С������ԭ��Ϊ��

Function Setsize(NewSize:Longint);virtual;

���⣬Tstream���л������˼�����̬������

1��ReadBuffer:�˷����������Ǵ����е�ǰλ�ö�ȡ��ݡ�����ԭ��Ϊ��

Procedure ReadBuffer(var Buffer;Count:Longint);

����Ķ���������Read��ͬ��ע�⣺����ȡ������ֽ�������Ҫ��ȡ���ֽ���
��ͬʱ��������EReadError�쳣��

2��WriteBuffer:�˷������������ڵ�ǰλ������д����ݡ�����ԭ��Ϊ��

Procedure WriteBuffer(var Buffer;Count:Longint);

����Ķ���������Write��ͬ��ע�⣺��д�������ֽ�������Ҫд����ֽ���
��ͬʱ��������EWriteError�쳣��

3��CopyFrom:�˷����������Ǵ��������п��������������ԭ��Ϊ��

Function CopyFrom(Source:Tstream;Count:Longint):Longint;

����SourceΪ�ṩ��ݵ�����CountΪ����������ֽ���Count����0ʱ��CopyF
rom��Source����ĵ�ǰλ�ÿ���Count���ֽڵ���ݣ���Count����0ʱ��CopyFrom
����Source�����Position����Ϊ0,Ȼ�󿽱�Source��������ݣ�

Tstream�������������࣬������õ���TFileStream�ࡣʹ��TFileStream������
ȡ�ļ�������Ҫ����һ��ʵ���������£�

constructor Create(const Filename:string;Mode:Word);

FilenameΪ�ļ������·����,����ModeΪ���ļ��ķ�ʽ��������ļ��Ĵ�ģ
ʽ�͹���ģʽ������ܵ�ȡֵ���������£�

��ģʽ��

fmCreate :��ָ�����ļ������ļ�������ļ��Ѿ����������

fmOpenRead :��ֻ����ʽ��ָ���ļ�

fmOpenWrite :��ֻд��ʽ��ָ���ļ�

fmOpenReadWrite:��дд��ʽ��ָ���ļ�

����ģʽ��

fmShareCompat :����ģʽ��FCBs����

fmShareExclusive:�������ij������κη�ʽ�򿪸��ļ�

fmShareDenyWrite:�������ij�����д��ʽ�򿪸��ļ�

fmShareDenyRead :�������ij����Զ���ʽ�򿪸��ļ�

fmShareDenyNone :��ij���������κη�ʽ�򿪸��ļ�

Tstream����һ��������TMemoryStream��ʵ��Ӧ�����õĴ���Ҳ�dz�Ƶ���������
����������˵���ڴ��н���һ����������Ļ����ͺ����������һ��ġ�

���ˣ���������Ļ�����ǾͿ��Կ�ʼ���ǵı��֮���ˡ�

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

����ʵ��Ӧ��֮һ������������EXE�ļ��������������Խ�ѹ�ļ�����װ����

��������˵һ���������һ��EXE�ļ��������ɡ� 

EXE�ļ���������ԭ�?���������ļ���һ�����������Դ������һ��EXE�ļ�����
����Ϊ��ӳ�������һ������ӵ�EXE�ļ���Ϊͷ�ļ����ó���Ĺ����ǰ���ӵ�
�Լ�������ļ���������Windows�µ�EXE�ļ��ṹ�Ƚϸ��ӣ��еij�����У���
���������Լ����ı�����Ϊ�Լ���������Ⱦ��ܾ�ִ�С��������ǰ��ļ���ӵ�
�Լ��ij������棬����Ͳ���ı�ԭ�����ļ��ṹ�ˡ�������дһ����Ӻ����
����Ĺ����ǰ�һ���ļ�����һ������ӵ�����һ���ļ���β�����������£�

Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;

var

Target,Source:TFileStream;

MyFileSize:integer;

begin

try

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);

Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);

try

Target.Seek(0,soFromEnd);//��β�������Դ

Target.CopyFrom(Source,0);

MyFileSize:=Source.Size+Sizeof(MyFileSize);//������Դ��С����д�븨��β��


Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));

finally

Target.Free;

Source.Free;

end;

except

Result:=False;

Exit;

end;

Result:=True;

end;

��������Ļ�����Ӧ�ú����׿��ö�����������в���SourceFile��Ҫ���
���ļ�,����TargetFile�DZ���ӵ���Ŀ���ļ�������˵��a.exe��ӵ�b.exe�����
�ԣ�Cjt_AddtoFile('a.exe',b.exe');�����ӳɹ��ͷ���True���򷵻ؼ١�

�������ĺ������ǿ���д���෴�Ķ�������

Function Cjt_LoadFromFile(SourceFile,TargetFile :string):Boolean;

var

Source:TFileStream;

Target:TMemoryStream;

MyFileSize:integer;

begin

try

Target:=TMemoryStream.Create;

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);

try

Source.Seek(-sizeof(MyFileSize),soFromEnd);

Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));//������Դ��С

Source.Seek(-MyFileSize,soFromEnd);//��λ����Դλ��

Target.CopyFrom(Source,MyFileSize-sizeof(MyFileSize));//ȡ����Դ

Target.SaveToFile(TargetFile);//��ŵ��ļ�

finally

Target.Free;

Source.Free;

end;

except

Result:=false;

Exit;

end;

Result:=true;

end;

���в���SourceFile���Ѿ�������ļ����ļ����,����TargetFile��ȡ���ļ���
���Ŀ���ļ������˵Cjt_LoadFromFile('b.exe','a.txt');��b.exe��ȡ���ļ�
����Ϊa.txt�����ȡ���ɹ��ͷ���True���򷵻ؼ١�

��Delphi���½�һ�����̣��ڴ����Ϸ���һ��Edit�ؼ�Edit1������Button:Butt
on1��Button2��Button��Caption���Էֱ�����Ϊ"ȷ��"��"ȡ��"����Button1��Cl
ick�¼���д����:

var S:string;

begin

S:=ChangeFileExt(Application.ExeName,'.Cjt');

if Edit1.Text='790617' then 

begin

Cjt_LoadFromFile(Application.ExeName,S);

{ȡ���ļ������ڵ�ǰ·���²�����"ԭ�ļ�.Cjt"}

Winexec(pchar(S),SW_Show);{����"ԭ�ļ�.Cjt"}

Application.Terminate;{�˳�����}

end

else 

Application.MessageBox('���벻��,���������룡','�������',MB_ICONERROR+M
B_OK);

����������򣬲���EXE�ļ�����Ϊhead.exe���½�һ���ı��ļ�head.rc,����Ϊ:
 head exefile head.exe,Ȼ������ǿ�����Delphi��BINĿ¼�£�ִ��Dos����Brc
c32.exe head.rc,������һ��head.res���ļ�������ļ���������Ҫ����Դ�ļ���
�����š�

���ǵ�ͷ�ļ��Ѿ������ˣ�����������������ӳ���

�½�һ�����̣��������¿ؼ���һ��Edit,һ��Opendialog,����Button1��Caption
���Էֱ�����Ϊ"ѡ���ļ�"��"����"����Դ���������һ��:{$R head.res}����he
ad.res�ļ�����������ǰĿ¼�¡�����һ���ͰѸղŵ�head.exe�����һ�����
�ˡ�

��Button1��Cilck�¼�����д�´��룺

if OpenDialog1.Execute then Edit1.Text:=OpenDialog1.FileName;

��Button2��Cilck�¼�����д�´��룺

var S:String;

begin

S:=ExtractFilePath(Edit1.Text);

if ExtractRes('exefile','head',S+'head.exe') then

if Cjt_AddtoFile(Edit1.Text,S+'head.exe') then

if DeleteFile(Edit1.Text) then

if RenameFile(S+'head.exe',Edit1.Text) then

Application.MessageBox('�ļ����ܳɹ�!','��Ϣ',MB_ICONINFORMATION+MB_OK)

else

begin

if FileExists(S+'head.exe') then DeleteFile(S+'head.exe');

Application.MessageBox('�ļ�����ʧ��!','��Ϣ',MB_ICONINFORMATION+MB_OK)

end;

end;

����ExtractResΪ�Զ��庯����������ǰ�head.exe����Դ�ļ���ȡ������

Function ExtractRes(ResType, ResName, ResNewName : String):boolean;

var

Res : TResourceStream;

begin

try

Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));

try

Res.SavetoFile(ResNewName);

Result:=true;

finally

Res.Free;

end;

except

Result:=false;

end;

end;

ע�⣺��������ĺ���ֻ�����Ǽ򵥵İ�һ���ļ���ӵ���һ���ļ���β����ʵ��
Ӧ���п��Ըijɿ�����Ӷ���ļ���ֻҪ���ʵ�ʴ�С�͸������ƫ�Ƶ�ַ�Ϳ�
���ˡ�����˵�ļ��������ǰ��������߶��������ӵ�һ��ͷ�ļ����档��Щ��
��ѹ����Ͱ�װ�����ԭ��Ҳ��һ��ģ��������ѹ�����ѡ�����˵���ǿ�������
һ��LAH��Ԫ������ѹ��������ӣ������ļ��ͻ��ĺ�С��������ʱ�Ƚ�ѹ�Ϳ���
�ˡ����⣬����EXE�����������ӻ��кܶ಻���Ƶĵط�������˵����̶�Ϊ"7906
17"��ȡ��EXE���к�Ӧ�õ���������Ϻ�ɾ��ȵȣ����߿��������޸ġ�

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

��ʵ��Ӧ��֮����������������ִ�е��Ӻؿ�

���Ǿ�������һЩ���Ӻؿ�֮���������������������Լ�ѡ��ͼƬ��Ȼ�������
��һ��EXE��ִ���ļ����㡣�򿪺ؿ�ʱ�ͻ�һ�߷�����һ����ʾ��ͼƬ��������ѧ
��������֮������Ҳ������һ���ˡ� 

���ͼƬ������ǿ���ֱ����ǰ���Cjt_AddtoFile��������Ҫ��������ΰ�ͼ���
������ʾ��������ǰ���Cjt_LoadFromFile�Ȱ�ͼƬ����������Ϊ�ļ��ٵ���Ҳ��
���Եģ����ǻ��и�򵥵ķ���������ֱ�Ӱ��ļ�����������ʾ���������������
��һ�ж���ļ��ˡ�

���ڵ�ͼƬ�Ƚ����е���BMP��ʽ��JPG��ʽ���������ھ����������ͼƬд����ȡ
����ʾ����

Function Cjt_BmpLoad(ImgBmp:Timage;SourceFile:String):Boolean;

var

Source:TFileStream;

MyFileSize:integer;

begin

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);

try

try

Source.Seek(-sizeof(MyFileSize),soFromEnd);

Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));//������Դ

Source.Seek(-MyFileSize,soFromEnd);//��λ����Դ��ʼλ��

ImgBmp.Picture.Bitmap.LoadFromStream(Source);

finally

Source.Free;

end;

except

Result:=False;

Exit;

end;

Result:=True;

end;

�����Ƕ���BMPͼƬ�ģ�������Ƕ���JPGͼƬ�ĺ�����ΪҪ�õ�JPG��Ԫ������Ҫ
�ڳ��������һ��:uses jpeg��

Function Cjt_JpgLoad(JpgImg:Timage;SourceFile:String):Boolean;

var

Source:TFileStream;

MyFileSize:integer;

Myjpg: TJpegImage;

begin

try

Myjpg:= TJpegImage.Create;

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);

try

Source.Seek(-sizeof(MyFileSize),soFromEnd);

Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));

Source.Seek(-MyFileSize,soFromEnd);

Myjpg.LoadFromStream(Source);

JpgImg.Picture.Bitmap.Assign(Myjpg);

finally

Source.Free;

Myjpg.free;

end;

except

Result:=false;

Exit;

end;

Result:=true;

end;

�����������������ǾͿ����������������ˡ�����������BMPͼƬΪ��

����Delphi���½�һ�����̣�����һ����ʾͼ��ؼ�Image1���ڴ��ڵ�Create�¼�
��д��һ��Ϳ����ˣ�

Cjt_BmpLoad(Image1,Application.ExeName);

�������ͷ�ļ��ˣ�Ȼ��������ǰ��ķ������һ��head.res��Դ�ļ���

����Ϳ��Կ�ʼ�������ǵ���ӳ����ˡ�ȫ���������£�

unit Unit1;

interface

uses

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

ExtCtrls, StdCtrls, ExtDlgs;

type

TForm1 = class(Tform)

Edit1: Tedit;

Button1: Tbutton;

Button2: Tbutton;

OpenPictureDialog1: TOpenPictureDialog;

procedure FormCreate(Sender: Tobject);

procedure Button1Click(Sender: Tobject);

procedure Button2Click(Sender: Tobject);

private

Function ExtractRes(ResType, ResName, ResNewName : String):boolean;

Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

Function TForm1.ExtractRes(ResType, ResName, ResNewName : String):boolea
n;

var

Res : TResourceStream;

begin

try

Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));

try

Res.SavetoFile(ResNewName);

Result:=true;

finally

Res.Free;

end;

except

Result:=false;

end;

end;

Function TForm1.Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;

var

Target,Source:TFileStream;

MyFileSize:integer;

begin

try

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);

Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);

try

Target.Seek(0,soFromEnd);//��β�������Դ

Target.CopyFrom(Source,0);

MyFileSize:=Source.Size+Sizeof(MyFileSize);//������Դ��С����д�븨��β��


Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));

finally

Target.Free;

Source.Free;

end;

except

Result:=False;

Exit;

end;

Result:=True;

end;

procedure TForm1.FormCreate(Sender: Tobject);

begin

Caption:='Bmp2Exe��ʾ����.����:�¾��';

Edit1.Text:='';

OpenPictureDialog1.DefaultExt := GraphicExtension(Tbitmap);

OpenPictureDialog1.Filter := GraphicFilter(Tbitmap);

Button1.Caption:='ѡ��BMPͼƬ';

Button2.Caption:='���EXE';

end;

procedure TForm1.Button1Click(Sender: Tobject);

begin

if OpenPictureDialog1.Execute then

Edit1.Text:=OpenPictureDialog1.FileName;

end;

procedure TForm1.Button2Click(Sender: Tobject);

var

HeadTemp:String;

begin

if Not FileExists(Edit1.Text) then

begin

Application.MessageBox('BMPͼƬ�ļ������ڣ�������ѡ��!','��Ϣ',MB_ICONIN
FORMATION+MB_OK)

Exit;

end;

HeadTemp:=ChangeFileExt(Edit1.Text,'.exe');

if ExtractRes('exefile','head',HeadTemp) then

if Cjt_AddtoFile(Edit1.Text,HeadTemp) then

Application.MessageBox('EXE�ļ���ɳɹ�!','��Ϣ',MB_ICONINFORMATION+MB_O
K)

else

begin

if FileExists(HeadTemp) then DeleteFile(HeadTemp);

Application.MessageBox('EXE�ļ����ʧ��!','��Ϣ',MB_ICONINFORMATION+MB_O
K)

end;

end;

end.

��ô��������:)�ѳ������Ū��Ư���㣬�����һЩ���ܣ���ᷢ�ֱ�����Щ
Ҫע��������Ҳ����ѷ���ٰɡ�

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

ʵ��Ӧ��֮�������������Լ���OICQ

OICQ��������Ѷ��˾��һ������ʵʱͨѶ������ڹ���ӵ�д������û�Ⱥ����OICQ
���������ϻ������½����Ѷ�ķ���������ʹ�á��������ǿ����Լ�дһ���ھֲ�
������ʹ�á�

OICQʹ�õ���UDPЭ�飬����һ��������Э�飬��ͨ��˫�����ý������ӾͿ��Է���
��Ϣ������Ч�ʱȽϸߡ�Delphi�����Դ��FastNEt��˾��NMUDP�ؼ�����һ��UDPЭ
����û���ݱ��ؼ�������Ҫע����������ʹ��������ؼ������˳�������ܹ�
�ռ������ΪTNMXXX�ؼ���BUG������nm�ؼ��Ļ� PowerSocket�õ���ThreadT
imer���õ�һ�����صĴ��ڣ���ΪTmrWindowClass��������Ӳ�ˡ�

������ĵط���

Psock::TThreadTimer::WndProc(var msg:Tmessage)

if msg.message=WM_TIMER then

���Լ�����

msg.result:=0

else

msg.result:=DefWindowProc(0,��.)

end 

����ͳ��ڵ��� DefWindowProcʱ�������HWND�����Ȼ�dz���0������ʵ����Def
WindowProc�Dz��ܹ����ģ����κ��������Ϣ�ĵ��þ��0������WM_QUERYENDSE
SSION�����Բ����˳�windows������DefWindowProc�IJ�����ã�ʵ���ϳ�WM_TI
MER��������Ϣ��DefWindowProc���?����Ч�ġ�

����İ취���� Psock.pas

�� TThreadTimer.Wndproc ��

Result := DefWindowProc( 0, Msg, WPARAM, LPARAM );

����

Result := DefWindowProc( FWindowHandle, Msg, WPARAM, LPARAM );

���ڵͰ汾��OICQҲ��������⣬���ر�OICQ�Ļ����رռ����ʱ��Ļ����һ
���ַ����ˡ�

���ˣ��ϻ���˵�������DZ�д���ǵ�OICQ��,���ʵ������Delphi�Դ�����Ӷ���:
)

�½�һ�����̣���FASTNET�����һ��NMUDP�ؼ������ڣ�Ȼ�����η������EDIT,��
�ֱַ�ΪEditIP��EditPort��EditMyTxt�������ťBtSend��BtClear��BtSave��һ
��MEMOMemoReceive��һ��SaveDialog��һ��״̬��StatusBar1�����û����BtSen
dʱ������һ���ڴ������󣬰�Ҫ���͵�������Ϣд���ڴ�����Ȼ��NMUDP��������
��ȥ����NMUDP����ݽ���ʱ���������DataReceived�¼��������������ٰѽ��յ�
����ת��Ϊ�ַ���Ϣ��Ȼ����ʾ������

ע�⣺���е�����������ʹ����Ϻ�Ҫ�ǵ��ͷ�(Free)����ʵ����͹�����Ӧ��
ΪDestroy�����������ʧ�ܵĻ�����Destroy������쳣������Free�Ļ������
�ȼ����û�гɹ�����������������˲��ͷţ�������Free�Ƚϰ�ȫ��

����������������õ���NMUDP�ؼ������м�����Ҫ�����ԡ�RemoteHost��ʾԶ�̵�
�Ե�IP���߼������LocalPort�DZ��ض˿ڣ���Ҫ������û����ݴ��롣��Remot
ePort��Զ�̶˿ڣ��������ʱͨ������˿ڰ���ݷ��ͳ�ȥ�������Щ�Ѿ����Կ�
�����ǵij����ˡ�

ȫ���������£�

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
,StdCtrls, ComCtrls,NMUDP;

type

TForm1 = class(Tform)

NMUDP1: TNMUDP;

EditIP: Tedit;

EditPort: Tedit;

EditMyTxt: Tedit;

MemoReceive: Tmemo; 

BtSend: Tbutton;

BtClear: Tbutton;

BtSave: Tbutton;

StatusBar1: TStatusBar; 

SaveDialog1: TSaveDialog;

procedure BtSendClick(Sender: Tobject);

procedure NMUDP1DataReceived(Sender: Tcomponent; NumberBytes: Integer;

FromIP: String; Port: Integer);

procedure NMUDP1InvalidHost(var handled: Boolean);

procedure NMUDP1DataSend(Sender: Tobject);

procedure FormCreate(Sender: Tobject);

procedure BtClearClick(Sender: Tobject);

procedure BtSaveClick(Sender: Tobject);

procedure EditMyTxtKeyPress(Sender: Tobject; var Key: Char);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BtSendClick(Sender: Tobject);

var

MyStream: TMemoryStream;

MySendTxt: String;

Iport,icode:integer;

Begin

Val(EditPort.Text,Iport,icode);

if icode<>0 then

begin

Application.MessageBox('�˿ڱ���Ϊ���֣�����������!','��Ϣ',MB_ICONINFOR
MATION+MB_OK);

Exit;

end;

NMUDP1.RemoteHost := EditIP.Text; {Զ������}

NMUDP1.LocalPort:=Iport; {���ض˿�}

NMUDP1.RemotePort := Iport; {Զ�̶˿�}

MySendTxt := EditMyTxt.Text;

MyStream := TMemoryStream.Create; {������}

try

MyStream.Write(MySendTxt[1], Length(EditMyTxt.Text));{��}

NMUDP1.SendStream(MyStream); {������}

finally

MyStream.Free; {�ͷ���}

end;

end;

procedure TForm1.NMUDP1DataReceived(Sender: Tcomponent;

NumberBytes: Integer; FromIP: String; Port: Integer);

var

MyStream: TMemoryStream;

MyReciveTxt: String;

begin

MyStream := TMemoryStream.Create; {������}

try

NMUDP1.ReadStream(MyStream);{������}

SetLength(MyReciveTxt,NumberBytes);{NumberBytesΪ���յ����ֽ���}

MyStream.Read(MyReciveTxt[1],NumberBytes);{�����}

MemoReceive.Lines.Add('���յ���������'+FromIP+'����Ϣ:'+MyReciveTxt);

finally

MyStream.Free; {�ͷ���}

end;

end;

procedure TForm1.NMUDP1InvalidHost(var handled: Boolean);

begin

Application.MessageBox('�Է�IP��ַ����ȷ������������!','��Ϣ',MB_ICONINF
ORMATION+MB_OK);

end;

procedure TForm1.NMUDP1DataSend(Sender: Tobject);

begin

StatusBar1.SimpleText:='��Ϣ�ɹ�����!';

end;

procedure TForm1.FormCreate(Sender: Tobject);

begin

EditIP.Text:='127.0.0.1';

EditPort.Text:='8868';

BtSend.Caption:='����';

BtClear.Caption:='��������¼';

BtSave.Caption:='���������¼';

MemoReceive.ScrollBars:=ssBoth;

MemoReceive.Clear;

EditMyTxt.Text:='������������Ϣ,Ȼ��������.';

StatusBar1.SimplePanel:=true;

end;

procedure TForm1.BtClearClick(Sender: Tobject);

begin

MemoReceive.Clear;

end;

procedure TForm1.BtSaveClick(Sender: Tobject);

begin

if SaveDialog1.Execute then MemoReceive.Lines.SaveToFile(SaveDialog1.Fil
eName);

end;

procedure TForm1.EditMyTxtKeyPress(Sender: Tobject; var Key: Char);

begin

if Key=#13 then BtSend.Click;

end;

end.

����ij����OICQ��ȵ�Ȼ��֮��Զ����ΪOICQ���õ���Socket5ͨ�ŷ�ʽ��������
ʱ�ȴӷ�����ȡ�غ�����Ϣ������״̬�����ͳ�ʱ���Ὣ��Ϣ�ȱ����ڷ���������
�Է��´����ߺ��ٷ���Ȼ��ѷ������ı���ɾ������Ը��ǰ��ѧ�ĸ���������
������򣬱���˵�����һ��NMUDP�ؼ�����������״̬�����͵���Ϣ��ת����ASC
II�����������в�����һ��ͷ��Ϣ�����շ�������Ϣ�����ж���Ϣͷ��ȷ���
�����ȷ�Ű���Ϣ������ʾ���������������˰�ȫ�����ԡ�

���⣬UDPЭ�黹��һ���ܴ�ĺô����ǿ��Թ㲥������˵����һ����εĶ����Խ�
�յ���Ϣ���ָ�������IP��ַ�����һ���A��B��C����,

1~126.XXX.XXX.XXX (A����) :�㲥��ַΪXXX.255.255.255

128~191.XXX.XXX.XXX(B����):�㲥��ַΪXXX.XXX.255.255

192~254.XXX.XXX.XXX(C����):�㲥��ַΪXXX.XXX.XXX.255

����˵��̨�����192.168.0.1��192.168.0.10��192.168.0.18��������ϢʱֻҪָ
��IP��ַΪ192.168.0.255�Ϳ���ʵ�ֹ㲥�ˡ�������һ��ת��IPΪ�㲥IP�ĺ���
������ȥ�����Լ���OICQ��^-^.

Function Trun_ip(S:string):string;

var s1,s2,s3,ss,sss,Head:string;

n,m:integer;

begin

sss:=S;

n:=pos('.',s);

s1:=copy(s,1,n);

m:=length(s1);

delete(s,1,m);

Head:=copy(s1,1,(length(s1)-1));

n:=pos('.',s);

s2:=copy(s,1,n);

m:=length(s2);

delete(s,1,m);

n:=pos('.',s);

s3:=copy(s,1,n);

m:=length(s3);

delete(s,1,m);

ss:=sss;

if strtoint(Head) in [1..126] then ss:=s1+'255.255.255'; //1~126.255.255
.255 (A����)

if strtoint(Head) in [128..191] then ss:=s1+s2+'255.255';//128~191.XXX.2
55.255(B����)

if strtoint(Head) in [192..254] then ss:=s1+s2+s3+'255'; //192~254.XXX.X
XX.255(C����)

Result:=ss; 

end;

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

�塢ʵ��Ӧ��֮�ģ�������ʵ�����紫����Ļͼ��

���Ӧ�ü��ܶ���ܳ����������������һ�����ܾ��Ǽ��Զ�̵��Ե���Ļ��
ʵ���ϣ���Ҳ��������������ʵ�ֵġ��������Ǹ��һ�����ӣ�������ӷ�������
��һ������ˣ�һ���ǿͻ��ˡ������������ֱ���ڵ���ֲ�����߻�����
��ʹ�á��������Ѿ������Ӧע�͡������������������������

�½�һ�����̣���Internet�������һ��ServerSocket�ؼ������ڣ��ÿؼ���Ҫ��
�ڼ���ͻ��ˣ�������ͻ��˽������Ӻ�ͨѶ�����úü���˿ں���÷���Open��
��Active:=True����ʼ������ע�⣺��ǰ���NMUDP��ͬ����Socket��ʼ�����Ͳ�
���ٸı���Ķ˿ڣ�Ҫ�ı�Ļ������ȵ���Close������ActiveΪFalse�����򽫻�
�����쳣�����⣬���ö˿��Ѿ��򿪵Ļ����Ͳ�����������˿��ˡ����Գ�����
����δ�˳��Ͳ���������������򣬷���Ҳ������쳣�����������?�ڡ�ʵ��Ӧ
���п���ͨ���жϳ����Ƿ��Ѿ����У�����Ѿ����о��˳��ķ�����������?

���ͻ�������ݴ��룬������ServerSocket1ClientRead�¼������ǿ���������Խ�
�յ���ݽ��д��?�ڱ������У���Ҫ�ǽ��տͻ��˷��͹������ַ���Ϣ�������
�ȵ�Լ����������Ӧ������

����ȫ���������£�

unit Unit1;{����˳���}

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
, JPEG,ExtCtrls, ScktComp;

type

TForm1 = class(Tform)

ServerSocket1: TServerSocket;

procedure ServerSocket1ClientRead(Sender: Tobject;Socket: TCustomWinSock
et);

procedure FormCreate(Sender: Tobject);

procedure FormClose(Sender: Tobject; var Action: TCloseAction);

private

procedure Cjt_GetScreen(var Mybmp: Tbitmap; DrawCur: Boolean);

{�Զ���ץ������,DrawCur��ʾץ���ͼ�����}

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

MyStream: Tmemorystream;{�ڴ�������} 

implementation

{$R *.DFM}

procedure TForm1.Cjt_GetScreen(var Mybmp: Tbitmap; DrawCur: Boolean);

var

Cursorx, Cursory: integer;

dc: hdc;

Mycan: Tcanvas;

R: Trect;

DrawPos: Tpoint;

MyCursor: Ticon;

hld: hwnd;

Threadld: dword;

mp: tpoint;

pIconInfo: TIconInfo;

begin

Mybmp := Tbitmap.Create; {����BMPMAP }

Mycan := Tcanvas.Create; {��Ļ��ȡ}

dc := GetWindowDC(0);

try

Mycan.Handle := dc;

R := Rect(0, 0, screen.Width, screen.Height);

Mybmp.Width := R.Right;

Mybmp.Height := R.Bottom;

Mybmp.Canvas.CopyRect(R, Mycan, R);

finally

releaseDC(0, DC);

end;

Mycan.Handle := 0;

Mycan.Free;

if DrawCur then {�������ͼ��}

begin

GetCursorPos(DrawPos);

MyCursor := Ticon.Create;

getcursorpos(mp);

hld := WindowFromPoint(mp);

Threadld := GetWindowThreadProcessId(hld, nil);

AttachThreadInput(GetCurrentThreadId, Threadld, True);

MyCursor.Handle := Getcursor();

AttachThreadInput(GetCurrentThreadId, threadld, False);

GetIconInfo(Mycursor.Handle, pIconInfo);

cursorx := DrawPos.x - round(pIconInfo.xHotspot);

cursory := DrawPos.y - round(pIconInfo.yHotspot);

Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {�������}

DeleteObject(pIconInfo.hbmColor);{GetIconInfo ʹ��ʱ����������bitmap����
. ��Ҫ�ֹ��ͷ�����������}

DeleteObject(pIconInfo.hbmMask);{����,�������,��ᴴ��һ��bitmap,��ε�
�û������,ֱ����Դ�ľ�}

Mycursor.ReleaseHandle; {�ͷ������ڴ�}

MyCursor.Free; {�ͷ����ָ��}

end; 

end;

procedure TForm1.FormCreate(Sender: Tobject);

begin

ServerSocket1.Port := 3000; {�˿�}

ServerSocket1.Open; {Socket��ʼ����}

end;

procedure TForm1.FormClose(Sender: Tobject; var Action: TCloseAction);

begin

if ServerSocket1.Active then ServerSocket1.Close; {�ر�Socket}

end;

procedure TForm1.ServerSocket1ClientRead(Sender: Tobject;

Socket: TCustomWinSocket);

var

S, S1: string;

MyBmp: Tbitmap;

Myjpg: Tjpegimage;

begin

S := Socket.ReceiveText;

if S = 'cap' then {�ͻ��˷���ץ��Ļָ��}

begin

try

MyStream := Tmemorystream.Create;{�����ڴ���}

MyBmp := Tbitmap.Create;

Myjpg := Tjpegimage.Create;

Cjt_GetScreen(MyBmp, True); {True��ʾץ���ͼ��}

Myjpg.Assign(MyBmp); {��BMPͼ��ת��JPG��ʽ,�����ڻ������ϴ���}

Myjpg.CompressionQuality := 10; {JPG�ļ�ѹ���ٷֱ�����,����Խ��ͼ��Խ����
,�����ҲԽ��}

Myjpg.SaveToStream(MyStream); {��JPGͼ��д������}

Myjpg.free;

MyStream.Position := 0;{ע��:������Ӵ˾�}

s1 := inttostr(MyStream.size);{���Ĵ�С}

Socket.sendtext(s1); {��������С}

finally

MyBmp.free;

end;

end;

if s = 'ready' then {�ͻ�����׼���ý���ͼ��}

begin

MyStream.Position := 0;

Socket.SendStream(MyStream); {�������ͳ�ȥ}

end;

end;

end.

�����Ƿ���ˣ�����������д�ͻ��˳����½�һ�����̣����Socket�ؼ�Client
Socket��ͼ����ʾ�ؼ�Image��һ�� Panel ��һ��Edit������ Button��һ��״̬��
�ؼ�StatusBar1��ע�⣺��Edit1������ Button����Panel1���档ClientSocket��
���Ը�ServerSocket��࣬�������һ��Address���ԣ���ʾҪ���ӵķ����IP��
ַ������IP��ַ���"����"�������˳��������ӣ����ɹ��Ϳ��Խ���ͨѶ��
�����"ץ��"�������ַ�����ˡ���Ϊ�����õ���JPEGͼ��Ԫ������Ҫ��Uses
�����Jpeg.

ȫ���������£�

unit Unit2{�ͻ���};

interface

uses

Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,StdCtr
ls,ScktComp,ExtCtrls,Jpeg, ComCtrls;

type

TForm1 = class(Tform)

ClientSocket1: TClientSocket;

Image1: Timage;

StatusBar1: TStatusBar;

Panel1: Tpanel;

Edit1: Tedit;

Button1: Tbutton;

Button2: Tbutton;

procedure Button1Click(Sender: Tobject);

procedure ClientSocket1Connect(Sender: Tobject;

Socket: TCustomWinSocket);

procedure Button2Click(Sender: Tobject);

procedure ClientSocket1Error(Sender: Tobject; Socket: TCustomWinSocket;

ErrorEvent: TErrorEvent; var ErrorCode: Integer);

procedure ClientSocket1Read(Sender: Tobject; Socket: TCustomWinSocket);

procedure FormCreate(Sender: Tobject);

procedure FormClose(Sender: Tobject; var Action: TCloseAction);

procedure ClientSocket1Disconnect(Sender: Tobject;

Socket: TCustomWinSocket);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

MySize: Longint;

MyStream: Tmemorystream;{�ڴ�������}

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: Tobject);

begin

{-------- ����Ϊ���ô��ڿؼ���������� ------------- }

{ע��:��Button1��Button2��Edit1����Panel1����}

Edit1.Text := '127.0.0.1';

Button1.Caption := '��������';

Button2.Caption := 'ץ��Ļ';

Button2.Enabled := false;

Panel1.Align := alTop;

Image1.Align := alClient;

Image1.Stretch := True;

StatusBar1.Align:=alBottom;

StatusBar1.SimplePanel := True;

{----------------------------------------------- }

MyStream := Tmemorystream.Create; {�����ڴ�������}

MySize := 0; {��ʼ��}

end;

procedure TForm1.Button1Click(Sender: Tobject);

begin

if not ClientSocket1.Active then

begin

ClientSocket1.Address := Edit1.Text; {Զ��IP��ַ}

ClientSocket1.Port := 3000; {Socket�˿�}

ClientSocket1.Open; {��������}

end;

end;

procedure TForm1.Button2Click(Sender: Tobject);

begin

Clientsocket1.Socket.SendText('cap'); {����ָ��֪ͨ�����ץȡ��Ļͼ��}

Button2.Enabled := False;

end;

procedure TForm1.ClientSocket1Connect(Sender: Tobject;

Socket: TCustomWinSocket);

begin

StatusBar1.SimpleText := '������' + ClientSocket1.Address + '�ɹ���������
!';

Button2.Enabled := True;

end;

procedure TForm1.ClientSocket1Error(Sender: Tobject;

Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

var ErrorCode: Integer);

begin

Errorcode := 0; {���������?��}

StatusBar1.SimpleText := '�޷�������' + ClientSocket1.Address + '��������
!';

end;

procedure TForm1.ClientSocket1Disconnect(Sender: Tobject;

Socket: TCustomWinSocket);

begin

StatusBar1.SimpleText := '������' + ClientSocket1.Address + '�Ͽ�����!';


Button2.Enabled := False;

end;

procedure TForm1.ClientSocket1Read(Sender: Tobject;

Socket: TCustomWinSocket);

var

MyBuffer: array[0..10000] of byte; {���ý��ջ�����}

MyReceviceLength: integer;

S: string;

MyBmp: Tbitmap;

MyJpg: Tjpegimage;

begin

StatusBar1.SimpleText := '���ڽ�����ݡ���';

if MySize = 0 then {MySizeΪ����˷��͵��ֽ������Ϊ0��ʾΪ��δ��ʼͼ��
����}

begin

S := Socket.ReceiveText;

MySize := Strtoint(S); {��������յ��ֽ���}

Clientsocket1.Socket.SendText('ready'); {��ָ��֪ͨ����˿�ʼ����ͼ��}

end

else

begin {����Ϊͼ����ݽ��ղ���}

MyReceviceLength := socket.ReceiveLength; {�������}

StatusBar1.SimpleText := '���ڽ������,��ݴ�СΪ:' + inttostr(MySize);

Socket.ReceiveBuf(MyBuffer, MyReceviceLength); {������ݰ���뻺������
}

MyStream.Write(MyBuffer, MyReceviceLength); {����������}

if MyStream.Size >= MySize then {��������ȴ�������յ��ֽ�����������
}

begin

MyStream.Position := 0;

MyBmp := tbitmap.Create;

MyJpg := tjpegimage.Create;

try

MyJpg.LoadFromStream(MyStream); {�����е���ݶ���JPGͼ�������}

MyBmp.Assign(MyJpg); {��JPGתΪBMP}

StatusBar1.SimpleText := '������ʾͼ��';

Image1.Picture.Bitmap.Assign(MyBmp); {�����image1Ԫ�� }

finally {��������� }

MyBmp.free;

MyJpg.free;

Button2.Enabled := true;

{ Socket.SendText('cap');��Ӵ˾伴������ץ�� }

MyStream.Clear;

MySize := 0;

end;

end;

end;

end;

procedure TForm1.FormClose(Sender: Tobject; var Action: TCloseAction);

begin

MyStream.Free; {�ͷ��ڴ�������}

if ClientSocket1.Active then ClientSocket1.Close; {�ر�Socket����}

end;

end.

����ԭ�?���з���˿�ʼ���������пͻ��ˣ���������IP��ַ�������ӣ�Ȼ
��һ���ַ�֪ͨ�����ץ��Ļ������˵����Զ��庯��Cjt_GetScreenץȡ��Ļ��
ΪBMP����BMPת����JPG����JPGд���ڴ����У�Ȼ��������͸�ͻ��ˡ��ͻ��˽�
�յ��������෴����������ת��ΪJPG��ת��ΪBMPȻ����ʾ������

ע�⣺��ΪSocket�����ƣ�����һ�η��͹�����ݣ�ֻ�ּܷ��η������Գ�����
�����ץ��ת��Ϊ�����ȷ������Ĵ�С��֪ͨ�ͻ�����������ж�󣬿ͻ��˸��
������ִ�С���ж��Ƿ��Ѿ��������������������ת������ʾ��

��������ǰ�������OICQ�����������ڴ�������TMemoryStream����ʵ���������
���dz���������õ����ձ�ģ���������I/O�Ķ�д���������������Ҫͬʱ����
������ͬ���͵��������ཻ����ݵĻ���������"�м���"����ò�����ˡ�����˵
���һ����ѹ�����߽�ѹ�������Ƚ���һ��TMemoryStream����Ȼ��ѱ����ݿ�
����ȥ����ִ����Ӧ�����Ϳ����ˡ���Ϊ����ֱ�����ڴ��й���������Ч���Ƿdz�
�ߵġ���ʱ��������о��������κε��ӳ١�

�����д�Ľ�ĵط�����Ȼ���Լ�һ��ѹ����Ԫ������ǰ��ѹ���ٷ��͡�ע�⣺��
��Ҳ���м��ɵģ�����ֱ�Ӱ�BMPѹ����Ҫ


--
ÿһ���ط��������������
ÿһ�����Ӷ�������ȫ��
------------------------------------------------------------------------------


�� ��Դ:����ɽ��ˮվ bbs.neu.edu.cn��[FROM: 202.118.18.20]
Technical Details
Message-ID: <4LY7kC$S45@bbs.neu.edu.cn>
Path: arc1-ca.pugleaf.net!g2news1.google.com!news3.google.com!border1.nntp.dca.giganews.com!nntp.giganews.com!feed2.newsreader.com!newsreader.com!news.neu.edu.cn!NEU

Show Full Headers
Complete Article Headers
X-Google-Thread: f7a78,d7a4fb6d51af90d7,start
X-Google-Attributes: gidf7a78,public
X-Google-Language: Chinese,GB
Path: arc1-ca.pugleaf.net!g2news1.google.com!news3.google.com!border1.nntp.dca.giganews.com!nntp.giganews.com!feed2.newsreader.com!newsreader.com!news.neu.edu.cn!NEU
From: ggp@bbs.neu.edu.cn (lovpro)
Newsgroups: cn.bbs.comp.lang.delphi
Subject: ̸Delphi�����"��"��Ӧ��
Date: 13 Dec 2005 10:51:53 GMT
Organization: ��ɽ��ˮ
Message-ID: <4LY7kC$S45@bbs.neu.edu.cn>
Mime-Version: 1.0
Content-Type: text/plain; charset="gb2312"
Content-Transfer-Encoding: 8bit
X-Filename: Delphi/M.1134471084.c0
Lines: 1605