談Delphi編程中"流"的應用 |
|
jackkcg
站務副站長 發表:891 回覆:1050 積分:848 註冊:2002-03-23 發送簡訊給我 |
此為轉貼資料 流,簡單來說就是建立在面向對象基礎上的一種抽象的處理數據的工具。在流中,定義了一些處理數據的基本操作,如讀取數據,寫入數據等,程式員是對流進行所有操作的,而不用關心流的另一頭數據的真正流向。流不但可以處理文件,還可以處理動態內存、網絡數據等多種數據形式。如果你對流的操作非常熟練,在程式中利用流的方便性,寫起程式會大大提高效率的。
--------------------------------------------------------------------------------
正文:
談Delphi編程中"流"的應用 什?是流?流,簡單來說就是建立在面向對象基礎上的一種抽象的處理數據的工具。在流中,定義了一些處理數據的基本操作,如讀取數據,寫入數據等,程式員是對流進行所有操作的,而不用關心流的另一頭數據的真正流向。流不但可以處理文件,還可以處理動態內存、網絡數據等多種數據形式。如果你對流的操作非常熟練,在程式中利用流的方便性,寫起程式會大大提高效率的。
下面,筆者通過四個實例:EXE文件加密器、電子賀卡、自製OICQ和網絡螢幕傳輸來說明Delphi編程中"流"的利用。這些例子中的一些技巧曾經是很多軟件的秘密而不公開的,現在大家可以無償的直接引用其中的代碼了。
"萬丈高樓平地起",在分析實例之前,我們先來瞭解一下流的基本概念和函數,只有在理解了這些基本的東西後我們才能進行下一步。請務必認真領會這些基本方法。當然,如果你對它們已經很熟悉了,則可以跳過這一步。 一、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為數據的長度字節數,該方法返回值為實際寫入流中的字節數。
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時,CopyFrom從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:不允許別的程式以任何方式打開該文件
fmShareDenyWrite:不允許別的程式以寫方式打開該文件
fmShareDenyRead :不允許別的程式以讀方式打開該文件
fmShareDenyNone :別的程式可以以任何方式打開該文件 TStream還有一個派生類TMemoryStream,實際應用中用的次數也非常頻繁。它叫內存流,就是說在內存中建立一個流對象。它的基本方法和函數跟上面是一樣的。
好了,有了上面的基礎後,我們就可以開始我們的編程之行了。
-----------------------------------------------------------------------
二、實際應用之一:利用流製作EXE文件加密器、捆綁、自解壓文件及安裝程式 我們先來說一下如何製作一個EXE文件加密器吧。
EXE文件加密器的原理:建立兩個文件,一個用來添加資源到另外一個EXE文件裏面,稱為添加程式。另外一個被添加的EXE文件稱為頭文件。該程式的功能是把添加到自己裏面的文件讀出來。Windows下的EXE文件結構比較複雜,有的程式還有校驗和,當發現自己被改變後會認為自己被病毒感染而拒絕執行。所以我們把文件添加到自己的程式裏面,這樣就不會改變原來的文件結構了。我們先寫一個添加函數,該函數的功能是把一個文件當作一個流添加到另外一個文件的尾部。函數如下: 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是被添加到的目標文件。比如說把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:Button1和Button2。Button的Caption屬性分別設置為"確定"和"取消"。在Button1的Click事件中寫代碼:
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 MB_OK);
編譯這個程式,並把EXE文件改名為head.exe。新建一個文字檔案head.rc,內容為: head exefile head.exe,然後把它們拷貝到Delphi的BIN目錄下,執行Dos命令Brcc32.exe head.rc,將產生一個head.res的文件,這個文件就是我們要的資原始檔案,先留著。
我們的頭文件已經建立了,下面我們來建立添加程式。
新建一個工程,放上以下控制項:一個Edit,一個Opendialog,兩個Button1的Caption屬性分別設置為"選擇文件"和"加密"。在根源程式中添加一句:{$R head.res}並把head.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;
注意:我們上面的函數只不過是簡單的把一個文件添加到另一個文件的尾部。實際應用中可以改成可以添加多個文件,只要根據實際大小和個數定義好偏移地址就可以了。比如說文件捆綁機就是把兩個或者多個程式添加到一個頭文件裏面。那些自解壓程式和安裝程式的原理也是一樣的,不過多了壓縮而已。比如說我們可以引用一個LAH單元,把流壓縮後再添加,這樣文件就會變的很小。讀出來時先解壓就可以了。另外,文中EXE加密器的例子還有很多不完善的地方,比如說密碼固定為"790617",取出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):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;
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_ICONINFORMATION 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_OK)
else
begin
if FileExists(HeadTemp) then DeleteFile(HeadTemp);
Application.MessageBox('EXE文件生成失敗!','資訊',MB_ICONINFORMATION MB_OK)
end;
end;
end.
怎?樣?很神奇吧:)把程式介面弄的漂亮點,再添加一些功能,你會發現比起那些要注冊的軟件來也不會遜多少吧。
-----------------------------------------------------------------------
實際應用之三:利用流製作自己的OICQ OICQ是深圳騰訊公司的一個網絡實時通訊軟件,在國內擁有大量的用戶群。但OICQ必須連接上互聯網登陸到騰訊的服務器才能使用。所以我們可以自己寫一個在局部網裏面使用。
OICQ使用的是UDP協議,這是一種無連接協議,即通信雙方不用建立連接就可以發送資訊,所以效率比較高。Delphi本身自帶的FastNEt公司的NMUDP控制項就是一個UDP協議的用戶數據報控制項。不過要注意的是如果你使用了這個控制項必須退出程式才能關閉計算機,因為TNMXXX控制項有BUG。所有nm控制項的基礎 PowerSocket用到的ThreadTimer,用到一個隱藏的窗口(類為TmrWindowClass)處理有硬傷。
出問題的地方:
Psock::TThreadTimer::WndProc(var msg:TMessage)
if msg.message=WM_TIMER then
他自己處理
msg.result:=0
else
msg.result:=DefWindowProc(0,....)
end
問題就出在調用 DefWindowProc時,傳輸的HWND參數居然是常數0,這樣實際上DefWindowProc是不能工作的,對任何輸入的消息的調用均返回0,包括WM_QUERYENDSESSION,所以不能退出windows。由於DefWindowProc的不正常調用,實際上除WM_TIMER,其他消息由DefWindowProc處理都是無效的。
解決的辦法是在 PSock.pas
在 TThreadTimer.Wndproc 內
Result := DefWindowProc( 0, Msg, WPARAM, LPARAM );
改為:
Result := DefWindowProc( FWindowHandle, Msg, WPARAM, LPARAM );
早期低版本的OICQ也有這個問題,如果不關閉OICQ的話,關閉計算機時螢幕閃了一下又返回了。
好了,廢話少說,讓我們編寫我們的OICQ吧,這個實際上是Delphi自帶的例子而已:)
新建一個工程,在FASTNET面版拖一個NMUDP控制項到視窗,然後依次放上三個EDIT,名字分別為EditIP、EditPort、EditMyTxt,三個按鈕BtSend、BtClear、BtSave,一個MEMOMemoReceive,一個SaveDialog和一個狀態條StatusBar1。當用戶點擊BtSend時,建立一個內存流對象,把要發送的文字資訊寫進內存流,然後NMUDP把流發送出去。當NMUDP有數據接收時,觸發它的DataReceived事件,我們在這裏再把接收到的流轉換為字元資訊,然後顯示出來。
注意:所有的流對象建立後使用完畢後要記得釋放(Free),其實它的釋構函數應該為Destroy,但如果建立流失敗的話,用Destroy會產生異常,而用Free的話程式會先檢查有沒有成功建立了流,如果建立了才釋放,所以用Free比較安全。
在這個程式中我們用到了NMUDP控制項,它有幾個重要的屬性。RemoteHost表示遠程電腦的IP或者計算機名,LocalPort是本地埠,主要監聽有沒有數據傳入。而RemotePort是遠程埠,發送數據時通過這個埠把數據發送出去。理解這些已經可以看懂我們的程式了。 全部代碼如下:
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_ICONINFORMATION 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_ICONINFORMATION 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.FileName);
end; procedure TForm1.EditMyTxtKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then BtSend.Click;
end;
end.
上面的程式跟OICQ相比當然差之甚遠,因為OICQ利用的是Socket5通信方式。它上線時先從服務器取回好友資訊和在線狀態,發送超時還會將資訊先保存在服務器,等對方下次上線後再發送然後把服務器的備份刪除。你可以根據前面學的概念來完善這個程式,比如說再添加一個NMUDP控制項來管理在線狀態,發送的資訊先轉換成ASCII碼進行與或運行並加上一個頭資訊,接收方接收資訊後先判斷資訊頭正確與否,如果正確才把資訊解密顯示出來,這樣就提高了安全保密性。
另外,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.255.255(B類網)
if strtoint(Head) in [192..254] then ss:=s1 s2 s3 '255'; //192~254.XXX.XXX.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: TCustomWinSocket);
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控制項ClientSocket、圖像顯示控制項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,StdCtrls,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。其實,這個流對像是程式設計中用得最普遍的,它可以提高I/O的讀寫能力,而且如果你要同時操作幾個不同類型的流,互相交換數據的話,用它作"中間人"是最好不過的了。比如說你把一個流壓縮或者解壓縮,就先建立一個TMemoryStream對象,然後把別的數據拷貝進去,再執行相應操作就可以了。因為它是直接在內存中工作,所以效率是非常高的。有時侯甚至你感覺不到有任何的延遲。
程式有待改進的地方:當然可以加一個壓縮單元,發送前先壓縮再發送。注意:這裏也是有技巧的,就是直接把BMP壓縮而不要轉換成JPG再壓。實驗証明:上面程式一幅圖像大小大概為40-50KB,如果用LAH壓縮演算法處理一下便只有8-12KB,這樣傳輸起來就比較快。如果想更快的話,可以採用這樣的方法:先抓第一幅圖像發送,然後從第二幅開始只發跟前一幅不同區域的圖像。外國有一個程式叫Remote Administrator,就是採用這樣的方法。他們測試的數據如下:局部網一秒鐘100-500幅,互聯網上,在網速極低的情況下,一秒鐘傳輸5-10幅。說這些題外話只想說明一個道理:想問題,特別是寫程式,特別是看起來很複雜的程式,千萬不要鑽牛角尖,有時侯不妨換個角度來想。程式是死的,人才是活的。當然,這些只能靠經驗的積累。但是一開始就養成好習慣是終身受益的! 轉摘 :丁大為
作者:
來源: 電腦商情報
------
********************************************************** 哈哈&兵燹 最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知 K.表Knowlege 知識,就是本站的標語:Open our mind |
joshua_liu
一般會員 發表:1 回覆:1 積分:0 註冊:2003-07-24 發送簡訊給我 |
{code}
void __fastcall TForm1::BtSendClick(TObject *Sender)
{
TMemoryStream *MyStream;
TFileStream *FileStream;
int Iport,icode;
try
{
Iport=EditPort->Text.ToInt();
}
catch(...)
{ Application->MessageBox("Not interger!","Infomation",MB_OK+MB_ICONINFORMATION);
return;
}
NMUDP1->RemoteHost = EditIP->Text; //{远程主机}
NMUDP1->LocalPort=Iport; //{本地端口}
NMUDP1->RemotePort = Iport; //{远程端口}
MyStream = new TMemoryStream();// {建立流}
try
{
if(OpenDialog1->Execute())
{
AnsiString FileName;
FileName="FileName"+OpenDialog1->FileName;
//MyStream->Write(EditMyTxt->Text.c_str(), EditMyTxt->Text.Length());//{写数据}
//MyStream->Write(FileName.c_str(),FileName.Length());
//NMUDP1->SendStream(MyStream);
FileStream=new TFileStream(OpenDialog1->FileName, fmOpenRead);
NMUDP1->SendStream(FileStream); //{发送流}
}
}
catch(...)
{ShowMessage("There are some errors!"); }
delete MyStream;
delete FileStream;
}
//---------------------------------------------------------------------------
AnsiString GetFileName(AnsiString filename)
{
int n=filename.Length();
while(filename[n]!='\\' || n<2)n--;
return filename.Delete(1,n);
}
//---------------------------------------------------------------------------
void __fastcall TForm1::NMUDP1DataReceived(TComponent *Sender,
int NumberBytes, AnsiString FromIP, int Port)
{
TMemoryStream *MyStream;
String MyReciveTxt;
MyStream = new TMemoryStream(); //{建立流}
try
{ NMUDP1->ReadStream(MyStream);//{接收流}
MyReciveTxt.SetLength(NumberBytes);//{NumberBytes为接收到的字节数}
MyStream->Read(MyReciveTxt.c_str(),NumberBytes);//{读数据}
MemoReceive->Lines->Add("From " FromIP ": " MyReciveTxt);
if(MyReciveTxt.AnsiPos("FileName")==1)
{
AnsiString filename=GetFileName(MyReciveTxt);
SaveDialog1->FileName=filename;
}
else
{
if(SaveDialog1->Execute())
{ MyStream->SaveToFile(SaveDialog1->FileName);
}
}
}
catch(...)
{;}
delete MyStream; //{释放流}
}
{/code}
这段程序发生错误,错误在NMUDP发送比较大的文件时,小文件不会发生错误,请问为什么?
|
shine5188
一般會員 發表:2 回覆:15 積分:8 註冊:2005-05-11 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |