DELPHI上簡單高效的SOCKET控件怎麽選擇

主要用異步通訊方式

直接api，winsock?

參考之：

Delphi(Pascal) code下面是壹個簡單的Socket通信程序，其中客戶機和服務機是同壹個程序，當客戶機（服務器）在壹個memo1中輸入壹段文字然後敲入回車，該段文字就可以顯示在服務器(客戶機)的memo2中，反之亦成立。具體步驟如下：

1、新建壹個form，任意命名，不妨設之為chatForm；放上壹個MainMenu(在Standard欄中)，建立ListenItem、ConnectItem、Disconnect和Exit菜單項；在從Internet欄中選擇TServerSocket、TClientSocket添加到chatForm中，其中把TClientSocket的名字設為ClientSocket, port設為1025，默認的active為false；把TServerSocket的名字設為ServerSocket，port設為1025，默認的active為false，其他的不變；再放入兩個memo，壹個命名為memo1,另外壹個命名為memo2,其中把memo2的color設置為灰色，因為主要用來顯示對方的輸入。下面我們壹邊編寫代碼壹邊解? 因。

2、雙擊ListemItem。寫入如下代碼：

procedure TChatForm.ListenItemClick(Sender: TObject);

begin

ListenItem.Checked := not ListenItem.Checked;

if ListenItem.Checked then

begin

ClientSocket.Active := False;

ServerSocket.Active := True;

end

else

begin

if ServerSocket.Active then

ServerSocket.Active := False;

end;

該程序段的說明如下：當用戶選擇ListemItem時，該ListenItem取反，如果選中的話，說明處於Listen狀態，讀者要了解的是：listen是Socket作為Server時壹個專有的方法，如果處於listen,則ServerSocket設置為活動狀態；否則，取消listen，則關閉ServerSocket。實際上，只有用戶壹開始選擇該菜單項，表明該程序用作Server。反之，如果用戶選擇ConnectItem，則必然作為Client使用。

3、雙擊ConnectItem，敲入以下代碼。

procedure TChatForm.ConnectItemClick(Sender: TObject);

begin

if ClientSocket.Active then ClientSocket.Active := False;

if InputQuery(Computer to connect to, Address Name:, Server) then

if Length(Server) $#@62; 0 then

with ClientSocket do

begin

Host := Server;

Active := True;

ListenItem.Checked := False;

end;

這段程序的主要功能就是當用戶選擇ConnectItem菜單項時，設置應用程序為客戶機，彈出input框，讓用戶輸入服務器的地址。這也就是我們不壹開始固定ClientSocket的host的原因，這樣用戶可以動態地連接不同的服務器。讀者需要了解的是主機地址只是Socket作為客戶機時具有的壹個屬性，Socket作為服務器時“壹般“不用地址，因為它同本機綁定。

4、在memo1的keydown方法中寫入如下代碼：

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_Return then

if IsServer then

ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count - 1])

else

ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);

end;

該段代碼的作用很明顯，就是開始發消息了。其中如果是Server的話，它只向第壹個客戶機發消息，由於壹個服務器可以連接多個客戶機，而同客戶機的每壹個連接都由壹個Socket來維持，因此ServerSocket.Socket.Connnections數組中存儲的就是同Client維持連接的Socket。在標準Socket中，服務器方的Socket通過accept()方法的返回值獲取維持同客戶機連接的Socket,而發送、接受消息的方法分別為send(sendto)和recv(recvfrom), Delphi對此進行了封裝。

5、其余代碼的簡要介紹。

procedure TChatForm.ServerSocketAccept(Sender: TObject;

Socket: TCustomWinSocket);

begin

IsServer := True;

end;

ServerSocket的Accept方法，當客戶機第壹次連接時完成，通過其參數可以認為，它是在標準的accept方法後執行的，因為有TCustomWinSocket這個參數類型，它應該是標準Server方Socket的返回值。

procedure TChatForm.ClientSocketRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Add(Socket.ReceiveText);

