TCP/IP (四）

(*@\\\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;
 

[1] [2]  下一页

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18