Delphi 局域网IPX通讯,寻求帮助.

unit IPXUnit;
//
// 硂琌 IPX 硄癟﹚じン, ㄑ Delphi 2.0 莱ノ祘Αㄏノ. 讽砞璸笆诀琌
// 暗穨北ノ, 璶ㄏ眔 WIN32 莱ノ祘Αぇ丁, ┪籔 DOS 莱ノ祘Α丁 IPX 硄癟
// ﹚暗肪硄.
//
// 繦帝┕耎, ㄏㄤㄣ称耕Ч俱.
//
// 硂じンЧ禣, 舧ī' э┪暗ヴㄤウノ硚. 埃虫縒砪芥じン.
//
// This component is totally free(copyleft), you can do anything in any
// purpose EXCEPT SELL IT ALONE.
//
// Author?: 睫 Small-Pig Team         in Taiwan R.O.C.
// Email   : [email protected]
// Date ? : 1997/4/28
//
//
// Version 1.0
//
// I implement the IPX network protocol component (VCL) for Delphi 2.0. It
// provide a easy interface for user to transmit and receive data. It call
// Winsock 1.1 API to make this protocol.
//
//

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  WinSock;

const
     PWM_ASYNCSELECT = WM_USER;

type
    //
    // WSIPX.H
    // This is the structure of the SOCKADDR structure for IPX and SPX.
    //

    PSockAddrIPX = ^TSockAddrIPX;
    TSockAddrIPX = packed record
             sa_family : short;
             sa_netnum : array [0..3] of Byte;
             sa_nodenum : array [0..5] of Byte;
             sa_socket : u_short;
    end;

const
     //
     // WSIPX.H
     // Protocol families used in the "protocol" parameter of the socket() API.
     //

     NSPROTO_IPX = 1000;
     NSPROTO_SPX = 1256;
     NSPROTO_SPXII = 1257;

const
     //
     // WSNWLINK.H
     //

     (*
      *   Set/get the IPX packet type.  The value specified in the
      *   optval argument will be set as the packet type on every IPX
      *   packet sent from this socket.  The optval parameter of
      *   getsockopt()/setsockopt() points to an int.
      *)
     IPX_PTYPE = $4000;

     (*
      *   Set/get the receive filter packet type.  Only IPX packets with
      *   a packet type equal to the value specified in the optval
      *   argument will be returned; packets with a packet type that
      *   does not match are discarded.  optval points to an int.
      *)
     IPX_FILTERPTYPE = $4001;

     (*
      *   Stop filtering on packet type set with IPX_FILTERPTYPE.
      *)
     IPX_STOPFILTERPTYPE = $4003;

     (*
      *   Send protocol header up on all receive packets.  optval points
      *   to a BOOL.
      *)
     IPX_RECVHDR = $4005;

     (*
      *   Get the maximum data size that can be sent.  Not valid with
      *   setsockopt().  optval points to an int where the value is
      *   returned.
      *)
     IPX_MAXSIZE = $4006;

     (*
      *   A hint that broadcast packets may be received.  The default is
      *   TRUE.  Applications that do not need to receive broadcast packets
      *   should set this sockopt to FALSE which may cause better system
      *   performance (note that it does not necessarily cause broadcasts
      *   to be filtered for the application).  Not valid with getsockopt().
      *   optval points to a BOOL.
      *)
     IPX_RECEIVE_BROADCAST = $400F;

type
    ESocketError = class ( Exception )
    private
      FError : Integer;
    public
      constructor Create( const Msg : String ; Error : Integer );
      property Error : Integer read FError;
    end;

    TReceiveDataEvent = procedure ( Sender:TObject;
                                    Buffer:PChar; BufferLength:Integer;
                                    SockAddr:TSockAddrIPX; SockAddrLen:Integer ) of object;
    TSendDataEmptyEvent = procedure ( Sender:TObject ) of object;
    TErrorHappenedEvent = procedure ( Sender:TObject;
                                      EventWord:Integer; ErrorCode:Integer; ErrorMsg:String ) of object;
        // EventWord may be FD_READ or FD_WRITE
        // ErrorCode is get from WSAGetLastError

