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_S

[1] [2]  下一页

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18