{codecitation class="brush: pascal; gutter: false;" width="600px"}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

function GetBlobStream (Query: TADOQuery): TMemoryStream;

begin

result:= TMemoryStream.Create;

// You must connect to AccessDB first.

// See: Query.Connection, TADOConection or Query.ConnectString

// Send SQL command

Query.Active:= False;

Query.SQL.Clear;

// data is my row and email the table

Query.SQL.Append ('SELECT data FROM email WHERE id=1');

Query.Active:= True;

Result.LoadFromStream (Query.CreateBlobStream (Query.FieldByName ('Data'), bmRead));

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: Konstantin Einstein

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Создание ODBC драйвера для MSAccess

Функция создает ODBC драйвер для MSAccess.

В функцию передается имя файла и имя для драйвера.

В конкретной редакции драйвер создается в разделе «System DSN».

Зависимости: Windows, SysUtils, Dialogs, Variants;

Автор: Konstantin Einstein

Copyright: Konstantin Einstein

Дата: 9 декабря 2002 г.

***************************************************** }

unit CreateODBCforMDB;

interface

uses

Windows, SysUtils, Dialogs, Variants;

const

ODBC_ADD_DSN = 1; (* Add data source *)

ODBC_CONFIG_DSN = 2; (* Configure (edit) data source *)

ODBC_REMOVE_DSN = 3; (* Remove data source *)

ODBC_ADD_SYS_DSN = 4; (* add a system DSN *)

ODBC_CONFIG_SYS_DSN = 5; (* Configure a system DSN *)

ODBC_REMOVE_SYS_DSN = 6; (* remove a system DSN *)

type

TSQLConfigDataSource = function (hwndParent: HWND;

fRequest: WORD;

lpszDriver: LPCSTR;

lpszAttributes: LPCSTR): BOOL; stdcall;

function CreateODBCDriver (fail_name, driver_name: string): Boolean;

implementation

function CreateODBCDriver (fail_name, driver_name: string): Boolean;

var

pFn: TSQLConfigDataSource;

hLib: LongWord;

strDriver, strAttr: string;

fResult: BOOL;

srInfo: TSearchRec;

begin

Result:= True;

hLib:= LoadLibrary ('ODBCCP32'); //load from default path

if (hLib NULL) then

begin

@pFn:= GetProcAddress (hLib, 'SQLConfigDataSource');

if (@pFn nil) then

begin (* force (re-)create DSN *)

strDriver:= 'Microsoft Access Driver (*.mdb)';

strAttr:= Format ('DSN=' driver_name #0

'DBQ=%s' #0

'Exclusive=0' #0

'Description=' driver_name ' DSN' #0 #0,

[fail_name]);

fResult:= pFn (0, ODBC_ADD_SYS_DSN, @strDriver[1], @strAttr[1]);

if (fResult = false) then

begin

ShowMessage ('Create DSN (Datasource) failed!');

Result:= False;

Exit;

end;

// test/create MDB file associated with DSN

if (FindFirst (fail_name, 0, srInfo) 0) then

begin

strDriver:= 'Microsoft Access Driver (*.mdb)';

strAttr:= Format ('DSN=' driver_name #0

'DBQ=%s' #0

'Exclusive=0' #0

'Description=' driver_name ' DSN' #0

'CREATE_DB="%s"'#0 #0,

[fail_name, fail_name]);

fResult:= pFn (0, ODBC_ADD_SYS_DSN, @strDriver[1], @strAttr[1]);

if (fResult = false) then

begin

ShowMessage ('Create MDB (Database file) failed!');

Result:= False;

end;

end;

FindClose (srInfo);

end;

FreeLibrary (hLib);

end

else

begin

ShowMessage ('Unable to load ODBCCP32.DLL');

Result:= False;

end;

Result:= fResult;

end;

end.

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: Vit

WEB-сайт: http://forum.vingrad.ru

Приведенная ниже процедура создает пустую базу данных MS Access

procedure CreateMSAccessDatabase (filename: string);

var

DAO: Variant;

i: integer;

const

Engines: array[0..2] of string = ('DAO.DBEngine.36', 'DAO.DBEngine.35',

'DAO.DBEngine');

