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

页面导航:首页 > 软件编程 > Delphi > TCP/IP使网络连接驱向简单化(二)

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

来源: 作者: 时间:2016-01-23 10:15 【

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

(*@/// 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 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;
(*@\\0000000201*)
(*@/// function parse_line_(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:[email protected][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 ; var proto,user,pass,host,port,path:string); *)
procedure parse_url(const ; 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   (* 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_

Tags:

文章评论

最 近 更 新
热 点 排 行
Js与CSS工具
代码转换工具

<