unit1.~pas

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

          if edtExcelPath_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入目标Excel文件路径', '提示', MB_OK + MB_ICONWARNING);
            edtExcelPath_d.SetFocus;
            exit;
          end;
        end;
      2:
        begin
          if cbbParadoxDSN_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请选择目标Paradox数据库的数据源名', '提示', MB_OK + MB_ICONWARNING);
            cbbParadoxDSN_d.SetFocus;
            exit;
          end;
          if edtParadoxPath_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请选择目标Paradox数据库路径', '提示', MB_OK + MB_ICONWARNING);
            edtParadoxPath_d.SetFocus;
            exit;
          end;
        end;
      3:
        begin
          if edtFoxproPath_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请选择目标Foxpro数据库路径', '提示', MB_OK + MB_ICONWARNING);
            edtFoxproPath_d.SetFocus;
            exit;
          end;
        end;
      4:
        begin
          if edtSqlServerIP_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入服务器的名称或IP地址', '提示', MB_OK + MB_ICONWARNING);
            edtSqlServerIP_d.SetFocus;
            exit;
          end;
          if edtSqlServerName_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入SQL SERVER数据库的名称', '提示', MB_OK + MB_ICONWARNING);
            edtSqlServerName_d.SetFocus;
            exit;
          end;
          if edtSqlServerUser_d.Text = '' then
          begin
            MessageBox(Self.Handle, '请输入SQL SERVER数据库的用户名', '提示', MB_OK + MB_ICONWARNING);
            edtSqlServerUser_d.SetFocus;
            exit;
          end;
        end;
    end;

  end;
  Result := true;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DBC := TDBConverter.Create;
  ssn1.GetAliasNames(cbbParadoxDSN_s.Items);
  ssn1.GetAliasNames(cbbParadoxDSN_d.Items);
end;

procedure TForm1.mniMenuItemClick(Sender: TObject);
begin
  cbbDbTypeSelecter_s.ItemIndex := ((Sender as TMenuItem).Tag) div 10;
  cbbDbTypeSelecter_sChange(Sender);
  cbbDbTypeSelecter_d.ItemIndex := ((Sender as TMenuItem).Tag) mod 10;
  cbbDbTypeSelecter_dChange(Sender);
end;

procedure TForm1.btnConvertClick(Sender: TObject);
begin
  //检查数据库设置信息填写是否正确
  if not CheckDBParamValid(0, cbbDbTypeSelecter_s.ItemIndex) then exit;
  if not CheckDBParamValid(1, cbbDbTypeSelecter_d.ItemIndex) then exit;

  //检查数据库表设置信息填写是否正确
  if not CheckTableParamValid then exit;

  //填充数据库信息结构变量
  FillSourceDBInfoParam;
  FillTargetDBInfoParam;
  FillCvtTableParam;

  DBC.SourceDatabaseInfoPara := SourceDatabaseInfoPara;
  DBC.TargetDatabaseInfoPara := TargetDatabaseInfoPara;
  DBC.ConvertTablePara := ConvertTablePara;

  DBC.Execute;
  MessageBox(Self.Handle, '数据库转换操作已完成!', '提示', MB_OK + MB_ICONWARNING);
end;

function TForm1.CheckTableParamValid: boolean;
begin
  Result := false;
  if edtTabel_s.Text = '' then
  begin
    MessageBox(Self.Handle, '请输入源数据库表名称', '提示', MB_OK + MB_ICONWARNING);
    edtTabel_s.SetFocus;
    exit;
  end;
  if edtTabel_d.Text = '' then
  begin
    MessageBox(Self.Handle, '请输入目标数据库表名称', '提示', MB_OK + MB_ICONWARNING);
    edtTabel_d.SetFocus;
    exit;
  end;
  Result := true;
end;

procedure TForm1.FillCvtTableParam;
begin
  ConvertTablePara.SourceTable := edtTabel_s.Text;
  ConvertTablePara.TargetTable := edtTabel_d.Text;
end;

procedure TForm1.FillSourceDBInfoParam;
begin
  SourceDatabaseInfoPara.DBType := TDBType(cbbDbTypeSelecter_s.ItemIndex);
  case cbbDbTypeSelecter_s.ItemIndex of
    0: //Access
      begin
        SourceDatabaseInfoPara.AccessPara.Path := edtAccessPath_s.Text;
        SourceDatabaseInfoPara.AccessPara.Password := edtAccessPwd_s.Text;
      end;
    1: //Excel
      begin
        SourceDatabaseInfoPara.ExcelPara.Path := edtExcelPath_s.Text;
      end;
    2: //paradox
      begin
        SourceDatabaseInfoPara.ParadoxPara.DSN := cbbParadoxDSN_s.Text;
        SourceDatabaseInfoPara.ParadoxPara.Path := edtParadoxPath_s.Text;
      end;
    3: //Foxpro
      begin
        SourceDatabaseInfoPara.FoxproPara.Path := edtFoxproPath_s.Text;
      end;
    4: //sql server
      begin
        SourceDatabaseInfoPara.SqlServerPara.Server := edtSqlServerIP_s.Text;
        SourceDatabaseInfoPara.SqlServerPara.DBName := edtSqlServerName_s.Text;
        SourceDatabaseInfoPara.SqlServerPara.UserName := edtSqlServerUser_s.Text;
        SourceDatabaseInfoPara.SqlServerPara.Password := edtSqlServerPwd_s.Text;
      end;
  end;

end;

procedure TForm1.FillTargetDBInfoParam;
begin
  TargetDatabaseInfoPara.DBType := TDBType(cbbDbTypeSelecter_d.ItemIndex);

  case cbbDbTypeSelecter_d.ItemIndex of
    0: //Access
      begin
        TargetDatabaseInfoPara.AccessPara.Path := edtAccessPath_d.Text;
      end;
    1: //Excel
      begin
        TargetDatabaseInfoPara.ExcelPara.Path := edtExcelPath_d.Text;
      end;
    2: //paradox
      begin
        TargetDatabaseInfoPara.ParadoxPara.DSN := cbbParadoxDSN_d.Text;
        TargetDatabaseInfoPara.ParadoxPara.Path := edtParadoxPath_d.Text;
      end;
    3: //Foxpro
      begin
        TargetDatabaseInfoPara.FoxproPara.Path := edtFoxproPath_d.Text;
      end;
    4: //sql server
      begin
        TargetDatabaseInfoPara.SqlServerPara.Server := edtSqlServerIP_d.Text;
        TargetDatabaseInfoPara.SqlServerPara.DBName := edtSqlServerName_d.Text;
        TargetDatabaseInfoPara.SqlServerPara.UserName := edtSqlServerUser_d.Text;
        TargetDatabaseInfoPara.SqlServerPara.Password := edtSqlServerPwd_d.Text;
      end;
  end;

end;

procedure TForm1.btnAccessPathBrw_dClick(Sender: TObject);
begin
  dlgOpenFile.Filter := 'MS Access DB file|*.mdb';
  if dlgOpenFile.Execute then
    edtAccessPath_d.Text := dlgOpenFile.FileName;
end;

procedure TForm1.btnAccessPathBrw_sClick(Sender: TObject);
begin
  dlgOpenFile.Filter := 'MS Access DB file|*.mdb';
  if dlgOpenFile.Execute then
    edtAccessPath_s.Text := dlgOpenFile.FileName;
end;

procedure TForm1.btnExcelPathBrw_sClick(Sender: TObject);
begin
  dlgOpenFile.Filter := 'MS Excel file|*.xls';
  if dlgOpenFile.Execute then
    edtExcelPath_s.Text := dlgOpenFile.FileName;
end;

procedure TForm1.btnExcelPathBrw_dClick(Sender: TObject);
begin
  dlgOpenFile.Filter := 'MS Excel file|*.xls';
  if dlgOpenFile.Execute then
    edtExcelPath_d.Text := dlgOpenFile.FileName;
end;

procedure TForm1.btnParadoxPathBrw_sClick(Sender: TObject);
begin
  SelectFolderfrm := TSelectFolderfrm.Create(Self);
  SelectFolderfrm.ShowModal;

  if SelectFolderfrm.ModalResult = mrOK then
  begin
    edtParadoxPath_s.Text := SelectFolderfrm.SelectedPath;
  end;
  SelectFolderfrm.Free;
  SelectFolderfrm := nil;
end;

procedure TForm1.btnParadoxPathBrw_dClick(Sender: TObject);
begin
  SelectFolderfrm := TSelectFolderfrm.Create(Self);
  SelectFolderfrm.ShowModal;

  if SelectFolderfrm.ModalResult = mrOK then
  begin
    edtParadoxPath_d.Text := SelectFolderfrm.SelectedPath;
  end;
  SelectFolderfrm.Free;
  SelectFolderfrm := nil;
end;

procedure TForm1.btnFoxproPath_sClick(Sender: TObject);
begin
  SelectFolderfrm := TSelectFolderfrm.Create(Self);
  SelectFolderfrm.ShowModal;

  if SelectFolderfrm.ModalResult = mrOK then
  begin
    edtFoxproPath_s.Text := SelectFolderfrm.SelectedPath;
  end;
  SelectFolderfrm.Free;
  SelectFolderfrm := nil;
end;

procedure TForm1.btnFoxproPath_dClick(Sender: TObject);
begin
  SelectFolderfrm := TSelectFolderfrm.Create(Self);
  SelectFolderfrm.ShowModal;

  if SelectFolderfrm.ModalResult = mrOK then
  begin
    edtFoxproPath_d.Text := SelectFolderfrm.SelectedPath;
  end;
  SelectFolderfrm.Free;
  SelectFolderfrm := nil;
end;

procedure TForm1.lblRiselonMouseEnter(Sender: TObject);
begin
   Screen.Cursor:=  crHandPoint;
end;

procedure TForm1.lblRiselonMouseLeave(Sender: TObject);
begin
  Screen.Cursor:=crDefault;
end;

procedure TForm1.lblSourceMouseLeave(Sender: TObject);
begin
  Screen.Cursor:=crDefault;
end;

procedure TForm1.lblSourceMouseEnter(Sender: TObject);
begin
   Screen.Cursor:=  crHandPoint;
end;

procedure TForm1.lblRiselonClick(Sender: TObject);
begin
   ShellExecute(handle, nil, 'http://www.riselon.com', nil, nil, sw_shownormal);
end;

procedure TForm1.lblSourceClick(Sender: TObject);
var
  S:string;
begin
   S:='http://www.softreg.com.cn/shareware_view.asp?id=/740445FC-435D-4688-8307-785AFDBDC667/';
    ShellExecute(handle, nil, PChar(S), nil, nil, sw_shownormal);
end;

end.