程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> TCP/IP(三)

TCP/IP(三)

編輯:Delphi

(*@\000000D01*)
(*@/// procedure t_tcpip.close_socket(var socket:TSocket); *)
procedure t_tcpip.close_socket(var socket:TSocket);
begin
  if socket<>INVALID_SOCKET then begin
    Winsock.CloseSocket(socket);
    if assigned(f_tracer) then
      f_tracer(Closed socket ID +inttostr(socket),tt_socket);
    socket:=INVALID_SOCKET;
    end;
  end;
(*@\000000501*)
(*@/// procedure t_tcpip.close_socket_linger(var socket:TSocket); *)
procedure t_tcpip.close_socket_linger(var socket:TSocket);
var
  linger: TLinger;
begin
  if socket<>INVALID_SOCKET then begin
    linger.l_onoff:=1;
    linger.l_linger:=fingerd_timeout;
    winsock.setsockopt(socket,sol_socket,SO_LINGER,PChar(@linger),sizeof(linger));
    winsock.shutdown(socket,1);
    close_socket(socket);
    socket:=INVALID_SOCKET;
    end;
  end;
(*@\000000842*)
(*@/// function t_tcpip.Socket_by_name(const service:string):smallint; *)
function t_tcpip.Socket_by_name(const service:string):smallint;
var
  service_entry : PServEnt;
  s: string;
begin
  s:=service+#0;
(*$ifdef ver80 *)
  service_entry:=Winsock.GetServByName(pchar(@s[1]),tcp);
(*$else *)
 (*$ifopt h- *)
  service_entry:=Winsock.GetServByName(pchar(@s[1]),tcp);
 (*$else *)
  service_entry:=Winsock.GetServByName(pchar(s),tcp);
 (*$endif *)
(*$endif *)
  if service_entry=nil then
    result:=0
  else
    result:=winsock.htons(service_entry^.s_port);
  end;
(*@\000000E02*)

(*@/// procedure t_tcpip.Login; *)
procedure t_tcpip.Login;
begin
  if f_logged_in then logout;
  ip_address:=lookup_hostname(f_hostname);
  if ip_address=INVALID_IP_ADDRESS then
    raise ETcpIpError.Create(Couldnt resolve hostname +f_hostname);
  open_socket_out(f_socket,f_Socket_number,ip_address);
  if f_socket=INVALID_SOCKET then
    raise ESocketError.Create(WSAGetLastError);
  f_eof:=false;
  f_logged_in:=true;
  end;
(*@\000000315*)
(*@/// procedure t_tcpip.LogOut; *)
procedure t_tcpip.LogOut;
begin
  close_socket(f_socket);
  f_socket:=invalid_socket;
  f_logged_in:=false;
  end;
(*@\000000501*)
(*@/// procedure t_tcpip.SendCommand(const s:string); *)
procedure t_tcpip.SendCommand(const s:string);
begin
  self.write_s(f_socket,s+#13#10);
  if assigned(f_tracer) then
    f_tracer(s,tt_proto_sent);
  end;
(*@\000000301*)


(*@/// function t_tcpip.eof(f_socket:TSocket):boolean;            !!! *)
function t_tcpip.eof(f_socket:TSocket):boolean;
begin
  eof:=f_eof or (socket_state(f_socket)<>connected);
  end;
(*@\000000114*)
(*@/// procedure t_tcpip.read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer); *)
procedure t_tcpip.read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer);
var
  temp_buf: pointer;
  error: integer;
begin
  temp_buf:=NIL;
  try
    if @buf=NIL then
      getmem(temp_buf,size)  (* alloc for the -> /dev/null *)
    else
      temp_buf:=@buf;
    repeat
      _ok:=Winsock.recv(F_Socket,temp_Buf^,Size,0);
      if _ok<=0 then begin
        error:=Winsock.WSAGetLastError;
        (* listening socket is always non-blocking, but this causes
           problems with the recv command *)
        if error=wsaewouldblock then begin
          if f_async then begin
            f_newdata:=false;
            while not f_newdata do
              Application.ProcessMessages;
            end;
          end;
        f_eof:=error<>wsaewouldblock;
        end
      else
        if assigned(f_tracer) then
          f_tracer(Received +inttostr(_ok)+ bytes on socket ID +
                   inttostr(f_socket),tt_socket);
    until f_eof or (_ok>0);
  finally
    if @buf=NIL then
      freemem(temp_buf,size)
    end;
  end;
(*@\000000601*)
(*@/// function t_tcpip.read_line(f_socket:TSocket):string; *)
function t_tcpip.read_line(f_socket:TSocket):string;
var
  x: char;
  ok: integer;
  s: string;
begin
  s:=;
  repeat
    read_var(f_socket,x,1,ok);
    if x=#13 then               (* at least NCSA 1.3 does send a #10 only *)
    else if x=#10 then begin
        result:=s;
        EXIT;
      end
    else begin
      s:=s+x;
      end;
  until eof(f_socket);
  end;
(*@\*)
(*@/// procedure t_tcpip.write_buf(f_socket:TSocket; const buf; size:integer); *)
procedure t_tcpip.write_buf(f_socket:TSocket; const buf; size:integer);
begin
  if Winsock.Send(F_Socket,pointer(@buf)^,size,0)=SOCKET_ERROR then
     EXIT  (* Error writing *)
  else
  if assigned(f_tracer) then
    f_tracer(Sent +inttostr(size)+ bytes on socket ID +
             inttostr(f_socket),tt_socket);
  end;
(*@\000000801*)
(*@/// procedure t_tcpip.write_s(f_socket:TSocket; const s:string); *)
procedure t_tcpip.write_s(f_socket:TSocket; const s:string);
begin
(*$ifdef ver80 *)
  write_buf(f_socket,pchar(@s[1])^,length(s));
(*$else *)
(*$ifopt h- *)
  write_buf(f_socket,pchar(@s[1])^,length(s));
(*$else *)
  write_buf(f_socket,pchar(s)^,length(s));
(*$endif *)
(*$endif *)
  end;
(*@\000000801*)

(*@/// procedure t_tcpip.SetStream(value:TStream); *)
procedure t_tcpip.SetStream(value:TStream);
begin
  TMemoryStream(f_stream).LoadFromStream(value);
  end;
(*@\000000301*)

(*@/// procedure t_tcpip.action; *)
procedure t_tcpip.action;
var
  p: pointer;
  ok,ok2:integer;
begin
  login;
  TMemorystream(f_stream).clear;
  while not eof(f_socket) do begin
    read_var(f_socket,f_buffer^,buf_size,ok);
    p:=f_buffer;
    while ok>0 do begin   (* just to be sure ever

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved