ufrmcomparetb.pas

数据库通用工具

unit UfrmCompareTB;

interface

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

type
  TfrmCompareTB = class(TForm)
    Database1: TDatabase;
    Query1: TQuery;
    DataSource1: TDataSource;
    Database2: TDatabase;
    Query2: TQuery;
    DataSource2: TDataSource;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    edita1: TEdit;
    edita2: TEdit;
    edita3: TEdit;
    edita4: TEdit;
    btnlink1: TButton;
    btnunlink1: TButton;
    Panel2: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    editb1: TEdit;
    editb4: TEdit;
    editb3: TEdit;
    editb2: TEdit;
    btnlink2: TButton;
    btnunlink2: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    pnlZS1: TPanel;
    pnlZS2: TPanel;
    ActionList1: TActionList;
    actEsc: TAction;
    mo: TMemo;
    lv: TListView;
    ImageList1: TImageList;
    Panel5: TPanel;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    lv1: TListView;
    lab: TLabel;
    BitBtn3: TBitBtn;
    procedure actEscExecute(Sender: TObject);
    procedure btnlink1Click(Sender: TObject);
    procedure Database1AfterConnect(Sender: TObject);
    procedure Database1AfterDisconnect(Sender: TObject);
    procedure Database2AfterConnect(Sender: TObject);
    procedure Database2AfterDisconnect(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnunlink1Click(Sender: TObject);
    procedure moAdd( str: string );
    procedure btnlink2Click(Sender: TObject);
    procedure btnunlink2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure lvCustomDrawItem(Sender: TCustomListView; Item: TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure BitBtn2Click(Sender: TObject);
    procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure BitBtn3Click(Sender: TObject);

  private
    { Private declarations }
    path : string;
    ini:TIniFile;
    item : TListItem;
  public
    { Public declarations }
  end;

var
  frmCompareTB: TfrmCompareTB;

implementation

{$R *.dfm}

procedure TfrmCompareTB.actEscExecute(Sender: TObject);
begin
  close;
end;

procedure TfrmCompareTB.moAdd( str: string );
begin
  mo.Lines.Add( str );
end;

procedure TfrmCompareTB.btnlink1Click(Sender: TObject);
begin
  Database1.Connected := false;
  Database1.Params.Clear();
  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 ;
  try
    Database1.Connected := true;
  except
    Application.MessageBox('数据库链接错误，请重新设置!','提示',MB_OK+MB_ICONINFORMATION);
    exit;
  end;

  if Database1.Connected = true then
  begin
    Query1.Close;
    Query1.DatabaseName := Database1.DatabaseName ;
    
    {查存数据库表对象的语句
    select * from sysobjects where xtype='U' order by xtype,name
    }
    
    ListBox1.Items.Clear;
    with Query1 do
    begin
      Close();
      SQL.Text := 'select * from sysobjects where xtype=''U'' order by xtype,name' ;
      try
        Open();
      except
        exit;
      end;

      while not Eof do
      begin
        ListBox1.Items.Add( FieldByName('name').AsString );
        Next;
      end;

    end;

    pnlZS1.Caption := '表数量：' + IntToStr( ListBox1.Items.Count );
    moAdd( edita2.Text+' | '+pnlZS1.Caption );
  end;

end;

procedure TfrmCompareTB.Database1AfterConnect(Sender: TObject);
begin
  btnlink1.Enabled := False;
  btnunlink1.Enabled := not btnlink1.Enabled;
end;

procedure TfrmCompareTB.Database1AfterDisconnect(Sender: TObject);
begin
  Query1.Close;
  btnlink1.Enabled := True;
  btnunlink1.Enabled := not btnlink1.Enabled;
end;

procedure TfrmCompareTB.Database2AfterConnect(Sender: TObject);
begin
  btnlink2.Enabled := False;
  btnunlink2.Enabled := not btnlink2.Enabled;
end;

procedure TfrmCompareTB.Database2AfterDisconnect(Sender: TObject);
begin
  Query2.Close;
  btnlink2.Enabled := True;
  btnunlink2.Enabled := not btnlink2.Enabled;
end;

procedure TfrmCompareTB.FormDestroy(Sender: TObject);
begin
  Query1.Close;
  Query2.Close;
  Database1.Connected := false;
  Database2.Connected := false;

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

procedure TfrmCompareTB.FormShow(Sender: TObject);
begin
  Database1.Connected := false;
  Database2.Connected := false;
  
  path := ExtractFilePath(application.ExeName);
  ini := TIniFile.Create(path+'config.may');
  edita1.Text := ini.ReadString('Compare', 'Server1',  '127.0.0.1');
  edita2.Text := ini.ReadString('Compare', 'Database1','master');
  edita3.Text := ini.ReadString('Compare', 'user1',    'sa');
  edita4.Text := ini.ReadString('Compare', 'pass1',    '');
  //--------------------------------------------------------------
  editb1.Text := ini.ReadString('Compare', 'Server2',  '127.0.0.1');
  editb2.Text := ini.ReadString('Compare', 'Database2','master');
  editb3.Text := ini.ReadString('Compare', 'user2',    'sa');
  editb4.Text := ini.ReadString('Compare', 'pass2',    '');
  ini.Free;
  //-------------------
  lv.Items.Clear;
  lv1.Items.Clear;  
end;

procedure TfrmCompareTB.btnunlink1Click(Sender: TObject);
begin
  Query1.Active := false;
  Database1.Connected := false;
  ListBox1.Items.Clear;
end;

procedure TfrmCompareTB.btnlink2Click(Sender: TObject);
begin
  Database2.Connected := false;
  Database2.Params.Clear();
  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 ;
  try
    Database2.Connected := true;
  except
    Application.MessageBox('数据库链接错误，请重新设置!','提示',MB_OK+MB_ICONINFORMATION);
    exit;
  end;

  if Database2.Connected = true then
  begin
    Query2.Close;
    Query2.DatabaseName := Database2.DatabaseName ;
    
    {查存数据库表对象的语句
    select * from sysobjects where xtype='U' order by xtype,name
    }
    
    ListBox2.Items.Clear;
    with Query2 do
    begin
      Close();
      SQL.Text := 'select * from sysobjects where xtype=''U'' order by xtype,name' ;
      try
        Open();
      except
        exit;
      end;

      while not Eof do
      begin
        ListBox2.Items.Add( FieldByName('name').AsString );
        Next;
      end;

    end;

    pnlZS2.Caption := '表数量：' + IntToStr( ListBox2.Items.Count );
    moAdd( editB2.Text+' | '+pnlZS2.Caption );
  end;
end;

procedure TfrmCompareTB.btnunlink2Click(Sender: TObject);
begin
  Query2.Active := false;
  Database2.Connected := false;
  ListBox2.Items.Clear;
end;

procedure TfrmCompareTB.BitBtn1Click(Sender: TObject);
var
  i,j,k : Integer;
  ss,sa,sb : string;
begin
  //比较表
  lv.Items.Clear;
  for i := 0 to ListBox1.Items.Count-1 do
  begin
    sa := ListBox1.Items.Strings[i];
    item := lv.Items.Add;
    item.Caption := sa;
    item.SubItems.Add('*');
    item.SubItems.Add(' ');
    for j := 0 to ListBox2.Items.Count-1 do
    begin
      sb := ListBox2.Items.Strings[j];
      if LowerCase(sb)=LowerCase(sa) then
      begin
        item.SubItems.Strings[1] := '*';
        Break;
      end;
    end;
  end;

  for i := 0 to ListBox2.Items.Count-1 do
  begin
    sa := ListBox2.Items.Strings[i];
    k := 0;
    for j := 0 to lv.Items.Count-1 do
    begin
      sb := lv.Items.Item[j].Caption;
      if LowerCase(sb)=LowerCase(sa) then
      begin
        k := 1;
        Break;
      end; 
    end;

    if k = 0 then
    begin
      item := lv.Items.Add;
      item.Caption := sa;
      item.SubItems.Add(' ');
      item.SubItems.Add('*');
    end;

  end; 

end;

procedure TfrmCompareTB.lvCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  {
  if item.Checked then
    Sender.Canvas.Font.Color := clRed
  else
    Sender.Canvas.Font.Color := clBlue;
  //}
  {
  case SubItem of
    1: Sender.Canvas.Font.Color := clBlack;
    2: Sender.Canvas.Font.Color := clBlue;
    3: Sender.Canvas.Font.Color := clRed;
  else Sender.Canvas.Font.Color := clBlack;
  end;
  //}
  if Trim( item.SubItems.Strings[0]) = '' then
  begin
    Sender.Canvas.Font.Color := clRed;
  end;

  if Trim( item.SubItems.Strings[1]) = '' then
  begin
    Sender.Canvas.Font.Color := clFuchsia;
  end;

end;

procedure TfrmCompareTB.BitBtn2Click(Sender: TObject);
var
  i,j,k,m,n : Integer;
  ss,sa,sb : string;
  item : TListItem;
begin
  lab.Caption := '0';
  if ListBox1.ItemIndex<0 then Exit;
  if ListBox2.ItemIndex<0 then Exit;

  lv1.Items.Clear;
  with Query1 do
  begin
    Close;                                                                   
    sql.Text := 'select top 1 * from '+ListBox1.Items.Strings[ ListBox1.ItemIndex ];

    try
      Open;
    except
      Exit;
    end;
    
    k := Query1.FieldCount;
    for i := 0 to k-1 do
    begin
      //ss := qryMessage.FieldDefs.Items[i].DisplayName;
      item := lv1.Items.Add;
      item.Caption := FieldDefs.Items[i].Name;
      item.SubItems.Add( FieldList.Fields[i].ClassName );
      item.SubItems.Add( IntToStr( FieldList.Fields[i].Size ) );
      item.SubItems.Add( '' );
      item.SubItems.Add( '' );
      item.SubItems.Add( '' );
    end;
  end;

  n := 0;
  with Query2 do
  begin
    Close;                                                                   
    sql.Text := 'select top 1 * from '+ListBox2.Items.Strings[ ListBox2.ItemIndex ];

    try
      Open;
    except
      Exit;
    end;

    k := Query2.FieldCount;
    for i := 0 to k-1 do
    begin
      ss := FieldDefs.Items[i].Name;
      sa := FieldList.Fields[i].ClassName;
      sb := IntToStr( FieldList.Fields[i].Size );
      m := 0;
      for j := 0 to lv1.Items.Count-1 do
      begin
        item := lv1.Items.Item[j];
        if SameText( item.Caption,ss ) then
        begin
          item.SubItems.Strings[2] := ss;
          item.SubItems.Strings[3] := sa;
          item.SubItems.Strings[4] := sb;
          m := 1;
          Break;
        end;
      end;

      if m=0 then
      begin
        item := lv1.Items.Add;
        item.Caption := '';
        item.SubItems.Add( '' );
        item.SubItems.Add( '' );
        item.SubItems.Add( ss );
        item.SubItems.Add( sa );
        item.SubItems.Add( sb );
        Inc(n);
      end;

    end;
  end;

  if n>0 then
    lab.Caption := '字段相差: '+ IntToStr(n);
    
end;

procedure TfrmCompareTB.lv1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  t1,t2,z1,z2 : string;
begin
  t1 := item.SubItems.Strings[0];
  t2 := item.SubItems.Strings[3];
  z1 := item.SubItems.Strings[1];
  z2 := item.SubItems.Strings[4];
  
  if (not SameText( t1,t2 ))
    or (not SameText( z1,z2 )) then
  begin
    Sender.Canvas.Font.Color := clRed;
  end
  else
  begin
    Sender.Canvas.Font.Color := clBlack;
  end;

  //Sender.Canvas.Font.Color := clFuchsia;
  
end;

procedure TfrmCompareTB.BitBtn3Click(Sender: TObject);
begin
  if (ListBox1.ItemIndex+1) <= ListBox1.Items.Count-1 then
    ListBox1.ItemIndex := ListBox1.ItemIndex+1
  else
    ListBox1.ItemIndex := 0;

  if (ListBox2.ItemIndex+1) <= ListBox2.Items.Count-1 then
    ListBox2.ItemIndex := ListBox2.ItemIndex+1
  else
    ListBox2.ItemIndex := 0;

end;

end.