idstackwindows.pas

网络控件适用于Delphi6

      if length(AIP) = 0 then begin
        FillChar(Addr6.sin6_addr, 16, 0);
      end else begin
        TranslateStringToTInAddr(AIP, Addr6.sin6_addr, Id_IPv6);
      end;
      Addr6.sin6_port := HToNs(APort);
      CheckForSocketError(IdWinsock2.Bind(ASocket, psockaddr(@addr6), SizeOf(Addr6)));
    end;
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

function TIdStackWindows.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
begin
  result := CloseSocket(ASocket);
end;

function TIdStackWindows.HostByAddress(const AAddress: string;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
var
  Host: PHostEnt;
  LAddr: u_long;

  Hints:TAddrInfo;
  AddrInfo:pAddrInfo;
  RetVal:integer;
begin
  case AIPVersion of
    Id_IPv4: begin
      LAddr := inet_addr(PChar(AAddress));
      Host := GetHostByAddr(@LAddr, SizeOf(LAddr), AF_INET);
      if Host = nil then begin
        CheckForSocketError(SOCKET_ERROR);
      end else begin
        result := Host^.h_name;
      end;
    end;
    Id_IPv6: begin
      if not IdIPv6Available then raise EIdIPv6Unavailable.Create(RSIPv6Unavailable);
      FillChar(Hints,sizeof(Hints), 0);
      Hints.ai_family := IdIPFamily[AIPVersion];
      Hints.ai_socktype := Integer(SOCK_STREAM);
      Hints.ai_flags := AI_CANONNAME;
      AddrInfo:=nil;
      RetVal := getaddrinfo(pchar(AAddress), nil, @Hints, @AddrInfo);
      try
        if RetVal<>0 then
          RaiseSocketError(gaiErrorToWsaError(RetVal))
        else begin
          setlength(result,NI_MAXHOST);
          getnameinfo(AddrInfo.ai_addr,AddrInfo.ai_addrlen,pointer(result),NI_MAXHOST, nil,0,NI_NAMEREQD);
          result:=pchar(result);
        end;
      finally
        FreeAddrInfo(AddrInfo);
      end;
    end else begin
      IPVersionUnsupported;
    end;
  end;
end;

function TIdStackWindows.ReadHostName: string;
begin
  SetLength(result, 250);
  GetHostName(PChar(result), Length(result));
  Result := String(PChar(result));
end;

procedure TIdStackWindows.Listen(ASocket: TIdStackSocketHandle;
  ABackLog: Integer);
begin
  CheckForSocketError(IdWinsock2.Listen(ASocket, ABacklog));
end;

function TIdStackWindows.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  const ABufferLength, AFlags: Integer) : Integer;
begin
  Result := Recv(ASocket, ABuffer, ABufferLength, AFlags);
end;

function TIdStackWindows.RecvFrom(const ASocket: TIdStackSocketHandle;
  var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  var VPort: Integer; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION ): Integer;
var
  iSize: integer;
  Addr4: TSockAddrIn;
  Addr6: TSockAddrIn6;
begin
  case AIPVersion of
    Id_IPv4: begin
      iSize := SizeOf(Addr4);
      Result := IdWinsock2.RecvFrom(ASocket, VBuffer, ALength, AFlags, @Addr4, @iSize);
      VIP :=  TranslateTInAddrToString(Addr4.sin_addr,Id_IPv4);
      VPort := NToHs(Addr4.sin_port);
    end;
    Id_IPv6: begin
      iSize := SizeOf(Addr6);
      Result := IdWinsock2.RecvFrom(ASocket, VBuffer, ALength, AFlags, PSockAddr(@Addr6), @iSize);
      VIP := TranslateTInAddrToString(Addr6.sin6_addr, Id_IPv6);
      VPort := NToHs(Addr6.sin6_port);
    end;
    else begin
      Result := 0; // avoid warning
      IPVersionUnsupported;
    end;
  end;
end;

function TIdStackWindows.WSSend(ASocket: TIdStackSocketHandle;
  const ABuffer; const ABufferLength, AFlags: Integer): Integer;
begin
  Result := CheckForSocketError(IdWinsock2.Send(ASocket, ABuffer, ABufferLength
   , AFlags));
end;

procedure TIdStackWindows.WSSendTo(ASocket: TIdStackSocketHandle;
  const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
  const APort: integer; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
var
  Addr4: TSockAddrIn;
  Addr6: TSockAddrIn6;
  LBytesOut: integer;
begin
  case AIPVersion of
    Id_IPv4: begin
      FillChar(Addr4, SizeOf(Addr4), 0);
      with Addr4 do begin
        sin_family := Id_PF_INET4;
       TranslateStringToTInAddr(AIP, sin_addr, Id_IPv4);
       //TODO:  Renable when IPv6 is available
     //   TranslateStringToTInAddr(AIP, sin_addr, Id_IPv4);
        sin_port := HToNs(APort);
      end;
      LBytesOut := IdWinsock2.SendTo(ASocket, ABuffer, ABufferLength, AFlags, @Addr4, SizeOf(Addr4));
    end;
    Id_IPv6: begin
      FillChar(Addr6, SizeOf(Addr6), 0);
      with Addr6 do
      begin
        sin6_family := Id_PF_INET6;
        TranslateStringToTInAddr(AIP, sin6_addr, Id_IPv6);
        sin6_port := HToNs(APort);
      end;
      LBytesOut := IdWinsock2.SendTo(ASocket, ABuffer, ABufferLength, AFlags, PSockAddr(@Addr6), SizeOf(Addr6));
    end;
    else begin
      LBytesOut := 0; // avoid warning
      IPVersionUnsupported;
    end;
  end;
  if LBytesOut = Id_SOCKET_ERROR then begin
    if WSGetLastError() = Id_WSAEMSGSIZE then begin
      raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig);
    end else begin
      RaiseLastSocketError;
    end;
  end else if LBytesOut <> ABufferLength then begin
    raise EIdNotAllBytesSent.Create(RSNotAllBytesSent);
  end;
end;

procedure TIdStackWindows.SetSocketOption(ASocket: TIdStackSocketHandle;
  ALevel:TIdSocketProtocol; AOptName: TIdSocketOption; AOptVal: Integer);
begin
  CheckForSocketError(SetSockOpt(ASocket, ALevel, AOptName, PChar(@AOptVal), SizeOf(AOptVal)));
end;

function TIdStackWindows.GetLocalAddresses: TIdStrings;
begin
  if FLocalAddresses = nil then
  begin
    FLocalAddresses := TIdStringList.Create;
  end;
  PopulateLocalAddresses;
  Result := FLocalAddresses;
end;

function TIdStackWindows.WSGetLastError: Integer;
begin
  result := WSAGetLastError;
end;

function TIdStackWindows.WSSocket(AFamily, AStruct, AProtocol: Integer;
 const AOverlapped: Boolean = False): TIdStackSocketHandle;
begin
  if AOverlapped then begin
    Result := WSASocket(AFamily, AStruct, AProtocol,nil,0,WSA_FLAG_OVERLAPPED);
  end else begin
    Result := IdWinsock2.Socket(AFamily, AStruct, AProtocol);
  end;
end;

function TIdStackWindows.WSGetServByName(const AServiceName: string): Integer;
var
  ps: PServEnt;
begin
  ps := GetServByName(PChar(AServiceName), nil);
  if ps <> nil then begin
    Result := Ntohs(ps^.s_port);
  end else begin
    try
      Result := StrToInt(AServiceName);
    except
      on EConvertError do begin
        raise EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]);
      end;
    end;
  end;
end;

function TIdStackWindows.WSGetServByPort(
  const APortNumber: Integer): TIdStrings;
var
  ps: PServEnt;
  i: integer;
  p: array of PChar;
begin
  Result := TIdStringList.Create;
  p := nil;
  try
    ps := GetServByPort(HToNs(APortNumber), nil);
    if ps <> nil then
    begin
      Result.Add(ps^.s_name);
      i := 0;
      p := pointer(ps^.s_aliases);
      while p[i] <> nil do
      begin
        Result.Add(PChar(p[i]));
        inc(i);
      end;
    end;
  except
    Result.Free;
  end;