function CheckClass (OLEClassName: string): boolean;

var

Res: HResult;

begin

Result:= CoCreateInstance (ProgIDToClassID (OLEClassName), nil,

CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IDispatch, Res) = S_OK;

end;

begin

for i:= 0 to 2 do

if CheckClass (Engines[i]) then

begin

DAO:= CreateOleObject (Engines[i]);

DAO.Workspaces[0].CreateDatabase (filename,

';LANGID=0×0409;CP=1252;COUNTRY=0', 32);

exit;

end;

raise Exception.Create ('DAO engine could not be initialized');

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

// Using ODBC:

const

ODBC_ADD_DSN = 1; // Add data source

ODBC_CONFIG_DSN = 2; // Configure (edit) data source

ODBC_REMOVE_DSN = 3; // Remove data source

ODBC_ADD_SYS_DSN = 4; // add a system DSN

ODBC_CONFIG_SYS_DSN = 5; // Configure a system DSN

ODBC_REMOVE_SYS_DSN = 6; // remove a system DSN

ODBC_REMOVE_DEFAULT_DSN = 7; // remove the default DSN

function SQLConfigDataSource (hwndParent: HWND;

fRequest: Word;

lpszDriver: LPCSTR;

lpszAttributes: LPCSTR): BOOL; stdcall; external 'ODBCCP32.DLL';

function CreateDB (const Database: string): Boolean;

begin

Result:= SQLConfigDataSource (0, ODBC_ADD_DSN,

'Microsoft Access Driver (*.mdb)', PChar ('CREATE_DB=' Database ' General'#0));

end;

procedure TForm1.Button2Click (Sender: TObject);

begin

CreateAccessDatabase ('c:\Testdb.mdb');

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

// Читаем файл (любой версии)

// Проверяем что это ACCESS MDB

// Нужны компаненты:

// TADOtable,TDataSource,TOpenDialog,TDBGrid,TBitBtn.

unit uMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons;

type

TfrmMain = class (TForm)

DSUsers: TDataSource;

DBGridUsers: TDBGrid;

BitBtn1: TBitBtn;

OpenDialog1: TOpenDialog;

TUsers: TADOTable;

procedure FormCreate (Sender: TObject);

procedure ValidateAccessDB;

function CheckIfAccessDB (lDBPathName: string): boolean;

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

const

DBNAME = 'ADODemo.MDB';

DBPASSWORD = '123'; // Access DB Password Protected

implementation

{$R *.DFM}

procedure TfrmMain.FormCreate (Sender: TObject);

begin

validateAccessDB;

end;

procedure TfrmMain.ValidateAccessDB;

var

lDBpathName: String;

lDBcheck: boolean;

begin

if FileExists (ExtractFileDir (Application.ExeName) '\' DBNAME) then

lDBPathName:= ExtractFileDir (Application.ExeName) '\' DBNAME

else if OpenDialog1.Execute then

// Set the OpenDialog Filter for ADOdemo.mdb only

lDBPathName:= OpenDialog1.FileName;

lDBCheck:= False;

if Trim (lDBPathName) '' then

lDBCheck:= CheckIfAccessDB (lDBPathName);

if lDBCheck = True then

begin

// ADO Connection String to the MS-ACCESS DB

TUsers.ConnectionString:=

'Provider=Microsoft.Jet.OLEDB.4.0;'

'Data Source=' lDBPathName ';'

'Persist Security Info=False;'

'Jet OLEDB:Database Password=' DBPASSWORD;

TUsers.TableName:= 'Users';

TUsers.Active:= True;

end

else

frmMain.Free;

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);

BlockRead (UnTypedFile, Buffer, High (Buffer), NumRecsRead);

CloseFile (UnTypedFile);

for i:= 1 to High (Buffer) do

MyString:= MyString Trim (Chr (Ord (Buffer[i])));

Result:= False;

if Mystring = 'StandardJetDB' then

Result:= True;

if Result = False then

MessageDlg ('Invalid Access Database', mtInformation, [mbOK], 0);

end;

end.

{/codecitation}