(*@\\\0000000501*)
(*@/// destructor t_fingerd.Destroy; *)
destructor t_fingerd.Destroy;
begin
f_answer.Free;
inherited destroy;
end;
(*@\\\0000000301*)
(*@/// procedure t_fingerd.do_action; *)
procedure t_fingerd.do_action;
var
i: integer;
temp_socket: TSocket;
finger_info:TFingerInfo;
sockinfo: TSockAddr;
s: string;
begin
temp_socket:=f_socket;
self.f_socket:=accept_socket_in(f_socket,sockinfo);
f_eof:=false;
finger_info.address:=longint(sockinfo.Sin_addr);
s:=self.read_line(f_socket);
finger_info.request:=s;
finger_info.hostname:=''; (* NYI !!! *)
if assigned(f_fingerrequest) then
f_fingerrequest(self,finger_info);
for i:=0 to f_answer.count-1 do begin
self.write_s(f_socket,f_answer.strings[i]+#13#10);
end;
close_socket_linger(f_socket);
f_socket:=temp_socket;
end;
(*@\\\000000131B*)
(*@/// procedure t_fingerd.SetAnswer(Value: TStringList); *)
procedure t_fingerd.SetAnswer(Value: TStringList);
begin
if value=NIL then
f_answer.clear
else
f_answer.assign(value);
end;
(*@\\\0000000603*)
(*@/// procedure t_fingerd.WndProc(var Msg : TMessage); *)
procedure t_fingerd.WndProc(var Msg : TMessage);
begin
if msg.msg<>uwm_socketevent then
inherited wndproc(msg)
else begin
if msg.lparamhi=socket_error then
else begin
case msg.lparamlo of
fd_accept: begin
do_action;
end;
end;
end;
end;
end;
(*@\\\0000000E09*)
(*@/// procedure t_fingerd.action; *)
procedure t_fingerd.action;
begin
open_socket_in(f_socket,f_Socket_number,my_ip_address);
if f_socket=INVALID_SOCKET then
raise ESocketError.Create(WSAGetLastError);
winsock.WSAAsyncSelect(f_socket,f_handle,uwm_socketevent,fd_accept);
end;
(*@\\\000000010B*)
(*@\\\000000051C*)
{ HTTP and FTP - the file transfer protocols }
(*@/// class t_http(t_tcpip) *)
(*@/// constructor t_http.Create(Aowner:TComponent); *)
constructor t_http.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_content_post:='application/x-www-form-urlencoded';
f_do_author:=TStringlist.Create;
end;
(*@\\\0000000503*)
(*@/// destructor t_http.Destroy; *)
destructor t_http.Destroy;
begin
f_do_author.free;
inherited destroy;
end;
(*@\\\*)
(*@/// procedure t_http.sendrequest(const method,version: string); *)
procedure t_http.sendrequest(const method,version: string);
begin
SendCommand(method+' '+f_path+' HTTP/'+version);
if f_sender<>'' then
SendCommand('From: '+f_sender);
if f_reference<>'' then
SendCommand('Referer: '+f_reference);
if f_agent<>'' then
SendCommand('User-Agent: '+f_agent);
if f_nocache then
SendCommand('Pragma: no-cache');
if method='POST' then begin
SendCommand('Content-Length: '+inttostr(stream.size));
if f_content_post<>'' then
SendCommand('Content-Type: '+f_content_post);
end;
if f_author<>'' then begin
self.write_s(f_socket,'Authorization: '+f_author+#13#10);
if assigned(f_tracer) then
f_tracer('Authorization: *****',tt_proto_sent);
end;
self.write_s(f_socket,#13#10); (* finalize the request *)
end;
(*@\\\0000000301*)
(*@/// procedure t_http.getanswer; *)
procedure t_http.getanswer;
var
s: string;
proto,user,pass,port: string;
field,data: string;
begin
f_do_author.clear;
f_type:='';
f_size:=0;
repeat
s:=self.read_line(f_socket);
if s<>'' then
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
if false then
(*@/// else if left(s,8)='HTTP/1.0' then http-status-reply *)
else if copy(s,1,8)='HTTP/1.0' then begin
f_status_nr:=strtoint(copy(s,10,3));
f_status_txt:=copy(s,14,length(s));
if f_status_nr>=400 then EXIT; (* HTTP error returned *)
end
(*@\\\*)
(*@/// else if pos(':',s)>0 then parse the response string *)
else if pos(':',s)>0 then begin
field:=lowercase(copy(s,1,pos(':',s)-1));
data:=copy(s,pos(':',s)+2,length(s));
if false then
{ else if field='date' then }
{ else if field='mime-version' then }
{ else if field='pragma' then }
{ else if field='allow' then }
(*@/// else if field='location' then change the uri !!! *)
else if field='location' then begin
if proxy<>'' then
f_path:=data (* it goes via a proxy, so just change the uri *)
else begin
parse_url(data,proto,user,pass,f_hostname,port,f_path);
if port<>'' then f_Socket_number:=strtoint(port);
end;
end
(*@\\\0000000601*)
{ else if field='server' then }
{ else if field='content-encoding' then }
(*@/// else if field='content-length' then *)
else if field='content-length' then
f_size:=strtoint(data)
(*@\\\*)
(*@/// else if field='content-type' then *)
else if field='content-type' then
f_type:=data
(*@\\\*)
(*@/// else if field='www-authenticate' then *)
else if field='www-authenticate' then
f_do_author.add(data)
(*@\\\000000020E*)
{ else if field='expires' then }
{ else if field='last-modified' then }
end
(*@\\\0000000901*)
(*@/// else some very strange response, ignore it *)
else;
(*@\\\*)
until s='';
if f_status_nr>=400 then
raise EProtocolError.Create('HTTP',f_status_txt,f_status_nr);
end;
(*@\\\0000001101*)
(*@/// procedure t_http.action; *)
procedure t_http.action;
var
proto,user,pass,host,port,path: string;
begin
(*@/// parse url and proxy to f_hostname, f_path and f_socket_number *)
if f_proxy<>'' then begin
parse_url(f_url,proto,user,pass,host,port,path);
f_path:=f_url;
if proto='' then
f_path:='http://'+f_path;
parse_url(f_proxy,proto,user,pass,host,port,path);
if port='' then port:='8080';
end
else begin
parse_url(f_url,proto,user,pass,host,port,f_path);
if port='' then port:='80';
end;
if proto='' then proto:='http';
if f_path='' then f_path:='/';
f_hostname:=host;
f_Socket_number:=strtoint(port);
(*@\\\0000000601*)
gethead; (* to process an eventually Location: answer *)
getbody;
end;
(*@\\\0000000501*)
(*@/// procedure t_http.GetHead; *)
procedure t_http.GetHead;
begin
login;
sendrequest('HEAD','1.0');
getanswer;
logout;
end;
(*@\\\0000000701*)
(*@/// procedure t_http.GetBody; *)
procedure t_http.GetBody;
var
p: pointer;
ok,ok2:integer;
begin
login;
sendrequest('GET','1.0');
getanswer;
(*@/// read the data *)
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
(*@\\\*)
logout;
end;
(*@\\\0000000901*)
(*@/// procedure t_http.Post; *)
procedure t_http.Post;
var
p: pointer;
ok,ok2:integer;
proto,user,pass,host,port,path: string;
begin
(*@/// parse url and proxy to f_hostname, f_path and f_socket_number *)
if f_proxy<>'' then begin
parse_url(f_proxy,proto,user,pass,host,port,path);
f_path:=f_url;
if port='' then port:='8080';
end
else begin
parse_url(f_url,proto,user,pass,host,port,f_path);
if port='' then port:='80';
end;
if proto='' then proto:='http';
if path='' then path:='/';
f_hostname:=host;
f_Socket_number:=strtoint(port);
(*@\\\*)
login;
sendrequest('POST','1.0');
(*@/// Send the data *)
TMemorystream(f_stream).seek(0,0);
ok:=1;
while ok>0 do begin
ok:=f_stream.read(f_buffer^,buf_size);
write_buf(f_socket,f_buffer^,ok);
end;
(*@\\\0000000607*)
getanswer;
(*@/// read in the response body *)
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
(*@\\\0000000201*)
logout;
end;