type
  IPX = class(TComponent)
  private
    { Private declarations }
    Buffer : array [0..4095] of Char;
    FHWnd : THandle;
    FSocket : TSocket;             // Handle of this socket
    WSAData : TWSAData;

    FAllowSendBroadcast : Boolean;
    FReceiveBroadcast : Boolean;
    FReceiveHeader : Boolean;
    FMaxSendDataSize : Integer;
    FLinger : Boolean;
    FLingerTimeout : u_short;

    FLocalNetworkNumber : array [0..3] of Byte;
    FLocalNodeNumber : array [0..5] of Byte;
    FLocalSocketNumber : u_short;
    FRemoteNetworkNumber : array [0..3] of Byte;   // big-endian
    FRemoteNodeNumber : array [0..5] of Byte;
    FRemoteSocketNumber : u_short;

    FPacketTypeFiltered : Boolean;
    FPacketTypeFilter : DWORD;
    FSendPacketType : DWORD;

    FOnReceiveData : TReceiveDataEvent;
    FOnSendDataEmpty : TSendDataEmptyEvent;
    FOnErrorHappened : TErrorHappenedEvent;

    procedure SetAllowSendBroadcast( b : Boolean );
    procedure SetReceiveBroadcast( b : Boolean );
    procedure SetReceiveHeader( b : Boolean );
    procedure SetLinger( b : Boolean );
    procedure SetLingerTimeout( timeout : u_short );

    function GetLocalNetworkNumber : String;
    function GetRemoteNetworkNumber : String;
    function GetLocalNodeNumber : String;
    function GetRemoteNodeNumber : String;

    procedure SetNumber( var FNumber ; Number : String; ByteNum : Integer );
       // SetNodeNumber is called by SetRemoteNetworkNumber and SetRemoteNodeNumber only
    procedure SetRemoteNetworkNumber( NetworkNumber : String );
    procedure SetRemoteNodeNumber( NodeNumber : String );

    procedure SetPacketTypeFiltered( b : Boolean );
    procedure SetPacketTypeFilter( filter : DWORD );
    procedure SetSendPacketType( pt : DWORD );

    procedure IPXWndProc( var msg: TMessage );
    procedure SocketError( Socket: TSocket; SocketFunctionName: String; ErrorCode: Integer );
    function SocketErrorDesc( ErrorCode: Integer ) : String;

  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Handle : TSocket read FSocket;
    property MaxSendDataSize : Integer read FMaxSendDataSize;
        // This property is set after calling 'Open'

    // Following is the local name(local address) exclude LocalSocketNumber
    // They are set after calling 'Open'
    property LocalNetworkNumber : String read GetLocalNetworkNumber;
        // Network number is in format: XX.XX.XX.XX
    property LocalNodeNumber : String read GetLocalNodeNumber;
        // Node number is in format: XX.XX.XX.XX.XX.XX

    procedure Open;
    procedure Close;
    procedure Send( Buffer : Pointer ; BufferLength : Integer );
  published
    { Published declarations }
    property AllowSendBroadcast : Boolean read FAllowSendBroadcast write SetAllowSendBroadcast;
// No support in this protocol:  property ReceiveBroadcast : Boolean read FReceiveBroadcast write SetReceiveBroadcast;
    property ReceiveHeader : Boolean read FReceiveHeader write SetReceiveHeader;
    property Linger : Boolean read FLinger write SetLinger;
    property LingerTimeout : u_short read FLingerTimeout write SetLingerTimeout;

    property LocalSocketNumber : u_short read FLocalSocketNumber write FLocalSocketNumber;
    property RemoteNetworkNumber : String read GetRemoteNetworkNumber write SetRemoteNetworkNumber;
    property RemoteNodeNumber : String read GetRemoteNodeNumber write SetRemoteNodeNumber;
    property RemoteSocketNumber : u_short read FRemoteSocketNumber write FRemoteSocketNumber;

    property PacketTypeFiltered : Boolean read FPacketTypeFiltered write SetPacketTypeFiltered;
    property PacketTypeFilter : DWORD read FPacketTypeFilter write SetPacketTypeFilter;
    property SendPacketType : DWORD read FSendPacketType write SetSendPacketType;

    property OnReceiveData : TReceiveDataEvent read FOnReceiveData write FOnReceiveData;
    property OnSendDataEmpty : TSendDataEmptyEvent read FOnSendDataEmpty write FOnSendDataEmpty;
    property OnErrorHappened : TErrorHappenedEvent read FOnErrorHappened write FOnErrorHappened;
    // OOB datagram packet is not exist
  end;

