846 lines
25 KiB
ObjectPascal
846 lines
25 KiB
ObjectPascal
unit KOLSocket;
|
|
|
|
interface
|
|
|
|
uses
|
|
KOL, Windows, Messages, Winsock;
|
|
|
|
const
|
|
WM_SOCKET = WM_USER + $7000;
|
|
WM_SOCKETERROR = WM_USER + $7001;
|
|
WM_SOCKETCLOSE = WM_USER + $7002;
|
|
WM_SOCKETREAD = WM_USER + $7003;
|
|
WM_SOCKETCONNECT = WM_USER + $7004;
|
|
WM_SOCKETACCEPT = WM_USER + $7005;
|
|
WM_SOCKETWRITE = WM_USER + $7006;
|
|
WM_SOCKETOOB = WM_USER + $7007;
|
|
WM_SOCKETLISTEN = WM_USER + $7008;
|
|
WM_SOCKETLOOKUP = WM_USER + $7009;
|
|
|
|
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_FIRST = 1;
|
|
|
|
INVALID_SOCKET = winsock.INVALID_SOCKET;
|
|
|
|
type
|
|
|
|
TWndMethod = procedure(var Message: TMessage) of object;
|
|
|
|
PhWnd =^ThWnd;
|
|
ThWnd = object( TObj )
|
|
protected
|
|
m_hWnd: hWnd;
|
|
destructor Destroy; virtual;
|
|
public
|
|
property Handle: hWnd read m_hWnd;
|
|
end;
|
|
|
|
PAsyncSocket =^TAsyncSocket;
|
|
TKOLSocket = PAsyncSocket;
|
|
|
|
TWMSocket = record
|
|
Msg: Word;
|
|
case Integer of
|
|
0: (
|
|
SocketWParam: Word;
|
|
SocketDataSize: LongInt;
|
|
SocketNumber: Longint;
|
|
SocketAddress: PAsyncSocket);
|
|
1: (
|
|
WParamLo: Byte;
|
|
WParamHi: Byte;
|
|
SocketEvent: Word;
|
|
SocketError: Word;
|
|
ResultLo: Word;
|
|
ResultHi: Word);
|
|
2: (
|
|
WParam: Word;
|
|
TaskHandle: Word;
|
|
WordHolder: Word;
|
|
pHostStruct: Pointer);
|
|
end;
|
|
|
|
TBArray = array[0..65534] of byte;
|
|
|
|
TBufRecord = record
|
|
i: integer;
|
|
p:^TBArray;
|
|
end;
|
|
|
|
TSocketMessageEvent = procedure (SocketMessage: TWMSocket) of object;
|
|
|
|
TAsyncSocket = object( TObj )
|
|
m_SockAddr: TSockAddr;
|
|
m_Handle: TSocket;
|
|
m_hWnd: PhWnd;
|
|
fConnected: boolean;
|
|
fDNSResult: string;
|
|
fDNSHandle: integer;
|
|
FDnsBuffer: array [0..MAXGETHOSTSTRUCT] of char;
|
|
FList: PList;
|
|
FOnError: TSocketMessageEvent;
|
|
FOnLookup: TSocketMessageEvent;
|
|
FOnAccept: TSocketMessageEvent;
|
|
FOnClose: TSocketMessageEvent;
|
|
FOnConnect: TSocketMessageEvent;
|
|
FOnRead: TSocketMessageEvent;
|
|
FOnWrite: TSocketMessageEvent;
|
|
FOnListen: TSocketMessageEvent;
|
|
FOnOOB: TSocketMessageEvent;
|
|
|
|
protected
|
|
destructor Destroy; virtual;
|
|
|
|
private
|
|
function GetCount: LongInt;
|
|
function GetPortNumber: LongInt;
|
|
function GetIPAddress: String;
|
|
function ErrorTest(Evaluation: LongInt): LongInt;
|
|
|
|
procedure AllocateSocket;
|
|
procedure KillWinsockBug;
|
|
procedure SetPortNumber(NewPortNumber: LongInt);
|
|
procedure SetIPAddress(NewIPAddress: String);
|
|
procedure SetSocketHandle(NewSocketHandle: TSocket);
|
|
function GetConnected: boolean;
|
|
|
|
// Message Handlers
|
|
|
|
procedure HWndProcedure(var Message: TMessage);
|
|
|
|
procedure Message_Error(var Message: TWMSocket);
|
|
procedure Message_Lookup(var Message: TWMSocket);
|
|
procedure Message_Close(var Message: TWMSocket);
|
|
procedure Message_Accept(var Message: TWMSocket);
|
|
procedure Message_Read(var Message: TWMSocket);
|
|
procedure Message_Connect(var Message: TWMSocket);
|
|
procedure Message_Write(var Message: TWMSocket);
|
|
procedure Message_OOB(var Message: TWMSocket);
|
|
procedure Message_Listen(var Message: TWMSocket);
|
|
procedure DoReceive(Buffer: Pointer; var ReceiveLen: LongInt);
|
|
procedure DoFinal(Abort: boolean);
|
|
|
|
public
|
|
procedure ProcessMessages;
|
|
function DoGetHostByAddr(IPAddr: PChar): String;
|
|
function DoGetHostByName(Name: PChar): String;
|
|
|
|
procedure DoLookup(host: string);
|
|
procedure DoClose;
|
|
procedure DoSend(Buffer: Pointer; var SendLen: LongInt);
|
|
procedure DoListen;
|
|
procedure DoConnect;
|
|
procedure DoAccept(var AcceptSocket: PAsyncSocket);
|
|
|
|
procedure SendString(fString: String);
|
|
|
|
function ReadData(b: pointer; c: integer): integer;
|
|
function ReadLine(c: char): string; overload;
|
|
function ReadLine(c: char; t: integer): string; overload;
|
|
function ErrToStr(Err: LongInt): String;
|
|
function LocalIP: String;
|
|
function LocalPort: integer;
|
|
|
|
property SocketHandle: TSocket read m_Handle write SetSocketHandle;
|
|
property IPAddress: String read GetIPAddress write SetIPAddress;
|
|
property PortNumber: LongInt read GetPortNumber write SetPortNumber;
|
|
property Count: LongInt read GetCount;
|
|
property Connected: boolean read GetConnected;
|
|
property DNSResult: string read fDNSResult write fDNSResult;
|
|
|
|
property OnError: TSocketMessageEvent read FOnError write FOnError;
|
|
property OnLookup: TSocketMessageEvent read FOnLookup write FOnLookup;
|
|
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;
|
|
end;
|
|
|
|
function NewThWnd(WndMethod: TWndMethod): PhWnd;
|
|
function NewAsyncSocket: PAsyncSocket;
|
|
|
|
var
|
|
InstanceCount: LongInt = 0;
|
|
|
|
implementation
|
|
|
|
uses objects;
|
|
|
|
function NewThWnd;
|
|
begin
|
|
New(Result, Create);
|
|
Result.m_hWnd := AllocateHWnd(WndMethod);
|
|
end; // constructor ThWnd.Create(WndMethod: TWndMethod)
|
|
|
|
destructor ThWnd.Destroy;
|
|
begin
|
|
DeallocateHWnd(m_hWnd);
|
|
inherited;
|
|
end;
|
|
|
|
function NewAsyncSocket;
|
|
var
|
|
TempWSAData: TWSAData;
|
|
begin
|
|
InstanceCount := InstanceCount + 1;
|
|
New(Result, Create);
|
|
if (InstanceCount = c_FIRST) then
|
|
Result.ErrorTest(WSAStartup($101, TempWSAData));
|
|
Result.KillWinsockBug;
|
|
Result.m_Handle := INVALID_SOCKET;
|
|
Result.m_SockAddr.sin_family := AF_INET;
|
|
Result.m_SockAddr.sin_addr.s_addr := INet_Addr('0.0.0.0');
|
|
Result.PortNumber := 0;
|
|
Result.FList := NewList;
|
|
Result.m_hWnd := NewThWnd(Result.HWndProcedure);
|
|
end; // constructor TAsyncSocket.Create
|
|
|
|
function TAsyncSocket.GetCount;
|
|
var i: integer;
|
|
t:^TBufRecord;
|
|
begin
|
|
result := 0;
|
|
for i := 0 to FList.Count - 1 do begin
|
|
t := FList.Items[i];
|
|
result := result + t^.i;
|
|
end;
|
|
end;
|
|
|
|
function TAsyncSocket.ReadData;
|
|
var n,
|
|
r: integer;
|
|
t:^TBufRecord;
|
|
u:^TBufRecord;
|
|
a:^TBArray;
|
|
begin
|
|
if FList.count = 0 then begin
|
|
result := 0;
|
|
exit;
|
|
end;
|
|
n := 0;
|
|
a := b;
|
|
while (n < c) and (n < count) do begin
|
|
r := c - n;
|
|
t := FList.Items[0];
|
|
if r > t^.i then r := t^.i;
|
|
move(t^.p^, a^[n], r);
|
|
n := n + r;
|
|
if r = t^.i then begin
|
|
FreeMem(t^.p, t^.i);
|
|
FreeMem(t, SizeOf(TBufRecord));
|
|
FList.Delete(0);
|
|
end else begin
|
|
GetMem(u, SizeOf(TBufRecord));
|
|
u^.i := t^.i - r;
|
|
GetMem(u^.p, u^.i);
|
|
move(t^.p^[r], u^.p^, u^.i);
|
|
FreeMem(t^.p, t^.i);
|
|
FreeMem(t, SizeOf(TBufRecord));
|
|
FList.Items[0] := u;
|
|
end;
|
|
end;
|
|
result := n;
|
|
end;
|
|
|
|
function TAsyncSocket.ReadLine(c: char): string;
|
|
var i,
|
|
n,
|
|
j: integer;
|
|
t:^TBufRecord;
|
|
s: string;
|
|
begin
|
|
result := '';
|
|
n := 0;
|
|
if count = 0 then exit;
|
|
for i := 0 to FList.Count - 1 do begin
|
|
t := FList.Items[i];
|
|
for j := 0 to t^.i - 1 do begin
|
|
inc(n);
|
|
if chr(t^.p^[j]) = c then begin
|
|
if n > 1 then begin
|
|
setlength(s, n - 1);
|
|
ReadData(@s[1], n - 1);
|
|
ReadData(@n , 1);
|
|
result := s;
|
|
end else begin
|
|
ReadData(@n , 1);
|
|
result := '';
|
|
end;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TAsyncSocket.ReadLine(c: char; t: integer): string;
|
|
var tt: longint;
|
|
Msg: tagMSG;
|
|
begin
|
|
result := '';
|
|
tt := gettickcount;
|
|
while (result = '') and (longint(gettickcount) < tt + t * 1000) do begin
|
|
if PeekMessage(Msg, m_hWnd.m_hWnd, 0, 0, PM_REMOVE) then begin
|
|
DispatchMessage(Msg);
|
|
end;
|
|
result := ReadLine(c);
|
|
if m_Handle = INVALID_SOCKET then exit;
|
|
end;
|
|
end;
|
|
|
|
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
|
|
DoFinal(True);
|
|
m_Handle := NewSocketHandle;
|
|
ErrorTest(WSAAsyncSelect(m_Handle, m_hWnd.Handle, WM_SOCKET, EVENTS_SETSOCKETHANDLE));
|
|
end; // procedure TAsyncSocket.SetSocketHandle(NewSocketHandle: TSocket)
|
|
|
|
function TAsyncSocket.GetConnected;
|
|
begin
|
|
result := fConnected;
|
|
end;
|
|
|
|
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;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Error(TempMessage);
|
|
Result := Evaluation;
|
|
end // if ((Evaluation = SOCKET_ERROR) OR (Evaluation = INVALID_SOCKET)) then
|
|
else
|
|
Result := Evaluation;
|
|
end; // function ErrorTest(Evaluation: LongInt): LongInt;
|
|
|
|
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.SetIPAddress(NewIPAddress: String);
|
|
var
|
|
pTempHostEnt: PHostEnt;
|
|
begin
|
|
m_SockAddr.sin_addr.s_addr := INet_Addr(PChar(NewIPAddress));
|
|
if (m_SockAddr.sin_addr.s_addr = u_long(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 > 0) 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, 0);
|
|
ErrorTest(ReceiveLen);
|
|
end; // TAsyncSocket.DoReceive(Buffer: Pointer; BufferLen: LongInt)
|
|
|
|
procedure TAsyncSocket.DoSend(Buffer: Pointer; var SendLen: LongInt);
|
|
begin
|
|
SendLen := send(m_Handle, Buffer^, SendLen, 0);
|
|
ErrorTest(SendLen);
|
|
end; // procedure TAsyncSocket.DoSend(Buffer: Pointer; BufferLen: LongInt)
|
|
|
|
procedure TAsyncSocket.DoLookup;
|
|
var
|
|
IPAddr : TInAddr;
|
|
begin
|
|
if Host = '' then begin
|
|
Exit;
|
|
end;
|
|
|
|
{ Cancel any pending lookup }
|
|
if FDnsHandle <> 0 then
|
|
WSACancelAsyncRequest(FDnsHandle);
|
|
|
|
FDnsResult := '';
|
|
|
|
IPAddr.S_addr := Inet_addr(PChar(Host));
|
|
if IPAddr.S_addr <> u_long(INADDR_NONE) then begin
|
|
FDnsResult := inet_ntoa(IPAddr);
|
|
{ TriggerDnsLookupDone(0);}
|
|
Exit;
|
|
end;
|
|
|
|
FDnsHandle := WSAAsyncGetHostByName(m_hWnd.Handle,
|
|
WM_SOCKETLOOKUP,
|
|
@Host[1],
|
|
@FDnsBuffer,
|
|
SizeOf(FDnsBuffer));
|
|
if FDnsHandle = 0 then begin
|
|
ErrorTest(WSAGetLastError);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TAsyncSocket.DoClose;
|
|
begin
|
|
DoFinal(True);
|
|
end;
|
|
|
|
procedure TAsyncSocket.DoFinal;
|
|
var
|
|
TempMessage: TWMSocket;
|
|
begin
|
|
if (m_Handle <> INVALID_SOCKET) then begin
|
|
if not Abort then begin
|
|
ProcessMessages;
|
|
end;
|
|
TempMessage.Msg := WM_SOCKETCLOSE;
|
|
TempMessage.SocketNumber := m_Handle;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Close(TempMessage);
|
|
ErrorTest(closesocket(m_Handle));
|
|
m_Handle := INVALID_SOCKET;
|
|
end;
|
|
end;
|
|
|
|
procedure TAsyncSocket.DoAccept(var AcceptSocket: PAsyncSocket);
|
|
var
|
|
TempSize: Integer;
|
|
TempSock: TSocket;
|
|
TempAddr: TSockAddrIn;
|
|
begin
|
|
TempSize := SizeOf(TSockAddr);
|
|
TempSock := accept(m_Handle, @TempAddr, @TempSize);
|
|
AcceptSocket.m_SockAddr := TempAddr;
|
|
if (ErrorTest(TempSock) <> INVALID_SOCKET) then
|
|
AcceptSocket.SocketHandle := TempSock;
|
|
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;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Listen(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
|
|
|
|
procedure TAsyncSocket.SendString;
|
|
var
|
|
L: LongInt;
|
|
begin
|
|
L := Length(fString);
|
|
DoSend(PChar(fString), L);
|
|
end;
|
|
|
|
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;
|
|
|
|
procedure TAsyncSocket.ProcessMessages;
|
|
var Msg: TMsg;
|
|
begin
|
|
while PeekMessage(Msg, m_hWnd.m_hWnd, WM_SOCKET, WM_SOCKETLOOKUP, PM_REMOVE) do begin
|
|
DispatchMessage(Msg);
|
|
end;
|
|
end;
|
|
|
|
function TAsyncSocket.DoGetHostByAddr(IPAddr: PChar): String;
|
|
var
|
|
pTempHostEnt: PHostEnt;
|
|
TempAddr: LongInt;
|
|
begin
|
|
TempAddr := INet_Addr(IPAddr);
|
|
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_SOCKETLOOKUP:
|
|
begin
|
|
TempMessage.Msg := WM_SOCKETLOOKUP;
|
|
TempMessage.SocketNumber := m_Handle;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Lookup(TempMessage);
|
|
end;
|
|
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;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Read(TempMessage);
|
|
end; // FD_READ
|
|
FD_CLOSE:
|
|
begin
|
|
DoFinal(False);
|
|
end; // FD_CLOSE
|
|
FD_CONNECT:
|
|
begin
|
|
TempMessage.Msg := WM_SOCKETCONNECT;
|
|
TempMessage.SocketNumber := m_Handle;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Connect(TempMessage);
|
|
end; // FD_CONNECT
|
|
FD_ACCEPT:
|
|
begin
|
|
TempMessage.Msg := WM_SOCKETACCEPT;
|
|
TempMessage.SocketNumber := m_Handle;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Accept(TempMessage);
|
|
end; // FD_ACCEPT
|
|
FD_WRITE:
|
|
begin
|
|
TempMessage.Msg := WM_SOCKETWRITE;
|
|
TempMessage.SocketNumber := m_Handle;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_Write(TempMessage);
|
|
end; // FD_WRITE
|
|
FD_OOB:
|
|
begin
|
|
TempMessage.Msg := WM_SOCKETOOB;
|
|
TempMessage.SocketNumber := m_Handle;
|
|
TempMessage.SocketAddress := @self;
|
|
Message_OOB(TempMessage);
|
|
end; // FD_OOB
|
|
end; // case Message.LParamLo of
|
|
end // else (if (Message.LParamHi > WSABASEERR) then)
|
|
end; // WM_SOCKET:
|
|
else
|
|
Message.Result := DefWindowProc(m_hWnd.m_hWnd, Message.Msg, Message.WParam, Message.LParam);
|
|
end; // case Message.Msg of
|
|
end; // procedure TAsyncSocket.HWndProcedure(var Message: TMessage)
|
|
|
|
procedure TAsyncSocket.Message_Error(var Message: TWMSocket);
|
|
begin
|
|
if Assigned(FOnError) then FOnError(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar(ErrToStr(Message.SocketError) + ' on socket ' +
|
|
Int2Str(Message.SocketNumber)), 'Message_Error', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_Error(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_Lookup(var Message: TWMSocket);
|
|
var p: PHostEnt;
|
|
begin
|
|
p := @fDNSBuffer;
|
|
fDNSResult := p.h_name;
|
|
if Assigned(FOnLookup) then FOnLookup(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETLOOKUP on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_Lookup', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_LookUp(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_Close(var Message: TWMSocket);
|
|
begin
|
|
fConnected := False;
|
|
if Assigned(FOnClose) then FOnClose(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCLOSE on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_Close', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_Close(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_Accept(var Message: TWMSocket);
|
|
begin
|
|
fConnected := True;
|
|
if Assigned(FOnAccept) then FOnAccept(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETACCEPT on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_Accept', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_Accept(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_Read(var Message: TWMSocket);
|
|
var t:^TBufRecord;
|
|
begin
|
|
if Message.SocketDataSize > 0 then begin
|
|
fConnected := True;
|
|
GetMem(t, sizeof(TBufRecord));
|
|
t^.i := Message.SocketDataSize;
|
|
GetMem(t^.p, t^.i);
|
|
DoReceive(t^.p, t^.i);
|
|
FList.Add(t);
|
|
end;
|
|
if Assigned(FOnRead) then FOnRead(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETREAD on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_Read', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_Read(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_Connect(var Message: TWMSocket);
|
|
begin
|
|
fConnected := True;
|
|
if Assigned(FOnConnect) then FOnConnect(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCONNECT on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_Connect', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_Connect(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_Write(var Message: TWMSocket);
|
|
begin
|
|
fConnected := True;
|
|
if Assigned(FOnWrite) then FOnWrite(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETWRITE on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_Write', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_Write(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_OOB(var Message: TWMSocket);
|
|
begin
|
|
if Assigned(FOnOOB) then FOnOOB(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETOOB on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_OOB', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_OOB(var Message: TWMSocket)
|
|
|
|
procedure TAsyncSocket.Message_Listen(var Message: TWMSocket);
|
|
begin
|
|
if Assigned(FOnListen) then FOnListen(Message)
|
|
else
|
|
MessageBox(HWND_DESKTOP, PChar('WM_SOCKETLISTEN on socket ' + Int2Str(Message.SocketNumber)),
|
|
'Message_Listen', MB_OK);
|
|
end; // procedure TAsyncSocket.Message_Listen(var Message: TWMSocket)
|
|
|
|
destructor TAsyncSocket.Destroy;
|
|
var t:^TBufRecord;
|
|
i: integer;
|
|
begin
|
|
DoClose;
|
|
if (InstanceCount = c_FIRST) then
|
|
ErrorTest(WSACleanup);
|
|
m_hWnd.Free;
|
|
for i := 0 to FList.Count - 1 do begin
|
|
t := FList.Items[i];
|
|
FreeMem(t^.p, t^.i);
|
|
FreeMem(t, SizeOf(TBufRecord));
|
|
end;
|
|
FList.Free;
|
|
InstanceCount := InstanceCount - 1;
|
|
inherited;
|
|
end;
|
|
|
|
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
|
|
|
|
function TAsyncSocket.LocalIP;
|
|
var Name: TSockAddrIn;
|
|
len: integer;
|
|
begin
|
|
GetSockName(m_Handle, Name, len);
|
|
Result := int2str(ord(Name.sin_addr.S_un_b.s_b1)) + '.' +
|
|
int2str(ord(Name.sin_addr.S_un_b.s_b2)) + '.' +
|
|
int2str(ord(Name.sin_addr.S_un_b.s_b3)) + '.' +
|
|
int2str(ord(Name.sin_addr.S_un_b.s_b4));
|
|
end;
|
|
|
|
function TAsyncSocket.LocalPort;
|
|
var Name: TSockAddrIn;
|
|
len: integer;
|
|
err: integer;
|
|
Tmp: TWMSocket;
|
|
begin
|
|
Result := 0;
|
|
err := GetSockName(m_Handle, Name, len);
|
|
if err = 0 then begin
|
|
Result := NToHS(Name.sin_port);
|
|
end else begin
|
|
Tmp.Msg := WM_SOCKETERROR;
|
|
Tmp.SocketError := WSAGetLastError;
|
|
Tmp.SocketNumber := m_Handle;
|
|
Tmp.SocketAddress := @self;
|
|
Message_Error(Tmp);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|