Полезное для программистов:

Фриланс
Новости
Статьи
   
Рубрики:


Записываем в Access используя OLE DB

Поиск:
Код

// Читаем Access`овскую базу используя ADO
// Проверяе являеться ли файл .mdb Access
// Записываем запись в базу
// Нужны компаненты-
//    TADOtable,TDataSource,TOpenDialog,TDBGrid,
//    TBitBtn,TTimer,TEditTextBox
program ADOdemo;

uses Forms, uMain in 'uMain.pas' {frmMain};

{$R *.RES}

begin
 Application.Initialize;
 Application.CreateForm(TfrmMain, frmMain);
 Application.Run;
end.
///////////////////////////////////////////////////////////////////
unit uMain;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons,
 ComObj;

type
 TfrmMain = class(TForm)
   DBGridUsers: TDBGrid;
   BitBtnClose: TBitBtn;
   DSource1: TDataSource;
   EditTextBox: TEdit;
   BitBtnAdd: TBitBtn;
   TUsers: TADOTable;
   BitBtnRefresh: TBitBtn;
   Timer1: TTimer;
   Button1: TButton;
   procedure FormCreate(Sender: TObject);
   procedure ConnectToAccessDB(lDBPathName, lsDBPassword: string);
   procedure ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
   procedure AddRecordToMSAccessDB;
   function CheckIfAccessDB(lDBPathName: string): Boolean;
   function GetDBPath(lsDBName: string): string;
   procedure BitBtnAddClick(Sender: TObject);
   procedure BitBtnRefreshClick(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   function GetADOVersion: Double;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 frmMain: TfrmMain;
 Global_DBConnection_String: string;
const
 ERRORMESSAGE_1 = 'No Database Selected';
 ERRORMESSAGE_2 = 'Invalid Access Database';

implementation

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
 ConnectToMSAccessDB('ADODemo.MDB', '123'); // DBName,DBPassword
end;

procedure TfrmMain.ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
var
 lDBpathName: string;
begin
 lDBpathName := GetDBPath(lsDBName);
 if (Trim(lDBPathName) <> '') then
   begin
     if CheckIfAccessDB(lDBPathName) then
       ConnectToAccessDB(lDBPathName, lsDBPassword);
   end
 else
   MessageDlg(ERRORMESSAGE_1, mtInformation, [mbOK], 0);
end;

function TfrmMain.GetDBPath(lsDBName: string): string;
var
 lOpenDialog: TOpenDialog;
begin
 lOpenDialog := TOpenDialog.Create(nil);
 if FileExists(ExtractFileDir(Application.ExeName) + '\' + lsDBName) then
   Result := ExtractFileDir(Application.ExeName) + '\' + lsDBName
 else
   begin
     lOpenDialog.Filter := 'MS Access DB|' + lsDBName;
     if lOpenDialog.Execute then
       Result := lOpenDialog.FileName;
   end;
end;

procedure TfrmMain.ConnectToAccessDB(lDBPathName, lsDBPassword: string);
begin
 Global_DBConnection_String :=
   'Provider=Microsoft.Jet.OLEDB.4.0;' +
   'Data Source=' + lDBPathName + ';' +
   'Persist Security Info=False;' +
   'Jet OLEDB:Database Password=' + lsDBPassword;

 with TUsers do
   begin
     ConnectionString := Global_DBConnection_String;
     TableName := 'Users';
     Active := True;
   end;
end;

// Check if it is a valid ACCESS DB File Before opening it.

function TfrmMain.CheckIfAccessDB(lDBPathName: string): Boolean;
var
 UnTypedFile: file of Byte;
 Buffer: array[0..19] of Byte;
 NumRecsRead: Integer;
 i: Integer;
 MyString: string;
begin
 AssignFile(UnTypedFile, lDBPathName);
 reset(UnTypedFile, 1);
 BlockRead(UnTypedFile, Buffer, 19, NumRecsRead);
 CloseFile(UnTypedFile);
 for i := 1 to 19 do
   MyString := MyString + Trim(Chr(Ord(Buffer[i])));
 Result := False;
 if Mystring = 'StandardJetDB' then
   Result := True;
 if Result = False then
   MessageDlg(ERRORMESSAGE_2, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.BitBtnAddClick(Sender: TObject);
begin
 AddRecordToMSAccessDB;
end;

procedure TfrmMain.AddRecordToMSAccessDB;
var
 lADOQuery: TADOQuery;
 lUniqueNumber: Integer;
begin
 if Trim(EditTextBox.Text) <> '' then
   begin
     lADOQuery := TADOQuery.Create(nil);
     with lADOQuery do
       begin
         ConnectionString := Global_DBConnection_String;
         SQL.Text :=
           'SELECT Number from Users';
         Open;
         Last;
     // Generate Unique Number (AutoNumber in Access)
         lUniqueNumber := 1 + StrToInt(FieldByName('Number').AsString);
         Close;
     // Insert Record into MSAccess DB using SQL
         SQL.Text :=
           'INSERT INTO Users Values (' +
           IntToStr(lUniqueNumber) + ',' +
           QuotedStr(UpperCase(EditTextBox.Text)) + ',' +
           QuotedStr(IntToStr(lUniqueNumber)) + ')';
         ExecSQL;
         Close;
     // This Refreshes the Grid Automatically
         Timer1.Interval := 5000;
         Timer1.Enabled := True;
       end;
   end;
end;

procedure TfrmMain.BitBtnRefreshClick(Sender: TObject);
begin
 Tusers.Active := False;
 Tusers.Active := True;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
 Tusers.Active := False;
 Tusers.Active := True;
 Timer1.Enabled := False;
end;

function TfrmMain.GetADOVersion: Double;
var
 ADO: OLEVariant;
begin
 try
   ADO := CreateOLEObject('adodb.connection');
   Result := StrToFloat(ADO.Version);
   ADO := Null;
 except
   Result := 0.0;
 end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
 ShowMessage(Format('ADO Version = %n', [GetADOVersion]));
end;

end.
Автор: delphiworld
Сайт: www.delphiworld.narod.ru






Просмотров: 2005

 

 

Новые статьи:


Популярные:
  1. Как сделать цикличным проигрывание MIDI-файла?
  2. Создание AVI файла из рисунков
  3. Как устройство "отключить в данной конфигурации"?
  4. Kто в данный момент присоединен через Сеть?
  5. Как узнать количество доступной памяти?
  6. Как реализовать в RichEdit разноцветный текст?
  7. Как скрыть свое приложение от ProcessViewer
  8. Как программно нажать/скрыть/показ кнопку "Start"?
  9. Модуль работы с ресурсами в PE файлах
10. Функции вызова диалоговых окон выбора
11. Проверка граматики средствами Word'а из Delphi.
12. Модуль для упрощенного вызова сообщений
13. Функции для записи и чтение своих данных в, ЕХЕ- файле
14. Рекурсивный просмотр директорий
15. Network Traffic Monitor
16. Разные модули
17. Универсальная функция для обращения к любым экспортируем функциям DLL
18. Библиотека от VladS
19. Протектор для UPX'а
20. Еще об ICQ, сообщения по контакт листу?
21. Использование открытых интерфейсов
22. Теория и практика использования RTTI
23. Работа с TApplication
24. Примеры использования Drag and Drop для различных визуальных компонентов
25. Что такое порт? Правила для работы с портами
26. Симфония на клавиатуре
27. Загрузка DLL
28. Исправление автоинкремента
29. Взаимодействие с чужими окнами
30. Проверить дубляжи в столбце


 

 

 
 
На главную