idstacklinux.pas

photo.163.com 相册下载器 多线程下载

  Result := String(PChar(Result));
end;

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

function TIdStackLinux.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  const ABufferLength, AFlags: Integer): Integer;
begin
  //IdStackWindows is just: Result := Recv(ASocket, ABuffer, ABufferLength, AFlags);
  Result := Recv(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL);
end;

function TIdStackLinux.RecvFrom(const ASocket: TIdStackSocketHandle;
  var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  var VPort: Integer; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION ): Integer;
var
  LiSize: Cardinal;
  LAddr6: sockaddr_in6;
begin
  case AIPVersion of
    Id_IPv4,
    Id_IPv6: begin
      LiSize := SizeOf(LAddr6);
      Result := Libc.RecvFrom(ASocket, VBuffer, ALength, AFlags or Id_MSG_NOSIGNAL, PSockAddr(@LAddr6), @LiSize);
      VIP := TranslateTInAddrToString(LAddr6.sin6_addr, AIPVersion);
      VPort := NToHs(LAddr6.sin6_port);
    end;
    else begin
      Result := 0;
      IPVersionUnsupported;
    end;
  end;
end;

function TIdStackLinux.WSSend(ASocket: TIdStackSocketHandle;
  const ABuffer; const ABufferLength, AFlags: Integer): Integer;
begin
  //CC: Should Id_MSG_NOSIGNAL be included?
  //  Result := Send(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL);
  Result := CheckForSocketError(Libc.send(ASocket, ABuffer, ABufferLength, AFlags));
end;

