|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
Помоги решить проблему с БД
Здравствуйте.
Помогите решить проблему. Есть база данных в Access БД.mdb, нужно сделать в Delphi чтобы при нажатии на кнопку создавалась новая база данных с такой же структорой таблиц, но пустая. |
#2
|
||||
|
||||
А не проще скопировать БД и очистить ??
Поживу - увижу, Доживу - узнаю, Выживу - учту. [P.S.]->Выражая благодарность за помощь - Вы получаете шанс на помощь в следующий раз
|
#3
|
||||
|
||||
Мы не ищем легких путей.
Такой вот вариант: Код:
unit Unit7; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, ADODB, ComObj, ComCtrls, Grids, DBGrids; type TfrmDuplicator = class(TForm) AppDB: TADOConnection; OpenDialog: TOpenDialog; btnSource: TButton; edSource: TEdit; edDestination: TEdit; btnDestination: TButton; Label1: TLabel; Label2: TLabel; btnCopy: TButton; ProgressBar: TProgressBar; qTable: TADOCommand; qTables: TADOQuery; procedure btnSourceClick(Sender: TObject); procedure btnCopyClick(Sender: TObject); procedure btnDestinationClick(Sender: TObject); end; var frmDuplicator: TfrmDuplicator; implementation {$R *.dfm} function CreateMDB(DBName: String): Boolean; var DBEngine,Workspace: Variant; const dbLangGeneral = ';langid=0x0409;cp=1252;country=0'; dbVersion30 = 32; begin Result := False; try try DBEngine := CreateOleObject('DAO.DBEngine.36'); except try DBEngine := CreateOleObject('DAO.DBEngine.35'); except raise; end; end; Workspace := DBEngine.Workspaces[0]; try Workspace.CreateDatabase(DBName, dbLangGeneral, dbVersion30); except on Err: EOleException do ShowMessage(Err.Message); end; except on Err: EOleException do ShowMessage(Err.Message); end; Result := True; end; procedure TfrmDuplicator.btnCopyClick(Sender: TObject); begin if not CreateMDB(edDestination.Text) then Exit; AppDB.ConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'+ 'Jet OLEDB:Create System Database=true;'+ 'Jet OLEDB:System database=C:\Users\Хозяин\AppData\Roaming\Microsoft\Access\System.mdw', [edSource.Text]); AppDB.LoginPrompt := False; AppDB.Open; qTables.SQL.Text := 'SELECT Name from MSysObjects where Type=1 and Flags=0'; qTables.Open; ProgressBar.Max := qTables.RecordCount; ProgressBar.Position := ProgressBar.Min; while not qTables.Eof do begin qTable.CommandText := Format('SELECT TOP 1 * INTO %s IN ''%s'' FROM %s', [qTables.FieldValues['Name'],edDestination.Text,qTables.FieldValues['Name']]); qTable.Execute; qTables.Next; ProgressBar.StepIt; end; end; procedure TfrmDuplicator.btnDestinationClick(Sender: TObject); begin if not OpenDialog.Execute then Exit; edDestination.Text := OpenDialog.FileName; btnCopy.Enabled := True; end; procedure TfrmDuplicator.btnSourceClick(Sender: TObject); begin if not OpenDialog.Execute then Exit; edSource.Text := OpenDialog.FileName; edDestination.Enabled := True; btnDestination.Enabled := True; end; end. Код:
object frmDuplicator: TfrmDuplicator Left = 0 Top = 0 Caption = #1044#1091#1073#1083#1080#1082#1072#1090#1086#1088 ClientHeight = 98 ClientWidth = 409 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 8 Top = 11 Width = 52 Height = 13 Caption = #1048#1089#1090#1086#1095#1085#1080#1082':' end object Label2: TLabel Left = 8 Top = 38 Width = 53 Height = 13 Caption = #1055#1088#1080#1077#1084#1085#1080#1082':' end object btnSource: TButton Left = 377 Top = 8 Width = 24 Height = 21 Caption = '...' TabOrder = 0 OnClick = btnSourceClick end object edSource: TEdit Left = 67 Top = 8 Width = 310 Height = 21 TabOrder = 1 Text = #1042#1099#1073#1077#1088#1080#1090#1077' '#1080#1084#1103' '#1092#1072#1081#1083#1072' '#1073#1072#1079#1099' '#1086#1090#1082#1091#1076#1072' '#1073#1091#1076#1077#1084' '#1082#1086#1087#1080#1088#1086#1074#1072#1090#1100 end object edDestination: TEdit Left = 67 Top = 35 Width = 310 Height = 21 Enabled = False TabOrder = 2 Text = #1042#1099#1073#1077#1088#1080#1090#1077' '#1080#1084#1103' '#1092#1072#1081#1083#1072' '#1073#1072#1079#1099' '#1082#1091#1076#1072' '#1073#1091#1076#1077#1084' '#1082#1086#1087#1080#1088#1086#1074#1072#1090#1100 end object btnDestination: TButton Left = 377 Top = 35 Width = 24 Height = 21 Caption = '...' Enabled = False TabOrder = 3 OnClick = btnDestinationClick end object btnCopy: TButton Left = 8 Top = 62 Width = 121 Height = 25 Caption = #1053#1072#1095#1072#1090#1100' '#1082#1086#1087#1080#1088#1086#1074#1072#1085#1080#1077 Enabled = False TabOrder = 4 OnClick = btnCopyClick end object ProgressBar: TProgressBar Left = 135 Top = 65 Width = 242 Height = 17 Step = 1 TabOrder = 5 end object AppDB: TADOConnection ConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\DBase\KLADR.mdb;' + 'Persist Security Info=False' Provider = 'Microsoft.Jet.OLEDB.4.0' Left = 168 Top = 64 end object OpenDialog: TOpenDialog DefaultExt = '*.mdb' Filter = #1041#1072#1079#1099' '#1076#1072#1085#1085#1099#1093' MS Access (*.mdb)|*.mdb|'#1042#1089#1077' '#1092#1072#1081#1083#1099' (*.*)|*.*' Left = 136 Top = 64 end object qTable: TADOCommand Connection = AppDB Parameters = <> Left = 232 Top = 64 end object qTables: TADOQuery Connection = AppDB Parameters = <> Left = 200 Top = 64 end end Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#4
|
|||
|
|||
Нужна помощь. При попытке открытия БД Paradox с использованием компонентов Ado,выдается ошибка драйвера внешней базы данных (11010). или (8961).
|
#5
|
||||
|
||||
Цитата:
Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |