unit1.~pas

不同数据库的转换 用delphi实现access excel sql server 等数据库的转换

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Menus, ShellAPI ,DBConverter, DBTables, WinSkinData;
type
  TForm1 = class(TForm)
    pgcDBLinkSetting_s: TPageControl;
    tsAccess: TTabSheet;
    grp1: TGroupBox;
    lbl1: TLabel;
    lbl2: TLabel;
    edtAccessPath_s: TEdit;
    edtAccessPwd_s: TEdit;
    btnAccessPathBrw_s: TButton;
    tsParadox: TTabSheet;
    grp2: TGroupBox;
    lbl3: TLabel;
    cbbParadoxDSN_s: TComboBox;
    tsSqlAnywhere: TTabSheet;
    grp3: TGroupBox;
    lbl5: TLabel;
    edtExcelPath_s: TEdit;
    btnExcelPathBrw_s: TButton;
    tsFoxpro: TTabSheet;
    grp4: TGroupBox;
    lbl7: TLabel;
    edtFoxproPath_s: TEdit;
    btnFoxproPath_s: TButton;
    tsSqlServer: TTabSheet;
    grp5: TGroupBox;
    lbl9: TLabel;
    lbl10: TLabel;
    lbl11: TLabel;
    lbl12: TLabel;
    edtSqlServerIP_s: TEdit;
    edtSqlServerUser_s: TEdit;
    edtSqlServerName_s: TEdit;
    edtSqlServerPwd_s: TEdit;
    cbbDbTypeSelecter_s: TComboBox;
    lbl25: TLabel;
    cbbDbTypeSelecter_d: TComboBox;
    lbl26: TLabel;
    btnClose: TButton;
    edtParadoxPath_s: TEdit;
    btnParadoxPathBrw_s: TButton;
    lbl27: TLabel;
    btnConvertDBList: TButton;
    pm1: TPopupMenu;
    mniAccess: TMenuItem;
    mniAccess2Access: TMenuItem;
    mniAccess2Excel: TMenuItem;
    mniAccess2SqlServer: TMenuItem;
    mniExcel: TMenuItem;
    mniExcel2Access: TMenuItem;
    mniExcel2Foxpro: TMenuItem;
    mniExcel2Paradox: TMenuItem;
    mniExcel2SqlServer: TMenuItem;
    mniFoxpro: TMenuItem;
    mniFoxpro2Excel: TMenuItem;
    mniFoxpro2SqlServer: TMenuItem;
    mniParadox: TMenuItem;
    mniParadox2Excel: TMenuItem;
    mniParadox2SqlServer: TMenuItem;
    mniSqlServer: TMenuItem;
    mniSqlServer2Excel: TMenuItem;
    mniSqlServer2Paradox: TMenuItem;
    mniSqlServer2Foxpro: TMenuItem;
    mniSqlServer2SqlServer: TMenuItem;
    mniSqlServer2Access: TMenuItem;
    btnConvert: TButton;
    mniFoxpro2Access: TMenuItem;
    mniParadox2Access: TMenuItem;
    mniAccess2Foxpro: TMenuItem;
    mniAccess2Paradox: TMenuItem;
    pgcDBLinkSetting_d: TPageControl;
    ts1: TTabSheet;
    grp6: TGroupBox;
    lbl13: TLabel;
    edtAccessPath_d: TEdit;
    btnAccessPathBrw_d: TButton;
    ts2: TTabSheet;
    grp7: TGroupBox;
    lbl15: TLabel;
    edtExcelPath_d: TEdit;
    btnExcelPathBrw_d: TButton;
    ts3: TTabSheet;
    grp8: TGroupBox;
    lbl17: TLabel;
    lbl19: TLabel;
    cbbParadoxDSN_d: TComboBox;
    edtParadoxPath_d: TEdit;
    btnParadoxPathBrw_d: TButton;
    ts4: TTabSheet;
    grp9: TGroupBox;
    lbl20: TLabel;
    edtFoxproPath_d: TEdit;
    btnFoxproPath_d: TButton;
    ts5: TTabSheet;
    grp10: TGroupBox;
    lbl22: TLabel;
    lbl23: TLabel;
    lbl24: TLabel;
    lbl28: TLabel;
    edtSqlServerIP_d: TEdit;
    edtSqlServerUser_d: TEdit;
    edtSqlServerName_d: TEdit;
    edtSqlServerPwd_d: TEdit;
    lblStatus: TLabel;
    grp11: TGroupBox;
    grp12: TGroupBox;
    lblTable_s: TLabel;
    lblTable_d: TLabel;
    edtTabel_s: TEdit;
    edtTabel_d: TEdit;
    dlgOpenFile: TOpenDialog;
    ssn1: TSession;
    skndt1: TSkinData;
    lblRiselon: TLabel;
    lblSource: TLabel;
    procedure btnConvertDBListClick(Sender: TObject);
    procedure cbbDbTypeSelecter_sChange(Sender: TObject);
    procedure cbbDbTypeSelecter_dChange(Sender: TObject);
    procedure btnConvertClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mniMenuItemClick(Sender: TObject);
    procedure btnAccessPathBrw_dClick(Sender: TObject);
    procedure btnAccessPathBrw_sClick(Sender: TObject);
    procedure btnExcelPathBrw_sClick(Sender: TObject);
    procedure btnExcelPathBrw_dClick(Sender: TObject);
    procedure btnParadoxPathBrw_sClick(Sender: TObject);
    procedure btnParadoxPathBrw_dClick(Sender: TObject);
    procedure btnFoxproPath_sClick(Sender: TObject);
    procedure btnFoxproPath_dClick(Sender: TObject);
    procedure lblRiselonMouseEnter(Sender: TObject);
    procedure lblRiselonMouseLeave(Sender: TObject);
    procedure lblSourceMouseLeave(Sender: TObject);
    procedure lblSourceMouseEnter(Sender: TObject);
    procedure lblRiselonClick(Sender: TObject);
    procedure lblSourceClick(Sender: TObject);
  private
    { Private declarations }
    SourceDatabaseInfoPara: TDatabaseInfoPara;
    TargetDatabaseInfoPara: TDatabaseInfoPara;
    ConvertTablePara: TConvertTablePara;

    DBC: TDBConverter;
    function CheckDBParamValid(sDb_Or_dDb, dbItemIdx: integer): boolean;
    function CheckTableParamValid: boolean;
    procedure FillSourceDBInfoParam;
    procedure FillTargetDBInfoParam;
    procedure FillCvtTableParam;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses SelectFolder;

{$R *.dfm}

procedure TForm1.btnConvertDBListClick(Sender: TObject);
var
  pt: TPoint;
begin
  pt.X := btnConvertDBList.Left;
  pt.Y := btnConvertDBList.Top;
  pt := ClientToScreen(pt);

  pm1.Popup(pt.X, pt.Y + btnConvertDBList.Height);
end;

procedure TForm1.cbbDbTypeSelecter_sChange(Sender: TObject);
begin
  pgcDBLinkSetting_s.ActivePageIndex := cbbDbTypeSelecter_s.ItemIndex;
  if cbbDbTypeSelecter_s.ItemIndex = 1 then //是Excel
    lblTable_s.Caption := '请输入源Excel工作表名:'
  else
    lblTable_s.Caption := '请输入源数据库表名:';

  if not DBC.CheckConvertAvailable(cbbDbTypeSelecter_s.ItemIndex,
    cbbDbTypeSelecter_d.ItemIndex) then
  begin
    lblStatus.Caption := '不支持此源、目标数据库转换组合';
    btnConvert.Enabled := false;
  end
  else
  begin
    lblStatus.Caption := '';
    btnConvert.Enabled := true;
  end;
end;

procedure TForm1.cbbDbTypeSelecter_dChange(Sender: TObject);
begin
  pgcDBLinkSetting_d.ActivePageIndex := cbbDbTypeSelecter_d.ItemIndex;
  if cbbDbTypeSelecter_d.ItemIndex = 1 then //是Excel
    lblTable_d.Caption := '请输入目标Excel工作表名:'
  else
    lblTable_d.Caption := '请输入目标数据库表名:';

  if not DBC.CheckConvertAvailable(cbbDbTypeSelecter_s.ItemIndex,
    cbbDbTypeSelecter_d.ItemIndex) then
  begin
    lblStatus.Caption := '不支持此源、目标数据库转换组合';
    btnConvert.Enabled := false;
  end
  else
  begin
    lblStatus.Caption := '';
    btnConvert.Enabled := true;
  end;
end;

function TForm1.CheckDBParamValid(sDb_Or_dDb, dbItemIdx: integer): boolean;
begin
  Result := false;
  if sDb_Or_dDb = 0 then //0源库参数,1目标库参数
  begin
    case dbItemIdx of
      0: //access
        begin
          if edtAccessPath_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入源Access数据库路径', '提示', MB_OK + MB_ICONWARNING);
            edtAccessPath_s.SetFocus;
            exit;
          end;
        end;
      1: //excel
        begin
          if edtExcelPath_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入源Excel文件路径', '提示', MB_OK + MB_ICONWARNING);
            edtExcelPath_s.SetFocus;
            exit;
          end;
        end;
      2: //Paradox
        begin
          if cbbParadoxDSN_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请选择源Paradox数据库的数据源名', '提示', MB_OK + MB_ICONWARNING);
            cbbParadoxDSN_s.SetFocus;
            exit;
          end;
          if edtParadoxPath_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请选择源Paradox数据库路径', '提示', MB_OK + MB_ICONWARNING);
            edtParadoxPath_s.SetFocus;
            exit;
          end;
        end;
      3: //Foxpro
        begin
          if edtFoxproPath_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请选择源Foxpro数据库路径', '提示', MB_OK + MB_ICONWARNING);
            edtFoxproPath_s.SetFocus;
            exit;
          end;
        end;
      4:
        begin
          if edtSqlServerIP_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入服务器的名称或IP地址', '提示', MB_OK + MB_ICONWARNING);
            edtSqlServerIP_s.SetFocus;
            exit;
          end;
          if edtSqlServerName_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入SQL SERVER数据库的名称', '提示', MB_OK + MB_ICONWARNING);
            edtSqlServerName_s.SetFocus;
            exit;
          end;
          if edtSqlServerUser_s.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入SQL SERVER数据库的用户名', '提示', MB_OK + MB_ICONWARNING);
            edtSqlServerUser_s.SetFocus;
            exit;
          end;
        end;
    end;
  end
  else
  begin
    case dbItemIdx of
      0:
        begin
          if edtAccessPath_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入目标Access数据库路径', '提示', MB_OK + MB_ICONWARNING);
            edtAccessPath_d.SetFocus;
            exit;
          end;
        end;
      1:
        begin