procedure Register;

implementation

//-----------------------------------------------------------------------------
// ESocketError Definition
// Public Methods
//-----------------------------------------------------------------------------

constructor ESocketError.Create( const Msg : String ; Error : Integer );
begin
     inherited Create( Msg );
     FError := Error
end;

//-----------------------------------------------------------------------------
// IPX component
// Public Methods
//-----------------------------------------------------------------------------

constructor IPX.Create(AOwner: TComponent);
var
   wVersionRequested : WORD;
begin
     inherited Create(AOwner);

     FSocket := INVALID_SOCKET;

     FAllowSendBroadcast := True;
     FReceiveBroadcast := True;
     FReceiveHeader := False;
     FMaxSendDataSize := 546;
     FLinger := False;
     FLingerTimeout := 0;

     FLocalNetworkNumber[0] := 0;
     FLocalNetworkNumber[1] := 0;
     FLocalNetworkNumber[2] := 0;
     FLocalNetworkNumber[3] := 0;
     FLocalNodeNumber[0] := 0;
     FLocalNodeNumber[1] := 0;
     FLocalNodeNumber[2] := 0;
     FLocalNodeNumber[3] := 0;
     FLocalNodeNumber[4] := 0;
     FLocalNodeNumber[5] := 0;
     FLocalSocketNumber := $5678;

     FRemoteNetworkNumber[0] := 0;
     FRemoteNetworkNumber[1] := 0;
     FRemoteNetworkNumber[2] := 0;
     FRemoteNetworkNumber[3] := 0;
     FRemoteNodeNumber[0] := $FF;
     FRemoteNodeNumber[1] := $FF;
     FRemoteNodeNumber[2] := $FF;
     FRemoteNodeNumber[3] := $FF;
     FRemoteNodeNumber[4] := $FF;
     FRemoteNodeNumber[5] := $FF;
     FRemoteSocketNumber := $5678;

     FPacketTypeFiltered := False;
     FPacketTypeFilter := 4;
     FSendPacketType := 4;

     if not (csDesigning in ComponentState) then
        FHWnd := AllocateHWnd(IPXWndProc);

     wVersionRequested := MAKEWORD( 1, 1 );
     if WSAStartup( wVersionRequested, WSAData ) <> 0 then
        raise ESocketError.Create( 'Cannot startup windows socket(.DLL)' ,
                                   WSABASEERR )
end;

destructor IPX.Destroy;
begin
     inherited Destroy;

     if not (csDesigning in ComponentState) then
        DeallocateHWnd(FHwnd);

     try
        Close
     except
           on ESocketError do
           begin  end
     end;

     (*
     if WSACleanup = SOCKET_ERROR then
        raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                   WSAGetLastError )
     *)

     WSACleanup
end;

procedure IPX.Open;
var
   Addr, BindAddr : TSockAddrIPX;
   i : Integer;
begin
     if FSocket <> INVALID_SOCKET then
        Exit;

     //
     // Allocate and open a socket
     //

     FSocket := socket( AF_IPX, SOCK_DGRAM, NSPROTO_IPX );
     if FSocket = INVALID_SOCKET then
        raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                   WSAGetLastError );

     //
     //  Bind to a socket.  We dont care what socket we bind to,
     //  so we will send down all 0's
     //

     Addr.sa_family := AF_IPX;
     for i := 0 to 3 do
         Addr.sa_netnum[i] := 0;
     for i := 0 to 5 do
         Addr.sa_nodenum[i] := 0;
     Addr.sa_socket := Swap( FLocalSocketNumber );

     if bind( FSocket, PSockAddr(@Addr)^, sizeof(TSockAddrIPX) ) = SOCKET_ERROR then
     begin
          i := WSAGetLastError;
          try
             Close
          except
                on ESocketError do
                begin  end
          end;
          raise ESocketError.Create( SocketErrorDesc(i), i )
     end;

     // get the local name(addr) for this socket

     i := sizeof(TSockAddrIPX);;
     if getsockname( FSocket, PSockAddr(@BindAddr)^, i ) = SOCKET_ERROR then
     begin
          i := WSAGetLastError;
          try
             Close
          except
                on ESocketError do
                begin  end
          end;
          raise ESocketError.Create( SocketErrorDesc(i), i )
     end;

     for i := 0 to 3 do
         FLocalNetworkNumber[i] := BindAddr.sa_netnum[i];
     for i := 0 to 5 do
         FLocalNodeNumber[i] := BindAddr.sa_nodenum[i];

     //
     //   Set the packet type to send for this socket
     //

     try
        SetSendPacketType( FSendPacketType )
     except
           on E : ESocketError do
           begin
                try
                   Close
                except
                      on ESocketError do
                      begin  end
                end;
                raise ESocketError.Create( E.Message, E.Error )
           end
     end;

     //
     // Set the incoming packet type. Packets with a packet type that
     //  does not match are discarded.
     //

     try
        SetPacketTypeFiltered( FPacketTypeFiltered )
     except
           on E : ESocketError do
           begin
                try
                   Close
                except
                      on ESocketError do
                      begin  end
                end;
                raise ESocketError.Create( E.Message, E.Error )
           end
     end;

     //
     //  Allow transmission of broadcast messages on the socket
     //

     try
        SetAllowSendBroadcast( FAllowSendBroadcast )
     except
           on E : ESocketError do
           begin
                try
                   Close
                except
                      on ESocketError do
                      begin  end
                end;
                raise ESocketError.Create( E.Message, E.Error )
           end
     end;

     //
     //  Received data include header
     //

     try
        SetReceiveHeader( FReceiveHeader )
     except
           on E : ESocketError do
           begin
                try
                   Close
                except
                      on ESocketError do
                      begin  end
                end;
                raise ESocketError.Create( E.Message, E.Error )
           end
     end;

     //
     // LINGER controls the action taken when unsent data is queued
     // on a socket and a closesocket is performed
     //
     // The semantics of closesocket are affected by the socket options
     // SO_LINGER and SO_DONTLINGER as follows
     // (Note: by default SO_DONTLINGER is enabled. That is, SO_LINGER is disabled)
     //
     // Option          Interval        Type of close   Wait for close?
     // -------------   -------------   -------------   ---------------
     // SO_DONTLINGER   Don't care      Graceful        No
     // SO_LINGER       Zero            Hard            No
     // SO_LINGER       Nonzero         Graceful        Yes
     //

     try
        SetLinger( FLinger )
     except
           on E : ESocketError do
           begin
                try
                   Close
                except
                      on ESocketError do
                      begin  end
                end;
                raise ESocketError.Create( E.Message, E.Error )
           end
     end;

     //
     // Get the max send data permit
     //

     i := sizeof(Integer);
     getsockopt( FSocket,
                 NSPROTO_IPX,
                 IPX_MAXSIZE,
                 @FMaxSendDataSize,
                 i );

     if WSAAsyncSelect( FSocket, FHwnd, PWM_ASYNCSELECT,
                        FD_READ or FD_WRITE ) = SOCKET_ERROR then
     begin
          try
             Close
          except
                on ESocketError do
                begin  end
          end;
          raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                     WSAGetLastError )
     end
end;

