unit11.pas

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

unit Unit11;

interface

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

type
  Treform = class(TForm)
    Image1: TImage;
    StatusBar1: TStatusBar;
    Image2: TImage;
    LMDSimpleLabel1: TLMDSimpleLabel;
    LMDSimpleLabel2: TLMDSimpleLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ProgressBar1: TProgressBar;
    Memo1: TMemo;
    ftp: T_FTP;
    StatusBar2: TStatusBar;
    Panel1: TPanel;
    Image4: TImage;
    Image5: TImage;
    Bevel1: TBevel;
    regmemo: TMemo;
    cbre: TCheckBox;
    procedure BitBtn2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn1Click(Sender: TObject);
       procedure ftp_data(Sender:TObject; mode: t_ftp_mode; data:integer);
    procedure FTPTrace(const s: String; level: TTraceLevel);
  private
     function makescreat(s:string) :string;
   function showscreat(s:string) :string;
    function strtoboolean(s:string) :boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  reform: Treform;

implementation

uses Unit1;

{$R *.DFM}

 var
 uploadsize:integer;
 size:word;
 downloadfile:boolean;
 y:word;
m:word;
d:word;
Fdate:Tdatetime;



procedure Treform.BitBtn2Click(Sender: TObject);
begin
close;
end;

procedure Treform.FormActivate(Sender: TObject);
begin
 bitbtn1.Enabled:=true;
 ProgressBar1.Position:=0;
 StatusBar2.Panels[1].text:='';
 StatusBar1.Panels[1].text:='';
form1.Enabled:=false;
LMDSimpleLabel1.Caption:='接收类别:  '+form1.ComboBox1.Text;
LMDSimpleLabel2.Caption:='接收时间:  '+datetostr(form1.DateTimePicker1.date);
{===========}
       memo1.Lines.Clear;
       memo1.Lines.LoadFromFile(form1.DirectoryListBox3.directory+'\dat\cdx0'+inttostr(form1.ComboBox1.ItemIndex+1)+'\id.txt');
       ProgressBar1.Max:=memo1.Lines.Count;
       ProgressBar1.Min:=0;


{===========}


end;

procedure Treform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
form1.Enabled:=true;
 screen.Cursor:=crarrow;
 try
   form1.ClientDataSet1.Close;
 except
 end;
end;


function finstr(sourcestr,destinstr:string):boolean;
 var
 s:string;
 i:integer;
 strlength: integer;
 slength:integer;
 begin
  {================================================}
        result:=false;
        strlength:=length(sourcestr);
        slength:=length(destinstr);
        for i:=0 to slength-1 do
            begin
                 try
                       s:=copy(destinstr,i,strlength);
                          if (sourcestr=s) or (uppercase(sourcestr)=s)  then
                            begin
                               result:=true;
                            end;
                 except
                 end;
             end;

  {================================================}
 end;






procedure Treform.BitBtn1Click(Sender: TObject);
var i:integer;
filename:string;
  full_name: string;
  h: t_filedata;
begin
      bitbtn1.Enabled:=false;
 Fdate:=form1.DateTimePicker1.date;
 DecodeDate(fdate,y,m,d);
  {===============ftp==========}

                           {FTP }
        ftp.hostname:=showscreat(trim(form1.hostsiteLabel.Caption));
        ftp.Password:=showscreat(trim(form1.datpassLabel.Caption));
        ftp.Port:=21;
        ftp.Username:=showscreat(trim(form1.datuserLabel.Caption));

        StatusBar1.Panels[1].text:=' 正在试图和服务器 '+ ftp.hostname+' 进行连接...';
        try
            ftp.login;
            ftp.getdir('.');
            ftp.changedir('report/dat0'+inttostr(form1.ComboBox1.ItemIndex+1));
            ftp.getdir('.');
        except

           StatusBar1.Panels[1].text:=' 登陆FTP服务器 '+ ftp.hostname+' 失败,请重试!!!...';

           ftp.abort;
           ftp.logout;

           exit;
        end;


          if  not cbre.Checked then     //接收当天
          begin
              for i:=0 to memo1.Lines.Count-1 do
              begin
                 StatusBar2.Panels[1].text:='正在接收 '+trim(memo1.Lines[i])+trim(form1.ComboBox1.Text)+inttostr(y)+inttostr(m)+inttostr(d)+'.cdx'+'....';
                 filename:=trim(memo1.Lines[i])+'-'+trim(form1.namelabel.caption)+trim(form1.ComboBox1.Text)+inttostr(y)+inttostr(m)+inttostr(d)+'.cdx';
                {========================}
                try
                  downloadfile:=false;
                  ftp.uri:=filename;
                  size:=0;
                  ftp.download;
                  TMemorystream(ftp.stream).savetofile(form1.DirectoryListBox3.directory+'\dat\temp0'+inttostr(form1.ComboBox1.ItemIndex+1)+'\'+filename);
                  form1.FileListBox3.update;
                  ftp.removefile(filename);

                except
                 StatusBar2.Panels[1].text:='接收失败!';
                end;
                {========================}
                 ProgressBar1.Position:=i+1;
              end;
        end;


          if  cbre.Checked then     //接收所有
          begin


                          {================================================================}
                        while true do begin
                         showmessage(h.name);
                        try
                           h:=ftp.getdirentry;
                        except
                           h.filetype:=ft_none;
                        end;

                         if h.filetype=ft_none then    BREAK;

                         case h.filetype of
                         ft_file: begin
                         full_name:=h.name;
                         showmessage(full_name);
                                   //================================================================================
                                       if  (finstr('-'+trim(form1.namelabel.caption)+trim(form1.ComboBox1.Text),full_name))  and (finstr('cdx',full_name))  then
                                       begin
                                       showmessage(full_name);
                                                          for i:=0 to memo1.Lines.Count-1 do
                                                          begin
                                                             if  (finstr(trim(memo1.Lines[i])+'-',full_name)) then
                                                             begin


                                                               StatusBar2.Panels[1].text:='正在接收 '+full_name+'....';
                                                               filename:=full_name;
                                                                  {========================}
                                                                  try
                                                                  downloadfile:=false;
                                                                  ftp.uri:=filename;
                                                                  size:=0;
                                                                  ftp.download;
                                                                  TMemorystream(ftp.stream).savetofile(form1.DirectoryListBox3.directory+'\dat\temp0'+inttostr(form1.ComboBox1.ItemIndex+1)+'\'+filename);
                                                                  form1.FileListBox3.update;
                                                                  ftp.removefile(filename);

                                                                  except
                                                                  StatusBar2.Panels[1].text:='接收失败!';
                                                                  end;
                                                                  {========================}

                                                             end;
                                                          end;

                                       end;
                                   //================================================================================


                                  end;
                         end; //end case


              end;   // end while

        {================================================================}
                   ProgressBar1.Position:=i+1;




        end;      //end if




           StatusBar2.Panels[1].text:='接收完毕...!';
           screen.Cursor:=crDefault;
           screen.Cursor:=crarrow;
           ftp.abort;
           ftp.logout;


           close;

end;


procedure Treform.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
   StatusBar1.Panels[1].text:=' @NewStar正在发送数据....';