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

 
// Using ADOX: 

uses
ComObj;

// You can with ADOX (Microsoft ADO Extensions for DDL and Security),

function CreateAccessDatabase(FileName: string): string;
var
cat: OLEVariant;
begin
Result := '';
try
cat := CreateOleObject('ADOX.Catalog');
cat.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + FileName + ';');
cat := NULL;
except
on e: Exception do Result := e.message;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateAccessDatabase('c:\Testdb.mdb');
end;

 
Приведенная ниже процедура создает пустую базу данных 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=0x0409;CP=1252;COUNTRY=0', 32);
exit;
end;
raise Exception.Create('DAO engine could not be initialized');
end;

 
{ **** 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.

 
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;

 
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Программное создание таблиц/ключей(первичных и вторичных) для бд Access

В принципе данный пример описан на сайте http://www.olap.ru/desc/microsoft/borland_ado.asp ,за
исключением создания ключей. Там же можно прочитать , о том как включить ссылку на библиотеку
типов ADOX(Для этого следует выбрать Project | Import Type Library главного меню среды
разработки Delphi, а затем из списка доступных библиотек типов выбрать Microsoft ADO Ext.
2.5 for DDL and Security. Чтобы избежать конфликтов с именами уже имеющихся классов Delphi
(например, TTable), следует переименовать классы ADOX, заменив имена на что-нибудь типа TADOXxxx.
Затем нужно убрать отметку из опции Generate Component Wrapper — в данном случае нам нужен
только файл *.pas, содержащий интерфейс для доступа к объектам ADOX, а затем нажать кнопку
Create Unit. Это приведет к созданию файла ADOX_TLB.PAS, содержащего интерфейс к библиотеке
типов ADOX. Создав этот файл, мы должны сослаться на него, а также на модуль ADODB в
предложении Uses главного модуля нашего проекта).

Создаются 2 таблицы (Otdel,Departament).Поле NumDepartament в таблице Otdel является
внешним ключем к полю NumDepartament в таблице NumDepartament. Поля NumDepartament и
NumOtdel в таблицах Departament и Otdel сответственно являются первичными ключами.

Зависимости: Библиотека типов ADOX
Автор: Дима
Copyright: http://www.olap.ru/desc/microsoft/borland_ado.asp + msdn
Дата: 30 июля 2003 г.
***************************************************** }


var
Catalog: _Catalog;
Table: _Table;
Column: _Column;
FKKey: _Key;
begin
Catalog := CoCatalog.Create;
try
Catalog.Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + DatabaseName + ';Persist Security Info=False');
//DatabaseName - Путь к файлу с базой данных (C:\1\12.mdb)
//=============================================DOLGNOST=========================
Table := CoTable.Create;
try
Table.Name := 'Dolgnost';
Table.ParentCatalog := Catalog;
Column := CoColumn.Create;
try
with Column do
begin
ParentCatalog := Catalog;
Name := 'NumDolgnost';
Type_ := adInteger;
end;
Table.Columns.Append(Column, 0, 0);
finally
Column := nil;
end;
with Table.Columns do
begin
Append('NameDolgnost', adVarWChar, 50);
end;
Catalog.Tables.Append(Table);
finally
Table := nil;
end;
//=============================================DEPARTAMENT======================
Table := CoTable.Create;
try
Table.Name := 'Departament';
Table.ParentCatalog := Catalog;
Column := CoColumn.Create;
try
with Column do
begin
ParentCatalog := Catalog;
Name := 'NumDepartament';
Type_ := adInteger;
end;
Table.Columns.Append(Column, 0, 0);
finally
Column := nil;
end;
with Table.Columns do
begin
Append('NameDepartament', adVarWChar, 50);
end;
Catalog.Tables.Append(Table);
finally
Table := nil;
end;
//==============================Создание первичных ключей=======================
//Otdel
FKKey := CoKey.Create;
try
with FKKey do
begin
Name := 'PKNumOtdel';
Type_ := adKeyPrimary;
Columns.Append('NumOtdel', adInteger, 0);
end;
Catalog.Tables['Otdel'].Keys.Append(FKKey, 0, EmptyParam, '', '');
finally
FKKey := nil;
end;
//Departament
FKKey := CoKey.Create;
try
with FKKey do
begin
Name := 'PKNumDepartament';
Type_ := adKeyPrimary;
Columns.Append('NumDepartament', adInteger, 0);
end;
Catalog.Tables['Departament'].Keys.Append(FKKey, 0, EmptyParam, '', '');
finally
FKKey := nil;
end;
//==============================Создание вторичных ключей=======================
//Otdel
FKKey := CoKey.Create;
try
with FKKey do
begin
Name := 'FKNumOtdel';
Type_ := adKeyForeign;
Columns.Append('NumDepartament', adInteger, 0);
RelatedTable := 'Departament';
Columns['NumDepartament'].RelatedColumn := 'NumDepartament';
UpdateRule := adRICascade;
end;
Catalog.Tables['Otdel'].Keys.Append(FKKey, 0, EmptyParam, '', '');
finally
FKKey := nil;
end;
finally
Catalog = nil;
end;

 
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Программное создание базы данных Access (DAO DBEngine)

Функция создания файла базы данных Access.

PS. кто будет использовать - в комментариях отметьте версии ОС, Access,Delphi.

Зависимости: ComObj, Dialogs,
Автор: savva, savva@nm.ru, ICQ:126578975, Орел
Copyright: Сапронов Алексей (Savva)
Дата: 11 октября 2002 г.
***************************************************** }


function CreateDatabase(DatabaseName: 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 {For DAO 3.5}
DBEngine := CreateOleObject('DAO.DBEngine.35');
except
raise;
end;
end;
Workspace := DBEngine.Workspaces[0];
try
Workspace.CreateDatabase(DatabaseName, dbLangGeneral, dbVersion30);
except on e0: EOleException do
ShowMessage(e0.Message);
end;
except on e1: EOleException do
ShowMessage(e1.Message);
end;
result := true;
end;

Пример использования:
...
CreateDatabase(db_name);
...

 
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Программное сжатие базы данных Access используя JRO (Jet Replication Objects)

Процедура позволяет сжать базу данных в формате Access,
используя JRO (Jet Replication Objects). Действие аналогичное
пункту меню в Access "Сервис -> Служебные программы ->
Сжать и восстановить базу данных".
Параметры:
* DatabaseName - путь к исходной (не сжатой) базе данных
* DestDatabaseName - путь к сжатой базе данных
(по умолчанию пустой - в этом случае исходная база заменяется сжатой)
* Password - пароль базы данных (по умолчанию пустой)

PS. этот код был написан в связи с тем что аналогичная процедура
через DAO у многих не работала (по пока неизвестным для меня причинам)

Зависимости: windows,SysUtils,ComObj,Dialogs (Dialogs можно исключить
используя MessageBox для вывода сообщения исключительной ситуации)
Автор: savva, savva@nm.ru, ICQ:126578975, Орел
Copyright: Сапронов Алексей (Savva)
Дата: 9 сентября 2002 г.
***************************************************** }


procedure CompactDatabase_JRO(DatabaseName: string; DestDatabaseName: string =
''; Password: string = '');
const
Provider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var
TempName: array[0..MAX_PATH] of Char; // имя временного файла
TempPath: string; // путь до него
Name: string;
Src, Dest: WideString;
V: Variant;
begin
try
Src := Provider + 'Data Source=' + DatabaseName;
if DestDatabaseName <> '' then
Name := DestDatabaseName
else
begin
// выходная база не указана - используем временный файл
// получаем путь для временного файла
TempPath := ExtractFilePath(DatabaseName);
if TempPath = '' then
TempPath := GetCurrentDir;
//получаем имя временного файла
GetTempFileName(PChar(TempPath), 'mdb', 0, TempName);
Name := StrPas(TempName);
end;
DeleteFile(PChar(Name)); // этого файла не должно существовать :))
Dest := Provider + 'Data Source=' + Name;
if Password <> '' then
begin
Src := Src + ';Jet OLEDB:Database Password=' + Password;
Dest := Dest + ';Jet OLEDB:Database Password=' + Password;
end;

V := CreateOleObject('jro.JetEngine');
try
V.CompactDatabase(Src, Dest); // сжимаем
finally
V := 0;
end;
if DestDatabaseName = '' then
begin // т.к. выходная база не указана
DeleteFile(PChar(DatabaseName)); //то удаляем не упакованную базу
RenameFile(Name, DatabaseName); // и переименовываем упакованную базу
end;
except
// выдаем сообщение об исключительной ситуации
on E: Exception do
ShowMessage(e.message);
end;
end;

Пример использования:
...
db.Close;
CompactDatabase_JRO('c:\database.mdb',
'c:\Archiv\database_pack.mdb', 'password');
db.open;
...

 
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Программное сжатие базы данных Access используя DAO

Процедура позволяет сжать базу данных в формате Access, используя DAO.
Действие аналогичное пункту меню в Access "Сервис -> Служебные программы ->
Сжать и восстановить базу данных".
Параметры:
* DatabaseName - путь к базе данных
* Password - пароль базы данных

Зависимости: windows,SysUtils,Dialogs,DAO2000,ComObj
(Dialogs можно исключить используя MessageBox для вывода
сообщения исключительной ситуации)
Автор: savva, savva@nm.ru, ICQ:126578975, Орел
Copyright: Сапронов Алексей (Savva)
Дата: 31 мая 2002 г.
***************************************************** }


//перед вызовом процедуры базу надо закрыть, а после - открыть

procedure TData.CompactAccessDatabase(DatabaseName, Password: string);
var
TempName: array[0..MAX_PATH] of Char; // имя временного файла
TempPath: string; // путь
Name: string;
tmpDAO: _DBEngine;
ClassID: TGUID;
V35, V36: string; // версия DAO
begin
V35 := 'DAO.DBEngine.35';
V36 := 'DAO.DBEngine.36';
try // получим ClassID
try
ClassID := ProgIDToClassID(v35);
except
try
ClassID := ProgIDToClassID(v36);
except
raise; // что то нам неизвестное
end;
end;
// получаем путь для временного файла
TempPath := ExtractFilePath(DatabaseName);
if TempPath = '' then
TempPath := GetCurrentDir;
//получаем имя временного файла
GetTempFileName(PChar(TempPath), 'mdb', 0, TempName);
Name := StrPas(TempName);
DeleteFile(PChar(Name)); // этого файла не должно существовать :))
if Password <> '' then
Password := ';pwd=' + Password;
tmpDAO := CreateComObject(ClassID) as _DBEngine;
tmpDAO.CompactDatabase(DatabaseName, Name, 0, 0, Password);
DeleteFile(PChar(DatabaseName)); // удаляем не упакованную базу
RenameFile(Name, DatabaseName); // переименовываем упакованную базу
except
// выдаем сообщение об исключительной ситуации
on E: Exception do
ShowMessage(e.message);
end;
еnd;

Пример использования:
...
db.Close;
CompactAccessDatabase('database.mdb', 'password');
db.open;
...

 
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Установка/Изменение/Удаление пароля на базу данных Access

Функция для удаления, задания и изменения пароля базы данных Access используя DAO Engine.

PS. кто будет использовать - в комментариях отметьте версии ОС, Access,Delphi.

Зависимости: Dialogs,DAO2000,ComObj
Автор: savva, savva@nm.ru, ICQ:126578975, Орел
Copyright: Сапронов Алексей (Savva)
Дата: 13 сентября 2002 г.
***************************************************** }


//определяем тип, указывающий действие над паролем
type
TPasswordAction = (paSet, paChange, paRemove);

....

function ChangeAccessDBPassword(DatabaseName: string; action: TPasswordAction;
OldPassword: string = ''; NewPassword: string = ''): boolean;
var
DAO: _DBEngine;
db: Database;
ClassID: TGUID;
V35, V36: string;
oldPass, newPass: string;
begin
Result := false;
V35 := 'DAO.DBEngine.35';
V36 := 'DAO.DBEngine.36';
try
try
ClassID := ProgIDToClassID(v36);
except
try
ClassID := ProgIDToClassID(v35);
except
raise;
end;
end;
DAO := CreateComObject(ClassID) as _DBEngine;
if action = paSet then
begin
db := DAO.OpenDatabase(DatabaseName, true, false, '');
db.NewPassword(#0, NewPassword);
end
else
begin
db := DAO.OpenDatabase(DatabaseName, true, false, ';pwd=' + OldPassword);
if action = paChange then
db.NewPassword(OldPassword, NewPassword)
else
db.NewPassword(OldPassword, #0);
end;
Result := true;
except
// выводим сообщение о ошибке
on E: Exception do
begin
Result := false;
ShowMessage(e.message);
end;
end;
end.

Пример использования:
//устанавливаем новый пароль - БАЗА ДОЛЖНА БЫТЬ НЕ ЗАПАРОЛЕНА,
// иначе будет ошибка:)

procedure TForm1.Button1Click(Sender: TObject);
var
newPass: string;
begin
if InputQuery('New password', 'Enter new password', newPass) then
if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb', paSet,
'', newPass) then
ShowMessage('OK!')
else
ShowMessage('Error!');
end;

//изменяем пароль

procedure TForm1.Button2Click(Sender: TObject);
var
oldPass, newPass: string;
begin
if InputQuery('Old password', 'Enter old password', oldPass) then
if InputQuery('New password', 'Enter new password', newPass) then
if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb',
paChange, oldPass, newPass) then
ShowMessage('OK!')
else
ShowMessage('Error!');
end;

//удаляем пароль

procedure TForm1.Button3Click(Sender: TObject);
var
oldPass: string;
begin
if InputQuery('Password', 'Enter password', oldPass) then
if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb',
paRemove, oldPass, '') then
ShowMessage('OK!')
else
ShowMessage('Error!');
end;

 

Советуем зайти


    Warning: Illegal string offset 'sites' in /var/www/zwd/data/www/wp-content/themes/functions.php on line 1046

    Warning: in_array() expects parameter 2 to be array, string given in /var/www/zwd/data/www/wp-content/themes/functions.php on line 1046

    Warning: Illegal string offset 'sites' in /var/www/zwd/data/www/wp-content/themes/functions.php on line 1046

    Warning: in_array() expects parameter 2 to be array, string given in /var/www/zwd/data/www/wp-content/themes/functions.php on line 1046
  • оперативная печать
  • изготовление печатей по оттиску
  • газификация