⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ufrmimport.pas

📁 数据库通用工具
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit UfrmImport;

interface

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

type
  TfrmImport = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    DBGrid1: TDBGrid;
    edita1: TEdit;
    edita2: TEdit;
    edita3: TEdit;
    edita4: TEdit;
    btnlink1: TButton;
    btnunlink1: TButton;
    Panel2: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    DBGrid2: TDBGrid;
    editb1: TEdit;
    editb4: TEdit;
    editb3: TEdit;
    editb2: TEdit;
    btnlink2: TButton;
    btnunlink2: TButton;
    Panel3: TPanel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    cbx2: TComboBox;
    cbx1: TComboBox;
    lv1: TListView;
    btnadd: TButton;
    btndel: TButton;
    btngo: TButton;
    btnclear: TButton;
    btnall: TButton;
    btnout: TButton;
    StatusBar1: TStatusBar;
    Database1: TDatabase;
    Query1: TQuery;
    DataSource1: TDataSource;
    Database2: TDatabase;
    Query2: TQuery;
    DataSource2: TDataSource;
    Query3: TQuery;
    BitBtn1: TBitBtn;
    labA: TLabel;
    labB: TLabel;
    edita5: TComboBox;
    editb5: TComboBox;
    procedure edita1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnoutClick(Sender: TObject);
    procedure btnlink1Click(Sender: TObject);
    procedure Database1AfterConnect(Sender: TObject);
    procedure Database1AfterDisconnect(Sender: TObject);
    procedure btnunlink1Click(Sender: TObject);
    procedure btnlink2Click(Sender: TObject);
    procedure btnunlink2Click(Sender: TObject);
    procedure Database2AfterConnect(Sender: TObject);
    procedure Database2AfterDisconnect(Sender: TObject);
    procedure btnaddClick(Sender: TObject);
    procedure btnclearClick(Sender: TObject);
    procedure btnallClick(Sender: TObject);
    procedure btndelClick(Sender: TObject);
    procedure btngoClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure edita5Change(Sender: TObject);
    procedure editb5Change(Sender: TObject);
  private
    { Private declarations }
    path:string;
    ini:TIniFile;
  public
    { Public declarations }
  end;

var
  frmImport: TfrmImport;

implementation

{$R *.dfm}

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

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

procedure TfrmImport.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 ;
  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;
    {
    Query1.Close();
    Query1.SQL.Text := 'select * from '+ edita5.Text ;
    try
      Query1.Open();
    except
      exit;
    end;

    a := DBGrid1.FieldCount;
    cbx1.Clear();
    for i := 0 to a-1 do
    begin
      ss := DBGrid1.Columns.Items[i].FieldName;
      cbx1.Items.Add(ss);
    end;
    if cbx1.Items.Count > 0 then
    begin
      cbx1.ItemIndex := 0;
    end;
    //}
    lv1.Items.Clear();

    btnall.Enabled := true;
  end;

end;

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

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

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

procedure TfrmImport.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 ;
  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;
    {
    Query2.Close();
    Query2.SQL.Text := 'select * from '+ editb5.Text ;
    try
      Query2.Open();
    except
      exit;
    end;
    
    a := DBGrid2.FieldCount;
    cbx2.Clear();
    for i := 0 to a-1 do
    begin
      ss := DBGrid2.Columns.Items[i].FieldName;
      cbx2.Items.Add(ss);
    end;
    if cbx2.Items.Count > 0 then
    begin
      cbx2.ItemIndex := 0;
    end;
    //}
    lv1.Items.Clear();
    btnall.Enabled := true;
    //=============================
  end;

end;

procedure TfrmImport.btnunlink2Click(Sender: TObject);
begin
  Query2.Close();
  cbx2.Clear();
  Query2.Active := false;
  Database2.Connected := false;
  btnlink2.Enabled := true;
  btnall.Enabled := false;
  lv1.Items.Clear();
  //===================
end;

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

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

procedure TfrmImport.btnaddClick(Sender: TObject);
var
  item : TListItem;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -