KOLIndy/myindy/IdSocketHandle.pas

   1 // 27-nov-2002
   2 unit IdSocketHandle;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes }{ ,
   8   IdException},KOLClasses,
   9   IdGlobal,
  10   IdStack, IdStackConsts;
  11
  12 type
  13
  14 {  TIdSocketHandle = object(TObj)
  15   end;}
  16 PIdSocketHandle=^TIdSocketHandle;
  17 PIdSocketHandles=^TIdSocketHandles;
  18
  19   TIdSocketHandles = object(TOwnedCollection)
  20   protected
  21     FDefaultPort: integer;
  22
  23     function GetItem(Index: Integer):PIdSocketHandle; //TIdSocketHandle;
  24     procedure SetItem(Index: Integer; const Value: {TIdSocketHandle}PIdSocketHandle);
  25   public
  26      { constructor Create(AOwner: TComponent);  }// reintroduce;
  27     function Add: PIdSocketHandle{TIdSocketHandle};// reintroduce;
  28     function BindingByHandle(const AHandle: TIdStackSocketHandle):
  29      { TIdSocketHandle}PIdSocketHandle;
  30     property Items[Index: Integer]: PIdSocketHandle{TIdSocketHandle} read GetItem write SetItem;
  31       default;
  32
  33     property DefaultPort: integer read FDefaultPort write FDefaultPort;
  34   end;
  35 //PdSocketHandle=^IdSocketHandle;
  36 //function NewIdSocketHandles(AOwner: PControl):PIdSocketHandles;
  37 // type
  38
  39   TIdSocketHandle = object(TCollectionItem)
  40   protected
  41 //    FACollection:PCollection;
  42     FHandle: TIdStackSocketHandle;
  43     FHandleAllocated: Boolean;
  44     FIP, FPeerIP: string;
  45     FPort, FPeerPort: integer;
  46   public
  47     procedure Init; virtual;
  48     procedure Accept(ASocket: TIdStackSocketHandle);
  49     procedure AllocateSocket(const ASocketType: Integer = Id_SOCK_STREAM;
  50       const AProtocol: Integer = Id_IPPROTO_IP);
  51
  52     procedure Assign(Source: PObj{TPersistent});// override;
  53     procedure Bind;
  54     procedure CloseSocket(const AResetLocal: boolean = True); virtual;
  55     function Connect(const AFamily: Integer = Id_PF_INET): Integer; virtual;
  56      { constructor Create(ACollection: TCollection); override;
  57      } destructor Destroy;
  58      virtual; procedure Listen(const anQueueCount: integer = 5);
  59     function Readable(AMSec: Integer = IdTimeoutDefault): boolean;
  60     function Recv(var ABuf; ALen, AFlags: Integer): Integer;
  61     function RecvFrom(var ABuffer; const ALength, AFlags: Integer; var VIP:
  62       string;
  63       var VPort: Integer): Integer; virtual;
  64     procedure Reset(const AResetLocal: boolean = True);
  65     function Send(var Buf; len, flags: Integer): Integer;
  66     procedure SendTo(const AIP: string; const APort: Integer; var ABuffer;
  67       const ABufferSize: Integer);
  68     procedure SetPeer(const asIP: string; anPort: integer);
  69     procedure SetSockOpt(level, optname: Integer; optval: PChar; optlen:
  70       Integer);
  71     procedure UpdateBindingLocal;
  72     procedure UpdateBindingPeer;
  73
  74     property HandleAllocated: Boolean read FHandleAllocated;
  75     property Handle: TIdStackSocketHandle read FHandle;
  76     property PeerIP: string read FPeerIP;
  77     property PeerPort: integer read FPeerPort;
  78    { published }
  79     property IP: string read FIP write FIP;
  80     property Port: integer read FPort write FPort;
  81   end;
  82 //PSocketHandle=^dSocketHandle;
  83 function NewIdSocketHandles(AOwner: PControl):PIdSocketHandles;
  84 function NewIdSocketHandle(ACollection: PCollection):PIdSocketHandle;
  85 { type  MyStupid86104=DWord;
  86   EIdSocketHandleError = object(EIdException);
  87 PocketHandle=^SocketHandle; type  MyStupid20258=DWord;
  88   EIdPackageSizeTooBig = object(EIdSocketHandleError);
  89 PcketHandle=^ocketHandle; type  MyStupid27292=DWord;
  90   EIdNotAllBytesSent = object(EIdSocketHandleError);
  91 PketHandle=^cketHandle; type  MyStupid67165=DWord;
  92   EIdCouldNotBindSocket = object(EIdSocketHandleError);
  93 PetHandle=^ketHandle; type  MyStupid31869=DWord;}
  94 implementation
  95
  96 uses
  97   IdAntiFreezeBase,
  98   IdComponent,
  99   IdResourceStrings;
 100
 101 procedure TIdSocketHandle.AllocateSocket(const ASocketType: Integer =
 102   Id_SOCK_STREAM;
 103   const AProtocol: Integer = Id_IPPROTO_IP);
 104 begin
 105
 106   CloseSocket;
 107   FHandle := GStack.CreateSocketHandle(ASocketType, AProtocol);
 108   FHandleAllocated := True;
 109 end;
 110
 111 procedure TIdSocketHandle.CloseSocket(const AResetLocal: boolean = True);
 112 begin
 113   if HandleAllocated then
 114   begin
 115     FHandleAllocated := False;
 116     GStack.WSShutdown(Handle, Id_SD_Send);
 117     GStack.WSCloseSocket(Handle);
 118     Reset(AResetLocal);
 119   end;
 120 end;
 121
 122 function TIdSocketHandle.Connect(const AFamily: Integer = Id_PF_INET): Integer;
 123 begin
 124   result := GStack.WSConnect(Handle, AFamily, PeerIP, PeerPort);
 125   if result <> Id_Socket_Error then
 126   begin
 127     UpdateBindingLocal;
 128     UpdateBindingPeer;
 129   end;
 130 end;
 131
 132 destructor TIdSocketHandle.Destroy;
 133 begin
 134   CloseSocket;
 135   inherited;
 136 end;
 137
 138 function TIdSocketHandle.Recv(var ABuf; ALen, AFlags: Integer): Integer;
 139 begin
 140   result := GStack.WSRecv(Handle, ABuf, ALen, AFlags);
 141 end;
 142
 143 function TIdSocketHandle.Send(var Buf; len, flags: Integer): Integer;
 144 begin
 145   result := GStack.WSSend(Handle, Buf, len, flags);
 146 end;
 147
 148 procedure TIdSocketHandle.SetSockOpt(level, optname: Integer; optval: PChar;
 149   optlen: Integer);
 150 begin
 151   GStack.CheckForSocketError(GStack.WSSetSockOpt(Handle, level, optname, optval,
 152     optlen));
 153 end;
 154
 155 procedure TIdSocketHandle.SendTo(const AIP: string; const APort: Integer; var
 156   ABuffer;
 157   const ABufferSize: Integer);
 158 var
 159   BytesOut: Integer;
 160 begin
 161   BytesOut := GStack.WSSendTo(Handle, ABuffer, ABufferSize, 0, AIP, APort);
 162   if BytesOut = Id_SOCKET_ERROR then
 163   begin
 164     if GStack.WSGetLastError() = Id_WSAEMSGSIZE then
 165     begin
 166 //      raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig);
 167     end
 168     else
 169     begin
 170       GStack.CheckForSocketError;
 171     end;
 172   end
 173   else
 174     if BytesOut <> ABufferSize then
 175   begin
 176 //    raise EIdNotAllBytesSent.Create(RSNotAllBytesSent);
 177   end;
 178 end;
 179
 180 function TIdSocketHandle.RecvFrom(var ABuffer; const ALength, AFlags: Integer;
 181   var VIP: string;
 182   var VPort: Integer): Integer;
 183 begin
 184   result := GStack.WSRecvFrom(Handle, ABuffer, ALength, AFlags, VIP, VPort);
 185 end;
 186
 187 procedure TIdSocketHandle.Bind;
 188 begin
 189   if GStack.CheckForSocketError(GStack.WSBind(Handle, Id_PF_INET, IP, Port),
 190     [Id_WSAEADDRINUSE]) then
 191   begin
 192 //    raise EIdCouldNotBindSocket.Create(RSCouldNotBindSocket);
 193   end;
 194   UpdateBindingLocal;
 195 end;
 196
 197 procedure TIdSocketHandle.SetPeer(const asIP: string; anPort: integer);
 198 begin
 199   FPeerIP := asIP;
 200   FPeerPort := anPort;
 201 end;
 202
 203 procedure TIdSocketHandle.Listen(const anQueueCount: integer);
 204 begin
 205   GStack.CheckForSocketError(GStack.WSListen(Handle, anQueueCount));
 206 end;
 207
 208 procedure TIdSocketHandle.Accept(ASocket: TIdStackSocketHandle);
 209 var
 210   LAcceptedSocket: TIdStackSocketHandle;
 211 begin
 212   LAcceptedSocket := GStack.WSAccept(ASocket, FIP, FPort);
 213   GStack.CheckForSocketError(LAcceptedSocket);
 214   FHandle := LAcceptedSocket;
 215   FHandleAllocated := True;
 216   UpdateBindingLocal;
 217   UpdateBindingPeer;
 218 end;
 219
 220 //constructor TIdSocketHandle.Create(ACollection: TCollection);
 221 function NewIdSocketHandle(ACollection: PCollection):PIdSocketHandle;
 222 begin
 223 //  inherited;
 224   New( Result, Create );
 225   with Result^ do
 226     FACollection:=ACollection;
 227   Result.Init;
 228 {with Result^ do
 229 begin
 230   Reset;
 231   if assigned(ACollection) then
 232   begin
 233 //    Port := TIdSocketHandles(ACollection).DefaultPort;
 234   end;
 235 end;    }
 236 end;
 237
 238 procedure TIdSocketHandle.Init;
 239 begin
 240   inherited;
 241 //  with Result^ do
 242 begin
 243   Reset;
 244   if assigned(FACollection) then
 245   begin
 246     Port := PIdSocketHandles(FACollection).DefaultPort;
 247   end;
 248 end;
 249 end;
 250
 251 function TIdSocketHandle.Readable(AMSec: Integer = IdTimeoutDefault): boolean;
 252 var
 253   ReadList: PList;//TList;
 254 begin
 255   if not FHandleAllocated then
 256   begin
 257 //    raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
 258   end;
 259
 260   if GAntiFreeze <> nil then
 261   begin
 262     if GAntiFreeze.Active then
 263     begin
 264       if AMSec = IdTimeoutInfinite then
 265       begin
 266         repeat
 267           result := Readable(GAntiFreeze.IdleTimeOut);
 268         until result;
 269         exit;
 270       end
 271       else
 272         if AMSec > GAntiFreeze.IdleTimeOut then
 273       begin
 274         result := Readable(AMSec - GAntiFreeze.IdleTimeOut);
 275         if result then
 276         begin
 277           exit;
 278         end
 279         else
 280         begin
 281           AMSec := GAntiFreeze.IdleTimeOut;
 282         end;
 283       end;
 284     end;
 285   end;
 286    ReadList:=NewList;
 287 //  ReadList := TList.Create;
 288   try
 289     ReadList.Add(Pointer(Handle));
 290     Result := GStack.WSSelect(ReadList, nil, nil, AMSec) = 1;
 291 //    TIdAntiFreezeBase.DoProcess(result = false);
 292   finally ReadList.free;
 293   end;
 294 end;
 295
 296 procedure TIdSocketHandle.Assign(Source: PObj);
 297 var
 298   LSource: PIdSocketHandle;//TIdSocketHandle;
 299 begin
 300 {  if ClassType <> Source.ClassType then
 301   begin
 302     inherited
 303   end
 304   else}
 305   begin
 306     LSource := PIdSocketHandle(Source);//TIdSocketHandle(Source);
 307     IP := LSource.IP;
 308     Port := LSource.Port;
 309     FPeerIP := LSource.PeerIP;
 310     FPeerPort := LSource.PeerPort;
 311   end;
 312 end;
 313
 314 procedure TIdSocketHandle.UpdateBindingLocal;
 315 var
 316   LFamily: integer;
 317 begin
 318   GStack.WSGetSockName(Handle, LFamily, FIP, FPort);
 319 end;
 320
 321 procedure TIdSocketHandle.UpdateBindingPeer;
 322 var
 323   LFamily: integer;
 324 begin
 325   GStack.WSGetPeerName(Handle, LFamily, FPeerIP, FPeerPort);
 326 end;
 327
 328 procedure TIdSocketHandle.Reset(const AResetLocal: boolean = True);
 329 begin
 330   FHandleAllocated := False;
 331   FHandle := Id_INVALID_SOCKET;
 332   if AResetLocal then
 333   begin
 334     FIP := '';
 335     FPort := 0;
 336   end;
 337   FPeerIP := '';
 338   FPeerPort := 0;
 339 end;
 340
 341 function TIdSocketHandles.Add: PIdSocketHandle;
 342 begin
 343   result := NewIdSocketHandle(@Self);//PIdSocketHandle(inherited Add);// PIdSocketHandle(Add);// as //TIdSocketHandle;
 344   result.Port := DefaultPort;
 345 end;
 346
 347 function TIdSocketHandles.BindingByHandle(const AHandle: TIdStackSocketHandle):
 348   PIdSocketHandle;
 349 var
 350   i: integer;
 351 begin
 352   Result := nil;
 353   i := Count - 1;
 354   while (i >= 0) and (Items[i].Handle <> AHandle) do
 355   begin
 356     dec(i);
 357   end;
 358   if i >= 0 then
 359   begin
 360     Result := Items[i];
 361   end;
 362 end;
 363
 364 //constructor TIdSocketHandles.Create(AOwner: TComponent);
 365 function NewIdSocketHandles(AOwner: PControl):PIdSocketHandles;
 366 begin
 367   New( Result, Create );
 368   Result.Init;
 369 ///  inherited Create(AOwner, TIdSocketHandle);
 370 end;
 371
 372 function TIdSocketHandles.GetItem(Index: Integer): PIdSocketHandle;
 373 begin
 374   result := PIdSocketHandle{TIdSocketHandle}(inherited Items[index]);
 375 end;
 376
 377 procedure TIdSocketHandles.SetItem(Index: Integer; const Value:
 378   PIdSocketHandle);
 379 begin
 380   inherited SetItem(Index, Value);
 381 end;
 382
 383 end.