idstackwindows.pas

Indy控件的使用源代码

begin
  FillChar(FDRead, SizeOf(FDRead), 0);
  FillChar(FDWrite, SizeOf(FDWrite), 0);
  FillChar(FDError, SizeOf(FDError), 0);
  SetFDSet(ARead, FDRead);
  SetFDSet(AWrite, FDWrite);
  SetFDSet(AErrors, FDError);
  if ATimeout = IdTimeoutInfinite then begin
    Result := Select(0, @FDRead, @FDWrite, @FDError, nil);
  end else begin
    tmTo.tv_sec := ATimeout div 1000;
    tmTo.tv_usec := (ATimeout mod 1000) * 1000;
    Result := Select(0, @FDRead, @FDWrite, @FDError, @tmTO);
  end;
  GetFDSet(ARead, FDRead);
  GetFDSet(AWrite, FDWrite);
  GetFDSet(AErrors, FDError);
end;

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

function TIdStackWindows.WSSendTo(ASocket: TIdStackSocketHandle;
  var ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
  const APort: integer): Integer;
var
  Addr: TSockAddrIn;
begin
  FillChar(Addr, SizeOf(Addr), 0);
  with Addr do
  begin
    sin_family := Id_PF_INET;
    sin_addr := TInAddr(StringToTInAddr(AIP));
    sin_port := HToNs(APort);
  end;
  result := SendTo(ASocket, ABuffer, ABufferLength, AFlags, @Addr, SizeOf(Addr));
end;

function TIdStackWindows.WSSetSockOpt(ASocket: TIdStackSocketHandle;
  ALevel, AOptName: Integer; AOptVal: PChar; AOptLen: Integer): Integer;
begin
  result := SetSockOpt(ASocket, ALevel, AOptName, AOptVal, AOptLen);
end;

function TIdStackWindows.WSGetLocalAddresses: TStrings;
begin
  if FLocalAddresses = nil then
  begin
    FLocalAddresses := TStringList.Create;
  end;
  PopulateLocalAddresses;
  Result := FLocalAddresses;
end;

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

function TIdStackWindows.WSSocket(AFamily, AStruct, AProtocol: Integer): TIdStackSocketHandle;
begin
  result := Socket(AFamily, AStruct, AProtocol);
end;

function TIdStackWindows.WSHToNs(AHostShort: Word): Word;
begin
  result := HToNs(AHostShort);
end;

function TIdStackWindows.WSNToHs(ANetShort: Word): Word;
begin
  result := NToHs(ANetShort);
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 raise EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]);
    end;
  end;
end;

function TIdStackWindows.WSGetServByPort(
  const APortNumber: Integer): TStrings;
var
  ps: PServEnt;
  i: integer;
  p: array of PChar;
begin
  Result := TStringList.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.WSHToNL(AHostLong: LongWord): LongWord;
begin
  Result := HToNL(AHostLong);
end;

function TIdStackWindows.WSNToHL(ANetLong: LongWord): LongWord;
begin
  Result := NToHL(ANetLong);
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(WSGetHostName));
  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(TInAddrToString(PAdrPtr^[I]^));
      Inc(I);
    end;
  end;
end;

function TIdStackWindows.WSGetLocalAddress: 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;

procedure TIdStackWindows.TranslateStringToTInAddr(AIP: string; var AInAddr);
begin
  with TInAddr(AInAddr).S_un_b do
  begin
    if not GetIPInfo(AIP, @s_b1, @s_b2, @s_b3, @s_b4) then
    begin
      raise EIdInvalidIPAddress.CreateFmt(RSStackInvalidIP, [AIP]);
    end;
  end;
end;

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

procedure TIdStackWindows.WSGetPeerName(ASocket: TIdStackSocketHandle;
  var VFamily: Integer; var VIP: string; var VPort: Integer);
var
  i: Integer;
  LAddr: TSockAddrIn;
begin
  i := SizeOf(LAddr);
  CheckForSocketError(GetPeerName(ASocket, @LAddr, i));
  VFamily := LAddr.sin_family;
  VIP := TInAddrToString(LAddr.sin_addr);
  VPort := Ntohs(LAddr.sin_port);
end;

procedure TIdStackWindows.WSGetSockName(ASocket: TIdStackSocketHandle;
  var VFamily: Integer; var VIP: string; var VPort: Integer);
var
  i: Integer;
  LAddr: TSockAddrIn;
begin
  i := SizeOf(LAddr);
  CheckForSocketError(GetSockName(ASocket, @LAddr, i));
  VFamily := LAddr.sin_family;
  VIP := TInAddrToString(LAddr.sin_addr);
  VPort := Ntohs(LAddr.sin_port);
end;

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

{ TIdSocketListWindows }

procedure TIdSocketListWindows.Add(AHandle: TIdStackSocketHandle);
Begin
  if FFDSet.fd_count >= FD_SETSIZE then begin
    raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
  end;
  FFDSet.fd_array[FFDSet.fd_count] := AHandle;
  inc(FFDSet.fd_count);
End;//

function TIdSocketListWindows.Count: Integer;
Begin
  Result := FFDSet.fd_count;
End;

function TIdSocketListWindows.GetItem(AIndex: Integer): TIdStackSocketHandle;
Begin
  if (AIndex>=0) and (AIndex<FFDSet.fd_count) then begin
    Result := FFDSet.fd_array[AIndex];
  end else begin
    raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
  end;
End;//

procedure TIdSocketListWindows.Remove(AHandle: TIdStackSocketHandle);
var
  i: Integer;
Begin
  for i:=0 to FFDSet.fd_count-1 do begin
    if FFDSet.fd_array[i] = AHandle then begin
      dec(FFDSet.fd_count);
      FFDSet.fd_array[i] := FFDSet.fd_array[FFDSet.fd_count];
      FFDSet.fd_array[FFDSet.fd_count] := 0; //extra purity
      Break;
    end;//if found
  end;
End;//

function TIdStackWindows.WSTranslateSocketErrorMsg(const AErr: integer): string;
Begin
  case AErr of
    wsahost_not_found: Result := RSStackHOST_NOT_FOUND;
  else
    Result :=  inherited WSTranslateSocketErrorMsg(AErr);
    EXIT;
  end;
  Result := Format(RSStackError, [AErr, Result]);
End;//

initialization
  GSocketListClass := TIdSocketListWindows;
  // Check if we are running under windows NT
  if (SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT) then begin
    GServeFileProc := ServeFile;
  end;
finalization
  if GStarted then begin
    WSACleanup;
  end;
end.