<font color = red>有谁用过API的socket函数簇?</font>(135分)

  • 主题发起人 主题发起人 ZhangFei
  • 开始时间 开始时间
Z

ZhangFei

Unregistered / Unconfirmed
GUEST, unregistred user!
小弟在做Socket编程时,不想使用TSocket等控件,而是自已使用
API的底层的socket,bind,WSAStartUp等函数。(Delphi有从
winsock.dll导出的函数,在
./Delphi 3/sourc/rtl/win/winsock.pas)
但是在使用中出现了一些问题。比如

1:TSockAddIn结构如下
TSockAddrIn = packed record
case Integer of
0: (sin_family: u_short;
sin_port: u_short;
sin_addr: TInAddr;
sin_zero: array[0..7] of Char);
1: (sa_family: u_short;
sa_data: array[0..13] of Char)
end;
如果引用第二种参数,sa_data是IP吗?服务器Port又如何指定?
2:为什么在Connect前要运行WSAStartUp?

最好哪位大虾能在MSDN中翻一翻,看看有没有源码,如果能提供
delphi代码,小弟一连通,分马上就给。
 
没用过!
 
1:
WSAStartup是初始化WinSocket实例的函数,必须首先调用

2:
sa_data不是IP, IP是sin_addr,
sa_data是为了能够同各种地址结构兼容,因为Socket
本身不是专门用于TCP/IP的, Socket是一种通用的通讯接口
服务器的port必须事先知道,例如:HTTP:80, SMTP:25,
POP3:110等,
您可以在RFC中找到,或者查看Unix系统或Windows系统中
的services文件
 
我用过一些,不过都是用的别人控件的!
 
按照C的标准,sin_port是2Byte的整数,对应到sa_data中是sa_data[0]以及
sa_data[1];你可以自己转换一下,大致是sa_data[0]=sin_port/256
sa_data[1]=sin_port % 256.这是C的用法。
关于这两种结构只是为了与其他协议兼容。
当你用TCP/IP的Socket时,用第一种结构就行了
 
unit client;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,winsock;
const SOCKET_MESSAGE = WM_USER+11;
type
TForm1 = class(TForm)
Prepare: TButton;
connectSrv: TButton;
SockClose: TButton;
Bevel1: TBevel;
SockState: TMemo;
IPAddr: TEdit;
Label1: TLabel;
Label2: TLabel;
port: TEdit;
Bevel2: TBevel;
Label3: TLabel;
DataToSend: TEdit;
Bevel3: TBevel;
SendData: TButton;
procedure ExitAppClick(Sender: TObject);
procedure PrepareClick(Sender: TObject);
procedure connectSrvClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SockCloseClick(Sender: TObject);
procedure SendDataClick(Sender: TObject);
private
{ Private declarations }
public
CliSocket:TSocket;
Srv_Addr:TSockAddrIn;
Cli_Addr:TSockAddrIn;
procedure GetMessageHandle(var Message : TMessage);message SOCKET_MESSAGE;
function ReceiveText: string;
function ReceiveBuf(var Buf; Count: Integer): Integer;

{ Public declarations }
end;
var
Form1: TForm1;

implementation

{$R *.DFM}
function TForm1.ReceiveBuf(var Buf; Count: Integer): Integer;
var
ErrorCode: Integer;
begin
Result := 0;
if (Count = -1) then
ioctlsocket(CliSocket, FIONREAD, Longint(Result))
else begin
Result := recv(CliSocket, Buf, Count, 0);
if Result = SOCKET_ERROR then
begin
ErrorCode := WSAGetLastError;
if ErrorCode &lt;&gt; WSAEWOULDBLOCK then
begin
ShowMessage('error receive data');
end;
end;
end;
end;

function TForm1.ReceiveText: string;
begin
SetLength(Result, ReceiveBuf(Pointer(nil)^, -1));
ReceiveBuf(Pointer(Result)^, Length(Result));
end;

procedure TForm1.ExitAppClick(Sender: TObject);
begin
close;
end;

procedure TForm1.PrepareClick(Sender: TObject);
var rc : integer;
address:array[0..15] of char;
begin
CliSocket:=socket(PF_INET,SOCK_STREAM,0);
if CliSocket = INVALID_SOCKET then
SockState.lines.append('Error CREATE SOCKET'+IntToStr(WSAGetlastError))
else
SockState.lines.append('OK Socket:'+ IntToStr(CliSocket));
cli_addr.sin_family := AF_INET;
cli_addr.sin_addr.s_addr := INADDR_ANY;
cli_addr.sin_port := 0;

rc := bind(cliSocket,cli_addr,sizeof(cli_addr));
if rc = SOCKET_ERROR then
SockState.lines.append('Error BIND SOCKET:'+IntToStr(WSAGetlastError))
else
SockState.lines.append('OK BIND Socket');


