redunit.pas

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

unit redunit;

interface

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

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

var
  redform: Tredform;

implementation

uses  ipdress, Unit11, Unit1;

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




procedure Tredform.FormActivate(Sender: TObject);
begin

BitBtn1.Enabled:=true;
LMDSimpleLabel2.Caption:='接收时间: '+datetostr(form1.DateTimePicker1.date);
ProgressBar1.Position:=0;
StatusBar1.Panels[1].text:='';

end;

procedure Tredform.FormClose(Sender: TObject; var Action: TCloseAction);
begin

form1.FileListBox3.Update;
screen.Cursor:=crarrow;
end;

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



procedure Tredform.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正在发送数据....';

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

    end;
    end else
    begin
     uploadsize:=0;

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


    end;
    end;
end;



(*@\\\0000000401*)
(*@/// procedure Tmainform.ftp_data(Sender:TObject; mode: t_ftp_mode; data:integer); *)
procedure Tredform.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
    StatusBar1.Panels[1].text:=' OK! 下载已成功完成...';

     end else begin

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

    end

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

     end else begin
    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
    StatusBar1.Panels[1].text:='   '+inttostr(size)+'   字节已被发送';

    end

    else
    begin
    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); *)



procedure Tredform.BitBtn1Click(Sender: TObject);
var i:integer;
j:integer;
filename:string;
down:boolean;
times:integer;
begin
 bitbtn1.Enabled:=false;
 Fdate:=form1.DateTimePicker1.date;
 DecodeDate(fdate,y,m,d);
 form1.Archiver1.Close;
 {======================================}

     restory.Lines.Clear;
     restory.Lines.LoadFromFile(dir+'dat\save\story\story.dat');
     restory01.Lines.Clear;
     restory01.Lines.LoadFromFile(dir+'dat\save\story\story.dat');


 {=======================================}
  {===============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));

        ProgressBar1.Position:=0;
        StatusBar1.Panels[1].text:=' 正在试图和服务器 '+ ftp.hostname+' 进行连接...';

        try
            ftp.login;
            ftp.getdir('.');
            ftp.changedir('dat');
            ftp.getdir('.');
        except
               StatusBar1.Panels[1].text:=' 登陆FTP服务器 '+ ftp.hostname+' 失败,请重试!!!...';
               ftp.abort;
               ftp.logout;
               exit;
        end;

             times:=form1.recSize.value;
             ProgressBar1.Max:=times;

         for  j:=0 to times do
         begin
          down:=true;
          ProgressBar1.Position:=j*10 ;
   {===========================================================}
          filename:='ZB'+inttostr(y)+inttostr(m)+inttostr(d)+'-'+inttostr(j)+'.rdx';


            for i:=0 to restory.Lines.Count-1 do
            begin
                     if restory.Lines[i]=filename then
                     begin
                     down:=false;
                     break;
                     end;
            end;


                StatusBar1.Panels[1].text:='正在接收总部索引 '+inttostr(y)+inttostr(m)+inttostr(d)+'.rdx'+'....';

              if down then
              begin
                {========================}
                try
                  downloadfile:=false;
                  ftp.uri:=filename;
                  size:=0;
                  ftp.download;
                  TMemorystream(ftp.stream).savetofile(dir+'dat\temp00\总部通告'+inttostr(y)+inttostr(m)+inttostr(d)+'-'+inttostr(j)+'.rdx');
                  restory01.Lines.Add('ZB'+inttostr(y)+inttostr(m)+inttostr(d)+'-'+inttostr(j)+'.rdx');
                  restory01.Lines.SaveToFile(dir+'dat\save\story\Story.dat');

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

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


         {=======================recive personal data===}


        form1.ClientDataSet1.Close;
        form1.ClientDataSet1.LoadFromFile('C:\NewStar\Enterpirse\user\sysuser.dat');
        form1.ClientDataSet1.Open;
        form1.ClientDataSet1.First;
    while not  form1.ClientDataSet1.EOF do
    begin
       if form1.ClientDataSet1.fieldbyname('local').Value=true then
       begin
         try

           ftp.changedir('regse');
           filename:=trim(form1.nameLabel.Caption)+'p.reg';
           ftp.uri:=filename;
                  size:=0;
                  ftp.download;
                  TMemorystream(ftp.stream).savetofile('C:\NewStar\Enterpirse\user\Update\common\'+trim(form1.nameLabel.Caption)+'p.reg');
                  regMemo.Lines.Clear;
                  regMemo.Lines.LoadFromFile('C:\NewStar\Enterpirse\user\Update\common\'+trim(form1.nameLabel.Caption)+'p.reg');
                   if trim(regMemo.Lines.Text)<>'' then
                   begin
                     form1.ClientDataSet1.Edit;
                     form1.ClientDataSet1.FieldByName('skyjy').Value:=strtoboolean(regmemo.Lines[0]);
                     form1.ClientDataSet1.FieldByName('skyfsjy').Value:=strtoboolean(regmemo.Lines[1]);