WhoIs, Демо получения информации с WhoIs сервера

////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Project Name : WhoIs
// * Unit Name : uMain
// * Purpose : Демонстрационный пример получения информации с WhoIs сервера.
// * Author : Александр (Rouse_) Багель
// * Version : 1.00
// ****************************************************************************
//
unit uMain;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, Winsock;
type
 TfrmMain = class(TForm)
 edServer: TLabeledEdit;
 edRecipient: TLabeledEdit;
 GroupBox1: TGroupBox;
 memReport: TMemo;
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 end;
var
 frmMain: TfrmMain;
implementation
{$R *.dfm}
function WhoIs(Server, Query: String; Timeout: Integer;
 var Response: TStringList): Boolean;
const
 MAXBLOCKSIZE = 1024;
var
 WSAData: TWSAData;
 hSocket: TSocket;
 Addr_in: sockaddr_in;
 Host: PHostEnt;
 InAddr, NoBlock: u_long;
 FDSet: TFDSet;
 Time: timeval;
 Buff: array [0..MAXBLOCKSIZE - 1] of Char;
 RecvCount: Integer;
begin
 // инициализируем WinSock
 Result := WSAStartup(MakeWord(1, 0), WSAData) = NOERROR;
 if not Result then Exit;
 try
 // создаем сокет
 hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
 if hSocket = INVALID_SOCKET then
 begin
 Result := False;
 Exit;
 end;
 try
 // Определяем, что ввел пользователь имя хоста или его адрес
 InAddr := inet_addr(PChar(Server));
 if InAddr = INADDR_NONE then
 begin
 Host := gethostbyname(PChar(Server));
 if not Assigned(Host) then
 begin
 Result := False;
 Exit;
 end;
 InAddr := PInAddr(Host.h_addr_list^)^.S_addr;
 end;
 // Подготавливаем структуру для соединения
 FillChar(Addr_in, SizeOf(sockaddr_in), 0);
 Addr_in.sin_addr.S_addr := InAddr;
 Addr_in.sin_family := AF_INET;
 Addr_in.sin_port := htons(IPPORT_WHOIS);
 // Устанавливаем интервалы таймаута
 setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @Timeout, SizeOf(Integer));
 setsockopt(hSocket, SOL_SOCKET, SO_SNDTIMEO, @Timeout, SizeOf(Integer));
 // Соединение с сервером - довольно долгий процесс, поэтому мы поступим по
 // хитрому - а именно переводим сокет в неблокирующий режим
 NoBlock := 1;
 ioctlsocket(hSocket, FIONBIO, NoBlock);
 // соединяемся
 if connect(hSocket, Addr_in, SizeOf(sockaddr_in)) = SOCKET_ERROR then
 case WSAGetLastError of
 // Обычно при неблокирующем соединении выдается вот эта ошибка
 // на попытку соединения, поэтому мы будем ждать окончания
 // соединения через select
 WSAEWOULDBLOCK:
 begin
 FD_ZERO(FDSet);
 FD_SET(hSocket, FDSet);
 Time.tv_sec := Timeout div 1000;
 Time.tv_usec := Timeout;
 if select(0, nil, @FDSet, nil, @Time) <> 1 then
 begin
 Result := False;
 Exit;
 end;
 end;
 else
 begin
 Result := False;
 Exit;
 end;
 end;
 // Соединились - теперь неблокирующий режим нам не нужен
 // Возвращаем все как было
 NoBlock := 0;
 ioctlsocket(hSocket, FIONBIO, NoBlock);
 // Обязательно проверяем чтобы в конце запроса стояло #13#10
 Query := Query + sLineBreak;
 // И отправляем запрос серверу
 if Send(hSocket, Query[1], Length(Query), 0) = SOCKET_ERROR then
 begin
 Result := False;
 Exit;
 end;
 // Запрос отправлен - начинаем читать данные пока не кончатся
 RecvCount := 1;
 while RecvCount > 0 do
 begin
 RecvCount := recv(hSocket, Buff, MAXBLOCKSIZE, 0);
 Response.Text := Response.Text + String(Buff);
 end;
 finally
 // Завершаем установленную сессию
 shutdown(hSocket, SD_BOTH);
 // Закрываем сокет
 closesocket(hSocket);
 end;
 finally
 // Деинициализируем WinSock
 WSACleanup;
 end;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
var
 S: TStringList;
begin
 S := TStringList.Create;
 try
 // edServer.Text = whois.alldomains.com
 // edRecipient.Text = borland.com
 WhoIs(edServer.Text, edRecipient.Text, 10000, S);
 memReport.Lines.Assign(S);
 finally
 S.Free;
 end;
end;
end.
Author: Rouse_
Source: http://forum.sources.ru
ID: 03390
Category:Связь