srv_addr.sin_family := AF_INET;
strpcopy(address,IPAddr.text);
srv_addr.sin_addr.s_addr := inet_addr(address);
srv_addr.sin_port := htons(strtoint(port.text));
end;

procedure TForm1.connectSrvClick(Sender: TObject);
var rc :integer;
begin
rc := connect(CliSocket,srv_addr,sizeof(srv_addr));
if rc = SOCKET_ERROR then
SockState.lines.append('Error connect:'+IntToStr(WSAGetlastError))
else
SockState.lines.append('OK connect');
rc := WSAAsyncSelect(CliSocket,handle,SOCKET_MESSAGE,FD_READ+FD_WRITE+FD_CLOSE);
if rc = SOCKET_ERROR then
SockState.lines.append('Error WSAAsyncSelect:'+IntToStr(WSAGetlastError))
else
SockState.lines.append('OK WSAAsyncSelect');
end;

procedure TForm1.FormCreate(Sender: TObject);
var WSAData : TWSAData;
err : integer;
begin
err := WSAStartUp(257,WSAData);
if err &lt;&gt; 0 then
MessageDlg('Error'+IntToStr(err), mtInformation,[mbOk], 0);

end;

procedure TForm1.SockCloseClick(Sender: TObject);
var err:integer;
begin
err := CloseSocket(CliSocket);
if err = SOCKET_ERROR then
SockState.lines.append('Close Socket Error')
else
SockState.lines.append('Socket : '+IntToStr(CliSocket)+' be Close');
end;
procedure TForm1.GetMessageHandle(var Message : TMessage);
var buf:array[0..255] of char;
loginfo:array[0..255] of char;
s:string;
begin
case WSAGetSelectEvent( Message.lParam) of
FD_READ:
begin
// SockState.lines.append('FD_READ');
// recv(CliSocket,buf,sizeof(buf),0);
s:=ReceiveText;
SockState.lines.append(s);
end;
FD_CLOSE:
begin
SockState.lines.append('FD_CLOSE');

end;
FD_WRITE:
begin
//SockState.lines.append('FD_WRITE');
// strpcopy(loginfo, 'Hello, This is Roger');
// send(CliSocket,loginfo,sizeof(loginfo),0);
end;
else
begin
SockState.lines.append('Some body opertate me');
SockState.lines.append('operate:'+intToStr(WSAGetSelectEvent( Message.lParam)));
end;
end;
end;

procedure TForm1.SendDataClick(Sender: TObject);
var buf:array[0..255] of char;
begin
strpcopy(buf,DataToSend.text);
send(CliSocket,buf,sizeof(buf),0);
end;

end.
 
我手头有一个socket的控件,我大概看了一下,好象用的都是底层的东西,
如果有人需要的话,告诉我一声,我给你们寄过去。
 
你可以把TSockAddrIn看成C里面的union,
WSAStartUp是对winsocket的初始化,
只要你用winsock,你就必须首先调用.
 
得了,我把程序贴在这里,大家看去吧.
unit Sockets;
//***********************************************************************
//** Sockets Component Version 3.1 **
//***********************************************************************
//** This component provides a quick and easy way to begin **
//** implementing sockets in your applications. The component was **
//** designed as a minimalist framework upon which more complex and **
//** customized asynchronous sockets could be constructed. As a **
//** direct result of interest in this component, I have released it **
//** with a few quick code changes. Therefore, although I believe it **
//** appears fine, it may indeed be succeptible to a few 'features'. **
//** This component also demonstrates an internalized messaging **
//** structure that will hopefully be deemed useful. **
//** The code contained in this document is entirely free to use in **
//** both commercial and non-commercial applications. If this **
//** component is utilized in any way, shape, or form, I would **
//** appreciate a notification via email indicating this, as well as **
//** any comments or suggestions you may have. Bug reports are **
//** encouraged. **
//** I have been very busy of late, but I have been attempting to **
//** read all of the email. My address changed so if I didn't get **
//** back to you I apologize. Feel free to send mail to my new **
//** address. The component is getting much more refined, but the **
//** chance for bugs is still there. The only way to get rid of them **
//** is through your input. Thanks for the support. I will attempt **
//** to provide a release with a full sample and such. Until then, **
//** read through the code - all of the DoFunctions are the most **
//** user friendly and should be easy to understand. The defines **
//** at the top of the file control how the object behaves and how **
//** you wish to receive messages. Once again, read the code for **
//** further insights. If anyone knows how to fix the peer bug **
//** I have found, please let me know. I believe it to be a Winsock **
//** problem, but I can't be certain (To see it, remove the fix and **
//** call the procedures as I have indicated). Thanks again, and **
//** happy coding. **
//** I can be reached at: **
//** philus@mailexcite.com **
//** Sincerely, **
//** T. J. Sobotka **
//** April 1998 **
//** OFFICIAL NEW VERSIONS AT WWW.TORRY.RU **
//** Other components include: TCard, TChip, TSystemTrayIcon **
//***********************************************************************
//** **
//** *NOTE*: It is encouraged that you customize this code to suit **
//** your personal needs. Items that might be useful to **
//** alter for optimization purposes are the FD_ events. **
//** Simply remove the ones you feel you do not need. **
//** Be CAREFUL if you are unfamiliar with sockets. All **
//** properties offer their related members as public for **
//** advanced users who wish to access them directly - **
//** altering the m_Handle, although possible, will **
//** result in abnormal functioning if invalid. For **
//** anyone who does not wish to use them, simply use the **
//** aforementioned properties and procedures. You can **
//** also undefine the WANT_MESSAGEBOX_ALERTS to prevent the **
//** component from generating exceptions for unallocated **
//** events. WANT_MESSAGEBOX_ALERTS provided for debug **
//** purposes. **
//** **
//** Added for Version 1.10 **
//** - OnListen now fails gracefully as opposed to appearing **
//** successful. **
//** - Consecutive OnClose events prevented in certain **
//** circumstances. **
//** Added for Version 2.00 **
//** - DoGetHostByName and DoGetHostByAddress **
//** - Exchanged Exceptions for MessageBox to prevent **
//** unwanted code avoidance. **
//** Added for Version 3.0 **
//** - IPAddress now accepts names such as pc.where.com **
//** - Added defines for multi mode behavior **
//** - Fixed some code problems (doubled lines) **
//** - Added virtual functions for complete inheritance **
//** Added for Version 3.1 **
//** - Fixed a hasty bug in the Winsock fix **
//** - Added a demonstration to the package **
//** - Added the DCR that was missing from 3.0 **
//** **
//** How to use: **
//** Add the Object or Component. Set the IP address using **
//** TAsyncSocket.IPAddress (EX: MySock.IPAddress := blah.com or **
//** 127.0.0.1). Set the port number using TAsyncSocket.PortNumber*
//** (EX: MySock.PortNumber := 2001). Perform DoConnect or **
//** DoListen. You are now up and running. **
//***********************************************************************
interface

{$DEFINE WANT_MESSAGEBOX_ALERTS}

// Define TREAT_AS_OBJECT if you desire this component to behave as an object or
// simply undefine it if you wish to integrate it into your form designer.
// The TREAT_AS_OBJECT version is smaller and skips the On###### format of
// calling events. Hasn't been entirley checked for define errors in component
// mode, but works great in Object mode. Email me with problems.

{$DEFINE TREAT_AS_OBJECT}

{$IFDEF TREAT_AS_OBJECT}
{$UNDEF TREAT_AS_COMPONENT}
{$ELSE}
{$DEFINE TREAT_AS_COMPONENT}
{$ENDIF} // TREAT_AS_OBJECT


uses
Windows, Classes, Messages, Winsock, Forms, SysUtils;

const
WM_SOCKET = WM_USER + 0;
WM_SOCKETERROR = WM_USER + 1;
WM_SOCKETCLOSE = WM_USER + 2;
WM_SOCKETREAD = WM_USER + 3;
WM_SOCKETCONNECT = WM_USER + 4;
WM_SOCKETACCEPT = WM_USER + 5;
WM_SOCKETWRITE = WM_USER + 6;
WM_SOCKETOOB = WM_USER + 7;
WM_SOCKETLISTEN = WM_USER + 8;

EVENTS_DOLISTEN = FD_CLOSE OR FD_ACCEPT;
EVENTS_DOCONNECT = FD_CONNECT OR FD_CLOSE OR FD_READ;
EVENTS_SETSOCKETHANDLE = FD_READ OR FD_CLOSE OR FD_CONNECT;

MaxWord = 65535;
MinWord = 0;

c_ZERO = 0;
c_NULL = 0;
c_FIRST = 1;

type

ESocket = class(Exception);

ThWnd = class(TObject)
protected
m_hWnd: hWnd;
public
constructor Create(WndMethod: TWndMethod);
destructor Destroy; override;
property Handle: hWnd read m_hWnd;
end;

TWMSocket = record
Msg: Word;
case Integer of
0: (
SocketWParam: Word;
SocketDataSize: LongInt;
SocketNumber: Longint);
1: (
WParamLo: Byte;
WParamHi: Byte;
SocketEvent: Word;
SocketError: Word;
ResultLo: Word;
ResultHi: Word);
2: (
WParam: Word;
TaskHandle: Word;
WordHolder: Word;
pHostStruct: Pointer);
end;

TSocketMessageEvent = procedure (SocketMessage: TWMSocket) of object;

