手机站
网通分站
电信主站
密 码:
用户名:
当前位置 : 主页>程序设计>delphi>列表

TCP/IP (三)

来源:互联网 作者:西部数码 时间:2008-04-10
西部数码-全国虚拟主机10强!40余项虚拟主机管理功能,全国领先!双线多线虚拟主机南北访问畅通无阻!免费赠送企业邮局,.CN域名,自助建站480元起,免费试用7天,满意再付款! P4主机租用799元/月.月付免压金!

(*@\\\0000000D01*)
(*@/// 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;
(*@\\\0000000501*)
(*@/// 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;
(*@\\\0000000842*)
(*@/// 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;
(*@\\\0000000E02*)

(*@/// 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(''''Couldn''''''''t 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;
(*@\\\0000000315*)
(*@/// procedure t_tcpip.LogOut; *)
procedure t_tcpip.LogOut;
begin
close_socket(f_socket);
f_socket:=invalid_socket;
f_logged_in:=false;
end;
(*@\\\0000000501*)
(*@/// 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;
(*@\\\0000000301*)


(*@/// 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;
(*@\\\0000000114*)
(*@/// 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;
(*@\\\0000000601*)
(*@/// 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 ''''

文章整理:西部数码--专业提供域名注册虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!