sendunit.pas

本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过

unit sendUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  lmdctrl, lmdstdcS, ExtCtrls, StdCtrls, Buttons, tcpip, ComCtrls,
  cmpGFXComboBox;

type
  TDform = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label1: TLabel;
    FTP: T_FTP;
    Label2: TLabel;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Image1: TImage;
    Image3: TImage;
    LMDSimpleLabel3: TLMDSimpleLabel;
    LMDSimpleLabel2: TLMDSimpleLabel;
    LMDSimpleLabel1: TLMDSimpleLabel;
    Edit1: TEdit;
    DateTimePicker1: TDateTimePicker;
    Label3: TLabel;
    Image2: TImage;
    ComboBox1: TGFXComboBox;
    ImageList1: TImageList;
    Bevel1: TBevel;
    Image4: TImage;
    Panel2: TPanel;
    Image5: TImage;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
     procedure ftp_data(Sender:TObject; mode: t_ftp_mode; data:integer);
    procedure FTPTrace(const s: String; level: TTraceLevel);
    procedure FormActivate(Sender: TObject);
    procedure DateTimePicker1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);

  private
     function makescreat(s:string) :string;
   function showscreat(s:string) :string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Dform: TDform;

implementation

uses   ipdress, REMain1, newunit;

{$R *.DFM}
 var
 uploadsize:integer;
 size:word;
 downloadfile:boolean;
 y:word;
m:word;
d:word;
Fdate:Tdatetime;


procedure TDform.BitBtn2Click(Sender: TObject);
begin

close;
end;

procedure TDform.BitBtn1Click(Sender: TObject);
var
file1name:string;
ffilename:string;
begin

 Fdate:=DateTimePicker1.date;
 DecodeDate(fdate,y,m,d);

 if dform.Label1.Caption='mainform01' then
    begin

       mainform.editor.lines.SaveToFile('c:\NewStar\Save\'+mainform.nameLabel.Caption+'0'+typeform.Label4.Caption+'文档资料.sav');

      {============暂 存=============================}

    if trim(ComboBox1.Text)='' then
       begin
       showmessage('请选择你要发送的部门....!');
       exit;
       end;

                     with mainform do
                     begin

    {=============================}
    deletefile(pchar('C:\Sky\tmp.tmp'));
    screen.Cursor:=crHourGlass;
    FFileName:='C:\Sky\'+mainform.nameLabel.Caption+'0'+typeform.Label4.Caption+dform.ComboBox1.Text+inttostr(y)+inttostr(m)+inttostr(d);
    Editor.Lines.SaveToFile('C:\Sky\tmp.tmp');
    Editor.Modified := False;


     if fileexists(FFileName+'.rdx') then
       deletefile(pchar(FFileName+'.rdx'));
      with Archiver1 do
    begin
      FileName :=  FFileName+'.rdx'   ;
      Archiver1.DeleteFiles;
      Open;
      try
       AddFile('C:\Sky\tmp.tmp');
         if fileexists('C:\Sky\tmp.tmp') then
          deletefile(pchar('C:\Sky\tmp.tmp'));
          screen.Cursor:=crDefault;
      finally
        Close;
      end;
    end;
{+====================}

      screen.Cursor:=crDefault;
{============================================================}

                        end;

       file1name:=FFileName+'.rdx' ;
       BitBtn1.Enabled:=false;

         {===============ftp==========}

                           {FTP }
        ftp.hostname:=showscreat(trim(mainform.hostsiteLabel.Caption));
        ftp.Password:=showscreat(trim(mainform.datpassLabel.Caption));
        ftp.Port:=21;
        ftp.Username:=showscreat(trim(mainform.datuserLabel.Caption));
        dform.StatusBar1.Panels[1].text:=' 正在试图和服务器 '+ ftp.hostname+' 进行连接...';
        try
            ftp.login;
            ftp.getdir('.');
            ftp.changedir('report/dat0'+typeform.Label4.Caption);
            ftp.getdir('.');
        except

           dform.StatusBar1.Panels[1].text:=' 登陆FTP服务器 '+ ftp.hostname+' 失败,请重试!!!...';
                 screen.Cursor:=crDefault;
           ftp.abort;
           ftp.logout;
                                         BitBtn1.Enabled:=true;
           exit;
        end;

        try



                          ftp.Mode:=tftp_upload;
                          ftp.uri:=extractfilename(file1name);
                          TMemorystream(ftp.stream).loadfromfile(file1name);
                          ftp.upload;
                          ftp.getdir('.');
                           ftp.abort;
                           ftp.logout;


                     dform.StatusBar1.Panels[1].text:=' 已经和数据服务器 '+ ftp.hostname+' 断开,数据全部处理完毕...';
                     screen.Cursor:=crdefault;

          except

                     ftp.abort;
                     ftp.logout;
                    dform.StatusBar1.Panels[1].text:=' 发送数据时出现意外错误，请关闭程序重试!';
                    screen.Cursor:=crdefault;
                    BitBtn1.Enabled:=true;
           end;

         {=================ftpend;===========}
 close;
  end;




    close;

end;


procedure Tdform.FTPTrace(const s: String; level: TTraceLevel);
begin
if ftp.busy then
 begin
     screen.Cursor:=crDefault;
 end else
 begin

   screen.Cursor:=crHourGlass;

 end;
  case level of
    tt_proto_sent, tt_proto_get: begin

    if trim(s)<>'200 Type set to I.' then begin
    if ftp.mode=tftp_upload then begin
     dform.StatusBar1.Panels[1].text:=' @NewStar正在发送数据....';

    end else
    begin
   dform.StatusBar1.Panels[1].text:=' @NewStar 正在处理命令...: '+s;

    end;
    end else
    begin
     uploadsize:=0;

   dform.StatusBar1.Panels[1].text:=' OK! 命令处理完毕!';
    end;


    end;
    end;
end;



(*@\\\0000000401*)
(*@/// procedure Tmainform.ftp_data(Sender:TObject; mode: t_ftp_mode; data:integer); *)
procedure Tdform.ftp_data(Sender:TObject; mode: t_ftp_mode; data:integer);
begin
  if mode=tftp_download then begin
    size:=size+data;
    if t_ftp(sender).size=0 then
    begin
     if downloadfile then begin
   dform. StatusBar1.Panels[1].text:=' OK! 下载已成功完成...';

     end else begin

     dform.StatusBar1.Panels[1].text:='   '+inttostr(size)+'   字节已被接收';
     end;

    end

    else
    begin
    if downloadfile then begin
     dform.StatusBar1.Panels[1].text:=' OK 下载已成功完成..';

     end else begin
    dform.StatusBar1.Panels[1].text:='  总计:'+inttostr(t_ftp(sender).size)+' 字节，已下载 '+inttostr(size)+' 字节...';

                      end;

    end ;

    end;
 if mode=tftp_upload then begin

    size:=size+data;
    if t_ftp(sender).size=0 then
    begin
     dform.StatusBar1.Panels[1].text:='   '+inttostr(size)+'   字节已被发送';

    end

    else
    begin
  dform.StatusBar1.Panels[1].text:='   '+inttostr(size)+' of '+
                         inttostr(t_ftp(sender).size)+'  字节已被发送';

    end ;

    end;

  end;
(*@\\\003C000801000801000923000935000801*)
(*@/// procedure Tmainform.ftp_trace(const s: string; level: TTraceLevel); *)