units/indy/IdUDPBase.pas

   1 // 27-nov-2002
   2 unit IdUDPBase;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes } ,
   8   IdComponent{, IdException}, IdGlobal, IdSocketHandle;
   9
  10 const
  11   ID_UDP_BUFFERSIZE = 8192;
  12
  13 type
  14   TIdUDPBase = object(TIdComponent)
  15   protected
  16     FBinding: TIdSocketHandle;
  17     FBufferSize: Integer;
  18     FDsgnActive: Boolean;
  19     FHost: string;
  20     FPort: Integer;
  21     FReceiveTimeout: Integer;
  22     //
  23     FBroadcastEnabled: Boolean;
  24     procedure BroadcastEnabledChanged;// dynamic;
  25     procedure CloseBinding; virtual;
  26     function GetActive: Boolean; virtual;
  27     procedure SetActive(const Value: Boolean);
  28     procedure SetBroadcastFlag(const Enabled: Boolean; ABinding: TIdSocketHandle
  29 {      = nil});
  30     procedure SetBroadcastEnabled(const Value: Boolean);
  31     function GetBinding: TIdSocketHandle; virtual;
  32     procedure Loaded; virtual;//override;
  33   public
  34      { constructor Create(AOwner: TComponent); override;
  35      } destructor Destroy;
  36      virtual; //
  37     property Binding: TIdSocketHandle read GetBinding;
  38     procedure Broadcast(const AData: string; const APort: integer);
  39     function ReceiveBuffer(var ABuffer; const ABufferSize: Integer;
  40       const AMSec: Integer = IdTimeoutDefault): integer; overload;
  41     function ReceiveBuffer(var ABuffer; const ABufferSize: Integer; var VPeerIP:
  42       string;
  43       var VPeerPort: integer; AMSec: Integer = IdTimeoutDefault): integer;
  44         overload;
  45     function ReceiveString(const AMSec: Integer = IdTimeoutDefault): string;
  46       overload;
  47     function ReceiveString(var VPeerIP: string; var VPeerPort: integer;
  48       const AMSec: Integer = IdTimeoutDefault): string; overload;
  49     procedure Send(AHost: string; const APort: Integer; const AData: string);
  50     procedure SendBuffer(AHost: string; const APort: Integer; var ABuffer;
  51       const AByteCount: integer);
  52
  53     property ReceiveTimeout: Integer read FReceiveTimeout write FReceiveTimeout
  54       default IdTimeoutInfinite;
  55    { published }
  56     property Active: Boolean read GetActive write SetActive default False;
  57     property BufferSize: Integer read FBufferSize write FBufferSize default
  58       ID_UDP_BUFFERSIZE;
  59     property BroadcastEnabled: Boolean read FBroadcastEnabled write
  60       SetBroadcastEnabled default False;
  61   end;
  62 PIdUDPBase=^TIdUDPBase;
  63 function NewIdUDPBase(AOwner: PControl):PIdUDPBase;{ type  MyStupid0=DWord;
  64   EIdUDPException = object(EIdException);
  65 PdUDPBase=^IdUDPBase; type  MyStupid3137=DWord;
  66   EIdUDPReceiveErrorZeroBytes = object(EIdUDPException);
  67 PUDPBase=^dUDPBase; type  MyStupid86104=DWord;        }
  68
  69 implementation
  70
  71 uses
  72   IdResourceStrings, IdStack, IdStackConsts, SysUtils;
  73
  74 procedure TIdUDPBase.Broadcast(const AData: string; const APort: integer);
  75 begin
  76 //  SetBroadcastFlag(True);
  77   Send('255.255.255.255', APort, AData);
  78   BroadcastEnabledChanged;
  79 end;
  80
  81 procedure TIdUDPBase.BroadcastEnabledChanged;
  82 begin
  83 //  SetBroadcastFlag(BroadcastEnabled);
  84 end;
  85
  86 procedure TIdUDPBase.CloseBinding;
  87 begin
  88   FreeAndNil(FBinding);
  89 end;
  90
  91 //constructor TIdUDPBase.Create(AOwner: TComponent);
  92 function NewIdUDPBase(AOwner: PControl):PIdUDPBase;
  93 begin
  94 //  inherited;
  95   New( Result, Create );
  96 with Result^ do
  97 begin
  98   BufferSize := ID_UDP_BUFFERSIZE;
  99   FReceiveTimeout := IdTimeoutInfinite;
 100 end;
 101 end;
 102
 103 destructor TIdUDPBase.Destroy;
 104 begin
 105   Active := False;
 106   inherited;
 107 end;
 108
 109 function TIdUDPBase.GetActive: Boolean;
 110 begin
 111 //  Result := FDsgnActive or (Assigned(FBinding) and FBinding.HandleAllocated);
 112 end;
 113
 114 function TIdUDPBase.GetBinding: TIdSocketHandle;
 115 begin
 116 //  if not Assigned(FBinding) then
 117   begin
 118 //    FBinding := TIdSocketHandle.Create(nil);
 119   end;
 120   if not FBinding.HandleAllocated then
 121   begin
 122     FBinding.AllocateSocket(Id_SOCK_DGRAM);
 123     BroadcastEnabledChanged;
 124   end;
 125   result := FBinding;
 126 end;
 127
 128 procedure TIdUDPBase.Loaded;
 129 var
 130   b: Boolean;
 131 begin
 132   inherited;
 133   b := FDsgnActive;
 134   FDsgnActive := False;
 135   Active := b;
 136 end;
 137
 138 function TIdUDPBase.ReceiveBuffer(var ABuffer; const ABufferSize: Integer;
 139   const AMSec: Integer): Integer;
 140 var
 141   VoidIP: string;
 142   VoidPort: Integer;
 143 begin
 144   Result := ReceiveBuffer(ABuffer, ABufferSize, VoidIP, VoidPort, AMSec);
 145 end;
 146
 147 function TIdUDPBase.ReceiveBuffer(var ABuffer; const ABufferSize: Integer;
 148   var VPeerIP: string; var VPeerPort: integer;
 149   AMSec: Integer = IdTimeoutDefault): integer;
 150 begin
 151   if AMSec = IdTimeoutDefault then
 152   begin
 153     AMSec := ReceiveTimeOut;
 154   end;
 155   if not Binding.Readable(AMSec) then
 156   begin
 157     Result := 0;
 158     VPeerIP := '';
 159     VPeerPort := 0;
 160     Exit;
 161   end;
 162   Result := Binding.RecvFrom(ABuffer, ABufferSize, 0, VPeerIP, VPeerPort);
 163   GStack.CheckForSocketError(Result);
 164   if Result = 0 then
 165   begin
 166 //    raise EIdUDPReceiveErrorZeroBytes.Create(RSUDPReceiveError0);
 167   end;
 168 end;
 169
 170 function TIdUDPBase.ReceiveString(var VPeerIP: string; var VPeerPort: integer;
 171   const AMSec: Integer = IdTimeoutDefault): string;
 172 var
 173   i: integer;
 174 begin
 175   SetLength(Result, BufferSize);
 176   i := ReceiveBuffer(Result[1], Length(Result), VPeerIP, VPeerPort, AMSec);
 177   SetLength(Result, i);
 178 end;
 179
 180 function TIdUDPBase.ReceiveString(const AMSec: Integer): string;
 181 var
 182   VoidIP: string;
 183   VoidPort: Integer;
 184 begin
 185   result := ReceiveString(VoidIP, VoidPort, AMSec);
 186 end;
 187
 188 procedure TIdUDPBase.Send(AHost: string; const APort: Integer; const AData:
 189   string);
 190 begin
 191   SendBuffer(AHost, APort, PChar(AData)^, Length(AData));
 192 end;
 193
 194 procedure TIdUDPBase.SendBuffer(AHost: string; const APort: Integer; var
 195   ABuffer;
 196   const AByteCount: integer);
 197 begin
 198   AHost := GStack.ResolveHost(AHost);
 199   Binding.SendTo(AHost, APort, ABuffer, AByteCount);
 200 end;
 201
 202 procedure TIdUDPBase.SetActive(const Value: Boolean);
 203 begin
 204   if (Active <> Value) then
 205   begin
 206 //    if not ((csDesigning in ComponentState) or (csLoading in ComponentState))
 207 //      then
 208     begin
 209       if Value then
 210       begin
 211         GetBinding;
 212       end
 213       else
 214       begin
 215         CloseBinding;
 216       end;
 217     end
 218 {    else
 219     begin
 220       FDsgnActive := Value;
 221     end;}
 222   end;
 223 end;
 224
 225 procedure TIdUDPBase.SetBroadcastEnabled(const Value: Boolean);
 226 begin
 227   if FBroadCastEnabled <> Value then
 228   begin
 229     FBroadcastEnabled := Value;
 230     if Active then
 231     begin
 232       BroadcastEnabledChanged;
 233     end;
 234   end;
 235 end;
 236
 237 procedure TIdUDPBase.SetBroadcastFlag(const Enabled: Boolean; ABinding:
 238   TIdSocketHandle{ = nil});
 239 var
 240   BroadCastData: LongBool;
 241 begin
 242   BroadCastData := Enabled;
 243 //  if ABinding = nil then
 244   begin
 245     ABinding := Binding;
 246   end;
 247   ABinding.SetSockOpt(Id_SOL_SOCKET, Id_SO_BROADCAST, PChar(@BroadCastData),
 248     SizeOf(BroadCastData));
 249 end;
 250
 251 end.