TCP/IP(六)

页面导航:首页 > 软件编程 > Delphi > TCP/IP(六)

TCP/IP(六)

来源: 作者: 时间:2016-01-23 10:15 【

*@\000000B01*)(*@/// procedure t_ftp.WndProc(var Msg : TMessage); *)procedure t_ftp.WndProc(var Msg : TMessage);var temp_socket:TSocket; sockinfo: TSockAddr;begin if msg.msguwm_socketevent+

*@\\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
                                           clients 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:

Tags:

相关文章

    文章评论

    最 近 更 新
    热 点 排 行
    Js与CSS工具
    代码转换工具
    
    <