delphi Tftp 控件没有支持http代理功能，如何添加? (跪求答案)(200分)

部分代码摘抄 ,用的是 TCP/IP Component Pack
可以到网上下
unit tcpip;
{ Copyright 1997 Andreas H鰎stemeier Version 0.22 2001-07-09 }
{ this component is public domain - please check the file readme.txt for }
{ more detailed info on usage and distributing }

(*@/// interface *)
interface
(*$x+ *)

(*@/// uses *)
uses
sysutils,
classes,
controls,
forms,
winsock,
(*$ifdef ver80 *)
winprocs,
wintypes,
(*$else *)
windows,
(*$endif *)
messages,
ip_misc;
(*@///*)

type
t_socket_state = (invalid,valid,connected,state_unknown);
t_timemode = (tzUTC,tzLocal);
t_ftp_mode = (tftp_download,tftp_upload,tftp_getdir);
t_filetype = (ft_none, ft_dir, ft_file, ft_link);
t_lpr_types = (lp_plain, lp_ascii, lp_dvi, lp_plot, lp_ditroff, lp_ps,
lp_pr, lp_fortran, lp_troff, lp_raster, lp_cif);
t_encoding = (ec_base64, ec_quotedprintable, ec_none);
TTraceLevel = (tt_proto_sent, tt_proto_get, tt_socket);
(*@/// t_filedata=record ... end; *)
t_filedata=packed record
filetype: t_filetype;
size: integer;
name: string;
datetime: TDateTime;
end;
(*@///*)
ETcpIpError=class(Exception);
(*@/// ESocketError=class(ETcpIpError) *)
ESocketError=class(ETcpIpError)
errornumber: word;
constructor Create(number:word);
end;
(*@///0000000301*)
(*@/// EProtocolError=class(ETcpIpError) *)
EProtocolError=class(ETcpIpError)
errornumber: word;
protocoll: string;
constructor Create(const proto,Msg:String; number:word);
end;
(*@///0000000401*)
(*@/// EProtocolBusy=class(ETcpIpError) *)
EProtocolBusy=class(ETcpIpError)
constructor Create;
end;
(*@///0000000201*)

TTraceProc = procedure (const s:string; level:TTraceLevel) of object;
TDataTransferProc = procedure (Sender:TObject; mode: t_ftp_mode; bytes: integer) of object;
TFTPActionCompleteProc = procedure (Sender:TObject; mode: t_ftp_mode) of object;

{ The base component }
(*@/// T_AH_Component=class(TComponent) *)
T_AH_Component=class(TComponent)
protected
f_list: TList; (* List of components to be notified for removing *)
procedure AddToNotify(sender: T_AH_Component);
procedure RemoveFromNotify(sender: T_AH_Component);
procedure NotifyRemove(sender: T_AH_Component); VIRTUAL;
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
end;
(*@///*)

(*@/// T_FTP = class(T_TcpIp) // RFC 959 *)
T_FTP = class(T_TcpIp)
protected
f_url: string;
f_status_nr: integer;
f_status_txt: string;
f_user: string;
f_password: string;
f_comm_socket: tsocket;
f_passive: boolean;
f_port: word;
f_mode: t_ftp_mode;
f_mode_intern: t_ftp_mode;
f_cur_dir: TStringList;
f_cur_dir_index: integer;
f_size: integer;
f_busy: boolean;
f_onaction: TFTPActionCompleteProc;
f_ondata_got: TDataTransferProc;
f_dir_stream: TMemoryStream;
f_async_data: boolean;
procedure response;
function read_line_comm:string;
procedure SendCommand(const s:string); override;
procedure get_datasocket;
procedure WndProc(var Msg : TMessage); override;
function do_write:boolean;
function do_read:boolean;
procedure finish_upload;
procedure finish_download;
procedure finish_getdir;
public (* will become public once tested *)
procedure changedir(const f_dir:string);
procedure removefile(const filename:string);
procedure removedir(const dirname:string);
procedure makedir(const dirname:string);
procedure renamefile(const prior,after:string);
procedure getdir(const dirname:string);
function getdirentry:t_filedata;
public
property stream: TStream read f_stream write SetStream;
property status_number: integer read f_status_nr;
property status_text: string read f_status_txt;
property busy: boolean read f_busy;
procedure login; override;
procedure logout; override;
procedure download;
procedure upload;
procedure abort;
procedure noop;
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; override;
property Size:integer read f_size;
published
property Hostname: string read f_hostname write f_hostname;
property URI: string read f_url write f_url;
property Password:string read f_password write f_password;
property Username:string read f_user write f_user;
property Passive:boolean read f_passive write f_passive default true;
property Port:word read f_port write f_port default 21;
property Mode:t_ftp_mode read f_mode write f_mode default tftp_download;
property OnDataReceived:TDataTransferProc read f_ondata_got write f_ondata_got;
property OnActionComplete:TFTPActionCompleteProc read f_onaction write f_onaction;
property Async:boolean read f_async_data write f_async_data;
property OnTrace;
end;
(*@///0000003E01*)
(*@/// 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);
//加了防止异常发生的判断
if trim(s)='221' then exit;
if trim(s)='' then exit;

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
while do_write do;
{ 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;
(*@///0000001301*)

(*@/// 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,ok2:integer;
begin
result:=false;
if f_socket=invalid_socket then EXIT;

ok:=f_stream.read(f_buffer^,buf_size);
if ok=0 then begin
close_socket(f_socket);
if self.async then
PostMessage(self.f_handle,uwm_socketevent+1,0,fd_close);
result:=false;
end
else begin
ok2:=ok;
if ok>0 then
write_buf(f_socket,f_buffer^,ok);
if ok<ok2 then (* not all data written *)
f_stream.seek(ok-ok2+1,1);
if (ok>0) and assigned(f_ondata_got) then
f_ondata_got(self,f_mode_intern,ok);
result:=ok>0;
end;
end;
(*@///0000000D01*)
(*@/// 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;
(*@///*)

(*@/// procedure t_ftp.finish_upload; *)
procedure t_ftp.finish_upload;
begin
f_eof:=false;
self.response;
f_async:=false;
if assigned(f_onaction) then
f_onaction(self,f_mode_intern);
f_busy:=false;
end;
(*@///0000000401*)
(*@/// procedure t_ftp.finish_download; *)
procedure t_ftp.finish_download;
begin
while do_read do ;
f_eof:=false;
{ shutdown(f_socket,1); }
close_socket(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;
(*@///0000000601*)
(*@/// 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: smallint;
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;
po:=0; (* arbitrary port *)
open_socket_in(f_socket,po,ip);
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(po and $ff00 shr 8 )+','+
inttostr(po and $00ff ));
self.response;
(* 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;
(*@///0000000E05*)
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 or fd_close);
end;
(*@///0000000E01*)

(*@/// procedure t_ftp.WndProc(var Msg : TMessage); *)
procedure t_ftp.WndProc(var Msg : TMessage);
var
temp_socket:TSocket;
sockinfo: TSockAddr;
begin
if msg.msg<>uwm_socketevent+1 then
inherited WndProc(Msg)
else begin
if msg.lparamhi=socket_error then
else begin
case msg.lparamlo of
(*@/// fd_accept: *)
fd_accept: begin
temp_socket:=f_socket;
self.f_socket:=accept_socket_in(f_socket,sockinfo);
close_socket(temp_socket);
winsock.WSAAsyncSelect(f_socket,f_handle,uwm_socketevent+1,
fd_connect or fd_read or fd_write or fd_accept or fd_close);
end;
(*@///0000000605*)
(*@/// fd_write: *)
fd_write: begin
case f_mode_intern of
tftp_download,
tftp_getdir: ;
tftp_upload: while do_write do;
end;
end;
(*@///0000000501*)
(*@/// fd_read: *)
fd_read: begin
case f_mode_intern of
tftp_download,
tftp_getdir: do_read;
tftp_upload: ;
end;
end;
(*@///0000000201*)
fd_connect: ; (* can be ignored, a fd_write will come *)
(*@/// fd_close: *)
fd_close: begin
case f_mode_intern of
{ tftp_download: finish_download; }
{ tftp_getdir: finish_getdir; }
tftp_upload: finish_upload;
end;
end;
(*@///0000000501*)
end;
end;
end;
end;
(*@///0000000B01*)

(*@/// function t_ftp.getdirentry:t_filedata; *)
function t_ftp.getdirentry:t_filedata;
begin
result:=empty_filedata;
while (f_cur_dir_index<f_cur_dir.count) and ((result.filetype=ft_none)
or (result.name='.') or (result.name='..')) do begin
result:=parse_ftp_line(f_cur_dir[f_cur_dir_index]);

inc(f_cur_dir_index);
end;
end;
(*@///0000000601*)

(*@/// function t_ftp.read_line_comm:string; *)
function t_ftp.read_line_comm:string;
begin
result:=read_line(f_comm_socket);
end;
(*@///0000000401*)
(*@/// procedure t_ftp.SendCommand(const s:string); *)
procedure t_ftp.SendCommand(const s:string);
begin
write_s(f_comm_socket,s+#13#10);
if assigned(f_tracer) then
f_tracer(s,tt_proto_sent);
end;
(*@///0000000321*)
(*@///000000242D*)

有！
你也可以用Indy控件嘛！

现在是要用这个组件，怎么添加支持 HTTP代理的方法，谢谢

紧急求救，求高人指点啊

求高人指点！