unit1.~pas

功能特点 根据指定字段将Excel表导入到数据库中

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ToolWin, ComCtrls, Menus, Grids, DBGrids, StdCtrls, DB,
  ADODB, CheckLst, ExtCtrls, inifiles;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    SpeedButton1: TSpeedButton;
    OpenDialog1: TOpenDialog;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    TBNameList: TComboBox;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    SpeedButton6: TSpeedButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    Label6: TLabel;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    DBGrid1: TDBGrid;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    PBar: TProgressBar;
    GroupBox4: TGroupBox;
    CheckBox3: TCheckBox;
    procedure FormResize(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure TBNameListClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure TBNameListChange(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
    procedure SpeedButton15Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  adoconnstr:tadoconnection;  //数据库联接公共变量
  dbconnstr:string;
implementation
   uses  ToExcel,unit2,ufunction;
{$R *.dfm}

procedure TForm1.FormResize(Sender: TObject);
begin
    groupbox1.Width:=form1.Width-37;
    groupbox2.Width:=form1.Width-37;
    groupbox1.Height:=form1.Height-420;
    groupbox2.Top:=form1.Height-340;
    pbar.Width:=form1.Width-37;
    pbar.Height:=30;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
Var
  sFileName, sTableName : String;
  sl : TStringList;
  i:integer;
begin
  If Not OpenDialog1.Execute Then Exit;
  sFileName := OpenDialog1.FileName;
  ADOConnection1.Connected := False;
  ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Password="";Data Source='+sFileName + ';Extended Properties="Excel 8.0;IMEX=1";Persist Security Info=False';
  ADOConnection1.Connected := True;
  //
  sl := TStringList.Create;
  ADOConnection1.GetTableNames(sl); //sl是表名列表(Excel中可能有很多个sheet)
  //Excel表中可能有很多个sheet，可以循环，本程序只处理了第一个sheet(sl[0])
  for i := 0 to sl.Count-1 Do
  begin
    sTableName := sl[i];
  end;
  sTableName := sl[0];
  adoconnection1.GetFieldNames(stablename,sl);   //取得EXCEL中sheet的字段名
  listbox2.Items.Clear;
  listbox3.Items.Clear;
  for i:=0 to sl.Count-1 do
     begin
       listbox3.Items.Add(sl[i]);
     end;
  If Pos('$', sTableName)>0 Then sTableName := '[' + sTableName + ']';
  ADOQuery1.Close;
  ADOQuery1.SQL.Clear;
  ADOQuery1.SQL.Text := 'SELECT *  FROM ' + sTableName;
  ADOQuery1.Open;      //读取excel数据到dbgrid中
  sl.Free;
  listbox2.Clear;

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
   var
   s1:tstringlist;
  i:integer;
   inirw:tinifile;
begin
  if adoconnstr.Connected  then
      begin
        //application.MessageBox('数据库己打开','提示',mb_ok);
        adoconnstr.Connected:=false;
      end;
  inirw:=tinifile.Create(extractfilepath(application.ExeName)+'dbconn.ini');
  dbconnstr:=inirw.ReadString('dbconn','dbconn','');
  if dbconnstr='' then
      begin
          application.MessageBox('请先配置数据库连接，再点击此按钮','操作提示',mb_ok);
          speedbutton10.Click;
      end
  else
     begin
            adoconnstr.ConnectionString:=dbconnstr;
            adoconnstr.Open;
            s1:=tstringlist.Create;
            adoconnstr.GetTableNames(s1);
            tbnamelist.Clear;
         for i:=0 to s1.Count-1 do
            begin
                 tbnamelist.Items.Add(s1[i]);   //读取联接中的表名，然后导入选定的表
            end;
            s1.Free;
            application.MessageBox('打开数据库读取数据表成功','信息提示',MB_OK	);
    end;
end;

procedure TForm1.TBNameListClick(Sender: TObject);
    var
     s1:tstringlist;
     i:integer;
begin
     s1:=tstringlist.Create;
     listbox1.Clear;
     listbox2.Clear;
     adoconnstr.GetFieldNames(tbnamelist.Text,s1);
      for i:=0 to s1.Count-1 do
       begin
         listbox1.Items.Add(s1[i]);
       end;
     s1.Free;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
   //  showmessage(listbox1.Items.Strings[listbox1.ItemIndex]);
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
 //  var
 //  tmp,sqlstr1,sqlstr2:string;
 //  rectotal,i:integer;
 //  insertsql:tadotable;

begin
    //
    if  checkbox3.Checked  then
       begin
       //插入记录前清空表中记录
         delete_source_record(tbnamelist.Text);
       end;

         try
            double_ins_record();
            application.MessageBox('数据导入成功','信 息 提 示',MB_OK	);
          except
             ON  E:exception  do
                 showmessage(E.Message);
          end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
    application.Terminate;
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
var
    i:integer;
begin
     //检查两个listbox中的值数理是否相同   增加全部字段
     if  (listbox1.Count<>listbox3.Count) then
        begin
           messagedlg('源字段列表与目标字段不匹配!',mtError,[mbok],0);
           exit;
        end
     else
        begin   //值相同同时增加到导入字段表中
          for  i:=0 to listbox1.Count-1 do
             begin
                 listbox2.Items.Add(listbox1.Items.Strings[i]+'='+listbox3.Items.Strings[i]);
             end;
       end;
     speedbutton4.Enabled:=true;
    speedbutton7.Enabled:=true;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
var
   new_str1,new_str2:string;     //增加对照表 选择字段
begin
  new_str1:=listbox1.Items.Strings[listbox1.ItemIndex];
  new_str2:=listbox3.Items.Strings[listbox3.ItemIndex];
  if (new_str1='') or (new_str2='') then exit;
     listbox2.Items.Add(new_str1+'='+new_str2);
end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
    var
    result:tadoquery;
    result_dbs:tdatasource;
    rst_value:integer;
begin
   //导出选中的表到EXCEL
   try
   result_dbs:=tdatasource.Create(nil);
   result:=tadoquery.Create(nil);
   result.Connection:=adoconnstr;
   result.SQL.Clear;
   result.SQL.Text:='select * from '+tbnamelist.Text;
   result.Open;
   result_dbs.DataSet:=result;
   rst_value:=savexls(self.Handle,result_dbs,'hehe');
     case rst_value of
        100:showmessage('导出成功');
        101:showmessage('未安装Execl,请先安装再导出');
        102:showmessage('导出失败,原因未知,请重试');
        103:showmessage('数据集为空没有导出数据!');
     end;
   finally
     result_dbs.Free;
     result.Free;
   end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
    adoconnstr:=tadoconnection.Create(nil);
    adoconnstr.LoginPrompt:=false;
    speedbutton6.Enabled:=false;
    speedbutton8.Enabled:=false;
end;

procedure TForm1.TBNameListChange(Sender: TObject);
begin
    speedbutton6.Enabled:=true;
    speedbutton8.Enabled:=true;
end;

procedure TForm1.SpeedButton11Click(Sender: TObject);
begin
   form2.Show;
end;

procedure TForm1.SpeedButton10Click(Sender: TObject);
   var
  fname,s1,s:string;
  inirw:tinifile;
begin
   fname:=extractfilepath(application.ExeName)+'dbconn.ini';
   inirw:=tinifile.Create(fname);
   s1:=inirw.ReadString('dbconn','dbconn','');
s := PromptDataSource(application.Handle,s1);
if trim(s)<>''then
begin
  // adoconnstr.ConnectionString := s;
  // adoconnstr.Connected:=true;
   dbconnstr:=s;
   inirw.WriteString('dbconn','dbconn',s);
   inirw.Free;
end;
end;

procedure TForm1.SpeedButton14Click(Sender: TObject);
    var
    inirw:tinifile;
    i,fcount:integer;
    s:string;
begin
       //保存对照字段
    fcount:=listbox2.Items.Count;
    inirw:=tinifile.Create(extractfilepath(application.ExeName)+'savefield.ini');
    inirw.WriteInteger('count','fieldcount',fcount);
    for i:=0 to listbox2.Items.Count-1 do
        begin   //将对照表中的内容顺序写入配置文件中
           s:=listbox2.Items.Strings[i];
           inirw.WriteString('info','s'+inttostr(i),s);
        end;
    inirw.Free;
end;

procedure TForm1.SpeedButton15Click(Sender: TObject);
  var
   inirw:tinifile;
   i,fcount:integer;
   s:string;
begin
     //从配置文件中读取对照字段
     inirw:=tinifile.Create(extractfilepath(application.ExeName)+'savefield.ini');
     fcount:=inirw.ReadInteger('count','fieldcount',0);
     listbox2.Items.Clear;
     for i:=0 to fcount-1 do
        begin
           s:=inirw.ReadString('info','s'+inttostr(i),'');
           listbox2.Items.Add(s);
        end;
     inirw.Free;
end;


procedure TForm1.SpeedButton13Click(Sender: TObject);
begin
     listbox2.Items.Clear;
end;

procedure TForm1.SpeedButton12Click(Sender: TObject);
begin
     listbox2.Items.Delete(listbox2.ItemIndex); //删除选定的对照字段
end;

end.