overbyte.ics.wsocket.pas

BaiduMp3 search baidu mp3

             Thanks to Alex Kook <[e-mail]> for finding this one.
Apr 27, 2002 V4.40 Added procedure WSocketUnregisterClass to be able to
             unregister hidden window. This is necessary when TWSocket is
             used within a DLL which is unloaded and reloaded by applications,
             specially when running with Windows-XP. Thanks to Jean-Michel Aliu
             <[e-mail]> who provided a test case.
Jun 02, 2002 V4.41 allow SOCK_RAW in Connect method for any protocol which is
             not TCP or UDP. Thanks to Holger Lembke <[e-mail]>.
Jun 04, 2002 V4.42 Do not call Listen for SOCK_RAW.
             Thanks to Holger Lembke <[e-mail]>.
Jun 08, 2002 V4.43 Add a dummy Register procedure for BCB1.
             Thanks to Marc-Alexander Prowe <[e-mail]>.
Jul 07, 2002 V4.44 Added code in Connect method to check if socket still opened
             after OnChangeState event. If not, trigger an error WSAINVAL.
Sep 16, 2002 V4.45 Exposed RcvdPtr and RcvdCnt readonly properties.
Sep 17, 2002 V4.46 Used InterlockedIncrement/InterlockedDecrement to Inc/Dec
             socket count safely when TWSocket is used within a thread. This
             was proposed by Matthew Meadows <[e-mail]>
Sep 28, 2002 V4.47 Changed DnsLookup so that a hostname is checked for dotted
             IP addresse and resolve it numerically. Thanks to Bogdan Calin
             <[e-mail]> who found this bug. Alos loaded the result
             list with the address to be consistant with real lookup result.
Nov 17, 2002 V4.48 Roland Klabunde <[e-mail]> found a bug in
             multicast code: listening on a specific interface was ignored.
             He fixed Listen and Connect.
Nov 27, 2002 V4.49 Added ListenBacklog property, default to 5.
Dec 17, 2002 V4.50 Moved code to virtual function to permit SSL implementation.
Jan 19, 2003 V5.00 First pre-release for ICS-SSL. New major version number
             V5.01 Gabi Slonto <[e-mail]> found a bug in DnsLookup
             when hostname was actulally a dotted IP address.
Mar 18, 2003 V5.02 Fixed WSocketIsDottedIP: reordering of boolean expressions
             involaving a string. Thanks to Ian Baker <[e-mail]>
Apr 30, 2003 V5.03 Replaced all calls to setsockopt by calls to
             WSocket_setsockopt to avoid statically linked winsock DLL.
             Thanks to Piotr Dalek <[e-mail]>.
             Also replaced inet_addr by WSocket_iniet_addr.
Aug 27, 2003 V5.04 Marco van de Voort <[e-mail]> added FreePascal (FPC)
             conditional compilation. Please contact him for any FPC support
             question.
Aug 28, 2003 V5.05 Fixed a multithreading issue related to windows class
             registration. Now using a critical section around the code.
             Thanks to Bogdan Ureche <[e-mail]> for his precious help.
Aug 31, 2003 V5.06 Added warning about deprecated procedures Synchronize,
             WaitUntilReady and ReadLine. Do not use them in new applications.
Sep 03, 2003 V5.07 Bogdan Ureche <[e-mail]> added a critical section
             to avoid problem when winsock.dll is unloaded by a thread while
             another thread is still using some TWSocket.
Sep 15, 2003 V5.08 Fixed finalization section to no free critical section if
             a TWSocket is still existing. This happend for example when a
             TWSocket is on a form and Halt is called from FormCreate event.
             Changed SendStr argument to const.
Nov 09, 2003 V5.09 Added manifest constants for Shutdown
             Added TCustomLineWSocket.SendLine method.
Dec 07, 2003 V6.00 Pre-release for Delphi 8 for .NET framework


About multithreading and event-driven:
    TWSocket is a pure asynchronous component. It is non-blocking and
    event-driven. It means that when you request an operation such as connect,
    the component start the operation your requested and give control back
    immediately while performing the operation in the background automatically.
    When the operation is done, an event is triggered (such as
    OnSessionConnected if you called Connect).

    This asynchronous non-blocking behaviour is very high performance but a
    little bit difficult to start with. For example, you can't call Connect and
    immediately call SendStr the line below. If you try, you'll have an
    exception triggered saying you are not connected. Calling connect will start
    connection process but will return long before connection is established.
    Calling SendStr at the next line will not work because the socket is not
    connected yet. To make it works the right way, you have to put your SendStr
    in the OnSessionConnected event.

    The asynchronous operation allows you to do several TCP/IP I/O
    simultaneously. Just use as many component as you need. Each one will
    operate independently of the other without blocking each other ! So you
    basically don't need multi-threading with TWSocket, unless YOUR processing
    is lengthy and blocking.

    If you have to use multithreading, you have two possibilities:
    1) Create your TWSocket from your thread's Execute method
    2) Attach a TWSocket to a given thread using ThreadAttach.
    In both cases, you must set MultiThreaded property to TRUE.
    If you don't use one of those methods, you'll end up with a false
    multithreaded program: all events will be processed by the main tread !
    For both methods to work, you MUST have a message loop withing your thread.
    Delphi create a message loop automatically for the main thread (it's in
    the Forms unit), but does NOT create one in a thread ! For your convenience,
    TWSocket has his own MessageLoop procedure. You can use it from your thread.

    Sample program MtSrv uses first method while ThrdSrv uses second method.
    Sample program TcpSrv is much the same as ThrdSrv but doesn't use any
    thread. You'll see that it is able to server a lot of simultaneous clients
    as well and it is much simpler.


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverByte.Ics.WSocket platform;

