得了,我把程序贴在这里,大家看去吧.
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 '>'
// 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 <> 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 > c_ZERO) AND (NewPortNumber <= 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 <> 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 <> 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) <> 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))
<> SOCKET_ERROR) AND
(ErrorTest(bind(m_Handle, m_SockAddr, SizeOf(TSockAddr))) <> SOCKET_ERROR) AND
(ErrorTest(listen(m_Handle, 5)) <> 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 <> WSAEWOULDBLOCK)) then
ErrorTest(SOCKET_ERROR);
end; // procedure TAsyncSocket.DoConnect
function TAsyncSocket.DoGetHostByName(Name: PChar): String;
var
pTempHostEnt: PHostEnt;
begin
pTempHostEnt := GetHostByName(Name);
if (pTempHostEnt <> 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 <> 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 > WSABASEERR) then
begin
WSASetLastError(Message.LParamHi);
ErrorTest(SOCKET_ERROR);
end // if (Message.LParamHi > 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 > 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.