ufrmchild.pas

数据库通用工具

unit UfrmChild;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, ComCtrls, StdCtrls, Grids, DBGrids, ExtCtrls;

type
  TfrmChild = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    DBGrid1: TDBGrid;
    edita1: TEdit;
    edita2: TEdit;
    edita3: TEdit;
    edita4: TEdit;
    edita5: TEdit;
    btnlink1: TButton;
    btnunlink1: TButton;
    Panel2: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    DBGrid2: TDBGrid;
    editb1: TEdit;
    editb5: TEdit;
    editb4: TEdit;
    editb3: TEdit;
    editb2: TEdit;
    btnlink2: TButton;
    btnunlink2: TButton;
    Panel3: TPanel;
    btngo: TButton;
    btnout: TButton;
    StatusBar1: TStatusBar;
    Database1: TDatabase;
    Query1: TQuery;
    DataSource1: TDataSource;
    Database2: TDatabase;
    Query2: TQuery;
    DataSource2: TDataSource;
    qryInsert: TQuery;
    qryA: TQuery;
    qryB: TQuery;
    qryC: TQuery;
    qryInoculateSel: TQuery;
    QueryC: TQuery;
    mo: TMemo;
    checkInfo: TQuery;
    GetKey: TQuery;
    KeyAdd: TQuery;
    aryGetDate: TQuery;
    procedure btnlink1Click(Sender: TObject);
    procedure btnunlink1Click(Sender: TObject);
    procedure Database1AfterConnect(Sender: TObject);
    procedure Database1AfterDisconnect(Sender: TObject);
    procedure btnoutClick(Sender: TObject);
    procedure btnlink2Click(Sender: TObject);
    procedure btnunlink2Click(Sender: TObject);
    procedure Database2AfterConnect(Sender: TObject);
    procedure Database2AfterDisconnect(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btngoClick(Sender: TObject);
    function CheckChildInfo(sName,sBirth,sMather,sFather,iSex: String):integer;
    function GetKeyID( ichildType : integer ; sStationID : string):string;
    function InsertInoculate(sID,sChildID: String):integer;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmChild: TfrmChild;

implementation

uses UfrmMain;

{$R *.dfm}

procedure TfrmChild.btnlink1Click(Sender: TObject);
begin
  Database1.Connected := false;
  Database1.Params.Clear();
  Database1.DatabaseName :=  edita2.Text ;
  Database1.Params.Values['DATABASE NAME']:= edita2.Text ;
  Database1.Params.Values['SERVER NAME']  := edita1.Text ;
  Database1.Params.Values['USER NAME']    := edita3.Text ;
  Database1.Params.Values['PASSWORD']     := edita4.Text ;
  try
      Database1.Connected := true;
  except
      Application.MessageBox('数据库链接错误，请重新设置!','提示',MB_OK+MB_ICONINFORMATION);
      exit;
  end;

  if Database1.Connected = true then
  begin
    btnlink1.Enabled := false;
    qryA.DatabaseName := Database1.DatabaseName ;
    qryB.DatabaseName := Database1.DatabaseName ;
    qryC.DatabaseName := Database1.DatabaseName ;

    Query1.DatabaseName := Database1.DatabaseName ;
    Query1.Close();
    Query1.SQL.Text := 'select * from '+ edita5.Text ;
    try
      Query1.Open();
    except
      exit;
    end;
  end;

end;

procedure TfrmChild.btnunlink1Click(Sender: TObject);
begin
  Query1.Close();
  Query1.Active := false;
  Database1.Connected := false;
  btnlink1.Enabled := true;
end;

procedure TfrmChild.Database1AfterConnect(Sender: TObject);
begin
  StatusBar1.Panels.Items[0].Text := ' '+edita1.Text + ' < '+edita2.Text+' > 连接成功';
end;

procedure TfrmChild.Database1AfterDisconnect(Sender: TObject);
begin
  StatusBar1.Panels.Items[0].Text := ' '+edita1.Text + ' < '+edita2.Text+' > 断开连接!';
end;

procedure TfrmChild.btnoutClick(Sender: TObject);
begin
  close;
end;

procedure TfrmChild.btnlink2Click(Sender: TObject);
begin
  Database2.Connected := false;
  Database2.Params.Clear();
  Database2.DatabaseName :=  editb2.Text ;
  Database2.Params.Values['DATABASE NAME']:= editb2.Text ;
  Database2.Params.Values['SERVER NAME']  := editb1.Text ;
  Database2.Params.Values['USER NAME']    := editb3.Text ;
  Database2.Params.Values['PASSWORD']     := editb4.Text ;
  try
      Database2.Connected := true;
  except
      Application.MessageBox('数据库链接错误，请重新设置!','提示',MB_OK+MB_ICONINFORMATION);
      exit;
  end;

  if Database2.Connected = true then
  begin
    btnlink2.Enabled := false;
    qryInsert.DatabaseName := Database2.DatabaseName ;
    qryInoculateSel.DatabaseName := Database2.DatabaseName ;
    QueryC.DatabaseName := Database2.DatabaseName ;

    Query2.DatabaseName := Database2.DatabaseName ;
    Query2.Close();
    Query2.SQL.Text := 'select * from '+ editb5.Text ;
    try
      Query2.Open();
    except
      exit;
    end;
  end;
  
end;

procedure TfrmChild.btnunlink2Click(Sender: TObject);
begin
  Query2.Close();
  Query2.Active := false;
  Database2.Connected := false;
  btnlink2.Enabled := true;
end;

procedure TfrmChild.Database2AfterConnect(Sender: TObject);
begin
  StatusBar1.Panels.Items[1].Text := ' '+edita1.Text + ' < '+edita2.Text+' > 连接成功';
end;

procedure TfrmChild.Database2AfterDisconnect(Sender: TObject);
begin
  StatusBar1.Panels.Items[1].Text := ' '+edita1.Text + ' < '+edita2.Text+' > 断开连接!';
end;

procedure TfrmChild.FormDestroy(Sender: TObject);
begin
  Database1.Connected := false;
  Database2.Connected := false;
end;

procedure TfrmChild.btngoClick(Sender: TObject);
var
  sID,ss,sChildID : string;
  iOK,iNO: integer;
  sName,sBirth,sMather,sFather: String;
  spath,sfile:string;
begin

  mo.Lines.Add( ' -------------------------------------------------------------- ' );
  mo.Lines.Add( ' 开始时间: '+ DateTimeToStr( Now() ) );
  iOK := 0;
  iNO := 0;
  
  with qryA do
  begin
    while not qryA.Eof do
    begin
      //==========================================================================
      Application.ProcessMessages;
      sName  := FieldByName('name'  ).AsString;
      sBirth := FieldByName('birth' ).AsString;
      sMather:= FieldByName('mather').AsString;
      sFather:= FieldByName('father').AsString;
      ss := '儿童: '+sName
           +' , 生日: '+sBirth
           +' , 母亲: '+sMather
           +' , 父亲: '+sFather;
      //~~~~~~~~~~~~~~~~~~~~~~~~~~~
      //校验数据是否重复导入
      //校验总库中的儿童信息是否已经存在,0=不存在,1=查询出错,2=存在
      case CheckChildInfo(sName,sBirth,sMather,sFather,FieldByName('sex').AsString) of
        0:begin
          end;
        1:begin
            iNO := iNO + 1;
            mo.Lines.Add( ' 导入失败(查询异常) >< '+ss );
            qryA.Next;
            continue;
          end;
        2:begin
            iNO := iNO + 1;
            mo.Lines.Add( ' 导入失败(已经存在) >< '+ss );
            qryA.Next;
            continue;
          end;
      else
        begin