units/socket/KOLSocket.pas

   1 unit KOLSocket;
   2
   3 interface
   4
   5 uses
   6   KOL, Windows, Messages, Winsock;
   7
   8 const
   9   WM_SOCKET                 = WM_USER + $7000;
  10   WM_SOCKETERROR            = WM_USER + $7001;
  11   WM_SOCKETCLOSE            = WM_USER + $7002;
  12   WM_SOCKETREAD             = WM_USER + $7003;
  13   WM_SOCKETCONNECT          = WM_USER + $7004;
  14   WM_SOCKETACCEPT           = WM_USER + $7005;
  15   WM_SOCKETWRITE            = WM_USER + $7006;
  16   WM_SOCKETOOB              = WM_USER + $7007;
  17   WM_SOCKETLISTEN           = WM_USER + $7008;
  18   WM_SOCKETLOOKUP           = WM_USER + $7009;
  19
  20   EVENTS_DOLISTEN           = FD_CLOSE OR FD_ACCEPT;
  21   EVENTS_DOCONNECT          = FD_CONNECT OR FD_CLOSE OR FD_READ;
  22   EVENTS_SETSOCKETHANDLE    = FD_READ OR FD_CLOSE OR FD_CONNECT;
  23
  24   MaxWord                   = 65535;
  25   MinWord                   = 0;
  26
  27   c_FIRST                   = 1;
  28
  29   INVALID_SOCKET            = winsock.INVALID_SOCKET;
  30
  31 type
  32
  33   TWndMethod = procedure(var Message: TMessage) of object;
  34
  35   PhWnd =^ThWnd;
  36   ThWnd = object( TObj )
  37   protected
  38     m_hWnd: hWnd;
  39     destructor Destroy; virtual;
  40   public
  41     property Handle: hWnd read m_hWnd;
  42   end;
  43
  44   PAsyncSocket =^TAsyncSocket;
  45   TKOLSocket   = PAsyncSocket;
  46
  47   TWMSocket = record
  48     Msg: Word;
  49     case Integer of
  50     0: (
  51       SocketWParam: Word;
  52       SocketDataSize: LongInt;
  53       SocketNumber: Longint;
  54       SocketAddress: PAsyncSocket);
  55     1: (
  56       WParamLo: Byte;
  57       WParamHi: Byte;
  58       SocketEvent: Word;
  59       SocketError: Word;
  60       ResultLo: Word;
  61       ResultHi: Word);
  62     2: (
  63       WParam: Word;
  64       TaskHandle: Word;
  65       WordHolder: Word;
  66       pHostStruct: Pointer);
  67   end;
  68
  69   TBArray = array[0..65534] of byte;
  70
  71   TBufRecord = record
  72      i: integer;
  73      p:^TBArray;
  74   end;
  75
  76   TSocketMessageEvent = procedure (SocketMessage: TWMSocket) of object;
  77
  78   TAsyncSocket = object( TObj )
  79     m_SockAddr:         TSockAddr;
  80     m_Handle:           TSocket;
  81     m_hWnd:             PhWnd;
  82     fConnected:         boolean;
  83     fDNSResult:         string;
  84     fDNSHandle:         integer;
  85     FDnsBuffer:         array [0..MAXGETHOSTSTRUCT] of char;
  86     FList:              PList;
  87     FOnError:           TSocketMessageEvent;
  88     FOnLookup:          TSocketMessageEvent;
  89     FOnAccept:          TSocketMessageEvent;
  90     FOnClose:           TSocketMessageEvent;
  91     FOnConnect:         TSocketMessageEvent;
  92     FOnRead:            TSocketMessageEvent;
  93     FOnWrite:           TSocketMessageEvent;
  94     FOnListen:          TSocketMessageEvent;
  95     FOnOOB:             TSocketMessageEvent;
  96
  97   protected
  98     destructor Destroy; virtual;
  99
 100   private
 101     function GetCount: LongInt;
 102     function GetPortNumber: LongInt;
 103     function GetIPAddress: String;
 104     function ErrorTest(Evaluation: LongInt): LongInt;
 105
 106     procedure AllocateSocket;
 107     procedure KillWinsockBug;
 108     procedure SetPortNumber(NewPortNumber: LongInt);
 109     procedure SetIPAddress(NewIPAddress: String);
 110     procedure SetSocketHandle(NewSocketHandle: TSocket);
 111     function  GetConnected: boolean;
 112
 113     // Message Handlers
 114
 115     procedure HWndProcedure(var Message: TMessage);
 116
 117     procedure Message_Error(var Message: TWMSocket);
 118     procedure Message_Lookup(var Message: TWMSocket);
 119     procedure Message_Close(var Message: TWMSocket);
 120     procedure Message_Accept(var Message: TWMSocket);
 121     procedure Message_Read(var Message: TWMSocket);
 122     procedure Message_Connect(var Message: TWMSocket);
 123     procedure Message_Write(var Message: TWMSocket);
 124     procedure Message_OOB(var Message: TWMSocket);
 125     procedure Message_Listen(var Message: TWMSocket);
 126     procedure DoReceive(Buffer: Pointer; var ReceiveLen: LongInt);
 127     procedure DoFinal(Abort: boolean);
 128
 129   public
 130     procedure ProcessMessages;
 131     function  DoGetHostByAddr(IPAddr: PChar): String;
 132     function  DoGetHostByName(Name: PChar): String;
 133
 134     procedure DoLookup(host: string);
 135     procedure DoClose;
 136     procedure DoSend(Buffer: Pointer; var SendLen: LongInt);
 137     procedure DoListen;
 138     procedure DoConnect;
 139     procedure DoAccept(var AcceptSocket: PAsyncSocket);
 140
 141     procedure SendString(fString: String);
 142
 143     function  ReadData(b: pointer; c: integer): integer;
 144     function  ReadLine(c: char): string; overload;
 145     function  ReadLine(c: char; t: integer): string; overload;
 146     function  ErrToStr(Err: LongInt): String;
 147     function  LocalIP: String;
 148     function  LocalPort: integer;
 149
 150     property  SocketHandle: TSocket read m_Handle write SetSocketHandle;
 151     property  IPAddress: String read GetIPAddress write SetIPAddress;
 152     property  PortNumber: LongInt read GetPortNumber write SetPortNumber;
 153     property  Count: LongInt read GetCount;
 154     property  Connected: boolean read GetConnected;
 155     property  DNSResult: string read fDNSResult write fDNSResult;
 156
 157     property  OnError: TSocketMessageEvent read FOnError write FOnError;
 158     property  OnLookup: TSocketMessageEvent read FOnLookup write FOnLookup;
 159     property  OnAccept: TSocketMessageEvent read FOnAccept write FOnAccept;
 160     property  OnClose: TSocketMessageEvent read FOnClose write FOnClose;
 161     property  OnConnect: TSocketMessageEvent read FOnConnect write FOnConnect;
 162     property  OnRead: TSocketMessageEvent read FOnRead write FOnRead;
 163     property  OnWrite: TSocketMessageEvent read FOnWrite write FOnWrite;
 164     property  OnOOB: TSocketMessageEvent read FOnOOB write FOnOOB;
 165     property  OnListen: TSocketMessageEvent read FOnListen write FOnListen;
 166   end;
 167
 168   function NewThWnd(WndMethod: TWndMethod): PhWnd;
 169   function NewAsyncSocket: PAsyncSocket;
 170
 171 var
 172   InstanceCount: LongInt = 0;
 173
 174 implementation
 175
 176 uses objects;
 177
 178 function NewThWnd;
 179 begin
 180   New(Result, Create);
 181   Result.m_hWnd := AllocateHWnd(WndMethod);
 182 end;  // constructor ThWnd.Create(WndMethod: TWndMethod)
 183
 184 destructor ThWnd.Destroy;
 185 begin
 186   DeallocateHWnd(m_hWnd);
 187   inherited;
 188 end;
 189
 190 function NewAsyncSocket;
 191 var
 192   TempWSAData: TWSAData;
 193 begin
 194   InstanceCount := InstanceCount + 1;
 195   New(Result, Create);
 196   if (InstanceCount = c_FIRST) then
 197     Result.ErrorTest(WSAStartup($101, TempWSAData));
 198   Result.KillWinsockBug;
 199   Result.m_Handle := INVALID_SOCKET;
 200   Result.m_SockAddr.sin_family := AF_INET;
 201   Result.m_SockAddr.sin_addr.s_addr := INet_Addr('0.0.0.0');
 202   Result.PortNumber := 0;
 203   Result.FList := NewList;
 204   Result.m_hWnd := NewThWnd(Result.HWndProcedure);
 205 end;  // constructor TAsyncSocket.Create
 206
 207 function TAsyncSocket.GetCount;
 208 var i: integer;
 209     t:^TBufRecord;
 210 begin
 211    result := 0;
 212    for i := 0 to FList.Count - 1 do begin
 213       t := FList.Items[i];
 214       result := result + t^.i;
 215    end;
 216 end;
 217
 218 function TAsyncSocket.ReadData;
 219 var n,
 220     r: integer;
 221     t:^TBufRecord;
 222     u:^TBufRecord;
 223     a:^TBArray;
 224 begin
 225    if FList.count = 0 then begin
 226       result := 0;
 227       exit;
 228    end;
 229    n := 0;
 230    a := b;
 231    while (n < c) and (n < count) do begin
 232       r := c - n;
 233       t := FList.Items[0];
 234       if r > t^.i then r := t^.i;
 235       move(t^.p^, a^[n], r);
 236       n := n + r;
 237       if r = t^.i then begin
 238          FreeMem(t^.p, t^.i);
 239          FreeMem(t, SizeOf(TBufRecord));
 240          FList.Delete(0);
 241       end else begin
 242          GetMem(u, SizeOf(TBufRecord));
 243          u^.i := t^.i - r;
 244          GetMem(u^.p, u^.i);
 245          move(t^.p^[r], u^.p^, u^.i);
 246          FreeMem(t^.p, t^.i);
 247          FreeMem(t, SizeOf(TBufRecord));
 248          FList.Items[0] := u;
 249       end;
 250    end;
 251    result := n;
 252 end;
 253
 254 function TAsyncSocket.ReadLine(c: char): string;
 255 var i,
 256     n,
 257     j: integer;
 258     t:^TBufRecord;
 259     s: string;
 260 begin
 261    result := '';
 262    n := 0;
 263    if count = 0 then exit;
 264    for i := 0 to FList.Count - 1 do begin
 265       t := FList.Items[i];
 266       for j := 0 to t^.i - 1 do begin
 267          inc(n);
 268          if chr(t^.p^[j]) = c then begin
 269             if n > 1 then begin
 270                setlength(s, n - 1);
 271                ReadData(@s[1], n - 1);
 272                ReadData(@n   ,     1);
 273                result := s;
 274             end else begin
 275                result := '';
 276             end;
 277             exit;
 278          end;
 279       end;
 280    end;
 281 {   setlength(s, n);
 282    ReadData(@s[1], n);
 283    Result := s;}
 284 end;
 285
 286 function TAsyncSocket.ReadLine(c: char; t: integer): string;
 287 var tt: longint;
 288    Msg: tagMSG;
 289 begin
 290    result := '';
 291    tt := gettickcount;
 292    while (result = '') and (longint(gettickcount) < tt + t * 1000) do begin
 293       if PeekMessage(Msg, m_hWnd.m_hWnd, 0, 0, PM_REMOVE) then begin
 294          DispatchMessage(Msg);
 295       end;
 296       result := ReadLine(c);
 297       if m_Handle = INVALID_SOCKET then exit;
 298    end;
 299 end;
 300
 301 function TAsyncSocket.GetIPAddress: String;
 302 begin
 303   Result := INet_NToA(m_SockAddr.sin_addr);
 304 end;  // function TAsyncSocket.GetIPAddress: String
 305
 306 function TAsyncSocket.GetPortNumber: LongInt;
 307 begin
 308   Result := NToHS(m_SockAddr.sin_port);
 309 end;  // function TAsyncSocket.GetPortNumber: Word
 310
 311 procedure TAsyncSocket.AllocateSocket;
 312 begin
 313   if (m_Handle = INVALID_SOCKET) then
 314     begin
 315     m_Handle := ErrorTest(socket(AF_INET, SOCK_STREAM, 0));
 316     end;  // if (m_Handle = INVALID_SOCKET) then
 317 end;  // procedure TAsyncSocket.AllocateSocket
 318
 319 procedure TAsyncSocket.SetSocketHandle(NewSocketHandle: TSocket);
 320 begin
 321   DoFinal(True);
 322   m_Handle := NewSocketHandle;
 323   ErrorTest(WSAAsyncSelect(m_Handle, m_hWnd.Handle, WM_SOCKET, EVENTS_SETSOCKETHANDLE));
 324 end;  // procedure TAsyncSocket.SetSocketHandle(NewSocketHandle: TSocket)
 325
 326 function TAsyncSocket.GetConnected;
 327 begin
 328    result := fConnected;
 329 end;
 330
 331 function TAsyncSocket.ErrorTest(Evaluation: LongInt): LongInt;
 332 var
 333   TempMessage: TWMSocket;
 334 begin
 335   if ((Evaluation = SOCKET_ERROR) OR (Evaluation = INVALID_SOCKET)) then
 336     begin
 337     TempMessage.Msg := WM_SOCKETERROR;
 338     TempMessage.SocketError := WSAGetLastError;
 339     TempMessage.SocketNumber := m_Handle;
 340     TempMessage.SocketAddress := @self;
 341     Message_Error(TempMessage);
 342     Result := Evaluation;
 343     end  // if ((Evaluation = SOCKET_ERROR) OR (Evaluation = INVALID_SOCKET)) then
 344   else
 345     Result := Evaluation;
 346 end;  // function ErrorTest(Evaluation: LongInt): LongInt;
 347
 348 procedure TAsyncSocket.KillWinsockBug;
 349 var
 350   Addr: Integer;
 351 begin
 352   Addr := 0;
 353   // For an unknown reason, if a call is made to GetHostByName and it should
 354   // fail, the following call to GetHostByAddr will not fail, but return '>'
 355   // in the place of the host name.  This clears the problem up.
 356   GetHostByName('');
 357   GetHostByAddr(@Addr, SizeOf(Integer), PF_INET);
 358   GetHostByName('');
 359 end;
 360
 361 procedure TAsyncSocket.SetIPAddress(NewIPAddress: String);
 362 var
 363    pTempHostEnt: PHostEnt;
 364 begin
 365   m_SockAddr.sin_addr.s_addr := INet_Addr(PChar(NewIPAddress));
 366   if (m_SockAddr.sin_addr.s_addr = u_long(INADDR_NONE))  then
 367      begin
 368      pTempHostEnt := GetHostByName(PChar(NewIPAddress));
 369      if (pTempHostEnt <> Nil) then
 370         m_SockAddr.sin_addr.s_addr := PInAddr(pTempHostEnt^.h_addr_list^)^.s_addr;
 371      end;
 372 end;  // procedure TAsyncSocket.SetIPAddress(NewIPAddress: String)
 373
 374 procedure TAsyncSocket.SetPortNumber(NewPortNumber: LongInt);
 375 begin
 376   if ((NewPortNumber > 0) AND (NewPortNumber <= MaxWord)) then
 377     m_SockAddr.sin_port := HToNS(NewPortNumber);
 378 end;  // procedure TAsyncSocket.SetPortNumber(NewPortNumber: Word)
 379
 380 procedure TAsyncSocket.DoReceive(Buffer: Pointer; var ReceiveLen: LongInt);
 381 begin
 382   ReceiveLen := recv(m_Handle, Buffer^, ReceiveLen, 0);
 383   ErrorTest(ReceiveLen);
 384 end;  // TAsyncSocket.DoReceive(Buffer: Pointer; BufferLen: LongInt)
 385
 386 procedure TAsyncSocket.DoSend(Buffer: Pointer; var SendLen: LongInt);
 387 begin
 388   SendLen := send(m_Handle, Buffer^, SendLen, 0);
 389   ErrorTest(SendLen);
 390 end;  // procedure TAsyncSocket.DoSend(Buffer: Pointer; BufferLen: LongInt)
 391
 392 procedure TAsyncSocket.DoLookup;
 393 var
 394    IPAddr  : TInAddr;
 395 begin
 396    if Host = '' then begin
 397       Exit;
 398    end;
 399
 400    { Cancel any pending lookup }
 401    if FDnsHandle <> 0 then
 402       WSACancelAsyncRequest(FDnsHandle);
 403
 404     FDnsResult := '';
 405
 406     IPAddr.S_addr := Inet_addr(PChar(Host));
 407     if IPAddr.S_addr <> u_long(INADDR_NONE) then begin
 408         FDnsResult := inet_ntoa(IPAddr);
 409 {        TriggerDnsLookupDone(0);}
 410         Exit;
 411     end;
 412
 413     FDnsHandle := WSAAsyncGetHostByName(m_hWnd.Handle,
 414                                         WM_SOCKETLOOKUP,
 415                                         @Host[1],
 416                                         @FDnsBuffer,
 417                                         SizeOf(FDnsBuffer));
 418     if FDnsHandle = 0 then begin
 419        ErrorTest(WSAGetLastError);
 420        Exit;
 421     end;
 422 end;
 423
 424 procedure TAsyncSocket.DoClose;
 425 begin
 426    DoFinal(True);
 427 end;
 428
 429 procedure TAsyncSocket.DoFinal;
 430 var
 431   TempMessage: TWMSocket;
 432 begin
 433   if (m_Handle <> INVALID_SOCKET) then begin
 434     if not Abort then begin
 435        ProcessMessages;
 436     end;
 437     TempMessage.Msg := WM_SOCKETCLOSE;
 438     TempMessage.SocketNumber := m_Handle;
 439     TempMessage.SocketAddress := @self;
 440     Message_Close(TempMessage);
 441     ErrorTest(closesocket(m_Handle));
 442     m_Handle := INVALID_SOCKET;
 443     end;
 444 end;
 445
 446 procedure TAsyncSocket.DoAccept(var AcceptSocket: PAsyncSocket);
 447 var
 448   TempSize: Integer;
 449   TempSock: TSocket;
 450   TempAddr: TSockAddrIn;
 451 begin
 452   TempSize := SizeOf(TSockAddr);
 453   TempSock := accept(m_Handle, @TempAddr, @TempSize);
 454   AcceptSocket.m_SockAddr := TempAddr;
 455   if (ErrorTest(TempSock) <> INVALID_SOCKET) then
 456     AcceptSocket.SocketHandle := TempSock;
 457 end;  // procedure TAsyncSocket.DoAccept(var AcceptSocket: TAsyncSocket)
 458
 459 procedure TAsyncSocket.DoListen;
 460 var
 461   TempMessage: TWMSocket;
 462 begin
 463   DoClose;
 464   AllocateSocket;
 465   if
 466     (ErrorTest(WSAAsyncSelect(m_Handle, m_hWnd.Handle, WM_SOCKET, EVENTS_DOLISTEN))
 467       <> SOCKET_ERROR) AND
 468     (ErrorTest(bind(m_Handle, m_SockAddr, SizeOf(TSockAddr))) <> SOCKET_ERROR) AND
 469     (ErrorTest(listen(m_Handle, 5)) <> SOCKET_ERROR) then
 470     begin
 471     TempMessage.Msg := WM_SOCKETLISTEN;
 472     TempMessage.SocketNumber := m_Handle;
 473     TempMessage.SocketAddress := @self;
 474     Message_Listen(TempMessage);
 475     end
 476   else
 477     DoClose;
 478 end;  // procedure TAsyncSocket.DoListen
 479
 480 procedure TAsyncSocket.DoConnect;
 481 var
 482   TempResult: LongInt;
 483 begin
 484   DoClose;
 485   AllocateSocket;
 486   ErrorTest(WSAAsyncSelect(m_Handle, m_hWnd.Handle, WM_SOCKET, EVENTS_DOCONNECT));
 487   TempResult := connect(m_Handle, m_SockAddr, SizeOf(TSockAddr));
 488   if ((TempResult = SOCKET_ERROR) AND (WSAGetLastError <> WSAEWOULDBLOCK)) then
 489     ErrorTest(SOCKET_ERROR);
 490 end;  // procedure TAsyncSocket.DoConnect
 491
 492 procedure TAsyncSocket.SendString;
 493 var
 494   L: LongInt;
 495 begin
 496   L := Length(fString);
 497   DoSend(PChar(fString), L);
 498 end;
 499
 500 function TAsyncSocket.DoGetHostByName(Name: PChar): String;
 501 var
 502    pTempHostEnt: PHostEnt;
 503 begin
 504   pTempHostEnt := GetHostByName(Name);
 505   if (pTempHostEnt <> Nil) then
 506     Result := inet_ntoa(pInAddr(pTempHostEnt^.h_addr_list^)^)
 507   else
 508     Result := '';
 509 end;
 510
 511 procedure TAsyncSocket.ProcessMessages;
 512 var Msg: TMsg;
 513 begin
 514    while PeekMessage(Msg, m_hWnd.m_hWnd, WM_SOCKET, WM_SOCKETLOOKUP, PM_REMOVE) do begin
 515       DispatchMessage(Msg);
 516    end;
 517 end;
 518
 519 function TAsyncSocket.DoGetHostByAddr(IPAddr: PChar): String;
 520 var
 521    pTempHostEnt: PHostEnt;
 522    TempAddr: LongInt;
 523 begin
 524   TempAddr := INet_Addr(IPAddr);
 525   pTempHostEnt := GetHostByAddr(@TempAddr, SizeOf(TempAddr), PF_INET);
 526   if (pTempHostEnt <> Nil) then
 527     Result := pTempHostEnt^.h_name
 528   else
 529     Result := '';
 530 end;
 531
 532 procedure TAsyncSocket.HWndProcedure(var Message: TMessage);
 533 var
 534   TempMessage: TWMSocket;
 535 begin
 536   case Message.Msg of
 537     WM_SOCKETLOOKUP:
 538       begin
 539          TempMessage.Msg := WM_SOCKETLOOKUP;
 540          TempMessage.SocketNumber := m_Handle;
 541          TempMessage.SocketAddress := @self;
 542          Message_Lookup(TempMessage);
 543       end;
 544     WM_SOCKET:
 545       begin
 546       if (Message.LParamHi > WSABASEERR) then
 547         begin
 548         WSASetLastError(Message.LParamHi);
 549         ErrorTest(SOCKET_ERROR);
 550         end  // if (Message.LParamHi > WSABASEERR) then
 551       else
 552         begin
 553         case Message.LParamLo of
 554           FD_READ:
 555             begin
 556             TempMessage.SocketDataSize := 0;
 557             ErrorTest(IOCtlSocket(m_Handle, FIONREAD, TempMessage.SocketDataSize));
 558             TempMessage.Msg := WM_SOCKETREAD;
 559             TempMessage.SocketNumber := m_Handle;
 560             TempMessage.SocketAddress := @self;
 561             Message_Read(TempMessage);
 562             end;  // FD_READ
 563           FD_CLOSE:
 564             begin
 565             DoFinal(False);
 566             end; // FD_CLOSE
 567           FD_CONNECT:
 568             begin
 569             TempMessage.Msg := WM_SOCKETCONNECT;
 570             TempMessage.SocketNumber := m_Handle;
 571             TempMessage.SocketAddress := @self;
 572             Message_Connect(TempMessage);
 573             end;  // FD_CONNECT
 574           FD_ACCEPT:
 575             begin
 576             TempMessage.Msg := WM_SOCKETACCEPT;
 577             TempMessage.SocketNumber := m_Handle;
 578             TempMessage.SocketAddress := @self;
 579             Message_Accept(TempMessage);
 580             end;  // FD_ACCEPT
 581           FD_WRITE:
 582             begin
 583             TempMessage.Msg := WM_SOCKETWRITE;
 584             TempMessage.SocketNumber := m_Handle;
 585             TempMessage.SocketAddress := @self;
 586             Message_Write(TempMessage);
 587             end;  // FD_WRITE
 588           FD_OOB:
 589             begin
 590             TempMessage.Msg := WM_SOCKETOOB;
 591             TempMessage.SocketNumber := m_Handle;
 592             TempMessage.SocketAddress := @self;
 593             Message_OOB(TempMessage);
 594             end;  // FD_OOB
 595           end;  // case Message.LParamLo of
 596         end  // else (if (Message.LParamHi > WSABASEERR) then)
 597       end;  // WM_SOCKET:
 598       else
 599       Message.Result := DefWindowProc(m_hWnd.m_hWnd, Message.Msg, Message.WParam, Message.LParam);
 600     end;  // case Message.Msg of
 601 end;  // procedure TAsyncSocket.HWndProcedure(var Message: TMessage)
 602
 603 procedure TAsyncSocket.Message_Error(var Message: TWMSocket);
 604 begin
 605   if Assigned(FOnError) then FOnError(Message)
 606   else
 607   MessageBox(HWND_DESKTOP, PChar(ErrToStr(Message.SocketError) + ' on socket ' +
 608     Int2Str(Message.SocketNumber)), 'Message_Error', MB_OK);
 609 end;  // procedure TAsyncSocket.Message_Error(var Message: TWMSocket)
 610
 611 procedure TAsyncSocket.Message_Lookup(var Message: TWMSocket);
 612 var p: PHostEnt;
 613 begin
 614   p := @fDNSBuffer;
 615   fDNSResult := p.h_name;
 616   if Assigned(FOnLookup) then FOnLookup(Message)
 617   else
 618   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETLOOKUP on socket ' + Int2Str(Message.SocketNumber)),
 619     'Message_Lookup', MB_OK);
 620 end;  // procedure TAsyncSocket.Message_LookUp(var Message: TWMSocket)
 621
 622 procedure TAsyncSocket.Message_Close(var Message: TWMSocket);
 623 begin
 624   fConnected := False;
 625   if Assigned(FOnClose) then FOnClose(Message)
 626   else
 627   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCLOSE on socket ' + Int2Str(Message.SocketNumber)),
 628     'Message_Close', MB_OK);
 629 end;  // procedure TAsyncSocket.Message_Close(var Message: TWMSocket)
 630
 631 procedure TAsyncSocket.Message_Accept(var Message: TWMSocket);
 632 begin
 633   fConnected := True;
 634   if Assigned(FOnAccept) then FOnAccept(Message)
 635   else
 636   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETACCEPT on socket ' + Int2Str(Message.SocketNumber)),
 637     'Message_Accept', MB_OK);
 638 end;  // procedure TAsyncSocket.Message_Accept(var Message: TWMSocket)
 639
 640 procedure TAsyncSocket.Message_Read(var Message: TWMSocket);
 641 var t:^TBufRecord;
 642 begin
 643   if Message.SocketDataSize > 0 then begin
 644      fConnected := True;
 645      GetMem(t, sizeof(TBufRecord));
 646      t^.i := Message.SocketDataSize;
 647      GetMem(t^.p, t^.i);
 648      DoReceive(t^.p, t^.i);
 649      FList.Add(t);
 650   end;
 651   if Assigned(FOnRead) then FOnRead(Message)
 652   else
 653   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETREAD on socket ' + Int2Str(Message.SocketNumber)),
 654     'Message_Read', MB_OK);
 655 end;  // procedure TAsyncSocket.Message_Read(var Message: TWMSocket)
 656
 657 procedure TAsyncSocket.Message_Connect(var Message: TWMSocket);
 658 begin
 659   fConnected := True;
 660   if Assigned(FOnConnect) then FOnConnect(Message)
 661   else
 662   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETCONNECT on socket ' + Int2Str(Message.SocketNumber)),
 663     'Message_Connect', MB_OK);
 664 end;  // procedure TAsyncSocket.Message_Connect(var Message: TWMSocket)
 665
 666 procedure TAsyncSocket.Message_Write(var Message: TWMSocket);
 667 begin
 668   fConnected := True;
 669   if Assigned(FOnWrite) then FOnWrite(Message)
 670   else
 671   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETWRITE on socket ' + Int2Str(Message.SocketNumber)),
 672     'Message_Write', MB_OK);
 673 end;  // procedure TAsyncSocket.Message_Write(var Message: TWMSocket)
 674
 675 procedure TAsyncSocket.Message_OOB(var Message: TWMSocket);
 676 begin
 677   if Assigned(FOnOOB) then FOnOOB(Message)
 678   else
 679   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETOOB on socket ' + Int2Str(Message.SocketNumber)),
 680     'Message_OOB', MB_OK);
 681 end;  // procedure TAsyncSocket.Message_OOB(var Message: TWMSocket)
 682
 683 procedure TAsyncSocket.Message_Listen(var Message: TWMSocket);
 684 begin
 685   if Assigned(FOnListen) then FOnListen(Message)
 686   else
 687   MessageBox(HWND_DESKTOP, PChar('WM_SOCKETLISTEN on socket ' + Int2Str(Message.SocketNumber)),
 688     'Message_Listen', MB_OK);
 689 end;  // procedure TAsyncSocket.Message_Listen(var Message: TWMSocket)
 690
 691 destructor TAsyncSocket.Destroy;
 692 var t:^TBufRecord;
 693     i: integer;
 694 begin
 695   DoClose;
 696   if (InstanceCount = c_FIRST) then
 697     ErrorTest(WSACleanup);
 698   m_hWnd.Free;
 699   for i := 0 to FList.Count - 1 do begin
 700      t := FList.Items[i];
 701      FreeMem(t^.p, t^.i);
 702      FreeMem(t, SizeOf(TBufRecord));
 703   end;
 704   FList.Free;
 705   InstanceCount := InstanceCount - 1;
 706   inherited;
 707 end;
 708
 709 function TAsyncSocket.ErrToStr(Err: LongInt): String;
 710 begin
 711   case Err of
 712     WSAEINTR:
 713       Result := 'WSAEINTR';
 714     WSAEBADF:
 715       Result := 'WSAEBADF';
 716     WSAEACCES:
 717       Result := 'WSAEACCES';
 718     WSAEFAULT:
 719       Result := 'WSAEFAULT';
 720     WSAEINVAL:
 721       Result := 'WSAEINVAL';
 722     WSAEMFILE:
 723       Result := 'WSAEMFILE';
 724     WSAEWOULDBLOCK:
 725       Result := 'WSAEWOULDBLOCK';
 726     WSAEINPROGRESS:
 727       Result := 'WSAEINPROGRESS';
 728     WSAEALREADY:
 729       Result := 'WSAEALREADY';
 730     WSAENOTSOCK:
 731       Result := 'WSAENOTSOCK';
 732     WSAEDESTADDRREQ:
 733       Result := 'WSAEDESTADDRREQ';
 734     WSAEMSGSIZE:
 735       Result := 'WSAEMSGSIZE';
 736     WSAEPROTOTYPE:
 737       Result := 'WSAEPROTOTYPE';
 738     WSAENOPROTOOPT:
 739       Result := 'WSAENOPROTOOPT';
 740     WSAEPROTONOSUPPORT:
 741       Result := 'WSAEPROTONOSUPPORT';
 742     WSAESOCKTNOSUPPORT:
 743       Result := 'WSAESOCKTNOSUPPORT';
 744     WSAEOPNOTSUPP:
 745       Result := 'WSAEOPNOTSUPP';
 746     WSAEPFNOSUPPORT:
 747       Result := 'WSAEPFNOSUPPORT';
 748     WSAEAFNOSUPPORT:
 749       Result := 'WSAEAFNOSUPPORT';
 750     WSAEADDRINUSE:
 751       Result := 'WSAEADDRINUSE';
 752     WSAEADDRNOTAVAIL:
 753       Result := 'WSAEADDRNOTAVAIL';
 754     WSAENETDOWN:
 755       Result := 'WSAENETDOWN';
 756     WSAENETUNREACH:
 757       Result := 'WSAENETUNREACH';
 758     WSAENETRESET:
 759       Result := 'WSAENETRESET';
 760     WSAECONNABORTED:
 761       Result := 'WSAECONNABORTED';
 762     WSAECONNRESET:
 763       Result := 'WSAECONNRESET';
 764     WSAENOBUFS:
 765       Result := 'WSAENOBUFS';
 766     WSAEISCONN:
 767       Result := 'WSAEISCONN';
 768     WSAENOTCONN:
 769       Result := 'WSAENOTCONN';
 770     WSAESHUTDOWN:
 771       Result := 'WSAESHUTDOWN';
 772     WSAETOOMANYREFS:
 773       Result := 'WSAETOOMANYREFS';
 774     WSAETIMEDOUT:
 775       Result := 'WSAETIMEDOUT';
 776     WSAECONNREFUSED:
 777       Result := 'WSAECONNREFUSED';
 778     WSAELOOP:
 779       Result := 'WSAELOOP';
 780     WSAENAMETOOLONG:
 781       Result := 'WSAENAMETOOLONG';
 782     WSAEHOSTDOWN:
 783       Result := 'WSAEHOSTDOWN';
 784     WSAEHOSTUNREACH:
 785       Result := 'WSAEHOSTUNREACH';
 786     WSAENOTEMPTY:
 787       Result := 'WSAENOTEMPTY';
 788     WSAEPROCLIM:
 789       Result := 'WSAEPROCLIM';
 790     WSAEUSERS:
 791       Result := 'WSAEUSERS';
 792     WSAEDQUOT:
 793       Result := 'WSAEDQUOT';
 794     WSAESTALE:
 795       Result := 'WSAESTALE';
 796     WSAEREMOTE:
 797       Result := 'WSAEREMOTE';
 798     WSASYSNOTREADY:
 799       Result := 'WSASYSNOTREADY';
 800     WSAVERNOTSUPPORTED:
 801       Result := 'WSAVERNOTSUPPORTED';
 802     WSANOTINITIALISED:
 803       Result := 'WSANOTINITIALISED';
 804     WSAHOST_NOT_FOUND:
 805       Result := 'WSAHOST_NOT_FOUND';
 806     WSATRY_AGAIN:
 807       Result := 'WSATRY_AGAIN';
 808     WSANO_RECOVERY:
 809       Result := 'WSANO_RECOVERY';
 810     WSANO_DATA:
 811       Result := 'WSANO_DATA';
 812     else Result := 'UNDEFINED WINSOCK ERROR';
 813     end;  // case Err of
 814 end;  // function TAsyncSocket.ErrToStr(Err: LongInt): String
 815
 816 function TAsyncSocket.LocalIP;
 817 var Name: TSockAddrIn;
 818      len: integer;
 819 begin
 820    GetSockName(m_Handle, Name, len);
 821    Result := int2str(ord(Name.sin_addr.S_un_b.s_b1)) + '.' +
 822              int2str(ord(Name.sin_addr.S_un_b.s_b2)) + '.' +
 823              int2str(ord(Name.sin_addr.S_un_b.s_b3)) + '.' +
 824              int2str(ord(Name.sin_addr.S_un_b.s_b4));
 825 end;
 826
 827 function TAsyncSocket.LocalPort;
 828 var Name: TSockAddrIn;
 829      len: integer;
 830      err: integer;
 831      Tmp: TWMSocket;
 832 begin
 833    Result := 0;
 834    err := GetSockName(m_Handle, Name, len);
 835    if err = 0 then begin
 836       Result  := NToHS(Name.sin_port);
 837    end else begin
 838       Tmp.Msg := WM_SOCKETERROR;
 839       Tmp.SocketError := WSAGetLastError;
 840       Tmp.SocketNumber := m_Handle;
 841       Tmp.SocketAddress := @self;
 842       Message_Error(Tmp);
 843    end;
 844 end;
 845
 846 end.
 847