на сокетах простой пример
Код:
program head;
{$APPTYPE CONSOLE}
uses windows, winsock;
var s:TSocket;
initExit:BOOL=false;
httpQuery:array[0..20]of char='HEAD / HTTP/1.0'#13#10#13#10#13#10;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//вывод текста описания ошибки и выход
procedure error(const ansiStr:string;ErrorCode:integer;bQuit:BOOL);
var Buffer: array[0..1023] of Char;
begin
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
SizeOf(Buffer), nil);
CharToOem(@Buffer, @Buffer);
write(ansiStr,'(',ErrorCode,') ',pChar(@Buffer));
if bQuit then halt(1);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Вызывается при закрытии консоли клиента
function ClientConsoleEvent(dwCtrlType:cardinal):BOOL;stdcall;
begin
initExit:=true;
shutdown(s,SD_SEND OR SD_RECEIVE);
closesocket(s);
ClientConsoleEvent:=true;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Узнать IP по имени хоста
function GetIpFromName(szServerName:pChar):TInAddr;
type TaPInAddr = array [0..0] of PinAddr;
PaPInAddr = ^TaPInAddr;
var phe: PHostEnt;
pptr: PaPInAddr;
begin
GetIpFromName.S_addr:=0;
phe := GetHostByName(szServerName);
if phe = nil then exit;
pptr := PaPInAddr(phe^.h_addr_list);
GetIpFromName:=pptr^[0]^;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Основная процедура клиента
procedure NetClient(const DestAddr:string;wPort:word);
var RemoteAddr:TSockAddr;
buf:array[0..1023]of char;
dwLen,hOut,beWritten:cardinal;
ip:TInAddr;
sPort:string;
begin
ip:=GetIpFromName(pChar(DestAddr));
if ip.S_addr=0 then
error('# error at gethostbyname: ',WSAGetLastError,TRUE);
fillchar(RemoteAddr, sizeof(RemoteAddr), 0);
RemoteAddr.sin_family:=AF_INET;
RemoteAddr.sin_port:=htons(wPort);
RemoteAddr.sin_addr:=ip;
str(wPort,sPort);
writeln('# host: ',DestAddr);
writeln('# ip : ',inet_ntoa(ip));
writeln('# port: ',wPort);
s:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if s=INVALID_SOCKET then
error('# error at socket: ',WSAGetLastError,true);
SetConsoleCtrlHandler(@ClientConsoleEvent, TRUE);
writeln('# connect...');
if connect(s,RemoteAddr,sizeof(TSockAddr))<>0 then begin
if not initExit then
error('# error at connect: ',WSAGetLastError,false);
closesocket(s);
exit;
end;
writeln('# success');
send(s,httpQuery,sizeof(httpQuery),0);
hOut:=GetStdHandle(STD_OUTPUT_HANDLE);
while true do begin
dwLen:=recv(s,buf,sizeof(buf),0);
if (dwLen=cardinal(-1)) OR (dwLen=0) then begin
if (not initExit)AND(dwLen=cardinal(-1)) then
error('# error at recv: ',WSAGetLastError,false);
if not initExit then closesocket(s);
exit;
end;
WriteFile(hOut,buf,dwLen,beWritten,nil);
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
var code:integer;
wPort:word;
InitData:TWSAData;
BEGIN
if (ParamCount=0)OR(ParamCount>2) then begin
writeln('Usage: head.exe host [port]');
halt(0);
end;
if ParamCount=1 then wPort:=80
else val(ParamStr(2),wPort,code);
if WSAStartup(MakeWord(2,2),InitData)<>0 then
error('# error at WSAStartup: ',WSAGetLastError,true);
NetClient(ParamStr(1),wPort);
WSACleanup;
END.
|