{$ALIGN 1}

interface

{$DEFINE NOFORMS}

uses
    System.Runtime.InteropServices,
    System.Threading,
    System.Text,
    Borland.Vcl.Windows,
    Borland.Vcl.Messages,
    Borland.Vcl.Classes,
    Borland.Vcl.WinUtils,
    Borland.Vcl.SysUtils,
    Overbyte.Ics.Component,
    OverByte.Ics.WSockBuf,
    OverByte.Ics.WinSock;

const
    WSocketVersion            = 600;
    CopyRight    : String     = ' TWSocket (c)1996-2005 Francois Piette V6.00 ';
    WM_ASYNCSELECT            = WM_USER + 1;
    WM_ASYNCGETHOSTBYNAME     = WM_USER + 2;
    WM_ASYNCGETHOSTBYADDR     = WM_USER + 3;
    WM_CLOSE_DELAYED          = WM_USER + 4;
    WM_WSOCKET_RELEASE        = WM_USER + 5;
    WM_TRIGGER_EXCEPTION      = WM_USER + 6;
    WM_TRIGGER_DATA_AVAILABLE = WM_USER + 20;
    WSA_WSOCKET_TIMEOUT       = 12001;

type
    TWndMethod           = procedure(var Message: TMessage) of object;
    ESocketException     = class(Exception);
    TSocketState         = (wsInvalidState,
                            wsOpened,     wsBound,
                            wsConnecting, wsSocksConnected, wsConnected,
                            wsAccepting,  wsListening,
                            wsClosed);
    TSocketSendFlags     = (wsSendNormal, wsSendUrgent);
    TSocketLingerOnOff   = (wsLingerOff, wsLingerOn, wsLingerNoSet);
    TWSocketSyncNextProc = procedure of object;
    TWSocketOption       = (wsoNoReceiveLoop, wsoTcpNoDelay);
    TWSocketOptions      = set of TWSocketOption;
    TDataAvailable       = procedure (Sender: TObject; ErrCode: Word) of object;
    TDataSent            = procedure (Sender: TObject; ErrCode: Word) of object;
    TSendData            = procedure (Sender: TObject; BytesSent: Integer) of object;
    TSessionClosed       = procedure (Sender: TObject; ErrCode: Word) of object;
    TSessionAvailable    = procedure (Sender: TObject; ErrCode: Word) of object;
    TSessionConnected    = procedure (Sender: TObject; ErrCode: Word) of object;
    TDnsLookupDone       = procedure (Sender: TObject; ErrCode: Word) of object;
    TChangeState         = procedure (Sender: TObject;
                                      OldState : TSocketState;
                                      NewState : TSocketState) of object;
    TDebugDisplay        = procedure (Sender: TObject;
                                      var Msg : String) of object;

    TCustomWSocket = class(TIcsComponent)
    private
        FDnsResult          : String;
        FDnsResultList      : TStrings;
        FSendFlags          : Integer;
        FLastError          : Integer;
        FDnsLookupBuffer    : TBytes;
        FDnsLookupHandle    : THandle;
        FDnsLookupCheckMsg  : Boolean;
        FDnsLookupTempMsg   : TMessage;
        FDnsLookupGCH       : GCHandle;
        FDnsLookupIntPtr    : IntPtr;
    protected
        FHSocket            : TSocket;
        FASocket            : TSocket;               { Accepted socket }
        FAddrStr            : String;
        FAddrResolved       : Boolean;
        FAddrFormat         : Integer;
        FAddrAssigned       : Boolean;
        FProto              : Integer;
        FProtoAssigned      : Boolean;
        FProtoResolved      : Boolean;
        FLocalPortResolved  : Boolean;
        FProtoStr           : String;
        FPortStr            : String;
        FPortAssigned       : Boolean;
        FPortResolved       : Boolean;
        FPortNum            : Integer;
        FLocalPortStr       : String;
        FLocalPortNum       : Integer;
        FLocalAddr          : String;     { IP address for local interface to use }
        FType               : Integer;
        FBufList            : TList;
        FBufSize            : Integer;
        FLingerOnOff        : TSocketLingerOnOff;
        FLingerTimeout      : Integer;              // In seconds, 0 = disabled
        FListenBacklog      : Integer;
        bAllSent            : Boolean;
        FReadCount          : LongInt;
        FPaused             : Boolean;
        FCloseInvoked       : Boolean;
        FFlushTimeout       : Integer;
        // More info about multicast can be found at:
        //   http://ntrg.cs.tcd.ie/undergrad/4ba2/multicast/antony/
        //    http://www.tldp.org/HOWTO/Multicast-HOWTO-6.html
        FMultiCast          : Boolean;
        // Multicast addresses consists of a range of addresses from 224.0.0.0
        // to 239.255.255.255. However, the multicast addresses from 224.0.0.0
        // to 224.0.0.255 are reserved for multicast routing information;
        // Application programs should use multicast addresses outside this
        // range.
        FMultiCastAddrStr   : String;
        FMultiCastIpTTL     : Integer;
        FReuseAddr          : Boolean;
        FComponentOptions   : TWSocketOptions;
        FState              : TSocketState;
        FRcvdFlag           : Boolean;
        FSelectEvent        : LongInt;
        FSelectMessage      : WORD;
        FRecvStrBuf         : TBytes;
        FOnSessionAvailable : TSessionAvailable;
        FOnSessionConnected : TSessionConnected;
        FOnSessionClosed    : TSessionClosed;
        FOnChangeState      : TChangeState;
        FOnDataAvailable    : TDataAvailable;
        FOnDataSent         : TDataSent;