end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Add(Socket.ReceiveText);

end;

這兩段代碼分別是服務器方和客戶機方在收到對方的消息時，由Delphi觸發的，作用是在memo2中顯示收到的消息。其中，ClientSocketRead中的Socket實際上就是Socket本身，而在ServerSocketClientRead中的Socket實際上是ServerSocket.Socket.Connection[]中的某個Socket。不過在Delphi中，對服務器方的Socket進行了有效的封裝。

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Clear;

end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ListenItemClick(nil);

end;

這兩段比較簡單。其中ServerSocketClientConnect在ServerSocket收到壹個新的連接時觸發。而ClientSocketDisconnect在ClientSocket發出Disconncet時觸發。

procedure TChatForm.Exit1Click(Sender: TObject);

begin

ServerSocket.Close;

ClientSocket.Close;

Close;

end;

procedure TChatForm.Disconnect1Click(Sender: TObject);

begin

ClientSocket.Active := False;

ServerSocket.Active := True;

end;

第壹段為關閉應用程序。在標準Socket中，每個Socket在關閉時，必須調用closesocket()方法，否則系統不會釋放資源。而在ServerSockt.Close和ClientSocket.Close中，系統內部肯定調用了closesocket（）方法。

三、標準Socket與Delphi中的Socket。

標準的Socket的應用程序框架如下：