procedure IPX.Close;
begin
     WSAASyncSelect( FSocket, FHWnd, PWM_ASYNCSELECT, 0 );

     if FSocket <> INVALID_SOCKET then
     begin
          try
             if closesocket( FSocket ) = SOCKET_ERROR then
                raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                           WSAGetLastError )
          finally
                 FSocket := INVALID_SOCKET
          end
     end
end;

procedure IPX.Send( Buffer : Pointer ; BufferLength : Integer );
var
   Addr : TSockAddrIPX;
   i : Integer;
begin
     Addr.sa_family := AF_IPX;
     for i := 0 to 3 do
         Addr.sa_netnum[i] := FRemoteNetworkNumber[i];
     for i := 0 to 5 do
         Addr.sa_nodenum[i] := FRemoteNodeNumber[i];
     Addr.sa_socket := Swap( FRemoteSocketNumber );

     if sendto( FSocket, Buffer^, BufferLength, 0, PSockAddr(@Addr)^, sizeof(Addr) ) =
        SOCKET_ERROR then
        raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                   WSAGetLastError )
end;

//-----------------------------------------------------------------------------
// IPX component
// Private Methods
//-----------------------------------------------------------------------------

procedure IPX.IPXWndProc( var msg: TMessage );
var
   err: Integer;
   errfn: String;
   Addr : TSockAddr;
   AddrLen : Integer;
   ByteNumber : Integer;
begin
     case msg.Msg of
     PWM_ASYNCSELECT:
     begin
          err := WSAGetSelectError(msg.LParam);
          if err > WSABASEERR then
          begin
               if Assigned( FOnErrorHappened ) then
                  FOnErrorHappened( Self, WSAGetSelectEvent(msg.lParam),
                                    err, SocketErrorDesc(err) )
          end
          else
          begin
               case WSAGetSelectEvent(msg.lParam) of
                    FD_READ:
                    begin
                         AddrLen := sizeof(Addr);
                         ByteNumber := recvfrom( FSocket, Buffer, sizeof(Buffer),
                                                 0, Addr, AddrLen );
                         if ByteNumber = SOCKET_ERROR then
                         begin
                              if Assigned( FOnErrorHappened ) then
                                 FOnErrorHappened( Self, FD_READ,
                                                   WSAGetLastError,
                                                   SocketErrorDesc(WSAGetLastError) )
                         end
                         else
                         begin
                              if Assigned( FOnReceiveData ) then
                                 FOnReceiveData( Self, @(Buffer[0]),
                                                 ByteNumber, PSockAddrIPX(@Addr)^, AddrLen )
                         end
                    end;
                    FD_WRITE:
                    begin
                         if Assigned( FOnSendDataEmpty ) then
                            FOnSendDataEmpty( Self )
                    end
               end
          end
     end
     end
end;

procedure IPX.SetAllowSendBroadcast( b : Boolean );
var
   i : Integer;
begin
     if FSocket <> INVALID_SOCKET then
     begin
          if b then
             i := 1
          else
              i := 0;
          if setsockopt( FSocket,
                         SOL_SOCKET,
                         SO_BROADCAST,
                         @i,
                         sizeof(Integer) ) = SOCKET_ERROR then
          begin
               raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                          WSAGetLastError )
          end
     end;
     FAllowSendBroadcast := b
end;

procedure IPX.SetReceiveBroadcast( b : Boolean );
var
   i : Integer;
begin
     if FSocket <> INVALID_SOCKET then
     begin
          if b then
             i := 1
          else
              i := 0;
          if setsockopt( FSocket,
                         NSPROTO_IPX,
                         IPX_RECEIVE_BROADCAST,
                         @i,
                         sizeof(Integer) ) = SOCKET_ERROR then
          begin
               raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                          WSAGetLastError )
          end
     end;
     FReceiveBroadcast := b
end;

procedure IPX.SetReceiveHeader( b : Boolean );
var
   i : Integer;
begin
     if FSocket <> INVALID_SOCKET then
     begin
          if b then
             i := 1
          else
              i := 0;
          if setsockopt( FSocket,
                         NSPROTO_IPX,
                         IPX_RECVHDR,
                         @i,
                         sizeof(Integer) ) = SOCKET_ERROR then
          begin
               raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                          WSAGetLastError )
          end
     end;
     FReceiveHeader := b
end;

procedure IPX.SetLinger( b : Boolean );
var
   vLinger : TLinger;
begin
     if b and (FLingerTimeout <> 0) then
     begin
          vLinger.l_onoff := 1;
          vLinger.l_linger := FLingerTimeout
     end
     else
     begin
          b := False;      // timeout is 0, also set to no linger
          vLinger.l_onoff := 0
     end;
     if FSocket <> INVALID_SOCKET then
     begin
          {
          if setsockopt( FSocket,
                         SOL_SOCKET,
                         SO_LINGER,
                         @vLinger,
                         sizeof(TLinger) ) = SOCKET_ERROR then
          begin
               raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                          WSAGetLastError )
          end
          }
     end;
     FLinger := b
end;

procedure IPX.SetLingerTimeout( timeout : u_short );
var
   vLinger : TLinger;
begin
     if FLinger and (timeout <> 0) then
     begin
          vLinger.l_onoff := 1;
          vLinger.l_linger := timeout
     end
     else
     begin
          FLinger := False;      // timeout is 0, also set to no linger
          vLinger.l_onoff := 0
     end;
     if FSocket <> INVALID_SOCKET then
     begin
          {
          if setsockopt( FSocket,
                         SOL_SOCKET,
                         SO_LINGER,
                         @vLinger,
                         sizeof(TLinger) ) = SOCKET_ERROR then
          begin
               raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                          WSAGetLastError )
          end
          }
     end;
     FLingerTimeout := timeout
end;

function IPX.GetLocalNetworkNumber : String;
var
   i, c : Integer;
   s : String;
begin
     s := '';
     for i := 0 to 3 do
     begin
          s := s + IntToHex(FLocalNetworkNumber[i],2);
          if i <> 3 then
             s := s + '.'
     end;
     Result := s
end;

function IPX.GetRemoteNetworkNumber : String;
var
   i, c : Integer;
   s : String;
begin
     s := '';
     for i := 0 to 3 do
     begin
          s := s + IntToHex(FRemoteNetworkNumber[i],2);
          if i <> 3 then
             s := s + '.'
     end;
     Result := s
end;

function IPX.GetLocalNodeNumber : String;
var
   i, c : Integer;
   s : String;
begin
     s := '';
     for i := 0 to 5 do
     begin
          s := s + IntToHex(FLocalNodeNumber[i],2);
          if i <> 5 then
             s := s + '.'
     end;
     Result := s
end;

function IPX.GetRemoteNodeNumber : String;
var
   i, c : Integer;
   s : String;
begin
     s := '';
     for i := 0 to 5 do
     begin
          s := s + IntToHex(FRemoteNodeNumber[i],2);
          if i <> 5 then
             s := s + '.'
     end;
     Result := s
end;

//
// Separate the string formated in AA.BB.CC.DD.EE.FF  (A, B, C, D, E, F is digit)
// to FXXXumber[0] := $AA, FXXXNumber[1] := $BB ...
//
procedure IPX.SetNumber( var FNumber ; Number : String ; ByteNum : Integer );
var
   i, c : Integer;
   s : String;
begin
     s := '';
     c := 0;

     for i := 0 to ByteNum-1 do
         PChar(@FNumber)[i] := #0;

     for i := 1 to Length(Number) do
     begin
          case Number[i] of
               '0'..'9', 'A'..'F', 'a'..'f':   s := s + Number[i]
          else
              if s <> '' then
              begin
                   try
                      PChar(@FNumber)[c] := Chr( (StrToInt('$'+s) and $ff) )
                   except
                         on EConvertError do
                         begin end
                   end;
                   s := '';
                   c := c + 1;
                   if c = ByteNum then
                      Break
              end
          end
     end;

     if s <> '' then
     begin
          try
             PChar(@FNumber)[c] := Chr( StrToInt('$'+s) )
          except
                on EConvertError do
                begin end
          end
     end
