dimain.~pas

导从文本文件或Excel导入数据到SQL SERVER中,自动匹配字段

unit DIMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, Buttons, dxExEdtr, dxCntner,
  DBClient, DB, ADODB, dxEdLib, Grids, DBGrids, dxEditor, ComObj,Math;

type
  TMyDBGrid=class(TDBGrid);
  TfrmDIMain = class(TForm)
    PageControl1: TPageControl;
    Panel1: TPanel;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    BtnBack: TBitBtn;
    BtnGo: TBitBtn;
    BtnCancel: TBitBtn;
    RG_SourceType: TRadioGroup;
    dxBtnSelectFile: TdxButtonEdit;
    Label1: TLabel;
    ADODB: TADOConnection;
    AQ_Table: TADOQuery;
    DS_Table: TDataSource;
    RadioGroup2: TRadioGroup;
    Label2: TLabel;
    dxSpinEdit1: TdxSpinEdit;
    dxSpinEdit2: TdxSpinEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    PB1: TProgressBar;
    Label7: TLabel;
    Memo1: TMemo;
    OD: TOpenDialog;
    Panel2: TPanel;
    DBGrid1: TDBGrid;
    Splitter1: TSplitter;
    DS_Match: TDataSource;
    GroupBox2: TGroupBox;
    RadioGroup4: TRadioGroup;
    CheckBox1: TCheckBox;
    Label8: TLabel;
    TV_DB: TTreeView;
    DBGrid2: TDBGrid;
    DBGrid3: TDBGrid;
    DS_RecCheck: TDataSource;
    lbMsg: TLabel;
    procedure RG_SourceTypeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure dxBtnSelectFileButtonClick(Sender: TObject;
      AbsoluteIndex: Integer);
    procedure TV_DBChange(Sender: TObject; Node: TTreeNode);
    procedure BtnGoClick(Sender: TObject);
    procedure AQ_TableAfterOpen(DataSet: TDataSet);
    procedure RadioGroup2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure DBGrid3ColExit(Sender: TObject);
    procedure DBGrid3ColEnter(Sender: TObject);
    procedure DBGrid3DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid3CellClick(Column: TColumn);
    procedure BtnBackClick(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    OldGridWnd : TWndMethod;
    FOriginalOptions : TDBGridOptions;
    Cancelimport:boolean;
    CDS_Temp,CDS_Temp2:TClientDataSet;
    procedure NewGridWnd (var Message : TMessage); //定义Dbgrid鼠标滚轮动作
    function DBGridRecordSize(mColumn: TColumn): Boolean;
    function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;
    function Pageswitch(Activepage:integer):Boolean;
    procedure SaveBoolean;
    Procedure AutoMatchField();
    function ConvertAsDate(Str:String):TDate;
    function ConvertAsTime(Str:String):TTime;
    function ConvertAsDateTime(Str:String):TDateTime;
  public
    { Public declarations }
  end;

var
  frmDIMain: TfrmDIMain;
  DllDBCnn:TADOConnection;
  DllTargetDT,DllCfgDT:TDataSet;
  SqlStr:Pchar;    

implementation

{$R *.dfm}

procedure TfrmDIMain.NewGridWnd(var Message: TMessage);
var
 IsNeg : Boolean;
begin
 if Message.Msg = WM_MOUSEWHEEL then
 begin
   IsNeg := Short(Message.WParamHi) < 0;
   if IsNeg then
     DBGrid1.DataSource.DataSet.MoveBy(1)
   else
     DBGrid1.DataSource.DataSet.MoveBy(-1)
 end
 else
   OldGridWnd(Message);
end;

function TfrmDIMain.DBGridRecordSize(mColumn: TColumn): Boolean;
{ 返回记录数据网格列显示最大宽度是否成功 }
begin
  Result := False;
  if not Assigned(mColumn.Field) then Exit;
  mColumn.Field.Tag := Max(mColumn.Field.Tag,
    TDBGrid(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText));
  Result := True;
end; { DBGridRecordSize }

function TfrmDIMain.DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;
{ 返回数据网格自动适应宽度是否成功 }
var
  I: Integer;
begin
  Result := False;
  if not Assigned(mDBGrid) then Exit;
  if not Assigned(mDBGrid.DataSource) then Exit;
  if not Assigned(mDBGrid.DataSource.DataSet) then Exit;
  if not mDBGrid.DataSource.DataSet.Active then Exit;
  for I := 0 to mDBGrid.Columns.Count - 1 do begin
    if not mDBGrid.Columns[I].Visible then Continue;
    if Assigned(mDBGrid.Columns[I].Field) then
      mDBGrid.Columns[I].Width := Max(mDBGrid.Columns[I].Field.Tag,
        mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset
    else mDBGrid.Columns[I].Width :=
      mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset;
    mDBGrid.Refresh;
  end;
  Result := True;
end; { DBGridAutoSize }


function TfrmDIMain.Pageswitch(Activepage:integer):Boolean;
begin
  if Activepage>(Pagecontrol1.PageCount-1) then
  begin
    messagebox(Application.Handle,'激活页不存在！','提示',Mb_Iconerror+Mb_Ok);
    Result:=False;
  end
  else
  begin
    Pagecontrol1.ActivePageIndex :=Activepage;
    Case Pagecontrol1.ActivePageIndex of
      0:
      begin
        Caption:='导入向导----选择文件';
        BtnBack.Enabled :=False;
        BtnGo.Enabled :=true;
        BtnGo.Caption :='下一步';
      end;
      1:
      begin
        DllCfgDT.Filtered:=False;
        Caption:='导入向导----字段匹配';
        BtnBack.Enabled :=True;
        BtnGo.Enabled :=true;
        BtnGo.Caption :='下一步';
        BtnCancel.Caption :='取消'; 
      end;
      2:
      begin
        Caption:='导入向导----导入选项';
        BtnBack.Enabled :=True;
        BtnGo.Enabled :=true;
        BtnGo.Caption :='开始导入';
        BtnCancel.Caption :='取消';
      end;
      3:
      begin
        Caption:='导入向导----完成';
        BtnBack.Enabled :=True;
        BtnGo.Enabled :=true;
        BtnGo.Caption :='停止';
        BtnCancel.Caption :='关闭';
      end;
    end;
  end;
end;

procedure TfrmDIMain.SaveBoolean;
begin
  DBGrid3.SelectedField.Dataset.Edit;
  DBGrid3.SelectedField.AsBoolean := Not DBGrid3.SelectedField.AsBoolean;
  DBGrid3.SelectedField.Dataset.Post;
end;

Procedure TfrmDIMain.AutoMatchField();
var
  i,n:integer;
begin
  DllCfgDT.First;
  try
    DllCfgDT.DisableControls ;
    for i:=1 to DllCfgDT.RecordCount do
    begin
      DllCfgDT.Edit;
      DllCfgDT.FieldByName('SourceField').AsString :='';
      for n:=0 to DBGrid2.Columns[3].PickList.Count-1 do
      begin
        if (Trim(DllCfgDT.FieldByName('FieldCaption').AsString) =Trim(DBGrid2.Columns[3].PickList[n]))
         Or (Trim(DllCfgDT.FieldByName('FieldName').AsString) =Trim(DBGrid2.Columns[3].PickList[n])) then
        begin
          DllCfgDT.FieldByName('SourceField').AsString:=DBGrid2.Columns[3].PickList[n];
          Break;
        end;
      end;
      DllCfgDT.Post;
      DllCfgDT.Next;
    end;
    DllCfgDT.First;
  finally
    DllCfgDT.EnableControls ;
  end;
end;

function TfrmDIMain.ConvertAsDate(Str:String):TDate;
type
  ConvertAsDateDll=function (Str:Pchar;Var vDate:TDate):Boolean;stdcall;
var
  DllHandle:THandle;
  Dllfarproc:Tfarproc;
  RstDate:TDate;
begin
  DllHandle:=LoadLibrary('PubFun.dll');
  if DllHandle>32 then
  begin
    try  
      Dllfarproc:=GetProcAddress(DllHandle,'ConvertAsDate'); //获取函数入口
      if DllfarProc<>Nil then
      begin
        if ConvertAsDateDll(Dllfarproc)(Pchar(Str),RstDate) then
          Result:=RstDate
        else
          Result:=StrtoDate('1899-12-30');
      end;
    finally
      FreeLibrary(DllHandle);
    end;
  end
  else
    MessageBox(Application.Handle,'调用动态库失败！','提示',MB_IconInformation+MB_Ok);
end;

function TfrmDIMain.ConvertAsTime(Str:String):TTime;
type
  ConvertAsTimeDll=function (Str:Pchar;Var vTime:TTime):Boolean;stdcall;
var
  DllHandle:THandle;
  Dllfarproc:Tfarproc;
  RstTime:TTime;
begin
  DllHandle:=LoadLibrary('PubFun.dll');
  if DllHandle>32 then
  begin
    try  
      Dllfarproc:=GetProcAddress(DllHandle,'ConvertAsTime'); //获取函数入口
      if DllfarProc<>Nil then begin
        if ConvertAsTimeDll(Dllfarproc)(Pchar(Str),RstTime) then
          Result:=RstTime
        else
          Result:=StrtoTime('00:00:00');
      end;
    finally
      FreeLibrary(DllHandle);
    end;
  end
  else
    MessageBox(Application.Handle,'调用动态库失败！','提示',MB_IconInformation+MB_Ok);
end;

function TfrmDIMain.ConvertAsDateTime(Str:String):TDateTime;
type
  ConvertAsDateTimeDll=function (Str:Pchar;Var vDateTime:TDateTime):Boolean;stdcall;
var
  DllHandle:THandle;
  Dllfarproc:Tfarproc;
  RstDateTime:TDateTime;
begin
  DllHandle:=LoadLibrary('PubFun.dll');
  if DllHandle>32 then
  begin
    try   
      Dllfarproc:=GetProcAddress(DllHandle,'ConvertAsDateTime'); //获取函数入口
      if DllfarProc<>Nil then begin
        if ConvertAsDateTimeDll(Dllfarproc)(Pchar(Str),RstDateTime) then
          Result:=RstDateTime
        else
          Result:=StrtoDateTime('1899-12-30 00:00:00');
      end;
    finally
      FreeLibrary(DllHandle);
    end;
  end
  else
    MessageBox(Application.Handle,'调用动态库失败！','提示',MB_IconInformation+MB_Ok);
end;

procedure TfrmDIMain.RG_SourceTypeClick(Sender: TObject);
var
  initstr,s: string;
  b: boolean;
  Aq_Tmp:TADOQuery;
  i:integer;
begin
  inherited;
  dxBtnSelectFile.Enabled :=(RG_SourceType.ItemIndex =0);
  initstr:='Provider=SQLOLEDB.1;Persist Security Info=False';
  if RG_SourceType.ItemIndex =0 then
  begin
    ADODB.Close;
    TV_DB.Items.Clear;
    ADODB.Provider :='Microsoft.Jet.OLEDB.4.0';
  end
  else if RG_SourceType.ItemIndex =1 then
  begin
    s := PromptDataSource(0, initstr);
    if Trim(s)=Trim(initstr) then
      Exit;
    ADODB.Close;
    ADODB.ConnectionString :=s;
    //ADODB.DefaultDatabase := 'master';
    b := True;
    try
      ADODB.open;
      TV_DB.Items.Clear;
      Aq_Tmp:=TADOQuery.Create(Application);
      try
        With Aq_Tmp do begin 
          Connection :=ADODB;
          Close;
          SQL.Clear;
          SQL.Add('Select name from sysobjects Where Upper(type)=''U''');
          Open;
          First;
          if RecordCount>0 then
          for i:=1 to RecordCount do
          begin
            TV_DB.Items.Add(Nil,FieldByName('Name').AsString);
            Next;   
          end;
        end;
      finally
        Aq_Tmp.Free;
      end;
    except
      on e: Exception do
      begin
        Messagebox(Application.Handle,'connect error','info',Mb_IconError+MB_Ok);
        b := False;
      end;
    end;  
  end;
end;

procedure TfrmDIMain.FormCreate(Sender: TObject);
var
  i:integer;
begin
  OldGridWnd := DBGrid1.WindowProc ;
  DBGrid1.WindowProc := NewGridWnd;

  CDS_Temp:=TClientDataSet.Create(Application);
  CDS_Temp2:=TClientDataSet.Create(Application);
  for i:=0 to PageControl1.PageCount -1 do
    PageControl1.Pages[i].TabVisible :=False;
  PageControl1.ActivePageIndex :=0;
  Pageswitch(0);
end;

procedure TfrmDIMain.dxBtnSelectFileButtonClick(Sender: TObject;
  AbsoluteIndex: Integer);
var
  XlsApp,WorkBook:Variant;
  i:integer;
  Conid,ConPw,ConStr:String;
begin
  inherited;
  Conid:='Admin';
  ConPw:='';
  OD.Filter:='Excel 文件（*.XlS）|*.xls|文件文件(*.TXT)|*.txt|Access文件(*.mdb)|*.mdb';
  OD.Title :='请选择要导入的文件';
  if OD.Execute then
    dxBtnSelectFile.Text:=OD.FileName;
  if trim(OD.FileName)<>'' then
  begin
    TV_DB.Items.Clear;
    Aq_Table.Close;
    Case OD.FilterIndex of
      1:
      begin
        Try
          XlsApp:=CreateOleObject('Excel.Application'); //建立Excel应用程序
          WorkBook:=CreateOleObject('Excel.Sheet');
        except
          Messagebox(Application.Handle,'您的机器未安装 Microsoft Excel 应用程序,导入失败!','提示',Mb_IconWarning+Mb_OK);
          Exit;
        end;
        Try
          WorkBook:=XlsApp.WorkBooks.Open(Trim(OD.FileName));
          if WorkBook.WorkSheets.Count>0 then
            for i:=1 to WorkBook.WorkSheets.Count do
              TV_DB.Items.Add (Nil,WorkBook.WorkSheets[i].name)
          else
            Exit;
        finally
          WorkBook.Close;
          XlsApp.Quit;
          XlsApp:=Unassigned;
        end;
        //对AdoCnn进行数据库连接
        ConStr:='Provider=Microsoft.Jet.OLEDB.4.0;Password='+ConPw+';User ID='+ConId+';';
        ConStr:=ConStr+'Data Source='+Trim(OD.FileName)+';Mode=Share Deny None;';
        ConStr:=ConStr+'Extended Properties=Excel 8.0;Persist Security Info=False';
        ADODB.Connected:=False;
        ADODB.ConnectionString :=ConStr;
        try
          ADODB.Connected :=True;
        except
          on E:Exception do
          begin
            MessageBox(Application.Handle,Pchar(E.Message),'错误',Mb_IconError+Mb_Ok);
            exit;
          end;
        end;
        TV_DB.Items[0].Selected:=True;
      end;
      2:
      begin
      end;
      3:
      begin
        Messagebox(Application.Handle,'该功能在下一版本提供！','提示',Mb_Iconinformation+MB_Ok);
      end;
      //假如还有其它项可再添加
    end;
  end;
end;

procedure TfrmDIMain.TV_DBChange(Sender: TObject; Node: TTreeNode);
begin
  if ADODB.Connected then begin