git-svn-id: https://svn.code.sf.net/p/kolmck/code@9 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
845
Addons/KOLSocket.pas
Normal file
845
Addons/KOLSocket.pas
Normal file
@ -0,0 +1,845 @@
|
||||
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.
|
||||
|
||||
Reference in New Issue
Block a user