www.pudn.com > transfox.rar > send.pas

unit send; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, Buttons, Grids, DBGrids, ExtCtrls, ComCtrls,DBTables; 
 
 
type 
  TFrm_send = class(TForm) 
    DBGrd_sendinfo: TDBGrid; 
    BtBtn_trans: TBitBtn; 
    BtBtn_close: TBitBtn; 
    BtBtn_find: TBitBtn; 
    GroupBox1: TGroupBox; 
    Label1: TLabel; 
    Label2: TLabel; 
    DtTmPckr_start: TDateTimePicker; 
    DtTmPckr_end: TDateTimePicker; 
    StatusBar1: TStatusBar; 
    BtBtn_ODBC: TBitBtn; 
    ComboBox1: TComboBox; 
    Label3: TLabel; 
    btn_contest: TBitBtn; 
    btn_accept: TButton; 
    procedure FormShow(Sender: TObject); 
    procedure BtBtn_transClick(Sender: TObject); 
    procedure BtBtn_findClick(Sender: TObject); 
    procedure BtBtn_ODBCClick(Sender: TObject); 
    procedure btn_contestClick(Sender: TObject); 
    procedure BtBtn_closeClick(Sender: TObject); 
    procedure btn_acceptClick(Sender: TObject); 
  private 
    { Private declarations } 
    procedure SqlTrantofox(tbname:string); 
    procedure deletebeforetran(tbname,baza01:string); 
  public 
    { Public declarations } 
  end; 
 
var 
  Frm_send: TFrm_send; 
 
implementation 
uses trans,data, createodbc; 
{$R *.dfm} 
 
procedure TFrm_send.SqlTrantofox(tbname:string); 
begin 
try 
   DM.Tbl_source.TableName:=tbname+'_temp'; 
   DM.Tbl_dest.TableName:=tbname; 
  //    DM.Tbl_source.TableName:='baf9_temp'; 
  //    DM.Tbl_dest.TableName:='baf9'; 
   with DM.BtchMv_sickcase do 
   begin 
      Execute; 
     // ShowMessage(tbname+'_temp:'+IntToStr(MovedCount) + ' records copied'); 
      //ShowMessage(IntToStr(ProblemCount) + ' records cannot copied'); 
     //ShowMessage(IntToStr(ChangedCount) + ' records cannot Changed'); 
   end; 
 except 
//    on E: Exception do 
//    begin 
//      application.MessageBox(pchar(e.message),'错误信息',mb_iconerror); 
      application.MessageBox(pchar(tbname+'表接收失败！'),'错误信息',mb_iconerror); 
      exit; 
   // end; 
  end; 
end; 
procedure TFrm_send.deletebeforetran(tbname,baza01:string); 
const 
 sqlstr2='delete from  %s where baza01<>%s'; 
begin 
   tbname:=trim(tbname)+'_temp'; 
   try 
    with dm.Q_source do 
    begin 
      close; 
      sql.clear; 
      sql.Add(format(sqlstr2,[tbname,baza01])); 
      Execsql; 
    end; 
    except 
        application.MessageBox(pchar(tbname+'记录提取失败！'),'错误信息',mb_iconerror); 
        exit; 
     end; 
 
end; 
 
 
procedure TFrm_send.FormShow(Sender: TObject); 
begin 
DtTmPckr_start.datetime:=now; 
DtTmPckr_end.DateTime:=now; 
Deplist(combobox1); 
//BtBtn_find.Click; 
end; 
 
procedure TFrm_send.BtBtn_transClick(Sender: TObject); 
var acaseidset:string; 
begin 
  if DBGrd_sendinfo.DataSource.DataSet.IsEmpty  then 
  begin 
    application.MessageBox('没有可传输的信息','信息',32); 
    exit; 
  end; 
  acaseidset:=CaseidSet(DBGrd_sendinfo); 
  try 
    TransSickCase('baza',acaseidset); 
    TransSickCase('baf1',acaseidset); 
    TransSickCase('baf2',acaseidset); 
    TransSickCase('baf3',acaseidset); 
    TransSickCase('baf4',acaseidset); 
    TransSickCase('baf5',acaseidset); 
    TransSickCase('baf9',acaseidset); 
    TransSickCase('bafc',acaseidset); 
    UpdateSeekInfo(acaseidset); 
    application.MessageBox('传输成功!','信息',0); 
  except 
    application.MessageBox('传输失败!','信息',16); 
    exit; 
  end; 
   BtBtn_find.Click; 
end; 
 
procedure TFrm_send.BtBtn_findClick(Sender: TObject); 
var reccount:integer; 
    ksbm:smallint; 
begin 
  ksbm:=strtoint(copy(combobox1.text,1,3)); 
  BrowsSeekInfo(DtTmPckr_start.datetime,DtTmPckr_end.DateTime,ksbm); 
  reccount:=DBGrd_sendinfo.DataSource.DataSet.RecordCount; 
  StatusBar1.Panels[0].Text:='记录数:'+inttostr(reccount); 
end; 
 
procedure TFrm_send.BtBtn_ODBCClick(Sender: TObject); 
begin 
  fm_createodbc.ShowModal; 
end; 
 
procedure TFrm_send.btn_contestClick(Sender: TObject); 
begin 
  try 
    application.MessageBox('连接成功！','提示信息',mb_iconinformation); 
    dm.Database_hmrs.Connected:=true; 
  except 
    application.MessageBox('连接失败！','错误信息',mb_iconerror); 
    exit; 
  end; 
end; 
 
procedure TFrm_send.BtBtn_closeClick(Sender: TObject); 
begin 
  close; 
end; 
 
procedure TFrm_send.btn_acceptClick(Sender: TObject); 
var baza01:string; 
begin 
      baza01:=DBGrd_sendinfo.Fields[0].AsString; 
      deletebeforetran('sickcase..baza',baza01); 
      deletebeforetran('sickcase..baf1',baza01); 
      deletebeforetran('sickcase..baf2',baza01); 
      deletebeforetran('sickcase..baf3',baza01); 
      deletebeforetran('sickcase..baf4',baza01); 
      deletebeforetran('sickcase..baf5',baza01); 
      deletebeforetran('sickcase..baf9',baza01); 
      deletebeforetran('sickcase..bafc',baza01); 
 
      with DM.BtchMv_sickcase do 
        begin 
          Source :=dm.Tbl_source; 
          Destination :=DM.Tbl_dest; 
          Mode := batCopy; 
          //AbortOnKeyViol := False; 
          //ShowMessage(IntToStr(MovedCount) + ' records copied'); 
          //ShowMessage(IntToStr(ChangedCount) + ' records cannot Changed'); 
        end; 
       try 
        SqlTrantofox('baza'); 
        SqlTrantofox('baf1'); 
        SqlTrantofox('baf2'); 
        SqlTrantofox('baf3'); 
        SqlTrantofox('baf4'); 
        SqlTrantofox('baf5'); 
        SqlTrantofox('baf9'); 
        SqlTrantofox('bafc'); 
        UpdateSeekInfo(baza01); 
        application.MessageBox('接收成功!','信息',0); 
       except 
          application.MessageBox('接收失败!','信息',16); 
          exit; 
       end; 
       BtBtn_find.Click; 
end; 
 
end.