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

原创 2001年07月30日 16:41:00

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

如何使用TCP/IP与服务器进行通信-一个简单的聊天程序

原文: http://www.devx.com/wireless/Article/43551在上一章,我们讨论了如何在iPhoneapp中调用web服务以及如何解析服务器返回的XML。在Web服务大行...
  • kmyhy
  • kmyhy
  • 2013年03月02日 13:20
  • 12686

简单的QT5网络Tcp通讯

ps:QT5 用网络头文件要在项目中的.pro文件中加入: QT +=  network #include "QtNetwork/QTcpSocket" #include "QtNetwork/Q...
  • ns2250225
  • ns2250225
  • 2014年02月19日 11:28
  • 6708

Python网络编程01-----基于TCP的Python简易服务器

Python网络01 原始Python服务器   之前我的Python教程中有人留言,表示只学Python没有用,必须学会一个框架(比如Django和web.py)才能找到工作。而我的想法是,掌握一...
  • a359680405
  • a359680405
  • 2015年01月06日 15:24
  • 3406

用tcp/ip进行网络连接(第2-5章 笔记)

第二章: 1. 客户机-服务器范例使用发起通信的方向来对程序分类 2. 服务器软件应该含有处理安全问题的机制 3. 全参数化客户软件是指客户软件允许用户指明远程服务器的端口号,而不使用默认的端口...
  • zhjutao
  • zhjutao
  • 2013年02月28日 14:44
  • 231

libcurl网络连接使用tcp/ip

不多说直接看代码:CURL *curl; CURLcode res; const char *request = "GETas.xxxxE测试发送"; curl_socket_t sockfd; ...
  • zengraoli
  • zengraoli
  • 2013年09月11日 21:01
  • 9284

列举本机上所有的TCP网络连接

  • 2007年09月04日 20:52
  • 10KB
  • 下载

java下用多线程实现tcp网络连接

  • 2012年10月18日 15:59
  • 1KB
  • 下载

tcp网络连接

  • 2014年04月26日 09:32
  • 11KB
  • 下载

TMS320F2812的ip协议实现dsp的网络连接,实现以太网底层的协议

  • 2013年11月22日 10:49
  • 162KB
  • 下载

WINXP 系统禁止更改IP禁止打开网络连接

  • 2011年04月17日 23:54
  • 188KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:TCP/IP 使网络连接驱向简单化(二)
举报原因:
原因补充:

(最多只允许输入30个字)