TCP/IP (三)
2008-04-10 02:58:14来源:互联网 阅读 ()
(*@\\\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 ''''
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash