| Код |
////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Project Name : WhoIs
// * Unit Name : uMain
// * Purpose : Демонстрационный пример получения информации с WhoIs сервера.
// * Author : Александр (Rouse_) Багель
// * Version : 1.00
// ****************************************************************************
//
// Особая благодарность TrefptYc и группе Машина Времени,
// за оказанную моральную поддержку, в процессе написания данного примера :)
//
unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Winsock, XPMan;
type
TfrmMain = class(TForm)
edServer: TLabeledEdit;
edRecipient: TLabeledEdit;
GroupBox1: TGroupBox;
memReport: TMemo;
Button1: TButton;
XPManifest1: TXPManifest;
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.internic.net
// edRecipient.Text = borland.com
WhoIs(edServer.Text, edRecipient.Text, 10000, S);
memReport.Lines.Assign(S);
finally
S.Free;
end;
end;
end.
|
Целиком забирай тут: http://rouse.front.ru/whois.zip |
