(*@\\\*)
(*@/// 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
raise EProtocolError.Create('FTP',f_status_txt,f_status_nr)
else begin
self.response;
f_busy:=false;
end;
end;
end;
end;
end;
(*@\\\0000000301*)
(*@/// procedure t_ftp.noop; // NOOP command *)
procedure t_ftp.noop;
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('NOOP');
self.response;
end;
(*@\\\0000000501*)
(*@/// procedure t_ftp.changedir(const f_dir:string); // CWD command *)
procedure t_ftp.changedir(const f_dir:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('CWD '+f_dir);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.removefile(const filename:string); // DELE command *)
procedure t_ftp.removefile(const filename:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('DELE '+filename);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.removedir(const dirname:string); // RMD command *)
procedure t_ftp.removedir(const dirname:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('RMD '+dirname);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.makedir(const dirname:string); // MKD command *)
procedure t_ftp.makedir(const dirname:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('MKD '+dirname);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.renamefile(const prior,after:string); // RNFR and RNTO commands *)
procedure t_ftp.renamefile(const prior,after:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('RNFR '+prior);
self.response;
self.SendCommand('RNTO '+after);
self.response;
end;
(*@\\\*)
(*@/// function t_ftp.do_write:boolean; *)
function t_ftp.do_write:boolean;
var
ok:integer;
begin
result:=false;
if f_socket=invalid_socket then EXIT;
ok:=f_stream.read(f_buffer^,buf_size);
if ok>0 then
write_buf(f_socket,f_buffer^,ok);
result:=ok>0;
end;
(*@\\\0000000501*)
(*@/// function t_ftp.do_read:boolean; *)
function t_ftp.do_read:boolean;
var
ok,ok2:integer;
h:integer;
p: pointer;
begin
result:=false;
if f_socket=invalid_socket then EXIT;
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
h:=ok;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=0; (* Delphi 2 shut up! *)
case f_mode_intern of
tftp_download: ok2:=f_stream.write(p^,ok);
tftp_getdir: ok2:=f_dir_stream.write(p^,ok);
end;
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
result:=h>0;
if assigned(f_ondata_got) then
f_ondata_got(self,f_mode_intern,h);
end;
(*@\\\0000000901*)
(*@/// procedure t_ftp.finish_upload; *)
procedure t_ftp.finish_upload;
begin
while do_write do ;
f_eof:=false;
shutdown(f_socket,1);
closesocket(f_socket);
f_async:=true;
self.response;
f_async:=false;
if assigned(f_onaction) then
f_onaction(self,f_mode_intern);
f_busy:=false;
end;
(*@\\\0000000901*)
(*@/// procedure t_ftp.finish_download; *)
procedure t_ftp.finish_download;
begin
while do_read do ;
f_eof:=false;
shutdown(f_socket,1);
closesocket(f_socket);
f_stream.seek(0,0); (* set the stream back to start *)
if assigned(f_onaction) then
f_onaction(self,f_mode_intern);
f_busy:=false;
end;
(*@\\\0000000701*)
(*@/// procedure t_ftp.finish_getdir; *)
procedure t_ftp.finish_getdir;
begin
f_eof:=false;
while do_read do ;
f_eof:=false;
shutdown(f_socket,1);
closesocket(f_socket);
self.SendCommand('TYPE I'); (* always use binary *)
self.response;
f_dir_stream.seek(0,0); (* set the stream back to start *)
f_cur_dir.clear;
f_cur_dir.LoadFromStream(f_dir_stream);
f_dir_stream.clear;
f_cur_dir_index:=0;
if assigned(f_onaction) then
f_onaction(self,f_mode_intern);
f_busy:=false;
end;
(*@\\\0000000901*)
(*@/// procedure t_ftp.get_datasocket; *)
procedure t_ftp.get_datasocket;
var
po: integer;
ip: longint;
s,t: string;
temp_socket: TSocket;
SockInfo:TSockAddr;
f_data_socket_number: smallint;
begin
f_socket:=INVALID_SOCKET;
(*@/// if self.passive then ask for the port and open the socket active *)
if self.passive then begin
self.SendCommand('PASV');
self.response;
if f_status_nr<>227 then
raise EProtocolError.Create('FTP',f_status_txt,f_status_nr)
else begin
s:=copy(f_status_txt,pos('(',f_status_txt)+1,length(f_status_txt));
s:=copy(s,1,pos(')',s)-1);
po:=posn(',',s,4);
t:=copy(s,1,po-1);
while pos(',',t)<>0 do
t[pos(',',t)]:='.';
(*@/// ip_address:=Winsock.Inet_Addr(PChar(t)); { try a xxx.xxx.xxx.xx } *)
(*$ifdef ver80 *)
t:=t+#0;
ip_address:=Winsock.Inet_Addr(PChar(@t[1])); (* try a xxx.xxx.xxx.xx first *)
(*$else *)
(*$ifopt h- *)
t:=t+#0;
ip_address:=Winsock.Inet_Addr(PChar(@t[1])); (* try a xxx.xxx.xxx.xx first *)
(*$else *)
ip_address:=Winsock.Inet_Addr(PChar(t)); (* try a xxx.xxx.xxx.xx first *)
(*$endif *)
(*$endif *)
(*@\\\0000000801*)
s:=copy(s,po+1,length(s));
try
f_data_socket_number:=strtoint(copy(s,1,pos(',',s)-1))*256
+strtoint(copy(s,pos(',',s)+1,length(s)));
f_socket:=self.create_socket;
if f_async_data then
winsock.WSAAsyncSelect(f_socket,f_handle,uwm_socketevent+1,
fd_connect or fd_read or fd_write or fd_accept);
self.connect_socket(f_socket, f_data_socket_number, ip_address);
except
f_socket:=INVALID_SOCKET;
end;
end;
end
(*@\\\0000000F01*)
(*@/// else send the port and open the socket passive *)
else begin
ip:=my_ip_address;
self.SendCommand('PORT '+inttostr(ip and $000000ff )+','+
inttostr(ip and $0000ff00 shr 8)+','+
inttostr(ip and $00ff0000 shr 16)+','+
inttostr(ip and $ff000000 shr 24)+','+
inttostr(f_port and $ff00 shr 8 )+','+
inttostr(f_port and $00ff ));
self.response;
open_socket_in(f_socket,f_port,ip);
(* take the first out of the queue and close the listening socket *)
if not f_async_data then begin
temp_socket:=accept_socket_in(f_socket,SockInfo);
if temp_socket=INVALID_SOCKET then
{do nothing}
else begin
close_socket(f_socket); (* no more listening necessary *)
f_socket:=temp_socket;
end;
end;
end;
(*@\\\0000000B01*)
if f_async_data and (f_socket<>INVALID_SOCKET) then
winsock.WSAAsyncSelect(f_socket,f_handle,uwm_socketevent+1,
fd_connect or fd_read or fd_write or fd_accept);
end;
本文地址：http://com.8s8s.com/it/it5976.htm