sendunit.pas

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

unit sendUnit;

interface

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

type
  TDform = class(TForm)
    Edit1: TEdit;
    Image1: TImage;
    LMDSimpleLabel1: TLMDSimpleLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    FTP: T_FTP;
    LMDSimpleLabel3: TLMDSimpleLabel;
    Image3: TImage;
    DateTimePicker1: TDateTimePicker;
    LMDSimpleLabel2: TLMDSimpleLabel;
    Image2: TImage;
    Panel2: TPanel;
    Image5: TImage;
    Bevel1: TBevel;
    StatusBar1: TStatusBar;
    ImageList1: TImageList;
    combobox1: TGFXComboBox;
    regMemo: TMemo;
    Image4: TImage;
    LMDSimpleLabel4: TLMDSimpleLabel;
    GFXComboBox1: TGFXComboBox;
    ClientDataSet1: TClientDataSet;
    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 FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure combobox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure combobox1Change(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
  Dform: TDform;

implementation

uses Unit2, Unit1, Unit4, Unit5;

{$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;
filename:string;
begin
 if trim(GFXComboBox1.Text)='' then
 begin
 showmessage('警告: 操作错误,请选择发送部门 !');
 exit;
 end;

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

 if form4.dformctlabel.Caption='form2' then
    begin

       form4.ClientDataSet1.SaveToFile(trim('c:\NewStar\Save\'+form4.name.Lines.Text+form2.label4.Caption)+'.sav');
       form4.ClientDataSet1.SaveToFile('c:\sky\'+edit1.Text);
       file1name:='c:\sky\'+edit1.Text;
       BitBtn1.Enabled:=false;

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

                           {FTP }
        ftp.hostname:=showscreat(trim(form4.hostsiteLabel.Caption));
        ftp.Password:=showscreat(trim(form4.datpasslabel.Caption));
        ftp.Port:=21;
        ftp.Username:=showscreat(trim(form4.datuserlabel.Caption));

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

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

           ftp.abort;
           ftp.logout;

           exit;
        end;

        try



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


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

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

         {=================ftpend;===========}



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


        form4.ClientDataSet2.Close;
        form4.ClientDataSet2.LoadFromFile('C:\NewStar\Enterpirse\user\sysuser.dat');
        form4.ClientDataSet2.Open;
        form4.ClientDataSet2.First;
    while not  form4.ClientDataSet2.EOF do
    begin
       if form4.ClientDataSet2.fieldbyname('local').Value=true then
       begin
         try
           ftp.abort;
           ftp.logout;
           ftp.login;
           ftp.changedir('dat/regse');
           filename:=trim(form4.nameLabel.Caption)+'p.reg';
           ftp.uri:=filename;
                  size:=0;
                  ftp.download;
                  TMemorystream(ftp.stream).savetofile('C:\NewStar\Enterpirse\user\Update\common\'+trim(form4.nameLabel.Caption)+'p.reg');
                  regMemo.Lines.Clear;
                  regMemo.Lines.LoadFromFile('C:\NewStar\Enterpirse\user\Update\common\'+trim(form4.nameLabel.Caption)+'p.reg');
                   if trim(regMemo.Lines.Text)<>'' then
                   begin
                     form4.ClientDataSet2.Edit;
                     form4.ClientDataSet2.FieldByName('skyjy').Value:=strtoboolean(regmemo.Lines[0]);
                     form4.ClientDataSet2.FieldByName('skyfsjy').Value:=strtoboolean(regmemo.Lines[1]);
                     form4.ClientDataSet2.FieldByName('skydqjy').Value:=strtoboolean(regmemo.Lines[2]);
                     form4.ClientDataSet2.FieldByName('skyeditorjy').Value:=strtoboolean(regmemo.Lines[3]);
                     form4.ClientDataSet2.FieldByName('skyeditorjsjy').Value:=strtoboolean(regmemo.Lines[4]);
                     form4.ClientDataSet2.FieldByName('skyeditorfsjy').Value:=strtoboolean(regmemo.Lines[5]);
                     form4.ClientDataSet2.FieldByName('skyeditortjjy').Value:=strtoboolean(regmemo.Lines[6]);
                     form4.ClientDataSet2.FieldByName('skynetjy').Value:=strtoboolean(regmemo.Lines[7]);
                     form4.ClientDataSet2.FieldByName('skyserverjy').Value:=strtoboolean(regmemo.Lines[8]);
                     form4.ClientDataSet2.FieldByName('skyserver01jy').Value:=strtoboolean(regmemo.Lines[9]);
                     form4.ClientDataSet2.FieldByName('skyserver02jy').Value:=strtoboolean(regmemo.Lines[10]);
                     form4.ClientDataSet2.FieldByName('skyserver03jy').Value:=strtoboolean(regmemo.Lines[11]);
                     form4.ClientDataSet2.FieldByName('skyserver04jy').Value:=strtoboolean(regmemo.Lines[12]);
                     form4.ClientDataSet2.FieldByName('skyserver05jy').Value:=strtoboolean(regmemo.Lines[13]);
                     form4.ClientDataSet2.FieldByName('skyserver06jy').Value:=strtoboolean(regmemo.Lines[14]);
                     form4.ClientDataSet2.FieldByName('editorserverjy').Value:=strtoboolean(regmemo.Lines[15]);
                     form4.ClientDataSet2.FieldByName('ftpjy').Value:=strtoboolean(regmemo.Lines[16]);
                     form4.ClientDataSet2.FieldByName('ftpszjy').Value:=strtoboolean(regmemo.Lines[17]);
                     form4.ClientDataSet2.FieldByName('ftpxjwjjjy').Value:=strtoboolean(regmemo.Lines[18]);
                     form4.ClientDataSet2.FieldByName('ftpscjy').Value:=strtoboolean(regmemo.Lines[19]);
                     form4.ClientDataSet2.FieldByName('ftpxzjy').Value:=strtoboolean(regmemo.Lines[20]);
                     form4.ClientDataSet2.FieldByName('ftpjy').Value:=strtoboolean(regmemo.Lines[21]);
                     form4.ClientDataSet2.FieldByName('sqljy').Value:=strtoboolean(regmemo.Lines[22]);
                     form4.ClientDataSet2.FieldByName('nssqljy').Value:=strtoboolean(regmemo.Lines[23]);
                     form4.ClientDataSet2.FieldByName('WinArchiverjy').Value:=strtoboolean(regmemo.Lines[24]);
                     form4.ClientDataSet2.FieldByName('Winftpjy').Value:=strtoboolean(regmemo.Lines[25]);
                     form4.ClientDataSet2.FieldByName('skyimagejy').Value:=strtoboolean(regmemo.Lines[26]);
                     form4.ClientDataSet2.SaveToFile('C:\NewStar\Enterpirse\user\sysuser.dat');

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

       end;

       form4.ClientDataSet2.Next;
    end;




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












 close;
  end;


   if form4.dformctlabel.Caption='form5' then
   begin
   {=================================================}
                 
     if trim(combobox1.Text)='' then
     begin
     showmessage('请选择发送范围和发送日期...!');
     exit;
     end;




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

     form5.ClientDataSet1.SaveToFile('c:\sky\'+edit1.Text);
     file1name:='c:\sky\'+edit1.Text;
     BitBtn1.Enabled:=false;

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

                           {FTP }
        ftp.hostname:=showscreat(trim(form4.hostsiteLabel.Caption));
        ftp.Password:=showscreat(trim(form4.datpasslabel.Caption));
        ftp.Port:=21;
        ftp.Username:=showscreat(trim(form4.datuserlabel.Caption));

        StatusBar1.Panels[1].text:=' 正在试图和服务器 '+ ftp.hostname+' 进行连接...';
 try
  ftp.login;
  ftp.getdir('.');


  ftp.changedir('report/dat0'+inttostr(combobox1.ItemIndex+1));

  ftp.getdir('.');
 except

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

         ftp.abort;
         ftp.logout;

     exit;
 end;

try



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


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

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

         {=================ftpend;===========}









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






    close;

end;


procedure Tdform.FTPTrace(const s: String; level: TTraceLevel);
begin
dform.Update;
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 Tdform.ftp_data(Sender:TObject; mode: t_ftp_mode; data:integer);
begin
dform.Update;
  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