{$IFDEF TREAT_AS_OBJECT}
TAsyncSocket = class(TObject)
{$ENDIF} // TREAT_AS_OBJECT
{$IFDEF TREAT_AS_COMPONENT}
TAsyncSocket = class(TComponent)
{$ENDIF} // TREAT_AS_COMPONENT
public
m_SockAddr: TSockAddr;
m_Handle: TSocket;
m_hWnd: ThWnd;

{$IFDEF TREAT_AS_OBJECT}
procedure OnError(SocketMessage: TWMSocket); virtual;
procedure OnAccept(SocketMessage: TWMSocket); virtual;
procedure OnClose(SocketMessage: TWMSocket); virtual;
procedure OnConnect(SocketMessage: TWMSocket); virtual;
procedure OnRead(SocketMessage: TWMSocket); virtual;
procedure OnWrite(SocketMessage: TWMSocket); virtual;
procedure OnListen(SocketMessage: TWMSocket); virtual;
procedure OnOOB(SocketMessage: TWMSocket); virtual;
{$ENDIF} // TREAT_AS_OBJECT

{$IFDEF TREAT_AS_COMPONENT}
FOnError: TSocketMessageEvent;
FOnAccept: TSocketMessageEvent;
FOnClose: TSocketMessageEvent;
FOnConnect: TSocketMessageEvent;
FOnRead: TSocketMessageEvent;
FOnWrite: TSocketMessageEvent;
FOnListen: TSocketMessageEvent;
FOnOOB: TSocketMessageEvent;
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
constructor Create;
{$ENDIF} // TREAT_AS_OBJECT
{$IFDEF TREAT_AS_COMPONENT}
constructor Create(AOwner: TComponent); override;
{$ENDIF} //TREAT_AS_COMPONENT
destructor Destroy; override;

function GetPortNumber: LongInt;
function GetIPAddress: String;
function ErrorTest(Evaluation: LongInt): LongInt;
function ErrToStr(Err: LongInt): String;

function DoGetHostByAddr(IPAddress: PChar): String;
function DoGetHostByName(Name: PChar): String;

procedure AllocateSocket;
procedure Initialize;
procedure DeInitialize;
procedure KillWinsockBug;
procedure SetPortNumber(NewPortNumber: LongInt);
procedure SetIPAddress(NewIPAddress: String);
procedure SetSocketHandle(NewSocketHandle: TSocket);

procedure DoClose;
procedure DoReceive(Buffer: Pointer; var ReceiveLen: LongInt);
procedure DoSend(Buffer: Pointer; var SendLen: LongInt);
procedure DoListen;
procedure DoConnect;
procedure DoAccept(var AcceptSocket: TAsyncSocket);

// Message Handlers

procedure HWndProcedure(var Message: TMessage);

procedure Message_Error(var Message: TWMSocket); message WM_SOCKETERROR;
procedure Message_Close(var Message: TWMSocket); message WM_SOCKETCLOSE;
procedure Message_Accept(var Message: TWMSocket); message WM_SOCKETACCEPT;
procedure Message_Read(var Message: TWMSocket); message WM_SOCKETREAD;
procedure Message_Connect(var Message: TWMSocket); message WM_SOCKETCONNECT;
procedure Message_Write(var Message: TWMSocket); message WM_SOCKETWRITE;
procedure Message_OOB(var Message: TWMSocket); message WM_SOCKETOOB;
procedure Message_Listen(var Message: TWMSocket); message WM_SOCKETLISTEN;

property SocketHandle: TSocket read m_Handle write SetSocketHandle;

published
property IPAddress: String read GetIPAddress write SetIPAddress;
property PortNumber: LongInt read GetPortNumber write SetPortNumber;

{$IFDEF TREAT_AS_COMPONENT}
property OnError: TSocketMessageEvent read FOnError write FOnError;
property OnAccept: TSocketMessageEvent read FOnAccept write FOnAccept;
property OnClose: TSocketMessageEvent read FOnClose write FOnClose;
property OnConnect: TSocketMessageEvent read FOnConnect write FOnConnect;
property OnRead: TSocketMessageEvent read FOnRead write FOnRead;
property OnWrite: TSocketMessageEvent read FOnWrite write FOnWrite;
property OnOOB: TSocketMessageEvent read FOnOOB write FOnOOB;
property OnListen: TSocketMessageEvent read FOnListen write FOnListen;
{$ENDIF} // TREAT_AS_COMPONENT
end;

{$IFDEF TREAT_AS_COMPONENT}
procedure Register;
{$ENDIF} // TREAT_AS_COMPONENT

var
InstanceCount: LongInt = 0;

implementation

{$IFDEF TREAT_AS_OBJECT}
constructor TAsyncSocket.Create;
begin
inherited Create;
{$ENDIF} // TREAT_AS_OBJECT
{$IFDEF TREAT_AS_COMPONENT}
constructor TAsyncSocket.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$ENDIF} // TREAT_AS_COMPONENT
InstanceCount := InstanceCount + 1;
Initialize;
end; // constructor TAsyncSocket.Create