end;

function TIdStackWindows.HostToNetwork(AValue: Word): Word;
begin
  Result := HToNs(AValue);
end;

function TIdStackWindows.NetworkToHost(AValue: Word): Word;
begin
  Result := NToHs(AValue);
end;

function TIdStackWindows.HostToNetwork(AValue: LongWord): LongWord;
begin
  Result := HToNL(AValue);
end;

function TIdStackWindows.NetworkToHost(AValue: LongWord): LongWord;
begin
  Result := NToHL(AValue);
end;

function TIdStackWindows.HostToNetwork(AValue: Int64): Int64;
var
  LParts: TIdInt64Parts;
  L: LongWord;
begin
  LParts.QuadPart := AValue;
  L := HToNL(LParts.HighPart);
  LParts.HighPart := HToNL(LParts.LowPart);
  LParts.LowPart := L;
  Result := LParts.QuadPart;
end;

function TIdStackWindows.NetworkToHost(AValue: Int64): Int64;
var
  LParts: TIdInt64Parts;
  L: LongWord;
begin
  LParts.QuadPart := AValue;
  L := NToHL(LParts.HighPart);
  LParts.HighPart := NToHL(LParts.LowPart);
  LParts.LowPart := L;
  Result := LParts.QuadPart;
end;

procedure TIdStackWindows.PopulateLocalAddresses;
type
  TaPInAddr = Array[0..250] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  i: integer;
  AHost: PHostEnt;
  PAdrPtr: PaPInAddr;
begin
  FLocalAddresses.Clear ;
  AHost := GetHostByName(PChar(HostName));
  if AHost = nil then begin
    CheckForSocketError(SOCKET_ERROR);
  end else begin
    PAdrPtr := PAPInAddr(AHost^.h_address_list);
    i := 0;
    while PAdrPtr^[i] <> nil do begin

      FLocalAddresses.Add(TranslateTInAddrToString(PAdrPtr^[I]^,Id_IPv4)); //BGO FIX
      Inc(I);
    end;
  end;
end;

function TIdStackWindows.GetLocalAddress: string;
begin
  Result := LocalAddresses[0];
end;

{ TIdStackVersionWinsock }

function ServeFile(ASocket: TIdStackSocketHandle; AFileName: string): cardinal;
var
  LFileHandle: THandle;
begin
  result := 0;
  LFileHandle := CreateFile(PChar(AFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING
   , FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0); try
    if TransmitFile(ASocket, LFileHandle, 0, 0, nil, nil, 0) then begin
      result := getFileSize(LFileHandle, nil);
    end;
  finally CloseHandle(LFileHandle); end;
end;

function TIdStackWindows.WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer;
begin
  result := Shutdown(ASocket, AHow);
end;

procedure TIdStackWindows.GetSocketName(ASocket: TIdStackSocketHandle;
 var VIP: string; var VPort: Integer);
var
  i: Integer;
  LAddr: TSockAddrIn6;
begin
  i := SizeOf(LAddr);
  CheckForSocketError(GetSockName(ASocket, PSockAddr(Pointer(@LAddr)), i));
  case LAddr.sin6_family of
    Id_PF_INET4: begin
      VIP := TranslateTInAddrToString(TSockAddr(Pointer(@LAddr)^).sin_addr,Id_IPv4);
      VPort := Ntohs(TSockAddr(Pointer(@LAddr)^).sin_port);
    end;
    Id_PF_INET6: begin
      VIP := TranslateTInAddrToString(LAddr.sin6_addr, Id_IPv6);
      VPort := Ntohs(LAddr.sin6_port);
    end;
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

procedure TIdStackWindows.WSGetSockOpt(ASocket: TIdStackSocketHandle; Alevel, AOptname: Integer; AOptval: PChar; var AOptlen: Integer);
begin
  CheckForSocketError(GetSockOpt(ASocket, ALevel, AOptname, AOptval, AOptlen));
end;

{ TIdSocketListWindows }

procedure TIdSocketListWindows.Add(AHandle: TIdStackSocketHandle);