idsockethandle.pas

网络控件适用于Delphi6

destructor TIdSocketHandle.Destroy;
begin
  CloseSocket;
  inherited;
end;

function TIdSocketHandle.Receive(var VBuffer: TIdBytes): Integer;
begin
  Result := GStack.Receive(Handle, VBuffer);
end;

function TIdSocketHandle.Send(
  const ABuffer: TIdBytes;
  AOffset: Integer;
  ASize: Integer = -1
  ): Integer;
begin
  Result := GStack.Send(Handle, ABuffer, AOffset, ASize);
end;

procedure TIdSocketHandle.SetSockOpt(ALevel:TIdSocketOptionLevel; 
      AOptName: TIdSocketOption; AOptVal: Integer);
begin
  GStack.SetSocketOption(Handle,ALevel,AOptName,AOptVal);
////  (GStack as TIdStackBSDBase).WSSetSockOpt(Handle, level, optname, optval, optlen);
end;

procedure TIdSocketHandle.SendTo(const AIP: string; const APort: Integer; const ABuffer : TIdBytes);
begin
  GStack.SendTo(Handle, ABuffer, 0, AIP, APort);
end;

function TIdSocketHandle.RecvFrom(var ABuffer : TIdBytes; var VIP: string;
 var VPort: Integer): Integer;
begin
  Result := GStack.ReceiveFrom(Handle,ABuffer,VIP,VPort);
//  (GStack as TIdStackBSDBase).WSRecvFrom(Handle, ABuffer, ALength, AFlags, VIP, VPort, IPVersion);
end;

procedure TIdSocketHandle.Bind;
begin
  if (Port = 0) and (FClientPortMin <> 0) and (FClientPortMax <> 0) then begin
    if (FClientPortMin > FClientPortMax) then begin
      raise EIdInvalidPortRange.CreateFmt(RSInvalidPortRange
       , [FClientPortMin, FClientPortMax]);
    end else if not BindPortReserved then begin
      raise EIdCanNotBindPortInRange.CreateFmt(RSCanNotBindRange
       , [FClientPortMin, FClientPortMax]);
    end;
  end else if not TryBind then begin
    raise EIdCouldNotBindSocket.Create(RSCouldNotBindSocket);
  end;
end;

procedure TIdSocketHandle.SetPeer(const AIP: string; const APort: TIdPort);
begin
  FPeerIP := AIP;
  FPeerPort := APort;
end;

procedure TIdSocketHandle.SetBinding(const AIP: string; const APort: TIdPort);
begin
  FIP := AIP;
  FPort := APort;
end;

procedure TIdSocketHandle.SetOverLapped(const AValue:boolean);
begin
  // TODO: check for HandleAllocated
  FOverLapped := AValue;
end;

procedure TIdSocketHandle.Listen(const anQueueCount: integer);
begin
  GStack.Listen(Handle, anQueueCount);
end;

function TIdSocketHandle.Accept(ASocket: TIdStackSocketHandle): Boolean;
var
  LAcceptedSocket: TIdStackSocketHandle;
begin
  Reset;
  LAcceptedSocket := GStack.Accept(ASocket, FIP, FPort, FIPVersion);
  result := (LAcceptedSocket <> Id_INVALID_SOCKET);
  if result then begin
    SetHandle(LAcceptedSocket);
    // UpdateBindingLocal is necessary as it may be listening on multiple IPs/Ports
    UpdateBindingLocal;
    UpdateBindingPeer;
  end;
end;

constructor TIdSocketHandle.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  Reset;
  FClientPortMin := 0;
  FClientPortMax := 0;
  if Assigned(ACollection) then begin
    Port := TIdSocketHandles(ACollection).DefaultPort;
  end;
end;

function TIdSocketHandle.Readable(AMSec: Integer = IdTimeoutDefault): Boolean;

  function CheckIsReadable(AMSec: Integer): Boolean;
  begin
    if HandleAllocated then begin
      Result := Select(AMSec);
    end else begin
      raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
    end;
  end;

