驱动编程

开发平台：
Delphi

BufferUDP.pas：源码内容
							unit BufferUDP;
interface
uses
  Windows, SysUtils, Classes, WinSock, syncobjs;
type // Main class
  TUDPDataEvent = procedure(Sender: TObject; const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer) of object;
  TUDPSender = class(TComponent)
  private
    { Private declarations }
    FHandle: TSocket;
    FActive: Boolean;
    FRemoteIP: String;
    FRemoteHost: String;
    FRemotePort: Word;
    CS: TCriticalSection;
    Procedure SetActive(const Value: Boolean);
    Procedure SetRemoteIP(const Value: String);
    Procedure SetRemoteHost(const Value: String);
    Procedure SetRemotePort(const Value: Word);
  protected
    { Protected declarations }
  public
    { Public declarations }
    Class function ResolveHost(const psHost: string; var psIP: string): u_long; virtual;
    Class function ResolveIP(const psIP: string): string; virtual;
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    Procedure Connect;
    Procedure Disconnect;
    Function SendBuf(var Buffer; BufSize: Integer): Integer;
    property Handle: TSocket read FHandle;
  published
    { Published declarations }
    property Active: Boolean read FActive write SetActive default False;
    property RemoteIP: String read FRemoteIP write SetRemoteIP;
    property RemoteHost: String read FRemoteHost write SetRemoteHost;
    property RemotePort: Word read FRemotePort write SetRemotePort;
  end;
  TUDPReceiver = class;
  TUDPReceiverThread = class(TThread)
  protected
    FReceiver: TUDPReceiver;
    FBuffer: Pointer;
    FRecvSize: Integer;
    FPeer: string;
    FPort: Integer;
    FBufSize: Integer;
    procedure SetBufSize(const Value: Integer);
  public
    procedure Execute; override;
    procedure UDPRead;
  published
    Property BufSize: Integer read FBufSize write SetBufSize;
    Property Receiver: TUDPReceiver read FReceiver write FReceiver;
  end;
  TUDPReceiver = class(TComponent)
  private
    { Private declarations }
    FHandle: TSocket;
    FActive: Boolean;
    FPort: Word;
    FBufferSize: Integer;
    FMulticastIP : String;
//    FUDPBuffer: Pointer;
    FOnUDPData: TUDPDataEvent;
    FUDPReceiverThread: TUDPReceiverThread;
    Procedure SetActive(const Value: Boolean);
    Procedure SetPort(const Value: Word);
    Procedure SetBufferSize(const Value: Integer);
    procedure SetMulticastIP(const Value: String);
  protected
    { Protected declarations }
  public
    { Public declarations }
    Class Function BindMulticast(const Socket: TSocket; const IP:String): LongInt; virtual;
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    Procedure Connect;
    Procedure Disconnect;
    procedure DoUDPRead(const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer); virtual;
    property Handle: TSocket read FHandle;
  published
    { Published declarations }
    property Active: Boolean read FActive write SetActive default False;
    property Port: Word read FPort write SetPort;
    property BufferSize: Integer read FBufferSize write SetBufferSize default 65000;
    property OnUDPData: TUDPDataEvent read FOnUDPData write FOnUDPData;
    property MulticastIP: String read FMulticastIP write SetMulticastIP;
  end;
type // exception
  EBufferUDP = Exception;
procedure Register;
resourcestring
  EUDPNOTACTIVE = 'UDP Socket not connected';
  EUDPACTIVED = 'UDP Socket already connected';
  EWSAError = 'Socket Error : %d';
  EUNABLERESOLVEHOST = 'Unable to resolve host: %s';
  EUNABLERESOLVEIP = 'Unable to resolve IP: %s';
  EZEROBYTESEND = '0 bytes were sent.';
  EPACKAGETOOBIG = 'Package Size Too Big: %d';
  ENOREMOTESIDE = 'Remote Host/IP not identified!';
  ESIZEOUTOFBOUNDARY = 'Size value is out of boundary!';
  EWSAENOBUFS        = 'An operation on a socket could not be performed because the system lacked sufficient buffer space or because a queue was full.';
  EWSANOTINITIALISED = 'A successful WSAStartup must occur before using this function.';
  EWSAENETDOWN       = 'The network subsystem has failed.';
  EWSAEFAULT         = 'optval is not in a valid part of the process address space or optlen argument is too small.';
  EWSAEINPROGRESS    = 'A blocking Windows Sockets 1.1 call is in progress, or the service provider is still processing a callback function.';
  EWSAEINVAL         = 'level is not valid, or the information in optval is not valid.';
  EWSAENETRESET      = 'Connection has timed out when SO_KEEPALIVE is set.';
  EWSAENOPROTOOPT    = 'The option is unknown or unsupported for the specified provider.';
  EWSAENOTCONN       = 'Connection has been reset when SO_KEEPALIVE is set.';
  EWSAENOTSOCK       = 'The descriptor is not a socket.';
  EWSAUNKNOW         = 'Unknow socket error.';
implementation
procedure Register;
begin
  RegisterComponents('Samples', [TUDPSender, TUDPReceiver]);
end;
Type
  TIMR = Packed Record
    imr_multiaddr: LongInt;
    imr_interface: LongInt;
  End;
{ TUDPSender }
procedure TUDPSender.Connect;
Var
  Faddr: TSockAddrIn;
begin
  CS.Enter;
  try
    If FActive then
      Raise EBufferUDP.CreateRes(@EUDPACTIVED);
    If ((FRemoteHost='') and (FRemoteIP='')) then
      Raise EBufferUDP.CreateRes(@ENOREMOTESIDE);
    If Not (csDesigning in ComponentState) then
    Begin
      FHandle:= WinSock.Socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
      If FHandle = INVALID_SOCKET then
        Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);
      with faddr do begin
        sin_family := PF_INET;
        sin_port := WinSock.htons(FRemotePort);
    //    sin_addr.s_addr := WinSock.ResolveHost(fsHost, fsPeerAddress);
        if length(FRemoteIP) > 0 then begin
          sin_addr.s_addr := WinSock.inet_addr(PChar(FRemoteIP));
        end;
      end;
      WinSock.connect(FHandle, faddr, Sizeof(faddr));
    End;
    FActive:= True;
  finally
    CS.Leave;
  end;
end;
constructor TUDPSender.Create(AOwner: TComponent);
begin
  inherited;
  CS:= TCriticalSection.Create;
  FActive:= False;
  FHandle := INVALID_SOCKET;
//  FReceiveTimeout := -1;
end;
destructor TUDPSender.Destroy;
begin
  Active:= False;
  CS.Free;
  inherited;
end;
procedure TUDPSender.Disconnect;
Var
  OldHandle: TSocket;
begin
  CS.Enter;
  try
    If FActive then
    Begin
      OldHandle:= FHandle;
      FHandle:= INVALID_SOCKET;
      CloseSocket(OldHandle);
    End;
  finally
    FActive:= False;
    CS.Leave;
  end;
end;
class function TUDPSender.ResolveHost(const psHost: string;
  var psIP: string): u_long;
Var
  pa: PChar;
  sa: TInAddr;
  aHost: PHostEnt;
begin
  psIP := psHost;
  // Sometimes 95 forgets who localhost is
  if CompareText(psHost, 'LOCALHOST') = 0 then
  begin
    sa.S_un_b.s_b1 := #127;
    sa.S_un_b.s_b2 := #0;
    sa.S_un_b.s_b3 := #0;
    sa.S_un_b.s_b4 := #1;
    psIP := '127.0.0.1';
    Result := sa.s_addr;
  end else begin
    // Done if is tranlated (ie There were numbers}
    Result := inet_addr(PChar(psHost));
    // If no translation, see if it resolves}
    if Result = u_long(INADDR_NONE) then begin
      aHost := Winsock.GetHostByName(PChar(psHost));
      if aHost = nil then
      begin
        Result:= 0;
        psIP:= '';
        Exit;
        //Raise EBufferUDP.CreateResFmt(@EUNABLERESOLVEHOST, [psHost]);
      end else
      begin
        pa := aHost^.h_addr_list^;
        sa.S_un_b.s_b1 := pa[0];
        sa.S_un_b.s_b2 := pa[1];
        sa.S_un_b.s_b3 := pa[2];
        sa.S_un_b.s_b4 := pa[3];
        psIP:= String(inet_ntoa(sa));
        //psIP := TInAddrToString(sa);
      end;
      Result := sa.s_addr;
    end;
  end;
end;
class function TUDPSender.ResolveIP(const psIP: string): string;
var
  i: Integer;
  P: PHostEnt;
begin
  result := '';
  if CompareText(psIP, '127.0.0.1') = 0 then
  begin
    result := 'LOCALHOST';
  end else
  begin
    i := Winsock.inet_addr(PChar(psIP));
    P := Winsock.GetHostByAddr(@i, 4, PF_INET);
    If P = nil then
    Begin
      Result:= '';
      Exit;
      // Raise EBufferUDP.CreateResFmt(@EUNABLERESOLVEIP, [psIP]);
      //CheckForSocketError2(SOCKET_ERROR, [WSANO_DATA]);
    End else
    Begin
      result := P.h_name;
    End;
  end;
end;
Function TUDPSender.SendBuf(var Buffer; BufSize: Integer): Integer;
begin
  CS.Enter;
  try
    Result:= 0;
    If BufSize<=0 then
      Exit;
    If Not FActive then
      Raise EBufferUDP.CreateRes(@EUDPNOTACTIVE);
    Result:= Winsock.send(FHandle, Buffer, BufSize, 0);
    If Result<>BufSize then
    Begin
      Case Result of
        0:
          Raise EBufferUDP.CreateRes(@EZEROBYTESEND);
        SOCKET_ERROR:
          If WSAGetLastError = WSAEMSGSIZE then
            Raise EBufferUDP.CreateResFmt(@EPACKAGETOOBIG, [BufSize])
      End;{CASE}
    End;
  finally
    CS.Leave;
  end;
end;
procedure TUDPSender.SetActive(const Value: Boolean);
begin
  If FActive<>Value then
  Begin
    If Value then
      Connect
    Else
      Disconnect;
  End;
end;
procedure TUDPSender.SetRemoteHost(const Value: String);
Var
  IsConnected: Boolean;
begin
  If FRemoteHost<>Value then
  Begin
    IsConnected:= Active;
    Active:= False;
    FRemoteHost:= Value;
    If Not (csDesigning in ComponentState) then
      ResolveHost(FRemoteHost, FRemoteIP);
    // Resovle IP
    Active:= IsConnected;
  End;
end;
procedure TUDPSender.SetRemoteIP(const Value: String);
Var
  IsConnected: Boolean;
begin
  If FRemoteIP<>Value then
  Begin
    IsConnected:= Active;
    Active:= False;
    FRemoteIP:= Value;
    // Resovle Host name
    If Not (csDesigning in ComponentState) then
      FRemoteHost:= ResolveIP(FRemoteIP);
    Active:= IsConnected;
  End;
end;
procedure TUDPSender.SetRemotePort(const Value: Word);
Var
  IsConnected: Boolean;
begin
  If FRemotePort<>Value then
  Begin
    IsConnected:= Active;
    Active:= False;
    FRemotePort:= Value;
    Active:= IsConnected;
  End;
end;
{ TUDPReceiver }
class function TUDPReceiver.BindMulticast(const Socket: TSocket;
  const IP: String): LongInt;
Var
  lpMulti: TIMR;
Begin
  lpMulti.imr_multiaddr := inet_addr(PChar(IP));
  lpMulti.imr_interface := 0;
  Result:= SetSockOpt(Socket, IPPROTO_IP, IP_ADD_MEMBERSHIP, @lpMulti, Sizeof(lpMulti));
End;
procedure TUDPReceiver.Connect;
var
  m_addr: TSockAddrIn;
begin
  If FActive then
    Raise EBufferUDP.CreateRes(@EUDPACTIVED);
  If csDesigning in ComponentState then
  Begin
    FActive:= True;
    Exit;
  End;
  // SOCKET
  FHandle := Winsock.Socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
  If FHandle = INVALID_SOCKET then
    Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);
  // BIND
  With m_addr do begin
    sin_family := PF_INET;
    sin_port := Winsock.htons(FPort);
    sin_addr.s_addr := INADDR_ANY;
  End;
  If WinSock.bind(FHandle, m_addr, Sizeof(m_addr))=SOCKET_ERROR then
    Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);
  // Bind Multicast
  If FMulticastIP<>'' then
    If BindMulticast(FHandle, FMulticastIP)=SOCKET_ERROR then
      Case WSAGetLastError of
        WSAENOBUFS:        Raise EBufferUDP.CreateRes(@EWSAENOBUFS       );
        WSANOTINITIALISED: Raise EBufferUDP.CreateRes(@EWSANOTINITIALISED);
        WSAENETDOWN:       Raise EBufferUDP.CreateRes(@EWSAENETDOWN      );
        WSAEFAULT:         Raise EBufferUDP.CreateRes(@EWSAEFAULT        );
        WSAEINPROGRESS:    Raise EBufferUDP.CreateRes(@EWSAEINPROGRESS   );
        WSAEINVAL:         Raise EBufferUDP.CreateRes(@EWSAEINVAL        );
        WSAENETRESET:      Raise EBufferUDP.CreateRes(@EWSAENETRESET     );
        WSAENOPROTOOPT:    Raise EBufferUDP.CreateRes(@EWSAENOPROTOOPT   );
        WSAENOTCONN:       Raise EBufferUDP.CreateRes(@EWSAENOTCONN      );
        WSAENOTSOCK:       Raise EBufferUDP.CreateRes(@EWSAENOTSOCK      );
        Else
          Raise EBufferUDP.CreateRes(@EWSAUNKNOW);
      End; {CASE}
  // Thread read
  FUDPReceiverThread := TUDPReceiverThread.Create(True);
  With FUDPReceiverThread do
  Begin
    Receiver:= Self;
    BufSize:= FBufferSize;
    FreeOnTerminate := True;
    Resume;
  End;
  FActive:= True;
end;
constructor TUDPReceiver.Create(AOwner: TComponent);
begin
  inherited;
  FHandle := INVALID_SOCKET;
  FActive:= False;
  FBufferSize:= 65000;
  FMulticastIP:= '';
end;
destructor TUDPReceiver.Destroy;
begin
  Active:= False;
  inherited;
end;
procedure TUDPReceiver.Disconnect;
Var
  OldHandle: TSocket;
begin
  If Not FActive then
    Exit;
  try
    OldHandle:= FHandle;
    FHandle:= INVALID_SOCKET;
    CloseSocket(OldHandle);
  finally
    FActive:= False;
  end;
  If FUDPReceiverThread <> nil then
  Begin
    FUDPReceiverThread.Terminate;
    FUDPReceiverThread.WaitFor;
  End;
end;
procedure TUDPReceiver.DoUDPRead(const Buffer: Pointer; const RecvSize:Integer;
  const Peer: string; const Port: Integer);
begin
  If Assigned(FOnUDPData) then begin
    FOnUDPData(Self, Buffer, RecvSize, Peer, Port);
  End;
end;
procedure TUDPReceiver.SetActive(const Value: Boolean);
begin
  If FActive<>Value then
  Begin
    If Value then
      Connect
    Else
      Disconnect;
  End;
end;
procedure TUDPReceiver.SetBufferSize(const Value: Integer);
begin
  If FBufferSize<>Value then
  Begin
    If ((Value>=1024) and (Value<=65000)) then
      FBufferSize:= Value
    Else
      Raise EBufferUDP.CreateRes(@ESIZEOUTOFBOUNDARY);
  End;
end;
procedure TUDPReceiver.SetMulticastIP(const Value: String);
Var
  IsConnected: Boolean;
begin
  If Value<>FMulticastIP then
  Begin
    IsConnected:= Active;
    Active:= False;
    FMulticastIP:= Value;
    Active:= IsConnected;
  End;
end;
procedure TUDPReceiver.SetPort(const Value: Word);
Var
  IsConnected: Boolean;
begin
  If FPort<>Value then
  Begin
    IsConnected:= Active;
    Active:= False;
    FPort:= Value;
    Active:= IsConnected;
  End;
end;
{ TUDPReceiverThread }
procedure TUDPReceiverThread.Execute;
var
  i: Integer;
  addr_remote: TSockAddrin;
  arSize: Integer;
begin
  GetMem(FBuffer, FBufSize);
  arSize:= SizeOf(addr_remote);
  while FReceiver.Active and not Terminated do
  Begin
    i := arSize;
    FRecvSize := Winsock.RecvFrom(FReceiver.Handle, FBuffer^, FBufSize, 0, addr_remote, i);
    If FReceiver.Active and (FRecvSize>0) then
    Begin
      //fsData := Copy(fListener.fsUDPBuffer, 1, iByteCount);
      FPeer := String(inet_ntoa(addr_remote.sin_addr));
      //FPeer := String(TWinshoe.TInAddrToString(addr_remote.sin_addr));
      FPort := Winsock.NToHS(addr_remote.sin_port);
      Synchronize(UDPRead);
    End;
  End;
  FreeMem(FBuffer);
end;
procedure TUDPReceiverThread.SetBufSize(const Value: Integer);
begin
  If FBufSize<> Value then
    FBufSize:= Value;
end;
procedure TUDPReceiverThread.UDPRead;
begin
  FReceiver.DoUDPRead(FBuffer, FRecvSize, FPeer, FPort);
end;
Var
  GWSADATA: TWSADATA;
initialization
  WSAStartup(MakeWord(2, 0), GWSADATA);
finalization
  WSACleanup;
end.

						