procedure TIdStackLinux.WSSendTo(ASocket: TIdStackSocketHandle;
  const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
  const APort: Integer; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
var
  LAddr6: SockAddr_in6;
  LBytesOut: integer;
begin
  case AIPVersion of
    Id_IPv4, Id_IPv6:
      begin
        FillChar(LAddr6, SizeOf(LAddr6), 0);
        with LAddr6 do begin
          sin6_family := IdIPFamily[AIPVersion];
          TranslateStringToTInAddr(AIP, sin6_addr, AIPVersion);
          sin6_port := HToNs(APort);
        end;
        LBytesOut := Libc.SendTo(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL, Psockaddr(@LAddr6)^, SizeOf(LAddr6));
      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 TIdStackLinux.SetSocketOption(ASocket: TIdStackSocketHandle;
  ALevel:TIdSocketProtocol; AOptName: TIdSocketOption; AOptVal: Integer);
begin
  CheckForSocketError(SetSockOpt(ASocket, ALevel, AOptName, PChar(@AOptVal), SizeOf(AOptVal)));
end;

procedure TIdStackLinux.SetSocketOption(
  const ASocket: TIdStackSocketHandle; const Alevel, Aoptname: Integer;
  Aoptval: PChar; const Aoptlen: Integer);
begin
  CheckForSocketError( setsockopt(ASocket,ALevel,Aoptname,Aoptval,Aoptlen ));
end;

function TIdStackLinux.WSGetLastError: Integer;
begin
  //IdStackWindows just uses   result := WSAGetLastError;
  Result := System.GetLastError;
  if Result = Id_WSAEPIPE then begin
    Result := Id_WSAECONNRESET;
  end;
end;

function TIdStackLinux.WSSocket(AFamily, AStruct, AProtocol: Integer;
     const AOverlapped: Boolean = False): TIdStackSocketHandle; 
begin
  Result := Libc.socket(AFamily, AStruct, AProtocol);
end;

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

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

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

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

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

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

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

{ RP - I'm not sure what endian Linux natively uses, thus the
check to see if the bytes need swapping or not ... }
function TIdStackLinux.HostToNetwork(AValue: Int64): Int64;
var
  LParts: TIdInt64Parts;
  L: LongWord;
begin
  LParts.QuadPart := AValue;
  L := HToNL(LParts.HighPart);
  if (L <> LParts.HighPart) then begin
    LParts.HighPart := HToNL(LParts.LowPart);
    LParts.LowPart := L;
  end;
  Result := LParts.QuadPart;
end;

function TIdStackLinux.NetworkToHost(AValue: Int64): Int64;
var
  LParts: TIdInt64Parts;
  L: LongWord;
begin
  LParts.QuadPart := AValue;
  L := NToHL(LParts.HighPart);
  if (L <> LParts.HighPart) then begin
    LParts.HighPart := NToHL(LParts.LowPart);
    LParts.LowPart := L;
  end;
  Result := LParts.QuadPart;
end;

procedure TIdStackLinux.PopulateLocalAddresses;
type
  TaPInAddr = Array[0..250] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  Li: Integer;
  LAHost: PHostEnt;
  LPAdrPtr: PaPInAddr;
begin
  // this won't get IPv6 addresses as I didn't find a way
  // to enumerate IPv6 addresses on a linux machine
  FLocalAddresses.Clear;
  LAHost := GetHostByName(PChar(HostName));
  if LAHost = nil then begin
    CheckForSocketError(SOCKET_ERROR);
  end else begin
    LPAdrPtr := PAPInAddr(LAHost^.h_addr_list);
    Li := 0;
    while LPAdrPtr^[Li] <> nil do begin
      FLocalAddresses.Add(TranslateTInAddrToString(LPAdrPtr^[Li]^, Id_IPv4));
      Inc(Li);
    end;
  end;
end;

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

function TIdStackLinux.HostByAddress(const AAddress: string;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
var
  LHints: TAddressInfo;
  LAddrInfo: PAddressInfo;
  LRetVal: integer;
begin
  case AIPVersion of
    Id_IPv6, Id_IPv4: begin
      FillChar(LHints,sizeof(LHints), 0);
      LHints.ai_family := IdIPFamily[AIPVersion];
      LHints.ai_socktype := Integer(SOCK_STREAM);
      LHints.ai_flags := AI_CANONNAME + AI_NUMERICHOST;
      LAddrInfo:=nil;
      LRetVal := getaddrinfo(pchar(AAddress), nil, @LHints, LAddrInfo);
      if LRetVal<>0 then begin
        if LRetVal = EAI_SYSTEM then begin
          RaiseLastOSError;
        end else begin
          raise EIdReverseResolveError.CreateFmt(RSReverseResolveError, [AAddress, gai_strerror(LRetVal), LRetVal]);
        end;
      end else begin
        result := LAddrInfo^.ai_canonname;
        freeaddrinfo(LAddrInfo);
      end;
    end;
(* JMB: I left this in here just in case someone
        complains, but the other code works on all
        linux systems for all addresses and is thread-safe

variables for it:
  Host: PHostEnt;
  LAddr: u_long;

    Id_IPv4: begin
      // GetHostByAddr is thread-safe in Linux.
      // It might not be safe in Solaris or BSD Unix
      LAddr := inet_addr(PChar(AAddress));
      Host := GetHostByAddr(@LAddr,SizeOf(LAddr),AF_INET);
      if (Host <> nil) then begin
        Result := Host^.h_name;
      end else begin
        RaiseSocketError(h_errno);
      end;
    end;
*)
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

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

procedure TIdStackLinux.Disconnect(ASocket: TIdStackSocketHandle);
begin
  // Windows uses Id_SD_Send, Linux should use Id_SD_Both
  WSShutdown(ASocket, Id_SD_Both);
  // SO_LINGER is false - socket may take a little while to actually close after this
  WSCloseSocket(ASocket);
end;

procedure TIdStackLinux.GetPeerName(ASocket: TIdStackSocketHandle;
 var VIP: string; var VPort: Integer);
var
  i: Cardinal;
  LAddr6: sockaddr_in6;
begin
  i := SizeOf(LAddr6);
  CheckForSocketError(Libc.GetPeerName(ASocket, Psockaddr(@LAddr6)^, i));
  case LAddr6.sin6_family of
    Id_PF_INET4: begin
      VIP := TranslateTInAddrToString(Psockaddr(@LAddr6)^.sin_addr, Id_IPv4);
      VPort := Ntohs(Psockaddr(@LAddr6)^.sin_port);
    end;
    Id_PF_INET6: begin
      VIP := TranslateTInAddrToString(LAddr6.sin6_addr, Id_IPv6);
      VPort := Ntohs(LAddr6.sin6_port);
    end;
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

procedure TIdStackLinux.GetSocketName(ASocket: TIdStackSocketHandle;
 var VIP: string; var VPort: Integer);
var
  i: Cardinal;