*@\\\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*) (*@///&nbs [1] [2] 下一页 [Delphi程序]Delphi 程序员代码编写标准指南 (六)
|