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;
(*@\\\0000000C1D*)
(*@\\\0000000501*)
(*@/// 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;
(*@\\\0000000301*)

(*@/// 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;
(*@\\\0000000303*)
(*@/// 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;
(*@\\\0000000701*)

(*@/// 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;
(*@\\\0000000301*)
(*@/// 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;
(*@\\\0000000406*)

(*@/// 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;
(*@\\\0000000501*)
(*@/// 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;
(*@\\\0000000907*)
(*@/// procedure t_ftp.upload;                               // STOR command *)
procedure t_ftp.upload;
begin
  if f_busy then  raise(EProtocolBusy.create);
  if not f_logged_in then login;
  if f_url<>'''''''' then begin
    get_datasocket;
    self.SendCommand(''''STOR ''''+f_url);  (* can I use the path here? *)
    self.response;
    f_mode_intern:=tftp_upload;
    f_busy:=true;
    f_size:=TMemorystream(f_stream).size;
    TMemorystream(f_stream).seek(0,0);
    if not f_async_data then begin
      while do_write do;
      finish_upload;
      end
    else begin
      winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,fd_read);
      finish_upload;
      winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,0);
      end;
    end;
  end;
(*@\\\0000000B0B*)

(*@/// procedure t_ftp.abort;                                // ABOR command *)
procedure t_ftp.abort;
begin
  if f_busy then begin
    self.SendCommand(''''ABOR'''');
    try
      self.response;
    except
      on EProtocolError do begin
        if f_status_nr<>426 then
        &

[1] [2] [3]  下一页

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

鄂公网安备 42011102001154号

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