end;

procedure IPX.SetRemoteNetworkNumber( NetworkNumber : String );
begin
     SetNumber( FRemoteNetworkNumber, NetworkNumber, 4 )
end;

procedure IPX.SetRemoteNodeNumber( NodeNumber : String );
begin
     SetNumber( FRemoteNodeNumber, NodeNumber, 6 )
end;

procedure IPX.SetPacketTypeFiltered( b : Boolean );
begin
     if FSocket <> INVALID_SOCKET then
     begin
          if b then
          begin
               //
               // Set filter enabled
               //
               if setsockopt( FSocket,
                              NSPROTO_IPX,
                              IPX_FILTERPTYPE,
                              @FPacketTypeFilter,
                              sizeof(DWORD) ) = SOCKET_ERROR then
               begin
                    raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                               WSAGetLastError )
               end
          end
          else
          begin
               //
               // Set filter disabled
               //
               if setsockopt( FSocket,
                              NSPROTO_IPX,
                              IPX_STOPFILTERPTYPE,
                              @FPacketTypeFilter,
                              sizeof(DWORD) ) = SOCKET_ERROR then
               begin
                    raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                               WSAGetLastError )
               end
          end
     end;

     FPacketTypeFiltered := b
end;

procedure IPX.SetPacketTypeFilter( filter : DWORD );
begin
     if FSocket <> INVALID_SOCKET then
     begin
          if FPacketTypeFiltered then
          begin
               if setsockopt( FSocket,
                              NSPROTO_IPX,
                              IPX_FILTERPTYPE,
                              @filter,
                              sizeof(DWORD) ) = SOCKET_ERROR then
               begin
                    raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                               WSAGetLastError )
               end
          end
     end;
     FPacketTypeFilter := filter
end;

procedure IPX.SetSendPacketType( pt : DWORD );
begin
     if FSocket <> INVALID_SOCKET then
     begin
          if setsockopt( FSocket,
                         NSPROTO_IPX,
                         IPX_PTYPE,
                         @pt,
                         sizeof(DWORD) ) = SOCKET_ERROR then
          begin
               raise ESocketError.Create( SocketErrorDesc(WSAGetLastError),
                                          WSAGetLastError )
          end
     end;
     FSendPacketType := pt
end;

procedure IPX.SocketError( Socket: TSocket; SocketFunctionName: String; ErrorCode: Integer );
var
   ErrMsg : String;
begin
     if Assigned(FOnErrorHappened) then
        FOnErrorHappened( Self, Socket, ErrorCode, SocketErrorDesc(ErrorCode) )
     else
     begin
          ErrMsg := 'Error '+ IntToStr(ErrorCode) + ' in function ' + SocketFunctionName +
                    #13#10 + SocketErrorDesc( ErrorCode );

          if Application.MessageBox( PChar(ErrMsg),
                                  'WINSOCK ERROR',
                                  MB_ICONERROR or MB_OKCANCEL ) =
                                  IDCANCEL then
             Application.Terminate
     end
end;

function IPX.SocketErrorDesc( ErrorCode : Integer ) : String;
begin
     case ErrorCode of
          WSAEINTR:         SocketErrorDesc := 'Interrupted system call';
          WSAEBADF:         SocketErrorDesc := 'Bad file number';
          WSAEACCES:        SocketErrorDesc := 'Permission denied';
          WSAEFAULT:        SocketErrorDesc := 'The name or the namelen argument is not a valid part of the user address space';
          WSAEINVAL:        SocketErrorDesc := 'The socket has not been bound to an address with bind';
          WSAEMFILE:        SocketErrorDesc := 'No more socket descriptors are available';
          WSAEWOULDBLOCK:   SocketErrorDesc := 'Operation would block';
          WSAEINPROGRESS:   SocketErrorDesc := 'A blocking Windows Sockets 1.1 call is in progress';
          WSAEALREADY:      SocketErrorDesc := 'Operation already in progress';
          WSAENOTSOCK:      SocketErrorDesc := 'The descriptor is not a socket';
          WSAEDESTADDRREQ:  SocketErrorDesc := 'Destination address required';
          WSAEMSGSIZE:      SocketErrorDesc := 'Message too long';
          WSAEPROTOTYPE:    SocketErrorDesc := 'The specified protocol is the wrong type for this socket';
          WSAENOPROTOOPT:   SocketErrorDesc := 'Protocol not available';
          WSAEPROTONOSUPPORT:   SocketErrorDesc := 'The specified protocol is not supported';
          WSAESOCKTNOSUPPORT:   SocketErrorDesc := 'The specified socket type is not supported in this address family';
          WSAEOPNOTSUPP:    SocketErrorDesc := 'Operation not supported on socket';
          WSAEPFNOSUPPORT:  SocketErrorDesc := 'Protocol family not supported';
          WSAEAFNOSUPPORT:  SocketErrorDesc := 'The specified address family is not supported';
          WSAEADDRINUSE:    SocketErrorDesc := 'The specified address is already in use';
          WSAEADDRNOTAVAIL: SocketErrorDesc := 'The specified address is not available from the local machine';
          WSAENETDOWN:      SocketErrorDesc := 'The network subsystem has failed';
          WSAENETUNREACH:   SocketErrorDesc := 'The network cannot be reached from this host at this time';
          WSAENETRESET:     SocketErrorDesc := 'Network dropped connection on reset';
          WSAECONNABORTED:  SocketErrorDesc := 'The connection was terminated due to a time-out or other failure';
          WSAECONNRESET:    SocketErrorDesc := 'The connection was reset by the remote side';
          WSAENOBUFS:       SocketErrorDesc := 'No buffer space is available. The socket cannot be created';
          WSAEISCONN:       SocketErrorDesc := 'The socket is already connected';
          WSAENOTCONN:      SocketErrorDesc := 'Socket is not connected';
          WSAESHUTDOWN:     SocketErrorDesc := 'Can''t send after socket shutdown';
          WSAETOOMANYREFS:  SocketErrorDesc := 'Too many references: can''t splice';
          WSAETIMEDOUT:     SocketErrorDesc := 'Attempt to connect timed out without establishing a connection';
          WSAECONNREFUSED:  SocketErrorDesc := 'The attempt to connect was forcefully rejected';
          WSAELOOP:         SocketErrorDesc := 'Too many levels of symbolic links';
          WSAENAMETOOLONG:  SocketErrorDesc := 'File name too long';
          WSAEHOSTDOWN:     SocketErrorDesc := 'Host is down';
          WSAEHOSTUNREACH:  SocketErrorDesc := 'No route to host';
          WSAENOTEMPTY:     SocketErrorDesc := 'Directory not empty';
          WSAEPROCLIM:      SocketErrorDesc := 'Too many processes';
          WSAEUSERS:        SocketErrorDesc := 'Too many users';
          WSAEDQUOT:        SocketErrorDesc := 'Disc quota exceeded';
          WSAESTALE:        SocketErrorDesc := 'Stale NFS file handle';
          WSAEREMOTE:       SocketErrorDesc := 'Too many levels of remote in path';
          WSASYSNOTREADY:   SocketErrorDesc := 'Network sub-system is unusable';
          WSAVERNOTSUPPORTED:   SocketErrorDesc := 'WinSock DLL cannot support this application';
          WSANOTINITIALISED:    SocketErrorDesc := 'A successful WSAStartup must occur before using this function';
          WSAHOST_NOT_FOUND:    SocketErrorDesc := 'Host not found';
          WSATRY_AGAIN:     SocketErrorDesc := 'Non-authoritative host not found';
          WSANO_RECOVERY:   SocketErrorDesc := 'Non-recoverable error';
          WSANO_DATA:       SocketErrorDesc := 'No Data'
     else SocketErrorDesc := 'Not a WinSock error'
     end
end;

procedure Register;
begin
  RegisterComponents('System', [IPX]);
end;

end.

调试易

Delphi 局域网IPX通讯,寻求帮助.

解决方案 »