(*@/// 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;
(*@\\\0000000301*)
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 unix's don't allow the anyway) *)
(* links aren't 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;
(*@\\\0000000201*)
(*@/// 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;
(*@\\\0000000201*)
(*@/// 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;
(*@\\\0000000301*)
(*@\\\0000000401*)
(*@/// 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;
(*@\\\0000000301*)
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;
(*@\\\0000000301*)
(*@/// 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;
(*@\\\0000000301*)
(*@/// 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;
(*@\\\0000003C07*)
{ The base component }
(*@/// class t_tcpip(TComponent) *)
(*@/// constructor t_tcpip.Create(Aowner:TComponent); *)
constructor t_tcpip.Create(Aowner:TComponent);
begin
inherited create(AOwner);
{ f_buffer:=NIL; }
getmem(f_buffer,buf_size);
f_stream:=TMemorystream.Create;
f_Socket:=INVALID_SOCKET;
ip_address:=INVALID_IP_ADDRESS;
(* A windows dummy handle to get messages *)
f_handle:=AllocateHwnd(self.WndProc);
f_async:=false;
f_logged_in:=false;
end;
(*@\\\0000000C03*)
(*@/// destructor t_tcpip.Destroy; *)
destructor t_tcpip.Destroy;
begin
f_tracer:=NIL;
if f_buffer<>NIL then
freemem(f_buffer,buf_size);
f_stream.free;
if f_socket<>invalid_socket then
logout;
DeallocateHwnd(f_Handle);
inherited destroy;
end;
(*@\\\0000000301*)
(*@/// procedure t_tcpip.WndProc(var Msg : TMessage); *)
procedure t_tcpip.WndProc(var Msg : TMessage);
begin
if msg.msg=uwm_socketevent then begin
if msg.lparamhi=socket_error then
else begin
case msg.lparamlo of
(*@/// fd_read: *)
fd_read: begin
f_newdata:=true;
end;
(*@\\\0000000213*)
end;
end;
end
else
dispatch(msg);
end;
(*@\\\0000000701*)
(*@/// function t_tcpip.Create_Socket:TSocket; *)
function t_tcpip.Create_Socket:TSocket;
begin
result:=Winsock.Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
end;
(*@\\\*)
(*@/// procedure t_tcpip.bind_socket(var socket:TSocket; out_port_min,out_port_max: word); *)
procedure t_tcpip.bind_socket(var socket:TSocket; out_port_min,out_port_max: word);
var
LocalAddress : TSockAddr;
i: word;
begin
with LocalAddress do begin
Sin_Family:=PF_INET;
Sin_addr.S_addr:=INADDR_ANY;
end;
i:=out_port_min;
while i<=out_port_max do begin
LocalAddress.Sin_Port:=Winsock.htons(i);
if Winsock.bind(socket,LocalAddress,
SizeOf(LocalAddress))<>SOCKET_ERROR then BREAK;
inc(i);
end;
end;
(*@\\\0000000401*)
(*@/// procedure t_tcpip.connect_socket(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_tcpip.connect_socket(var socket:TSocket; Socket_number:smallint;ip_address:longint);
var
RemoteAddress : TSockAddr;
begin
with RemoteAddress do begin
Sin_Family:=PF_INET;
Sin_Port:=Winsock.htons(Socket_number);
Sin_addr:=TInAddr(ip_address);
end;
if Winsock.Connect(Socket,RemoteAddress,
SizeOf(RemoteAddress))=SOCKET_ERROR then begin
if winsock.WSAGetLastError<>wsaewouldblock then begin
Close_Socket(socket);
if assigned(f_tracer) then
f_tracer('Failed to open output socket '+inttostr(Socket_number)+' to host '+
ip2string(ip_address),tt_socket);
end
end
else
if assigned(f_tracer) then
f_tracer('Opened output socket '+inttostr(Socket_number)+' to host '+
ip2string(ip_address)+' successfully; ID '+inttostr(socket),
tt_socket);
end;
(*@\\\000E00101C00101C00101C00101C*)
(*@/// procedure t_tcpip.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_tcpip.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint);
begin
close_socket(socket);
socket:=Create_Socket;
connect_socket(socket,Socket_number,ip_address);
end;
(*@\\\0000000501*)
(*@/// procedure t_tcpip.open_socket_in(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_tcpip.open_socket_in(var socket:TSocket; Socket_number:smallint;ip_address:longint);
var
LocalAddress : TSockAddr;
begin
close_socket(socket);
f_Socket:=Create_Socket;
(*@/// open the socket and let it listen *)
with LocalAddress do begin
Sin_Family:=PF_INET;
Sin_Port:=Winsock.htons(Socket_number);
Sin_addr:=TInAddr(ip_address);
end;
if Winsock.bind(socket,LocalAddress,
SizeOf(LocalAddress))=SOCKET_ERROR then begin
if assigned(f_tracer) then
f_tracer('Failed to bind socket '+inttostr(Socket_number)+' for local ip '+
ip2string(ip_address),tt_socket);
Close_Socket(socket);
EXIT;
end
else
if assigned(f_tracer) then
f_tracer('Bound to socket '+inttostr(Socket_number)+' for local ip '+
ip2string(ip_address),tt_socket);
if Winsock.Listen(Socket,back_log)=SOCKET_ERROR then begin
Close_Socket(socket);
if assigned(f_tracer) then
f_tracer('Failed to set input socket '+inttostr(Socket_number)+
' to listening mode',tt_socket);
end
else
if assigned(f_tracer) then
f_tracer('Set input socket '+inttostr(Socket_number)+
' to listening mode sucessfully; ID '+inttostr(socket),tt_socket);
(*@\\\0030000A18000A18001123*)
end;
(*@\\\0000000701*)
(*@/// function t_tcpip.accept_socket_in(socket:TSocket; var SockInfo:TSockAddr):TSocket; *)
function t_tcpip.accept_socket_in(socket:TSocket; var SockInfo:TSockAddr):TSocket;
var
x: u_int;
LocalAddress : TSockAddr;
temp_socket: TSocket;
begin
x:=SizeOf(LocalAddress);
(*$ifndef ver100 *)
temp_socket:=Winsock.Accept(Socket,LocalAddress,x);
(*$else *) { Delphi 3 ARGH! }
temp_socket:=Winsock.Accept(Socket,@LocalAddress,@x);
(*$endif *)
if temp_socket=SOCKET_ERROR then begin
(* no incoming call available *)
temp_socket:=INVALID_SOCKET;
if assigned(f_tracer) then
f_tracer('No incoming connection found on socket ID '+inttostr(Socket),
tt_socket);
end
else
if assigned(f_tracer) then
f_tracer('Incoming connection found on socket ID '+inttostr(Socket)+
'; generated socket ID '+inttostr(temp_socket),tt_socket);
accept_socket_in:=temp_socket;
sockinfo:=LocalAddress;
end;
(*@\\\0000001748*)
(*@/// function t_tcpip.socket_state(socket:TSocket):T_Socket_State; *)
function t_tcpip.socket_state(socket:TSocket):T_Socket_State;
var
peer_adr: TSockAddr;
x: u_int;
begin
if socket=INVALID_SOCKET then
socket_state:=invalid
else begin
x:=sizeof(TSockAddr);
if winsock.getpeername(socket,peer_adr,x)=0 then
socket_state:=connected
else begin
if winsock.WSAGetLastError<>WSAENOTCONN then
socket_state:=state_unknown
else
socket_state:=valid
end;
end;
end;