destructor TAsyncSocket.Destroy;
begin
DeInitialize;
InstanceCount := InstanceCount - 1;
inherited Destroy;
end; // destructor TAsyncSocket.Destroy;

function TAsyncSocket.GetIPAddress: String;
begin
Result := INet_NToA(m_SockAddr.sin_addr);
end; // function TAsyncSocket.GetIPAddress: String

function TAsyncSocket.GetPortNumber: LongInt;
begin
Result := NToHS(m_SockAddr.sin_port);
end; // function TAsyncSocket.GetPortNumber: Word

procedure TAsyncSocket.AllocateSocket;
begin
if (m_Handle = INVALID_SOCKET) then
begin
m_Handle := ErrorTest(socket(AF_INET, SOCK_STREAM, 0));
end; // if (m_Handle = INVALID_SOCKET) then
end; // procedure TAsyncSocket.AllocateSocket

procedure TAsyncSocket.SetSocketHandle(NewSocketHandle: TSocket);
begin
DoClose;
m_Handle := NewSocketHandle;
ErrorTest(WSAAsyncSelect(m_Handle, m_hWnd.Handle, WM_SOCKET, EVENTS_SETSOCKETHANDLE));
end; // procedure TAsyncSocket.SetSocketHandle(NewSocketHandle: TSocket)

function TAsyncSocket.ErrorTest(Evaluation: LongInt): LongInt;
var
TempMessage: TWMSocket;
begin
if ((Evaluation = SOCKET_ERROR) OR (Evaluation = INVALID_SOCKET)) then
begin
TempMessage.Msg := WM_SOCKETERROR;
TempMessage.SocketError := WSAGetLastError;
TempMessage.SocketNumber := m_Handle;
Dispatch(TempMessage);
Result := Evaluation;
end // if ((Evaluation = SOCKET_ERROR) OR (Evaluation = INVALID_SOCKET)) then
else
Result := Evaluation;
end; // function ErrorTest(Evaluation: LongInt): LongInt;

procedure TAsyncSocket.Initialize;
var
TempWSAData: TWSAData;
begin
if (InstanceCount = c_FIRST) then
ErrorTest(WSAStartup($101, TempWSAData));
KillWinsockBug;
m_hWnd := ThWnd.Create(HWndProcedure);
m_Handle := INVALID_SOCKET;
m_SockAddr.sin_family := AF_INET;
PortNumber := 1;
end; // procedure TAsyncSocket.Initialize

procedure TAsyncSocket.KillWinsockBug;
var
Addr: Integer;
begin
Addr := 0;
// For an unknown reason, if a call is made to GetHostByName and it should
// fail, the following call to GetHostByAddr will not fail, but return '&gt;'
// in the place of the host name. This clears the problem up.
GetHostByName('');
GetHostByAddr(@Addr, SizeOf(Integer), PF_INET);
GetHostByName('');
end;

procedure TAsyncSocket.DeInitialize;
begin
DoClose;
if (InstanceCount = c_FIRST) then
ErrorTest(WSACleanup);
m_hWnd.Free;
end; // procedure TAsyncSocket.DeInitialize

procedure TAsyncSocket.SetIPAddress(NewIPAddress: String);
var
pTempHostEnt: PHostEnt;
begin
m_SockAddr.sin_addr.s_addr := INet_Addr(PChar(NewIPAddress));
if (m_SockAddr.sin_addr.s_addr = INADDR_NONE) then
begin
pTempHostEnt := GetHostByName(PChar(NewIPAddress));
if (pTempHostEnt &lt;&gt; Nil) then
m_SockAddr.sin_addr.s_addr := PInAddr(pTempHostEnt^.h_addr_list^)^.s_addr;
end;
end; // procedure TAsyncSocket.SetIPAddress(NewIPAddress: String)

procedure TAsyncSocket.SetPortNumber(NewPortNumber: LongInt);
begin
if ((NewPortNumber &gt; c_ZERO) AND (NewPortNumber &lt;= MaxWord)) then
m_SockAddr.sin_port := HToNS(NewPortNumber);
end; // procedure TAsyncSocket.SetPortNumber(NewPortNumber: Word)

procedure TAsyncSocket.DoReceive(Buffer: Pointer; var ReceiveLen: LongInt);
begin
ReceiveLen := recv(m_Handle, Buffer^, ReceiveLen, c_ZERO);
ErrorTest(ReceiveLen);
end; // TAsyncSocket.DoReceive(Buffer: Pointer; BufferLen: LongInt)

procedure TAsyncSocket.DoSend(Buffer: Pointer; var SendLen: LongInt);
begin
SendLen := send(m_Handle, Buffer^, SendLen, c_ZERO);
ErrorTest(SendLen);
end; // procedure TAsyncSocket.DoSend(Buffer: Pointer; BufferLen: LongInt)

