TCP/IP(六）

最新推荐文章于 2020-02-26 17:14:30 发布

原创最新推荐文章于 2020-02-26 17:14:30 发布 · 866 阅读

0 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#socket #stream #constructor #integer #destructor

*@///0000000B01*)

(*@/// procedure t_ftp.WndProc(var Msg : TMessage); *)
procedure t_ftp.WndProc(var Msg : TMessage);
var
temp_socket:TSocket;
sockinfo: TSockAddr;
begin
if msg.msg<>uwm_socketevent+1 then
    inherited WndProc(Msg)
else begin
    if msg.lparamhi=socket_error then
    else begin
      case msg.lparamlo of
(*@///         fd_accept: *)
fd_accept: begin
temp_socket:=f_socket;
self.f_socket:=accept_socket_in(f_socket,sockinfo);
close_socket(temp_socket);
end;
(*@///0000000401*)
(*@///         fd_write: *)
fd_write: begin
case f_mode_intern of
    tftp_download,
    tftp_getdir:   ;
    tftp_upload: do_write;
    end;
end;
(*@///000000010B*)
(*@///         fd_read: *)
fd_read: begin
case f_mode_intern of
    tftp_download,
    tftp_getdir:   do_read;
    tftp_upload: ;
    end;
end;
(*@///0000000201*)
        fd_connect: ;   (* can be ignored, a fd_write will come *)
(*@///         fd_close: *)
fd_close: begin
{   case f_mode_intern of }
{     tftp_download: finish_download; }
{     tftp_getdir:   finish_getdir; }
{     tftp_upload:   finish_upload; }
{     end; }
end;
(*@///0000000701*)
        end;
      end;
    end;
end;
(*@///0000000C01*)

(*@/// function t_ftp.getdirentry:t_filedata; *)
function t_ftp.getdirentry:t_filedata;
begin
result:=empty_filedata;
while (f_cur_dir_index<f_cur_dir.count) and ((result.filetype=ft_none)
      or (result.name='.') or (result.name='..')) do begin
    result:=parse_ftp_line(f_cur_dir[f_cur_dir_index]);
    inc(f_cur_dir_index);
    end;
end;
(*@///0000000601*)

(*@/// function t_ftp.read_line_comm:string; *)
function t_ftp.read_line_comm:string;
begin
result:=read_line(f_comm_socket);
end;
(*@///0000000401*)
(*@/// procedure t_ftp.SendCommand(const s:string); *)
procedure t_ftp.SendCommand(const s:string);
begin
write_s(f_comm_socket,s+#13#10);
if assigned(f_tracer) then
f_tracer(s,tt_proto_sent);
end;
(*@///0000000321*)
(*@///0000000C01*)

{ Time, RExec, LPR - the most useful UNIX services }
(*@/// class t_time(t_tcpip) *)
(*@/// constructor t_time.Create(Aowner:TComponent); *)
constructor t_time.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=37;
f_time:=0;
f_timemode:=tzUTC;
end;
(*@///0000000601*)

(*@/// procedure t_time.action; *)
procedure t_time.action;
var
ok:integer;
b: byte;
bias: integer;
begin
login;
f_time:=0;
while not eof(f_socket) do begin
    read_var(f_socket,b,1,ok);
    if ok=1 then
      f_time:=f_time*256+b;
    end;
f_time:=f_time/86400+encodedate(1900,1,1);
if f_timemode<>tzUTC then begin
(* Alternative: use SystemTimeToTzSpecificLocalTime, but only works in NT *)
    bias:=TimeZoneBias;
    f_time:=f_time-bias/1440; (* bias is in minutes *)
    end;
end;
(*@///0000000901*)
(*@///0000000310*)
(*@/// class T_RCommon(t_tcpip) *)
(*@/// procedure t_rcommon.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_rcommon.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint);
begin
close_socket(socket);
socket:=Create_Socket;
bind_socket(socket,512,1023);
connect_socket(socket,Socket_number,ip_address);
end;
(*@///0000000113*)
(*@/// procedure t_rcommon.action; *)
procedure t_rcommon.action;
var
p: pointer;
ok,ok2:integer;
begin
login;
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 everything goes into the stream *)
      ok2:=f_stream.write(p^,ok);
      dec(ok,ok2);
      p:=pointer(longint(p)+ok2);
      end;
    end;
f_stream.seek(0,0); (* set the stream back to start *)
logout;
end;
(*@///0000000113*)
(*@///000000021B*)
(*@/// class t_rexec(t_rcommon) *)
(*@/// constructor t_rexec.Create(Aowner:TComponent); *)
constructor t_rexec.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=512;   (* rexec *)
end;
(*@///0000000501*)
(*@/// procedure t_rexec.login; *)
procedure t_rexec.login;
begin
inherited login;
self.write_s(f_socket,f_user+#0);
self.write_s(f_socket,f_pass+#0);
self.write_s(f_socket,f_command+#0);
end;
(*@///0000000410*)
(*@///0000000201*)
(*@/// class t_rsh(t_rcommon) *)
(*@/// constructor t_rsh.Create(Aowner:TComponent); *)
constructor t_rsh.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=514;   (* rsh *)
end;
(*@///0000000401*)
(*@/// procedure t_rsh.login; *)
procedure t_rsh.login;
begin
inherited login;
self.write_s(f_socket,'0'+#0);        (* port for stderr, NYI *)
                                        (* must be a listening port on the
                                           client's side, within the reserved
                                           port range 512..1023 *)
self.write_s(f_socket,f_user_r+#0);   (* remote *)
self.write_s(f_socket,f_user_l+#0);   (* local *)
self.write_s(f_socket,f_command+#0); (* command to execute *)
end;
(*@///0000000401*)
(*@///0000000201*)
(*@/// class T_lpr(t_tcpip) *)
(*@/// constructor t_lpr.Create(Aowner:TComponent); *)
constructor t_lpr.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=515;
f_printtype:=lp_ascii;
f_count:=1;
end;
(*@///000000060E*)

(*@/// procedure t_lpr.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_lpr.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint);
begin
close_socket(socket);
socket:=Create_Socket;
bind_socket(socket,512,1023);
connect_socket(socket,Socket_number,ip_address);
end;
(*@///0000000501*)
(*@/// procedure t_lpr.action; *)
procedure t_lpr.action;
begin
login;
SendPrintData;
logout;
end;
(*@///0000000501*)
(*@/// procedure t_lpr.SendPrintData; *)
procedure t_lpr.SendPrintData;
var
ok:integer;
i: integer;
s: string;
job_name: string;
config_stream: TMemoryStream;
begin
(* sanity checks *)
if (f_queue='') or (f_stream.size=0) or (f_count=0) or (f_user='') then EXIT;
s:=#02+f_queue+#10;
write_s(f_socket,s);
self.response;
job_name:=inttostr(lpr_count+1000);
job_name:=copy(job_name,length(job_name)-2,3)+my_hostname;
(*@///   collect and send the description data *)
config_stream:=NIL;
try
config_stream:=TMemorystream.Create;
(*@///   H originating host *)
s:='H'+ip2string(my_ip_address)+#10;
stream_write_s(config_stream,s);
(*@///0000000120*)
(*@///   P responsible user *)
s:='P'+copy(f_user,1,31)+#10;
stream_write_s(config_stream,s);
(*@///*)
(*@///   M address to send the mail to *)
if f_user_mail<>'' then begin
s:='M'+f_user_mail+#10;
stream_write_s(config_stream,s);
end;
(*@///0000000303*)
(*@///   J jobname (for banner) *)
if f_jobname<>'' then begin
s:='M'+copy(f_jobname,1,99)+#10;
stream_write_s(config_stream,s);
end;
(*@///0000000401*)
(*@///   C class name = host name of sender (for banner) *)
s:='C'+copy(my_hostname,1,99)+#10;
stream_write_s(config_stream,s);
(*@///*)
(*@///   L banner page *)
if f_banner then begin
s:='L'+f_user+#10;
stream_write_s(config_stream,s);
end;
(*@///0000000303*)
(*@///   T title (for lp_pr only) *)
if f_title<>'' then begin
s:='T'+copy(f_title,1,79)+#10;
stream_write_s(config_stream,s);
end;
(*@///0000000303*)
(*@///   the print command itself *)
case f_printtype of
lp_plain:   s:='l';
lp_ascii:   s:='f';
lp_dvi:     s:='d';
lp_plot:    s:='g';
lp_ditroff: s:='n';
lp_ps:      s:='o';
lp_pr:      s:='p';
lp_fortran: s:='r';
lp_troff:   s:='t';
lp_raster: s:='v';
lp_cif:     s:='c';
end;
s:=s+job_name+#10;
for i:=1 to f_count do
stream_write_s(config_stream,s);
(*@///*)
(*@///   U unlink the file after the printing *)
s:='U'+jobname+#10;
stream_write_s(config_stream,s);
(*@///*)
(*@///   send the data *)
config_stream.seek(0,0); (* set the stream back to start *)
s:=#02+inttostr(config_stream.size)+' cfA'+job_name+#10;
write_s(f_socket,s);
self.response;
ok:=1;
while ok>0 do begin
ok:=config_stream.read(f_buffer^,buf_size);
write_buf(f_socket,f_buffer^,ok);
end;
write_s(f_socket,#0);   (* finish the config data *)
(*@///*)
finally
config_stream.free;
end;
(*@///0000001007*)
(*@///   send the data to print *)
s:=#03+inttostr(stream.size)+' dfA'+job_name+#10;
write_s(f_socket,s);
self.response;
f_stream.seek(0,0); (* set the stream back to start *)
ok:=1;
while ok>0 do begin
ok:=f_stream.read(f_buffer^,buf_size);
write_buf(f_socket,f_buffer^,ok);
end;
write_s(f_socket,#0);   (* finish the plot *)
(*@///000000081E*)
inc(lpr_count);
end;
(*@///0000001001*)
(*@/// procedure t_lpr.GetQueueStatus(detailed:boolean); *)
procedure t_lpr.GetQueueStatus(detailed:boolean);
var
p: pointer;
ok,ok2:integer;
s: string;
begin
if (f_queue='') then EXIT;
if detailed then
    s:=#04+f_queue+#10
else
    s:=#03+f_queue+#10;
write_s(f_socket,s);
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 everything goes into the stream *)
      ok2:=f_stream.write(p^,ok);
      dec(ok,ok2);
      p:=pointer(longint(p)+ok2);
      end;
    end;
f_stream.seek(0,0); (* set the stream back to start *)
end;
(*@///0000001503*)
(*@/// procedure t_lpr.response; *)
procedure t_lpr.response;
var
b: byte;
ok: integer;
begin
read_var(f_socket,b,1,ok);
if (ok<>1) or (b<>0) then
    raise EProtocolError.Create('LPR','',999);
end;
(*@///0000000305*)

{ remove jobs }
{ get status }
(*@///0000000501*)

{ The Mail and News protocols }
(*@/// class t_smtp(t_tcpip) *)
(*@/// constructor t_smtp.Create(Aowner:TComponent); *)
constructor t_smtp.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=25;
f_receipts:=TStringList.Create;
f_body:=TStringList.Create;
end;
(*@///0000000501*)
(*@/// destructor t_smtp.Destroy; *)
destructor t_smtp.Destroy;
begin
f_receipts.Free;
f_body.Free;
inherited destroy;
end;