Article View: cn.bbs.comp.lang.delphi
Article #181̸Delphi�����"��"��Ӧ��
From: lovpro
Date: Tue, 13 Dec 2005 10:51
Date: Tue, 13 Dec 2005 10:51
1605 lines
46297 bytes
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ѹ����Ҫ
--
ÿһ���ط��������������
ÿһ�����Ӷ�������ȫ��
------------------------------------------------------------------------------
[m[1;33m�� ��Դ:����ɽ��ˮվ bbs.neu.edu.cn��[FROM: 202.118.18.20][m
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!NEUShow 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