procedure TAsyncSocket.DoClose;
var
TempMessage: TWMSocket;
begin
if (m_Handle &lt;&gt; INVALID_SOCKET) then
begin
TempMessage.Msg := WM_SOCKETCLOSE;
TempMessage.SocketNumber := m_Handle;
ErrorTest(closesocket(m_Handle));
m_Handle := INVALID_SOCKET;
Dispatch(TempMessage);
end; // if (m_Handle &lt;&gt; INVALID_SOCKET) then
end; // procedure TAsyncSocket.DoClose

procedure TAsyncSocket.DoAccept(var AcceptSocket: TAsyncSocket);
var
TempSize: Integer;
TempSocket: TSocket;
begin
TempSize := SizeOf(TSockAddr);
TempSocket := accept(m_Handle, AcceptSocket.m_SockAddr,
TempSize);
if (ErrorTest(TempSocket) &lt;&gt; INVALID_SOCKET) then
AcceptSocket.SocketHandle := TempSocket;
end; // procedure TAsyncSocket.DoAccept(var AcceptSocket: TAsyncSocket)

procedure TAsyncSocket.DoListen;
var
TempMessage: TWMSocket;
begin
DoClose;
AllocateSocket;
if
(ErrorTest(WSAAsyncSelect(m_Handle, m_hWnd.Handle, WM_SOCKET, EVENTS_DOLISTEN))
&lt;&gt; SOCKET_ERROR) AND
(ErrorTest(bind(m_Handle, m_SockAddr, SizeOf(TSockAddr))) &lt;&gt; SOCKET_ERROR) AND
(ErrorTest(listen(m_Handle, 5)) &lt;&gt; SOCKET_ERROR) then
begin
TempMessage.Msg := WM_SOCKETLISTEN;
TempMessage.SocketNumber := m_Handle;
Dispatch(TempMessage);
end
else
DoClose;
end; // procedure TAsyncSocket.DoListen

procedure TAsyncSocket.DoConnect;
var
TempResult: LongInt;
begin
DoClose;
AllocateSocket;
ErrorTest(WSAAsyncSelect(m_Handle, m_hWnd.Handle, WM_SOCKET, EVENTS_DOCONNECT));
TempResult := connect(m_Handle, m_SockAddr, SizeOf(TSockAddr));
if ((TempResult = SOCKET_ERROR) AND (WSAGetLastError &lt;&gt; WSAEWOULDBLOCK)) then
ErrorTest(SOCKET_ERROR);
end; // procedure TAsyncSocket.DoConnect

function TAsyncSocket.DoGetHostByName(Name: PChar): String;
var
pTempHostEnt: PHostEnt;
begin
pTempHostEnt := GetHostByName(Name);
if (pTempHostEnt &lt;&gt; Nil) then
Result := inet_ntoa(pInAddr(pTempHostEnt^.h_addr_list^)^)
else
Result := '';
end;

function TAsyncSocket.DoGetHostByAddr(IPAddress: PChar): String;
var
pTempHostEnt: PHostEnt;
TempAddr: LongInt;
begin
TempAddr := INet_Addr(IPAddress);
pTempHostEnt := GetHostByAddr(@TempAddr, SizeOf(TempAddr), PF_INET);
if (pTempHostEnt &lt;&gt; Nil) then
Result := pTempHostEnt^.h_name
else
Result := '';
end;

procedure TAsyncSocket.HWndProcedure(var Message: TMessage);
var
TempMessage: TWMSocket;
begin
case Message.Msg of
WM_SOCKET:
begin
if (Message.LParamHi &gt; WSABASEERR) then
begin
WSASetLastError(Message.LParamHi);
ErrorTest(SOCKET_ERROR);
end // if (Message.LParamHi &gt; WSABASEERR) then
else
begin
case Message.LParamLo of
FD_READ:
begin
TempMessage.SocketDataSize := 0;
ErrorTest(IOCtlSocket(m_Handle, FIONREAD, TempMessage.SocketDataSize));
TempMessage.Msg := WM_SOCKETREAD;
TempMessage.SocketNumber := m_Handle;
Dispatch(TempMessage);
end; // FD_READ
FD_CLOSE:
begin
DoClose;
end; // FD_CLOSE
FD_CONNECT:
begin
TempMessage.Msg := WM_SOCKETCONNECT;
TempMessage.SocketNumber := m_Handle;
Dispatch(TempMessage);
end; // FD_CONNECT
FD_ACCEPT:
begin
TempMessage.Msg := WM_SOCKETACCEPT;
TempMessage.SocketNumber := m_Handle;
Dispatch(TempMessage);
end; // FD_ACCEPT
FD_WRITE:
begin
TempMessage.Msg := WM_SOCKETWRITE;
TempMessage.SocketNumber := m_Handle;
Dispatch(TempMessage);
end; // FD_WRITE
FD_OOB:
begin
TempMessage.Msg := WM_SOCKETOOB;
TempMessage.SocketNumber := m_Handle;
Dispatch(TempMessage);
end; // FD_OOB
end; // case Message.LParamLo of
end // else (if (Message.LParamHi &gt; WSABASEERR) then)
end; // WM_SOCKET:
end; // case Message.Msg of
end; // procedure TAsyncSocket.HWndProcedure(var Message: TMessage)

{$IFDEF TREAT_AS_OBJECT}
procedure TAsyncSocket.OnError(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar(ErrToStr(SocketMessage.SocketError) + ' on socket ' +
IntToStr(SocketMessage.SocketNumber)), 'Message_Error', MB_OK);
{$ENDIF WANT_MESSAGEBOX_ALERTS}
end;

procedure TAsyncSocket.OnAccept(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETACCEPT on socket ' + IntToStr(SocketMessage.SocketNumber)),
'Message_Accept', MB_OK);
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
end;

procedure TAsyncSocket.OnClose(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCLOSE on socket ' + IntToStr(SocketMessage.SocketNumber)),
'Message_Close', MB_OK);
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
end;

procedure TAsyncSocket.OnConnect(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCONNECT on socket ' + IntToStr(SocketMessage.SocketNumber)),
'Message_Connect', MB_OK);
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
end;

procedure TAsyncSocket.OnRead(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETREAD on socket ' + IntToStr(SocketMessage.SocketNumber)),
'Message_Read', MB_OK);
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
end;

procedure TAsyncSocket.OnWrite(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETWRITE on socket ' + IntToStr(SocketMessage.SocketNumber)),
'Message_Write', MB_OK);
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
end;

procedure TAsyncSocket.OnListen(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETLISTEN on socket ' + IntToStr(SocketMessage.SocketNumber)),
'Message_Listen', MB_OK);
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
end;

procedure TAsyncSocket.OnOOB(SocketMessage: TWMSocket);
begin
{$IFDEF WANT_MESSAGEBOX_ALERTS}
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETOOB on socket ' + IntToStr(SocketMessage.SocketNumber)),
'Message_OOB', MB_OK);
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
end;
{$ENDIF} // TREAT_AS_OBJECT

procedure TAsyncSocket.Message_Error(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnError) then FOnError(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar(ErrToStr(Message.SocketError) + ' on socket ' +
IntToStr(Message.SocketNumber)), 'Message_Error', MB_OK);
{$ELSE}
;
{$ENDIF}
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnError(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_Error(var Message: TWMSocket)

procedure TAsyncSocket.Message_Close(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnClose) then FOnClose(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCLOSE on socket ' + IntToStr(Message.SocketNumber)),
'Message_Close', MB_OK);
{$ELSE}
;
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnClose(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_Close(var Message: TWMSocket)

procedure TAsyncSocket.Message_Accept(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnAccept) then FOnAccept(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETACCEPT on socket ' + IntToStr(Message.SocketNumber)),
'Message_Accept', MB_OK);
{$ELSE}
;
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnAccept(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_Accept(var Message: TWMSocket)

procedure TAsyncSocket.Message_Read(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnRead) then FOnRead(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETREAD on socket ' + IntToStr(Message.SocketNumber)),
'Message_Read', MB_OK);
{$ELSE}
;
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnRead(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_Read(var Message: TWMSocket)

procedure TAsyncSocket.Message_Connect(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnConnect) then FOnConnect(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCONNECT on socket ' + IntToStr(Message.SocketNumber)),
'Message_Connect', MB_OK);
{$ELSE}
;
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnConnect(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_Connect(var Message: TWMSocket)

procedure TAsyncSocket.Message_Write(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnWrite) then FOnWrite(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETWRITE on socket ' + IntToStr(Message.SocketNumber)),
'Message_Write', MB_OK);
{$ELSE}
;
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnWrite(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_Write(var Message: TWMSocket)

procedure TAsyncSocket.Message_OOB(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnOOB) then FOnOOB(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETOOB on socket ' + IntToStr(Message.SocketNumber)),
'Message_OOB', MB_OK);
{$ELSE}
;
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnOOB(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_OOB(var Message: TWMSocket)

procedure TAsyncSocket.Message_Listen(var Message: TWMSocket);
begin
{$IFDEF TREAT_AS_COMPONENT}
if Assigned(FOnListen) then FOnListen(Message)
{$IFDEF WANT_MESSAGEBOX_ALERTS}
else
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETLISTEN on socket ' + IntToStr(Message.SocketNumber)),
'Message_Listen', MB_OK);
{$ELSE}
;
{$ENDIF} // WANT_MESSAGEBOX_ALERTS
{$ENDIF} // TREAT_AS_COMPONENT

{$IFDEF TREAT_AS_OBJECT}
OnListen(Message);
{$ENDIF} // TREAT_AS_OBJECT
end; // procedure TAsyncSocket.Message_Listen(var Message: TWMSocket)

function TAsyncSocket.ErrToStr(Err: LongInt): String;
begin
case Err of
WSAEINTR:
Result := 'WSAEINTR';
WSAEBADF:
Result := 'WSAEBADF';
WSAEACCES:
Result := 'WSAEACCES';
WSAEFAULT:
Result := 'WSAEFAULT';
WSAEINVAL:
Result := 'WSAEINVAL';
WSAEMFILE:
Result := 'WSAEMFILE';
WSAEWOULDBLOCK:
Result := 'WSAEWOULDBLOCK';
WSAEINPROGRESS:
Result := 'WSAEINPROGRESS';
WSAEALREADY:
Result := 'WSAEALREADY';
WSAENOTSOCK:
Result := 'WSAENOTSOCK';
WSAEDESTADDRREQ:
Result := 'WSAEDESTADDRREQ';
WSAEMSGSIZE:
Result := 'WSAEMSGSIZE';
WSAEPROTOTYPE:
Result := 'WSAEPROTOTYPE';
WSAENOPROTOOPT:
Result := 'WSAENOPROTOOPT';
WSAEPROTONOSUPPORT:
Result := 'WSAEPROTONOSUPPORT';
WSAESOCKTNOSUPPORT:
Result := 'WSAESOCKTNOSUPPORT';
WSAEOPNOTSUPP:
Result := 'WSAEOPNOTSUPP';
WSAEPFNOSUPPORT:
Result := 'WSAEPFNOSUPPORT';
WSAEAFNOSUPPORT:
Result := 'WSAEAFNOSUPPORT';
WSAEADDRINUSE:
Result := 'WSAEADDRINUSE';
WSAEADDRNOTAVAIL:
Result := 'WSAEADDRNOTAVAIL';
WSAENETDOWN:
Result := 'WSAENETDOWN';
WSAENETUNREACH:
Result := 'WSAENETUNREACH';
WSAENETRESET:
Result := 'WSAENETRESET';
WSAECONNABORTED:
Result := 'WSAECONNABORTED';
WSAECONNRESET:
Result := 'WSAECONNRESET';
WSAENOBUFS:
Result := 'WSAENOBUFS';
WSAEISCONN:
Result := 'WSAEISCONN';
WSAENOTCONN:
Result := 'WSAENOTCONN';
WSAESHUTDOWN:
Result := 'WSAESHUTDOWN';
WSAETOOMANYREFS:
Result := 'WSAETOOMANYREFS';
WSAETIMEDOUT:
Result := 'WSAETIMEDOUT';
WSAECONNREFUSED:
Result := 'WSAECONNREFUSED';
WSAELOOP:
Result := 'WSAELOOP';
WSAENAMETOOLONG:
Result := 'WSAENAMETOOLONG';
WSAEHOSTDOWN:
Result := 'WSAEHOSTDOWN';
WSAEHOSTUNREACH:
Result := 'WSAEHOSTUNREACH';
WSAENOTEMPTY:
Result := 'WSAENOTEMPTY';
WSAEPROCLIM:
Result := 'WSAEPROCLIM';
WSAEUSERS:
Result := 'WSAEUSERS';
WSAEDQUOT:
Result := 'WSAEDQUOT';
WSAESTALE:
Result := 'WSAESTALE';
WSAEREMOTE:
Result := 'WSAEREMOTE';
WSASYSNOTREADY:
Result := 'WSASYSNOTREADY';
WSAVERNOTSUPPORTED:
Result := 'WSAVERNOTSUPPORTED';
WSANOTINITIALISED:
Result := 'WSANOTINITIALISED';
WSAHOST_NOT_FOUND:
Result := 'WSAHOST_NOT_FOUND';
WSATRY_AGAIN:
Result := 'WSATRY_AGAIN';
WSANO_RECOVERY:
Result := 'WSANO_RECOVERY';
WSANO_DATA:
Result := 'WSANO_DATA';
else Result := 'UNDEFINED WINSOCK ERROR';
end; // case Err of
end; // function TAsyncSocket.ErrToStr(Err: LongInt): String

{$IFNDEF TREAT_AS_OBJECT}
procedure Register;
begin
RegisterComponents('Samples', [TAsyncSocket]);
end;
{$ENDIF}

constructor ThWnd.Create(WndMethod: TWndMethod);
begin
inherited Create;
m_hWnd := AllocateHWnd(WndMethod);
end; // constructor ThWnd.Create(WndMethod: TWndMethod)

destructor ThWnd.Destroy;
begin
DeallocateHWnd(m_hWnd);
end; // destructor ThWnd.Destroy

end.

 
后退
顶部