begin
  if TIdAntiFreezeBase.ShouldUse then begin
    if AMSec = IdTimeoutInfinite then begin
      repeat
        Result := CheckIsReadable(GAntiFreeze.IdleTimeOut);
      until Result;
      Exit;
    end else if AMSec > GAntiFreeze.IdleTimeOut then begin
      Result := CheckIsReadable(AMSec - GAntiFreeze.IdleTimeOut);
      if Result then begin
        Exit;
      end;
      AMSec := GAntiFreeze.IdleTimeOut;
    end;
  end;
  Result := CheckIsReadable(AMSec);
end;

procedure TIdSocketHandle.Assign(Source: TPersistent);
var
  LSource: TIdSocketHandle;
begin
  if ClassType <> Source.ClassType then begin
    inherited
  end else begin
    LSource := TIdSocketHandle(Source);
    FIP := LSource.FIP;
    Port := LSource.Port;
    FPeerIP := LSource.FPeerIP;
    FPeerPort := LSource.FPeerPort;
    FIPVersion := LSource.IPVersion;
  end;
end;

procedure TIdSocketHandle.UpdateBindingLocal;
begin
  GStack.GetSocketName(Handle, FIP, FPort);
end;

procedure TIdSocketHandle.UpdateBindingPeer;
begin
  GStack.GetPeerName(Handle, FPeerIP, FPeerPort);
end;

procedure TIdSocketHandle.Reset(const AResetLocal: boolean = True);
begin
  SetHandle(Id_INVALID_SOCKET);
  if AResetLocal then begin
    FIP := '';
    FPort := 0;
  end;
  FPeerIP := '';
  FPeerPort := 0;
  FIPVersion := ID_DEFAULT_IP_VERSION ;
end;

function TIdSocketHandle.TryBind: Boolean;
begin
  try
    GStack.Bind(Handle, FIP, Port, FIPVersion);
    Result := True;
    UpdateBindingLocal;
  except
    Result := False;
  end;
end;

function TIdSocketHandle.BindPortReserved: Boolean;
var
  i : Integer;
begin
  Result := false;
  for i := FClientPortMax downto FClientPortMin do begin
    FPort := i;
    if TryBind then begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure TIdSocketHandle.GetSockOpt(ALevel:TIdSocketOptionLevel; AOptName: TIdSocketOption; out VOptVal: Integer);
begin
  GStack.GetSocketOption(Handle,ALevel,AOptName,VOptVal);
end;

function TIdSocketHandle.Select(ATimeOut: Integer = IdTimeoutInfinite): Boolean;
begin
  Result := FReadSocketList.SelectRead(ATimeOut);
  TIdAntiFreezeBase.DoProcess(Result = False);
end;

procedure TIdSocketHandle.SetHandle(AHandle: TIdStackSocketHandle);
begin
  FHandle := AHandle;
  FHandleAllocated := Handle <> Id_INVALID_SOCKET;
  FreeAndNil(FReadSocketList);
  if HandleAllocated then begin
    FReadSocketList := TIdSocketList.CreateSocketList;
    FReadSocketList.Add(Handle);
  end;
end;

procedure TIdSocketHandle.SetIPVersion(const Value: TIdIPVersion);
begin
  if Value <> FIPVersion then begin
    if HandleAllocated then begin
      raise EIdCannotSetIPVersionWhenConnected.Create(RSCannotSetIPVersionWhenConnected);
    end;
    FIPVersion := Value;
  end;
end;

{ TIdSocketHandles }

function TIdSocketHandles.Add: TIdSocketHandle;
begin
  Result := inherited Add as TIdSocketHandle;
  Result.Port := DefaultPort;
end;

function TIdSocketHandles.BindingByHandle(const AHandle: TIdStackSocketHandle): TIdSocketHandle;
var
  i: integer;
begin
  Result := nil;
  i := Count - 1;
  while (i >= 0) and (Items[i].Handle <> AHandle) do begin
    dec(i);
  end;
  if i >= 0 then begin
    Result := Items[i];
  end;
end;

constructor TIdSocketHandles.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TIdSocketHandle);
end;

function TIdSocketHandles.GetItem(Index: Integer): TIdSocketHandle;
begin
  Result := TIdSocketHandle(inherited Items[index]);
end;

procedure TIdSocketHandles.SetItem(Index: Integer; const Value: TIdSocketHandle);
begin
  inherited SetItem(Index, Value);
end;

end.