TCP/IP 使网络连接驱向简单化(二)

(*@/// 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;