(*@/// Parse a FTP directory line into a filedata record (UNIX and DOS style only) *)
const month_string: array[0..11] of string =
(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
(*@/// function getmonth(const s:string):integer; Month -> Integer *)
function getmonth(const s:string):integer;
var
i: integer;
begin
result:=0;
for i:=0 to 11 do
if s=month_string[i] then begin
result:=i+1;
EXIT;
end;
end;
(*@\000000301*)
const
empty_filedata:t_filedata=
(filetype:ft_none; size:0; name:; datetime:0);
(*@/// function parse_line_unix(const s: string):t_filedata; *)
function parse_line_unix(const v: string):t_filedata;
(* known problems: filename with spaces (most unixs dont allow the anyway) *)
(* links arent parsed at all *)
var
t,date: string;
y,m,d,h,n,s: word;
begin
try
case v[1] of
d: result.filetype:=ft_dir;
-: result.filetype:=ft_file;
l: result.filetype:=ft_link;
end;
result.name:=copy(v,posn( ,v,-1)+1,length(v));
t:=copy(v,12,length(v)-length(result.name)-12);
date:=copy(t,length(t)-11,12);
decodedate(now,y,m,d);
h:=0; n:=0; s:=0;
if pos(:,date)>0 then begin
h:=strtoint(copy(date,8,2));
n:=strtoint(copy(date,11,2));
end
else
y:=strtoint(copy(date,9,4));
d:=strtoint(trim(copy(date,5,2)));
m:=getmonth(copy(date,1,3));
t:=copy(t,1,length(t)-13);
result.size:=strtoint(copy(t,posn( ,t,-1)+1,length(t)));
result.datetime:=encodedate(y,m,d)+encodetime(h,n,s,0);
except
result:=empty_filedata;
end;
end;
(*@\000000201*)
(*@/// function parse_line_dos(const s: string):t_filedata; *)
function parse_line_dos(const v: string):t_filedata;
(* known problems: filename with spaces (why do something like that?) *)
var
t: string;
sd,st: string;
ds: char;
begin
ds:=DateSeparator;
sd:=ShortdateFormat;
st:=Shorttimeformat;
try
if pos(<DIR>,v)=0 then
result.filetype:=ft_file
else
result.filetype:=ft_dir;
result.name:=copy(v,posn( ,v,-1)+1,length(v));
t:=copy(v,1,length(v)-length(result.name)-1);
result.size:=strtoint(0+copy(t,posn( ,t,-1)+1,length(t)));
DateSeparator:=-;
ShortDateFormat:=mm/dd/yy;
Shorttimeformat:=hh:nnAM/PM;
result.datetime:=strtodatetime(copy(t,1,17));
except
result:=empty_filedata;
end;
DateSeparator:=ds;
ShortdateFormat:=sd;
Shorttimeformat:=st;
end;
(*@\000000201*)
(*@/// function parse_ftp_line(const s:string):t_filedata; *)
function parse_ftp_line(const s:string):t_filedata;
begin
if copy(s,1,5)=total then (* first line for some UNIX ftp server *)
result:=empty_filedata
else if s[1] in [d,l,-,s] then
result:=parse_line_unix(s)
else if s[1] in [0..9] then
result:=parse_line_dos(s);
end;
(*@\000000301*)
(*@\000000401*)
(*@/// procedure stream_write_s(h:TMemoryStream; const s:string); // string -> stream *)
procedure stream_write_s(h:TMemoryStream; const s:string);
var
buf: pointer;
begin
buf:=@s[1];
h.write(buf^,length(s));
end;
(*@\000000301*)
const
back_log=2; (* possible values 1..5 *)
fingerd_timeout=5;
buf_size=$7f00; (* size of the internal standard buffer *)
(*@/// class EProtocolError(ETcpIpError) *)
constructor EProtocolError.Create(const proto,Msg:String; number:word);
begin
Inherited Create(Msg);
protocoll:=proto;
errornumber:=number;
end;
(*@\000000301*)
(*@/// class ESocketError(ETcpIpError) *)
constructor ESocketError.Create(number:word);
begin
inherited create(Error creating socket);
errornumber:=number;
end;
(*@\*)
(*@/// class EProtocolBusy(ETcpIpError) *)
constructor EProtocolBusy.Create;
begin
inherited create(Protocol busy);
end;
(*@\000000301*)
(*@/// procedure parse_url(const url:string; var proto,user,pass,host,port,path:string); *)
procedure parse_url(const url:string; var proto,user,pass,host,port,path:string);
(* standard syntax of an URL:
protocol://[user[:password]@]server[:port]/path *)
var
p,q: integer;
s: string;
begin
proto:=;
user:=;
pass:=;
host:=;
port:=;
path:=;
p:=pos(://,url);
if p=0 then begin
if lowercase(copy(url,1,7))=mailto: then begin (* mailto:// not common *)
proto:=mailto;
p:=pos(:,url);
end;
end
else begin
proto:=copy(url,1,p-1);
inc(p,2);
end;
s:=copy(url,p+1,length(url));
p:=pos(/,s);
if p=0 then p:=length(s)+1;
path:=copy(s,p,length(s));
s:=copy(s,1,p-1);
p:=posn(:,s,-1);
if p>length(s) then p:=0;
q:=posn(@,s,-1);
if q>length(s) then q:=0;
if (p=0) and (q=0) then begin (* no user, password or port *)
host:=s;
EXIT;
end
else if q<p then begin (* a port given *)
port:=copy(s,p+1,length(s));
host:=copy(s,q+1,p-q-1);
if q=0 then EXIT; (* no user, password *)
s:=copy(s,1,q-1);
end
else begin
host:=copy(s,q+1,length(s));
s:=copy(s,1,q-1);
end;
p:=pos(:,s);
if p=0 then
user:=s
else begin
user:=copy(s,1,p-1);
pass:=copy(s,p+1,length(s));
end;
end;
(*@\000003C07*)
{ The base component }
(*@/// class t_tcpip(TComponent) *)
(*@/// constructor t_
