nmudpex.pas

nmudp

{
//  Version:5.6.3   Build:1091  Date:1/31/00  //
////////////////////////////////////////////////////////////////////////////
//                                                                        //
// Copyright ?1997-1999, NetMasters, L.L.C - All rights reserved worldwide.   //
//  Portions may be Copyright ?Borland International, Inc.               //
//                                                                        //
// Unit Name: NMUDP                                                       //
//                                                                        //
// DESCRIPTION:Internet UDP Component                                     //
//  + Aug-9-98  Version 4.1 -- KNA                                        //
//                                                                        //
// THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY  //
// KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE    //
// IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR  //
// PURPOSE.                                                               //
//                                                                        //
////////////////////////////////////////////////////////////////////////////
}
// Revision History
// 01 04 00 - KNA -  Non ASYNC messages passed on
// 07 12 99 - KNA -  Resolve Host converted to Wait
// 07 02 98 - KNA -  Port of sender available
// 01 27 98 - KNA -  Final release Ver 4.00 VCLS
//

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

unit nmudpex;

interface

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

const
/////////////////////////////////////////////////////////////////////////////////
   DataPackSize = 65535 ;                       //修改此数即可改变每次传送数据包大小；

   //  CompName           ='TNMUDPEX';

   //  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';

{$IFDEF NMF3}
resourcestring
{$ELSE}
const
{$ENDIF}
{  Cons_Palette_Inet = 'Internet';
  Cons_Msg_Wsk = 'Initializing Winsock';
  Cons_Msg_Lkp = 'Host Lookup Canceled';
  Cons_Msg_Data = 'Sending Data';
  Cons_Msg_InvStrm = 'Invalid stream';
  Cons_Msg_Echk = 'Checking Error In Error Manager';
  Cons_Msg_Eno = 'Unknown Error No. ';
  Cons_Msg_ELkp = 'Looking Up Error Message';
  Cons_Err_Addr = 'Null Remote Address';
  Cons_Err_Buffer = 'Invalid buffer';     }

  Cons_Palette_Inet = 'Internet';
  Cons_Msg_Wsk = '正在初始化 Winsock';
  Cons_Msg_Lkp = '主机查找已取消';
  Cons_Msg_Data = '正在传送数据';
  Cons_Msg_InvStrm = '无效的流';
  Cons_Msg_Echk = '正在错误管理器中检测错误';
  Cons_Msg_Eno = '未知错误代号 ';
  Cons_Msg_ELkp = '正在查找错误信息';
  Cons_Err_Addr = '空的远程地址';
  Cons_Err_Buffer = '无效的缓冲区';

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;

  TNMUDPEX = class(TComponent)
  private
    IBuff: array[0..DataPackSize] of char;                     ///////lsyx
    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; {_ TNMUDPEX               = class(TComponent) _}

procedure Register;

implementation

uses NMConst;

procedure Register;
begin
  RegisterComponents(Cons_Palette_Inet, [TNMUDPEX]);
end; {_ procedure register; _}

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 TNMUDPEX.Cancel;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_Cancel); {Status Message}
  Canceled := True; {Set Cancelled to true}
  SetEvent(EventHandle);
end;

constructor TNMUDPEX.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 TNMUDPEX.Create(AOwner: TComponent); _}

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

destructor TNMUDPEX.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 TNMUDPEX.Destroy; _}

procedure TNMUDPEX.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}