TCP/IP(五）

(*@\*)
(*@/// procedure t_http.DoBasicAuthorization(const username,password:string); *)
procedure t_http.DoBasicAuthorization(const username,password:string);
var
  h: TMemoryStream;
  encoded: TStringlist;
begin
  f_author:=username+:+password;
  h:=NIL;
  encoded:=NIL;
  try
    h:=TMemoryStream.Create;
    stream_write_s(h,f_author);
    encoded:=encode_base64(h);
    if encoded.count>0 then
      f_author:=Basic +encoded.strings[0];
  finally
    h.free;
    encoded.free;
    end;
  end;
(*@\000000C1D*)
(*@\000000501*)
(*@/// class t_ftp(t_tcpip) *)
(*@/// constructor t_ftp.Create(Aowner:TComponent); *)
constructor t_ftp.Create(Aowner:TComponent);
begin
  inherited create(AOwner);
  f_port:=21;
  f_user:=ftp;
  f_password:=nobody@nowhere; (* only to make it running without setting user/password *)
  f_passive:=true;
  f_mode:=tftp_download;
  f_cur_dir:=TStringlist.Create;
  f_comm_socket:=INVALID_SOCKET;
  f_busy:=false;
  f_dir_stream:=TMemorystream.Create;
  end;
(*@\*)
(*@/// destructor t_ftp.Destroy; *)
destructor t_ftp.Destroy;
begin
  f_cur_dir.free;
  f_dir_stream.free;
  inherited destroy;
  end;
(*@\000000301*)
(*@/// procedure t_ftp.action; *)
procedure t_ftp.action;
begin
  login;
  TMemorystream(f_stream).clear;
  case f_mode of
    tftp_download: download;
    tftp_upload:   upload;
    tftp_getdir:   getdir(.);
    end;
  logout;
  end;
(*@\000000303*)
(*@/// procedure t_ftp.response; *)
procedure t_ftp.response;
var
  s: string;
begin
  s:=self.read_line_comm;
  if assigned(f_tracer) then
    f_tracer(s,tt_proto_get);
  try
    f_status_nr:=strtoint(copy(s,1,3));
  except
    f_status_nr:=999;
  end;
  f_status_txt:=copy(s,5,length(s));
  if f_status_nr>=400 then
    raise EProtocolError.Create(FTP,f_status_txt,f_status_nr);
  (* if the answer consists of several lines read and discard all the following *)
  while (pos(-,s)=4) or (pos( ,s)=1) do begin
    s:=self.read_line_comm;
    if assigned(f_tracer) then
      f_tracer(s,tt_proto_get);
    end;
  end;
(*@\000000701*)
(*@/// procedure t_ftp.login;                                // USER and PASS commands *)
procedure t_ftp.login;
begin
  f_socket_number:=f_port;
  inherited login;
  f_comm_socket:=f_socket;
  self.response;   (* Read the welcome message *)
  self.SendCommand(USER +f_user);
  self.response;
{   self.SendCommand(PASS +f_password); }
  write_s(f_comm_socket,PASS +f_password+#13#10);
  if assigned(f_tracer) then
    f_tracer(PASS ******,tt_proto_sent);
  self.response;
  self.SendCommand(TYPE I);  (* always use binary *)
  self.response;
  end;
(*@\000000301*)
(*@/// procedure t_ftp.logout;                               // QUIT command *)
procedure t_ftp.logout;
begin
  if f_busy then  self.abort;
  if f_logged_in then begin
    if f_comm_socket<>INVALID_SOCKET then begin
      self.SendCommand(QUIT);
      self.response;
      end;
    if f_socket<>invalid_socket then
      closesocket(f_socket);
    f_socket:=f_comm_socket;
    f_comm_socket:=INVALID_SOCKET;
    end;
  inherited logout;
  end;
(*@\000000406*)
(*@/// procedure t_ftp.getdir(const dirname:string);         // LIST command *)
procedure t_ftp.getdir(const dirname:string);
begin
  if f_busy then  raise(EProtocolBusy.create);
  if not f_logged_in then login;
  if (dirname=) then EXIT;
  get_datasocket;
  self.SendCommand(TYPE A);
  self.response;
  self.SendCommand(LIST +dirname);
  self.response;
  f_mode_intern:=tftp_getdir;
  f_busy:=true;
  TMemorystream(f_dir_stream).clear;
  if not f_async_data then begin
    while do_read do ;
    f_eof:=false;
    self.response;
    finish_getdir;
    end
  else begin
    winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,fd_read);
    f_eof:=false;
    f_async:=true;
    self.response;
    f_async:=false;
    winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,0);
    finish_getdir;
    end;
  end;
(*@\000000501*)
(*@/// procedure t_ftp.download;                             // RETR command *)
procedure t_ftp.download;
begin
  if f_busy then  raise(EProtocolBusy.create);
  if not f_logged_in then login;
  if f_url<> then begin
    self.SendCommand(SIZE +f_url);  (* can I use the path here? *)
    try
      self.response;
      f_size:=strtoint(f_status_txt);
    except
      f_size:=0;
      end;
    get_datasocket;
    self.SendCommand(RETR +f_url);  (* can I use the path here? *)
    self.response;
    f_mode_intern:=tftp_download;
    f_busy:=true;
    TMemorystream(f_stream).clear;
    if not f_async_data then begin
      while do_read do ;
      f_eof:=false;
      self.response;
      finish_download;
      end
    else begin
      winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,fd_read);
      f_eof:=false;
      f_async:=true;
      self.response;
      f_async:=false;
      winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,0);
      finish_download;
      end;
    end;
  end;
(*@\000000907*)
(*@/// procedure t_ftp.upload;                       

补充：软件开发 , Delphi ,

上一个：TCP/IP(六）
下一个：TCP/IP(四）