Delphi World - Записываем в Access используя ADO
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Записываем в Access используя ADO


// Читаем 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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования