ufrmimportnew.pas

数据库通用工具

unit UfrmImportNew;

interface

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

type
  TfrmImportNew = class(TForm)
    Database1: TDatabase;
    Query1: TQuery;
    DataSource1: TDataSource;
    Database2: TDatabase;
    Query2: TQuery;
    DataSource2: TDataSource;
    Query3: TQuery;
    Panel1: TPanel;
    Panel4: TPanel;
    labA: TLabel;
    labB: TLabel;
    lv: TListView;
    btnadd: TButton;
    btndel: TButton;
    btnclear: TButton;
    btnout: TButton;
    BitBtn1: TBitBtn;
    Panel5: TPanel;
    DBGrid1: TDBGrid;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    edita1: TEdit;
    edita2: TEdit;
    edita3: TEdit;
    edita4: TEdit;
    btnlink1: TButton;
    btnunlink1: TButton;
    edita5: TComboBox;
    Panel6: TPanel;
    Panel3: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    editb1: TEdit;
    editb4: TEdit;
    editb3: TEdit;
    editb2: TEdit;
    btnlink2: TButton;
    btnunlink2: TButton;
    editb5: TComboBox;
    DBGrid2: TDBGrid;
    lv1: TListView;
    lv2: TListView;
    ImageList1: TImageList;
    Label12: TLabel;
    Label13: TLabel;
    mo: TMemo;
    bbtRun: TBitBtn;
    StatusBar1: TStatusBar;
    labRa: TLabel;
    labRb: TLabel;
    ProgressBar1: TProgressBar;
    procedure btnoutClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure edita1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnlink1Click(Sender: TObject);
    procedure btnunlink1Click(Sender: TObject);
    procedure Database1AfterConnect(Sender: TObject);
    procedure Database1AfterDisconnect(Sender: TObject);
    procedure btnlink2Click(Sender: TObject);
    procedure btnunlink2Click(Sender: TObject);
    procedure Database2AfterConnect(Sender: TObject);
    procedure Database2AfterDisconnect(Sender: TObject);
    procedure edita5Change(Sender: TObject);
    procedure lv1CustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure lv2CustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure lv1Resize(Sender: TObject);
    procedure lv2Resize(Sender: TObject);
    procedure editb5Change(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure btnaddClick(Sender: TObject);
    procedure addMo( ss : string );
    procedure btnclearClick(Sender: TObject);
    procedure btndelClick(Sender: TObject);
    procedure bbtRunClick(Sender: TObject);
    procedure lvCustomDrawSubItem(Sender: TCustomListView; Item: TListItem;
      SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure lvResize(Sender: TObject);
    function setFieldToParam( stype : string; tp : TParam; tf : TField ) : Integer;
    procedure lvKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure moKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    
  private
    { Private declarations }
    path : string;
    ini : TIniFile;
    item : TListItem;
    bDoing : Boolean;
  public
    { Public declarations }
  end;

var
  frmImportNew: TfrmImportNew;

implementation

{$R *.dfm}

procedure TfrmImportNew.addMo( ss : string );
begin
  mo.Lines.Add( ss );
end;

procedure TfrmImportNew.btnoutClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmImportNew.FormShow(Sender: TObject);
begin
  lv1.Items.Clear;
  lv2.Items.Clear;
  lv.Items.Clear;

  Database1.Connected := false;
  Database2.Connected := false;
  
  path := ExtractFilePath(application.ExeName);
  ini := TIniFile.Create(path+'config.may');
  edita1.Text := ini.ReadString('ImportNew', 'Server1',  '127.0.0.1');
  edita2.Text := ini.ReadString('ImportNew', 'Database1','master');
  edita3.Text := ini.ReadString('ImportNew', 'user1',    'sa');
  edita4.Text := ini.ReadString('ImportNew', 'pass1',    'sa');
  //edita5.Text := ini.ReadString('ImportNew', 'table1',   'operator');
  //--------------------------------------------------------------
  editb1.Text := ini.ReadString('ImportNew', 'Server2',  '127.0.0.1');
  editb2.Text := ini.ReadString('ImportNew', 'Database2','master');
  editb3.Text := ini.ReadString('ImportNew', 'user2',    'sa');
  editb4.Text := ini.ReadString('ImportNew', 'pass2',    'sa');
  //editb5.Text := ini.ReadString('ImportNew', 'table2',   'operator');
  ini.Free;
  
end;

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

  path := ExtractFilePath(application.ExeName);
  ini := TIniFile.Create(path+'config.may');
  ini.WriteString('ImportNew', 'Server1',  edita1.Text );
  ini.WriteString('ImportNew', 'Database1',edita2.Text );
  ini.WriteString('ImportNew', 'user1',    edita3.Text );
  ini.WriteString('ImportNew', 'pass1',    edita4.Text );
  //ini.WriteString('ImportNew', 'table1',   edita5.Text );
  //--------------------------------------------------
  ini.WriteString('ImportNew', 'Server2',  editb1.Text );
  ini.WriteString('ImportNew', 'Database2',editb2.Text );
  ini.WriteString('ImportNew', 'user2',    editb3.Text );
  ini.WriteString('ImportNew', 'pass2',    editb4.Text );
  //ini.WriteString('ImportNew', 'table2',   editb5.Text );
  ini.Free;
end;

procedure TfrmImportNew.edita1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = vk_return then
    sendMessage(handle,wm_nextdlgctl,0,0);
end;

procedure TfrmImportNew.btnlink1Click(Sender: TObject);
var
  i,j: integer;
  ss,sb : string;
  slt:TStringList;
begin
  Database1.Connected := false;
  Database1.Params.Clear();
  //Database1.DatabaseName :=  edita2.Text ;
  Database1.DatabaseName :=  'A'+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 ;
  Database1.Params.Values['BLOB SIZE']    := IntToStr( 1024*8 );
  
  try
      Database1.Connected := true;
  except
      Application.MessageBox('数据库链接错误，请重新设置!','提示',MB_OK+MB_ICONINFORMATION);
      exit;
  end;

  if Database1.Connected = true then
  begin
    slt := TStringList.Create();
    Database1.GetTableNames(slt,false);
    
    btnlink1.Enabled := false;
    Query1.DatabaseName := Database1.DatabaseName ;

    //排序
    for i := 0 to slt.Count-2 do
    begin
      ss := slt.Strings[i];
      for j := i to slt.Count-1 do
      begin
        sb := slt.Strings[j];
        if LowerCase(sb) < LowerCase(ss) then
        begin
          ss := slt.Strings[j];
          slt.Strings[j] := slt.Strings[i];
          slt.Strings[i] := ss;
        end;

      end;

    end;
    
    edita5.Items.Clear;
    for i := 0 to slt.Count-1 do
    begin
      ss := slt.Strings[i];
      ss := copy(ss,5,length(ss)-4);
      edita5.Items.Add( ss );
    end;

    if edita5.Items.Count>0 then edita5.ItemIndex := 0;
    slt.Free;
   
    lv1.Items.Clear();
    lv.Items.Clear();
  end;

end;

procedure TfrmImportNew.btnunlink1Click(Sender: TObject);
begin
  Query1.Close();
  lv1.Items.Clear;
  Query1.Active := false;
  Database1.Connected := false;
  btnlink1.Enabled := true;
  lv.Items.Clear();
end;

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

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

procedure TfrmImportNew.btnlink2Click(Sender: TObject);
var
  i,a,j: integer;
  ss,sb : string;
  slt:TStringList;
begin

  Database2.Connected := false;
  Database2.Params.Clear();
  //Database2.DatabaseName :=  editb2.Text ;
  Database2.DatabaseName :=  'B'+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 ;
  Database2.Params.Values['BLOB SIZE']    := IntToStr( 1024*8 );

  try
      Database2.Connected := true;
  except
      Application.MessageBox('数据库链接错误，请重新设置!','提示',MB_OK+MB_ICONINFORMATION);
      exit;
  end;

  if Database2.Connected = true then
  begin
    slt := TStringList.Create();
    Database2.GetTableNames(slt,false);
    
    btnlink2.Enabled := false;
    Query3.DatabaseName := Database1.DatabaseName ;
    Query2.DatabaseName := Database2.DatabaseName ;

    //排序
    for i := 0 to slt.Count-2 do
    begin
      ss := slt.Strings[i];
      for j := i to slt.Count-1 do
      begin
        sb := slt.Strings[j];
        if LowerCase(sb) < LowerCase(ss) then
        begin
          ss := slt.Strings[j];
          slt.Strings[j] := slt.Strings[i];
          slt.Strings[i] := ss;
        end;

      end;

    end;
    
    editb5.Items.Clear;
    for i := 0 to slt.Count-1 do
    begin
      ss := slt.Strings[i];
      ss := copy(ss,5,length(ss)-4);
      editb5.Items.Add( ss );
    end;
    
    if editb5.Items.Count>0 then editb5.ItemIndex := 0;
    slt.Free;

    lv2.Items.Clear();
    lv.Items.Clear();
    //=============================
  end;

end;

procedure TfrmImportNew.btnunlink2Click(Sender: TObject);
begin
  Query2.Close();
  lv2.Items.Clear;
  Query2.Active := false;
  Database2.Connected := false;
  btnlink2.Enabled := true;
  lv.Items.Clear();
end;

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

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

function getFieldType( sDPName : string ) : string;
begin
  sDPName := Trim(sDPName);
  Result := '';
  if sDPName='TIntegerField' then
  begin
    Result := 'int';
  end
  else if sDPName='TStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TFloatField' then
  begin
    Result := 'float';
  end
  else if sDPName='TCurrencyField' then
  begin
    Result := 'money';
  end
  else if sDPName='TDateTimeField' then
  begin
    Result := 'datetime';
  end
  else if sDPName='TBooleanField' then
  begin
    Result := 'bit';
  end
  else if sDPName='TBlobField' then
  begin
    Result := 'image';
  end
  else if sDPName='TAutoIncField' then
  begin
    Result := 'int(自增)';
  end
  else if sDPName='TSmallintField' then
  begin
    Result := 'smallint';
  end
  else if sDPName='TMemoField' then
  begin
    Result := 'text';
  end
  else
  begin
    Result := '--';
  end;

end;

procedure TfrmImportNew.edita5Change(Sender: TObject);
var
  i,a: integer;
  ss : string;
begin
  
  Query1.Close();
  Query1.SQL.Text := 'select * from '+ edita5.Text ;
  try
    Query1.Open();
  except
    addMo('执行语句出错: '+Query1.SQL.Text);
    exit;
  end;

  a := DBGrid1.FieldCount;
  labA.Caption := IntToStr(a);
  i := Query1.RecordCount;
  
  if i>=0 then
  begin
    labRa.Tag := Query1.RecordCount;
    labRa.Caption := '记录数 '+IntToStr( Query1.RecordCount );
  end
  else//<0
  begin
    //语句手工统计
    with Query1 do
    begin

      Close();
      SQL.Text := 'select count(*) as iCount from '+ edita5.Text ;
      
      try
        Open();
      except
        addMo('执行语句出错: '+SQL.Text);
        exit;
      end;

      if not IsEmpty then
      begin
        labRa.Tag := FieldByName('iCount').AsInteger;
        labRa.Caption := '记录数 '+FieldByName('iCount').AsString;
      end;
      //-----------------------
      Close();
      SQL.Text := 'select * from '+ edita5.Text ;
      
      try
        Open();
      except
        addMo('执行语句出错: '+SQL.Text);
        exit;
      end;
    end;

  end;

  addMo( '------------------------------' );
  addMo( '源库: '+edita2.Text );
  addMo( '源表: '+edita5  .Text );
  addMo( '源表: 字段数 '+IntToStr(a) );
  //addMo( '源表: 记录数 '+IntToStr( Query1.RecordCount ) );
  addMo( '源表: 记录数 '+IntToStr(labRa.Tag) );

  lv1.Items.Clear;
  
  for i := 0 to a-1 do
  begin
    ss := DBGrid1.Columns.Items[i].FieldName;
    item := lv1.Items.Add;
    item.Caption := ss;
    item.SubItems.Add( getFieldType( DBGrid1.Columns.Items[i].Field.ClassName ) );
    item.SubItems.Add( IntToStr( DBGrid1.Columns.Items[i].Field.Size ) );
  end;
  
  if lv1.Items.Count > 0 then
  begin
    lv1.Items.Item[0].Selected := true;
  end;

end;

procedure TfrmImportNew.editb5Change(Sender: TObject);
var
  i,a: integer;
  ss : string;
begin
  Query2.Close();