nmudp.pas

DELPHI里面一些常用的控件

{$IFDEF VER100}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE NMF3}
{$ENDIF}

unit NMUDP;

interface

uses
  Winsock, Classes, Sysutils, WinTypes, Messages, Forms, NMConst;
{$IFDEF VER110}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER120}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER125}
{$OBJEXPORTALL On}
{$ENDIF}

const

   //  CompName           ='TNMUDP';

   //  Major_Version      ='4';
   //  Minor_Version      ='02';
   //  Date_Version       ='012798';

   { Levels for reporting Status Messages}
  Status_None = 0;
  Status_Informational = 1;
  Status_Basic = 2;
  Status_Routines = 4;
  Status_Debug = 8;
  Status_Trace = 16;


  WM_ASYNCHRONOUSPROCESS = WM_USER + 101; {Message number for asynchronous socket messages}

const {protocol}
  Const_cmd_true = 'TRUE';

type

  UDPSockError = class(Exception);

   {Event Handlers}

  TOnErrorEvent = procedure(Sender: TComponent; errno: word; Errmsg: string) of object;
  TOnStatus = procedure(Sender: TComponent; status: string) of object;
  TOnReceive = procedure(Sender: TComponent; NumberBytes: Integer; FromIP: string; Port: Integer) of object;
  THandlerEvent = procedure(var handled: boolean) of object;
  TBuffInvalid = procedure(var handled: boolean; var Buff: array of char; var Length: Integer) of object;
  TStreamInvalid = procedure(var handled: boolean; Stream: TStream) of object;

  TNMUDP = class(TComponent)
  private
    IBuff: array[0..2048] of char;
    IBuffSize: Integer;
    FRemoteHost: string;
    FRemotePort: Integer;
    FLocalPort: Integer; {Port at server to connect to}
    RemoteAddress, RemoteAddress2: TSockAddr; {Address of remote host}
    FSocketWindow: hwnd;
    Wait_Flag: boolean; {Flag to indicate if synchronous request completed or not}
    RemoteHostS: PHostEnt; {Entity to store remote host linfo from a Hostname request}
    Canceled: boolean; {Flag to indicate request cancelled}
    Succeed: boolean; {Flag for indicating if synchronous request succeded}
    MyWSAData: TWSADATA; {Socket Information}
    FOnStatus: TOnStatus; {} {Event handler on a status change}
    FReportLevel: Integer; {Reporting Level}
    _status: string; {Current status}
    _ProcMsg: boolean; {Flag to supress or enable socket message processing}
    FLastErrorno: Integer; {The last error Encountered}
    FOnErrorEvent: TOnErrorEvent; {} {Event handler for error nitification}
    FOnDataReceived: TOnReceive;
    FOnDataSend: TNotifyEvent;
    FOnInvalidHost: THandlerEvent;
    FOnStreamInvalid: TStreamInvalid;
    FOnBufferInvalid: TBuffInvalid;
    procedure WndProc(var message: TMessage);
    procedure ResolveRemoteHost;
    procedure SetLocalPort(NewLocalPort: Integer);
    procedure ProcessIncomingdata;
  protected
    procedure StatusMessage(Level: byte; value: string);
    function ErrorManager(ignore: word): string;
    function SocketErrorStr(errno: word): string;
    procedure Wait;
  public
    EventHandle: THandle;
    ThisSocket: TSocket; {The socket number of the Powersocket}
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Cancel;
    procedure SendStream(DataStream: TStream);
    procedure SendBuffer(Buff: array of char; Length: Integer);
    procedure ReadStream(DataStream: TStream);
    procedure ReadBuffer(var Buff: array of char; var Length: Integer);
  published
    property RemoteHost: string read FRemoteHost write FRemoteHost; {Host Nmae or IP of remote host}
    property RemotePort: Integer read FRemotePort write FRemotePort; {Port of remote host}
    property LocalPort: Integer read FLocalPort write SetLocalPort; {Port of remote host}
    property ReportLevel: Integer read FReportLevel write FReportLevel;
    property OnDataReceived: TOnReceive read FOnDataReceived write FOnDataReceived;
    property OnDataSend: TNotifyEvent read FOnDataSend write FOnDataSend;
    property OnStatus: TOnStatus read FOnStatus write FOnStatus;
    property OnInvalidHost: THandlerEvent read FOnInvalidHost write FOnInvalidHost;
    property OnStreamInvalid: TStreamInvalid read FOnStreamInvalid write FOnStreamInvalid;
    property OnBufferInvalid: TBuffInvalid read FOnBufferInvalid write FOnBufferInvalid;
  end; {_ TNMUDP               = class(TComponent) _}

implementation

procedure WaitforSync(Handle: THandle);
begin
  repeat
    if MsgWaitForMultipleObjects(1, Handle, False,
      INFINITE, QS_ALLINPUT)
      = WAIT_OBJECT_0 + 1
      then Application.ProcessMessages
    else Break;
  until True = False;
end; {_WaitforSync_}

procedure TNMUDP.Cancel;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_Cancel); {Status Message}
  Canceled := True; {Set Cancelled to true}
  SetEvent(EventHandle);
end;


constructor TNMUDP.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  _ProcMsg := False; {Inhibit Event processing for socket}
   { Initialize memory }
  GetMem(RemoteHostS, MAXGETHOSTSTRUCT); {Initialize memory for host address structure}
  FSocketWindow := AllocateHWnd(WndProc); {Create Window handle to receive message notification}
   { Set Variables }
  FReportLevel := Status_Informational; {Set Default Reporting Level}
  Canceled := False; {Cancelled flag off}
  EventHandle := CreateEvent(nil, True, False, '');
  StatusMessage(Status_Debug, Cons_Msg_Wsk); {Status Message}
  if WSAStartUp($0101, MyWSAData) = 0 then
  try
    ThisSocket := Socket(AF_INET, SOCK_DGRAM, 0); {Get a new socket}
    if ThisSocket = TSocket(INVALID_SOCKET) then
      ErrorManager(WSAEWOULDBLOCK); {If error handle error}
    setsockopt(ThisSocket, SOL_SOCKET, SO_DONTLINGER, Const_cmd_true, 4);
  except
    WSACleanup; {If error Cleanup}
    raise; {Pass exception to calling function}
  end {_ try _}
  else {_ NOT if WSAStartUp($0101, MyWSADATA) = 0 then _}
    ErrorManager(WSAEWOULDBLOCK); {Handle Statrtup error}
  _ProcMsg := True;
end; {_ constructor TNMUDP.Create(AOwner: TComponent); _}

{*******************************************************************************************
Destroy Power Socket
********************************************************************************************}

destructor TNMUDP.Destroy;
begin
   {cancel; }
  FreeMem(RemoteHostS, MAXGETHOSTSTRUCT); {Free memory for fetching Host Entity}
  DeAllocateHWnd(FSocketWindow); {Release window handle for Winsock messages}
  CloseHandle(EventHandle);
  WSACleanup; {Clean up Winsock}
  inherited Destroy; {Do inherited destroy method}
end; {_ destructor TNMUDP.Destroy; _}

procedure TNMUDP.SetLocalPort(NewLocalPort: Integer);
begin
  if ThisSocket <> 0 then closesocket(ThisSocket);
  WSACleanup;
  if WSAStartUp($0101, MyWSAData) = 0 then
  try
    ThisSocket := Socket(AF_INET, SOCK_DGRAM, 0); {Get a new socket}
    if ThisSocket = TSocket(INVALID_SOCKET) then
      ErrorManager(WSAEWOULDBLOCK); {If error handle error}
  except
    WSACleanup; {If error Cleanup}
    raise; {Pass exception to calling function}
  end {_ try _}
  else {_ NOT if WSAStartUp($0101, MyWSADATA) = 0 then _}
    ErrorManager(WSAEWOULDBLOCK); {Handle Statrtup error}
  FLocalPort := NewLocalPort;
  Loaded;
end; {_ procedure TNMUDP.SetLocalPort(NewLocalPort: integer); _}


procedure TNMUDP.Loaded;
var
  buf: array[0..17] of char;
begin
  if not (csDesigning in ComponentState) then
  begin
    RemoteAddress2.sin_addr.S_addr := Inet_Addr(StrPCopy(buf, '0.0.0.0'));
    RemoteAddress2.sin_family := AF_INET; {Family = Internet address}
    RemoteAddress2.sin_port := htons(FLocalPort); {Set port to given port}
    Wait_Flag := False; {Set flag to wait}
      {Bind Socket to given address}
    Winsock.bind(ThisSocket, RemoteAddress2, SizeOf(RemoteAddress2));
      {Direct reply message to WM_WAITFORRESPONSE handler}
    WSAAsyncselect(ThisSocket, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_READ);
  end; {_ if not (csDesigning in ComponentState) then _}
end; {_ procedure TNMUDP.Loaded; _}

{*******************************************************************************************
Resolve IP Address of Remote Host
********************************************************************************************}

procedure TNMUDP.ResolveRemoteHost;
var
  buf: array[0..127] of char;