|
(*@\\\*)
(*@/// 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] 下一页 |