Server方： Socket()[ 新建壹個Socket]－－Bind()[ 同服務器地址邦定 ]－－Listen() －－Accept()－－block wait－－read()[接受消息，在windows平臺中，方法為send(TCP),或者是sendto(UDP)]－－處理服務請求－－Write()[發送消息，在windows平臺中，方法為send(TCP), 或者為sendto(UDP)。

Client方相對簡單：Socket()－－Connect()[通過壹定的port連接特定的服務器，這是與服務器建立連接]－－Write()－－Read()。

Socket可以是基於TCP的，也可以是基於UDP,同時Socket甚至建立在其他的協議，比如IPX/SPX，DECNet等。在新建壹個Socket時，可以指定新建何類Socket。Bind()用來同服務器的地址邦定，如果壹個主機只有壹個IP地址，實際上邦定的作用就相對多余了。Listen()開始監聽網絡，Accept()用於接受連接，其返回值是保持同客戶機聯系的Socket。

在Delphi中，對於Windows中的Socket進行了有效的封裝。在Delphi中，按其繼承關系，可以分層兩類：

壹、TComponent－－TAbstractSocket－－TCustomSocket－－TCustomServerSocket－－TServerSocket

TComponent－－TAbstractSocket－－TCustomSocket－－TClientSocket

二、直接從TObject繼承過來:

TObject－－TCustomWinSocket－－TServerWinSocket

TObject－－TCustomWinSocket－－TClientWinSocket

TObject－－TCustomWinSocket－－TServerClientWinSocket

可以看出第壹類建立在TCustomSocket基礎上，第二類建立在TCustomWinSocket的基礎上。第壹類建立在TComponet的基礎上，第二類直接構建在TObject基礎上。因此如果用戶非常熟悉Socket並且想要編寫控制臺程序時，可以使用TCustomWinScoket類。

同uses中可以看出，它們都在ScktComp.pas中實現，而在schtComp.pas中，則包含了winsock.pas文件，如果繼續深入winsock文件，在其中可以發現所有的Windows Socket的基本方法。

實際上，如果妳了解了標準Socket的應用程序框架，對於使用Delphi編寫Socket應用程序也就得心應手了；這不是說妳必須了解復雜的Socket中的標準函數，也沒有必要，因為Delphi已經為妳做了很好的封裝了，這也正是Delphi的強勢所在，妳只要了解那麽壹點點的基本框架。

這是我對Delphi中的Socket應用的理解，不足之處希望大家指正。同時也樂於為大家解答Delphi中有關Socket的問題。

SOCKET控件與直接使用API相比

Windows自帶的Tracert是向遠程主機發送ICMP包進行追蹤，但是目前很多主機關閉了ICMP答復，這個工具不太好使了~~~~~原理咱知道，正規的Trace不就是發送TTL依次遞增的UDP包嗎？什麽網關和路由敢隨意丟棄我們的UDP包而不通知我們？ICMP包妳可以不理，但是UDP包~~~~~不怕黑妳？

unit YRecords;

interface

uses

Windows;

const

PACKET_SIZE = 32;

MAX_PACKET_SIZE = 512;

TRACE_PORT = 34567;

LOCAL_PORT = 5555;

type

s32 = Integer;

u32 = DWORD;

u8 = Byte;

u16 = word; PU16 = ^U16;

//IP Packet Header

PIPHeader = ^YIPHeader;

YIPHeader = record

u8verlen : u8;//4bits ver, 4bits len, len*4=true length

u8tos : u8;//type of service, 3bits 優先權(現在已經被忽略), 4bits TOS, 最多只能有1bit為1

u16totallen : u16;//整個IP數據報的長度，以字節為單位。

u16id : u16;//標識主機發送的每壹份數據報。

u16offset : u16;//3bits 標誌，13bits片偏移

u8ttl : u8;//生存時間字段設置了數據報可以經過的最多路由器數。

u8protol : u8;//協議類型，6表示傳輸層是TCP協議。

u16checksum : u16;//首部檢驗和。

u32srcaddr : u32;//源IP地址，不是‘xxx.xxx.xxx.xxx’的形勢哦

u32destaddr : u32;//目的IP地址，同上

end;

//ICMP Packet Header

PICMPHeader = ^YICMPHeader;

YICMPHeader = record

u8type : u8;

u8code : u8;

u16chksum : u16;

u16id : u16;

u16seq : u16;

end;

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, YRecords, winsock2;

type

TForm1 = class(TForm)

ListBox1: TListBox;

Edit1: TEdit;

Button1: TButton;

procedure FormCreate(Sender: TObject);

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

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function DecodeIcmpReply( pbuf: PChar; var seq: s32 ): string;

var

pIpHdr : PChar;

pIcmphdr : PICMPHeader;

sip : string;

ttl : integer;

begin

pIpHdr := pbuf;

sip := inet_ntoa( TInAddr( PIPHeader(pIpHdr)^.u32srcaddr ) );

ttl := PIPHeader(pIpHdr)^.u8ttl;

Inc( pIpHdr, (PIPHeader(pIpHdr)^.u8verlen and $0F) * 4 );

pIcmpHdr := PICMPHeader(pIpHdr);

result := ;

if pIcmpHdr^.u8type = 3 then //目的不可達信息，Trace完成

seq := 0;

if pIcmpHdr^.u8type = 11 then //超時信息，正在Trace

result := Format( %4d%32s%8d, [seq, sip, ttl] );

end;

procedure ErrMsg( msg: string );

begin

MessageBox( 0, PChar(msg), Ping Program Error, MB_ICONERROR );

end;

procedure TForm1.FormCreate(Sender: TObject);

var

wsa : TWSAData;

begin

if WSAStartup( $0202, wsa ) <> 0 then

ErrMsg( Windows socket is not responed. );

ListBox1.Font.Name := Courier New;

ListBox1.Font.Size := 9;

end;

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

begin

if WSACleanup <> 0 then

ErrMsg( Windows socket can not be closed. );

end;

procedure TForm1.Button1Click(Sender: TObject);

const

SIO_RCVALL = IOC_IN or IOC_VENDOR or 1;

var

rawsock : TSocket;

pRecvBuf : PChar;

FromAdr : TSockAddr;

FromLen : s32;

fd_read : TFDSet;

timev : TTimeVal;

sReply : string;

udpsock : TSocket;

ret : s32;

DestAdr : TSockAddr;

pSendBuf : PChar;

ttl, opt : s32;

pHost : PHostEnt;

begin

//創建壹個RAWSOCK接收回應ICMP包

rawsock := socket( AF_INET, SOCK_RAW, IPPROTO_ICMP );

FromAdr.sin_family := AF_INET;

FromAdr.sin_port := htons(0);

FromAdr.sin_addr.S_addr := inet_addr(192.168.1.12); //換成妳的IP

//如果不bind就無法接收包了~~~因為下面還要創建壹個UDPSOCK

bind( rawsock, @FromAdr, SizeOf(FromAdr) );

Opt := 1;

WSAIoctl( rawsock, SIO_RCVALL, @Opt, SizeOf(Opt), nil, 0, @ret, nil, nil );

//接收ICMP回應包的緩沖區

pRecvBuf := AllocMem( MAX_PACKET_SIZE );

//創建壹個UDPSOCK發送探測包

udpsock := socket( AF_INET, SOCK_DGRAM, IPPROTO_UDP );

//要發送的UDP數據

pSendBuf := AllocMem( PACKET_SIZE );

FillChar( pSendBuf^, PACKET_SIZE, C );

FillChar( DestAdr, sizeof(DestAdr), 0 );

DestAdr.sin_family := AF_INET;

DestAdr.sin_port := htons( TRACE_PORT );

DestAdr.sin_addr.S_addr := inet_addr( PChar(Edit1.Text) );

//如果edit1.text不是IP地址，則嘗試解析域名

if DestAdr.sin_addr.S_addr = INADDR_NONE then

begin

pHost := gethostbyname( PChar(Edit1.Text) );

if pHost <> nil then

begin

move( pHost^.h_addr^^, DestAdr.sin_addr, pHost^.h_length );

DestAdr.sin_family := pHost^.h_addrtype;

DestAdr.sin_port := htons( TRACE_PORT );

ListBox1.Items.Add( Edit1.Text +IP地址->+ inet_ntoa(DestAdr.sin_addr) );

end else

begin

ListBox1.Items.Add( 解析域名: + Edit1.Text + 出錯。 );

closesocket( rawsock );

closesocket(udpsock);

FreeMem( pSendBuf );

FreeMem( pRecvBuf );

exit;

end;

ListBox1.Items.Add( Trace route + Edit1.Text + ...... );

Listbox1.Update;

//開始Trace!!!

ttl := 1;

while True do

begin

//設置TTL，使我們發送的UDP包的TTL依次累加

setsockopt( udpsock, IPPROTO_IP, IP_TTL, @ttl, sizeof(ttl) );

//發送UDP包到HOST

sendto( udpsock, pSendBuf^, PACKET_SIZE, 0, DestAdr, sizeof(DestAdr) );

FD_ZERO( fd_read );

FD_SET( rawsock, fd_read );

timev.tv_sec := 5;

timev.tv_usec := 0;

if select( 0, @fd_read, nil, nil, @timev ) < 1 then

break;

if FD_ISSET( rawsock, fd_read ) then

begin

FillChar( pRecvBuf^, MAX_PACKET_SIZE, 0 );

FillChar( FromAdr, sizeof(FromAdr), 0 );

FromAdr.sin_family := AF_INET;

FromLen := sizeof( FromAdr );

recvfrom( rawsock, pRecvBuf^, MAX_PACKET_SIZE, 0, FromAdr, FromLen );

sReply := DecodeIcmpReply( pRecvBuf, ttl );

if sReply <> then

begin

ListBox1.ItemIndex := ListBox1.Items.Add( sReply );

Listbox1.Update;

end;

if ttl = 0 then //如果收到目標主機的相應包，DecodeIcmpReply會把ttl==0

break;

end;

Inc( ttl );

Sleep( 110 );

end; //while not bStop do

ListBox1.Items.Add( 追蹤路由完成。 );

ListBox1.Items.Add( );

closesocket( rawsock );

closesocket(udpsock);

FreeMem( pSendBuf );

FreeMem( pRecvBuf );

end;

end.