Очень медленный доступ к таблице при первом обращении

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

Данная проблема возникает из-за того, что BDE вначале запрашивает базу данных для получения информации о таблице, прежде чем он начнет с ней работать. Как только появляется информация о таблице, она кэшируется и обращение к таблице во время всего сеанса (пока TDatabase.Connection имеет значение True) происходит практически мгновенно. Для того, чтобы использовать кэшируемую информацию и при последующем запуске приложения, в конфигурации BDE найдите необходимый псевдоним и установите BDE CACHE = TRUE и BDE CACHE DIR = ‘C:\temp’ или любой другой удобный каталог.

ПРИМЕЧАНИЕ:При любом изменении структуры таблицы Вам придется удалять кэш вручную. Имя файла, в котором хранится кэш, Вы можете узнать, посмотрев в любом текстовом редакторе файл SCache.INI.

{/codecitation}

Набор данных для отладки

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

unit DebugSet;

interface

uses

DbTables, Classes, Controls, Db, SysUtils;

type

TDebugNotify = procedure(const DegubStr: string) of object;

TDebugDataSet = class(TTable)

private

FDebugNotify: TDebugNotify;

protected

// TDataSet virtual abstract methods

function AllocRecordBuffer: PChar; override;

procedure FreeRecordBuffer(var Buffer: PChar); override;

procedure GetBookmarkData(Buffer: PChar;

Data: Pointer); override;

function GetBookmarkFlag(Buffer: PChar):

TBookmarkFlag; override;

function GetFieldData(Field: TField;

Buffer: Pointer): Boolean; override;

function GetRecord(Buffer: PChar; GetMode: TGetMode;

DoCheck: Boolean): TGetResult; override;

function GetRecordSize: Word; override;

procedure InternalAddRecord(Buffer: Pointer;

Append: Boolean); override;

procedure InternalClose; override;

procedure InternalDelete; override;

procedure InternalFirst; override;

procedure InternalGotoBookmark(

Bookmark: Pointer); override;

procedure InternalHandleException; override;

procedure InternalInitFieldDefs; override;

procedure InternalInitRecord(Buffer: PChar); override;

procedure InternalLast; override;

procedure InternalOpen; override;

procedure InternalPost; override;

procedure InternalSetToRecord(Buffer: PChar); override;

function IsCursorOpen: Boolean; override;

procedure SetBookmarkFlag(Buffer: PChar;

Value: TBookmarkFlag); override;

procedure SetBookmarkData(Buffer: PChar;

Data: Pointer); override;

procedure SetFieldData(Field: TField;

Buffer: Pointer); override;

// TDataSet virtual methods (optional)

procedure InternalRefresh; override;

function GetRecordCount: Integer; override;

procedure SetRecNo(Value: Integer); override;

function GetRecNo: Integer; override;

public

property OnDebugNotify: TDebugNotify

read FDebugNotify write FDebugNotify;

end;

implementation

procedure TDebugDataSet.InternalOpen;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalOpen’);

inherited;

end;

procedure TDebugDataSet.InternalInitFieldDefs;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalInitFieldDefs’);

inherited;

end;

procedure TDebugDataSet.InternalClose;

begin

FDebugNotify(‘InternalClose’);

inherited;

end;

function TDebugDataSet.IsCursorOpen: Boolean;

begin

Result := inherited IsCursorOpen;

if Result then

if Assigned(FDebugNotify) then

FDebugNotify(‘IsCursorOpen: True’)

else if Assigned(FDebugNotify) then

FDebugNotify(‘IsCursorOpen: False’);

end;

procedure TDebugDataSet.InternalGotoBookmark(Bookmark: Pointer);

begin

FDebugNotify(‘InternalGotoBookmark’

IntToStr(Integer(Bookmark)));

inherited;

end;

procedure TDebugDataSet.InternalSetToRecord(Buffer: PChar);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalSetToRecord’);

inherited;

end;

function TDebugDataSet.GetBookmarkFlag(

Buffer: PChar): TBookmarkFlag;

begin

FDebugNotify(‘GetBookmarkFlag’);

Result := inherited GetBookmarkFlag(Buffer);

end;

procedure TDebugDataSet.SetBookmarkFlag(Buffer: PChar;

Value: TBookmarkFlag);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘SetBookmarkFlag’);

inherited;

end;

procedure TDebugDataSet.GetBookmarkData(

Buffer: PChar; Data: Pointer);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘GetBookmarkData’);

inherited;

end;

procedure TDebugDataSet.SetBookmarkData(

Buffer: PChar; Data: Pointer);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘SetBookmarkData’);

inherited;

end;

function TDebugDataSet.GetRecordSize: Word;

begin

Result := inherited GetRecordSize;

if Assigned(FDebugNotify) then

FDebugNotify(‘GetRecordSize: ‘ IntToStr(Result));

end;

function TDebugDataSet.AllocRecordBuffer: PChar;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘AllocRecordBuffer’);

Result := inherited AllocRecordBuffer;

end;

procedure TDebugDataSet.InternalInitRecord(Buffer: PChar);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalInitRecord’);

inherited;

end;

procedure TDebugDataSet.FreeRecordBuffer(var Buffer: PChar);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘FreeRecordBuffer’);

inherited;

end;

function TDebugDataSet.GetRecord(Buffer: PChar;

GetMode: TGetMode; DoCheck: Boolean): TGetResult;

begin

case GetMode of

gmNext:

if Assigned(FDebugNotify) then

FDebugNotify(‘GetRecord: Next’);

gmPrior:

if Assigned(FDebugNotify) then

FDebugNotify(‘GetRecord: Prior’);

gmCurrent:

if Assigned(FDebugNotify) then

FDebugNotify(‘GetRecord: Current’);

end;

Result := inherited GetRecord(Buffer, GetMode, DoCheck);

end;

procedure TDebugDataSet.InternalFirst;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalFirst’);

inherited;

end;

procedure TDebugDataSet.InternalLast;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalLast’);

inherited;

end;

procedure TDebugDataSet.InternalPost;

begin

if State = dsEdit then

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalPost ***** dsEdit’)

else if Assigned(FDebugNotify) then

FDebugNotify(‘InternalPost ***** dsInsert’);

inherited;

end;

procedure TDebugDataSet.InternalAddRecord(

Buffer: Pointer; Append: Boolean);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalAddRecord ****’);

inherited;

end;

procedure TDebugDataSet.InternalDelete;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalDelete’);

inherited;

end;

function TDebugDataSet.GetFieldData(

Field: TField; Buffer: Pointer): Boolean;

begin

Result := inherited GetFieldData(Field, Buffer);

end;

procedure TDebugDataSet.SetFieldData(Field: TField; Buffer: Pointer);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘SetFieldData’);

inherited;

end;

function TDebugDataSet.GetRecordCount: Longint;

begin

Result := inherited GetRecordCount;

if Assigned(FDebugNotify) then

FDebugNotify(‘GetRecordCount: ‘ IntToStr(Result));

end;

function TDebugDataSet.GetRecNo: Longint;

begin

Result := inherited GetRecNo;

if Assigned(FDebugNotify) then

FDebugNotify(‘GetRecNo: ‘ IntToStr(Result));

end;

procedure TDebugDataSet.SetRecNo(Value: Integer);

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘SetRecNo: ‘ IntToStr(Value));

inherited;

end;

procedure TDebugDataSet.InternalRefresh;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalRefresh’);

inherited;

end;

procedure TDebugDataSet.InternalHandleException;

begin

if Assigned(FDebugNotify) then

FDebugNotify(‘InternalHandleException’);

inherited;

end;

end.

unit DebugDSForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs, DebugSet, Grids, DBGrids, DBCtrls, ExtCtrls,

StdCtrls, Db, DBTables, Menus;

type

TForm1 = class(TForm)

Table1: TTable;

DataSource1: TDataSource;

ListBox1: TListBox;

Splitter1: TSplitter;

Panel1: TPanel;

DBNavigator1: TDBNavigator;

DBGrid1: TDBGrid;

Panel2: TPanel;

BtnOpen: TButton;

BtnClose: TButton;

BtnClear: TButton;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure BtnClearClick(Sender: TObject);

procedure BtnOpenClick(Sender: TObject);

procedure BtnCloseClick(Sender: TObject);

private

TableClone: TDebugDataSet;

public

procedure LocalNotify(const DebugText: string);

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

Table1.Close;

TableClone := TDebugDataSet.Create(nil);

TableClone.DatabaseName := Table1.DatabaseName;

TableClone.TableName := Table1.TableName;

TableClone.OnDebugNotify := LocalNotify;

DataSource1.DataSet := TableClone;

end;

procedure TForm1.LocalNotify(const DebugText: string);

var

nItem: Integer;

begin

if Assigned(ListBox1) then

begin

// add the text to the string

nItem := ListBox1.Items.Add(DebugText);

// select the new item

ListBox1.ItemIndex := nItem;

end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

TableClone.Close;

TableClone.Free;

end;

procedure TForm1.BtnClearClick(Sender: TObject);

begin

ListBox1.Items.Clear;

end;

procedure TForm1.BtnOpenClick(Sender: TObject);

begin

TableClone.Active := True;

end;

procedure TForm1.BtnCloseClick(Sender: TObject);

begin

TableClone.Active := False;

end;

end.

{/codecitation}

Кросс-таблица через pivot-таблицу

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

Автор: John Crowley

Мне нужна помощь по реализации запроса кросс-таблицы в Delphi. У кого-нибудь имеется соответствующий опыт?

Использовать pivot-таблицу должен все тот-же общий механизм (относительно к любой базе данных SQL).

Предположим, что у нас есть данные продаж в таблице с полями Store, Product, Month, Sales, и вам необходимо отображать данные по продуктам за каждый месяц. (Примем, что поле ‘month’ для простоты имеет значения 1..12.)

Оригинальные данные примера:

Store Product Month Sales

#1 Toys 1 100

#2 Toys 1 68

#1 Toys 2 150

#1 Books 1 75

…

Желаемый отчет должен выглядеть похожим на этот:

Product January February March …..

Toys 168 150

Books 75 …..

Установите pivot-таблицу с именем tblPivot и 12 строками:

pvtMonth pvtJan pvtFeb pvtMar pvtApr ….

1 1 0 0 0 ….

2 0 1 0 0

3 0 0 1 0

4 0 0 0 1

…..

Теперь запрос, выполненный в виде:

select Product, January=sum(Sales*pvtJan),

February=sum(Sales*pvtFeb),

March=sum(Sales*pvtMar),

April=sum(Sales*pvtApr),…

where Month = pvtMonth

group by Product

даст вам информацию, опубликованную выше.

Поскольку pivot-таблица имеет только 12 строк, большинство SQL-движков сохранят результат в кэшовой памяти, так что скорость выполнения запроса весьма велика.

{/codecitation}

Копирование таблицы с помощью DBE

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

function CopyTable(tbl: TTable; dest: string): boolean;

var

psrc, pdest: array[0..DBIMAXTBLNAMELEN] of char;

rslt: DBIResult;

begin

Result := False;

StrPCopy(pdest, dest);

with tbl do

begin

try

DisableControls;

StrPCopy(psrc, TableName);

rslt := DbiCopyTable(DBHandle, True, psrc, nil, pdest);

Result := (rslt = 0);

finally

Refresh;

EnableControls;

end;

end;

end;

{/codecitation}

Как сохранить содержимое таблицы в текстовый файл

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

Эти небольшие функции анализирую таблицу и записывают её содержимое в TStringList. А затем просто сохраняют в файл.

procedure DatasetRecordToInfFile(aDataset: TDataSet; aStrList: TStrings);

var

i: integer;

begin

for i := 0 to (aDataset.FieldCount-1) do

aStrList.Add(aDataset.Fields[i].FieldName ‘=’

aDataset.Fields[i].AsString);

end;

procedure DatasetToInfFile(aDataset: TDataSet; aStrList: TStrings);

begin

aDataSet.First;

while not aDataSet.EOF do

begin

DatasetRecordToInfFile(aDataset,aStrList);

aDataSet.Next;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

DatasetRecordToInfFile(Table1,Memo1.Lines);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

DatasetToInfFile(Table1,Memo1.Lines);

end;

{/codecitation}

Как создать таблицу базы данных, не используя Database Desktop 5

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

Автор: Xavier Pacheco

unit Main;

interface

uses

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

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses DB, DBTables;

procedure TForm1.Button1Click(Sender: TObject);

begin

with TTable.Create(Self) do

begin // create TTable object

DatabaseName := ‘c:\temp’; // point to directory or alias

TableName := ‘FOO’; // give table a name

TableType := ttParadox; // make a Paradox table

with FieldDefs do

begin

Add(‘Age’, ftInteger, 0, True); // add an integer field

Add(‘Name’, ftString, 25, False); // add a string field

Add(‘Weight’, ftFloat, 0, False); // add a floating-point field

end;

{ create a primary index on the Age field… }

IndexDefs.Add(», ‘Age’, [ixPrimary, ixUnique]);

CreateTable; // create the table

end;

end;

end.

{/codecitation}

Как создать таблицу базы данных, не используя Database Desktop 4

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

// Создание DBF-файла во время работы приложения

…

const

CreateTab = ‘CREATE TABLE ‘;

IDXTab = ‘PRIMARY KEY ‘;

MyTabStruct =

‘IDX_TAB DECIMAL(6,0), ‘

‘DATE_ DATE, ‘

‘FLD_1 CHARACTER(20), ‘

‘FLD_2 DECIMAL(7,2), ‘

‘FLD_3 BOOLEAN, ‘

‘FLD_4 BLOB(1,1), ‘

‘FLD_5 BLOB(1,2), ‘

‘FLD_6 BLOB(1,3), ‘

‘FLD_7 BLOB(1,4), ‘

‘FLD_8 BLOB(1,5) ‘;

…

// создание таблицы без индекса

procedure TForm1.Button1Click(Sender: TObject);

begin

if CreateTable(‘»MYTAB.DBF»‘, MyTabStruct, ») then

…

// выполняем дальнейшие операции

else

…

end;

// создание таблицы с индексом

procedure TForm1.Button2Click(Sender: TObject);

begin

if CreateTable(‘»MYTAB.DBF»‘, MyTabStruct, IDXTab ‘ (IDX_TAB)’) then

…

// выполняем дальнейшие операции

else

…

end;

function TForm1.CreateTable(TabName, TabStruct, TabIDX: string): boolean;

var

qyTable: TQuery;

begin

result := true;

qyTable := TQuery.Create(Self);

with qyTable do

try

try

SQL.Clear;

SQL.Add(CreateTab TabName ‘(‘ TabStruct TabIDX ‘)’);

Prepare;

// ExecSQL, а не Open. Иначе … облом

ExecSQL;

except

// Обработка ошибок открытия таблицы Возможности обработчика можно расширить.

Exception.Create(‘Ошибка открытия таблицы’);

result := false;

end;

finally

Close;

end;

end;

{/codecitation}

Как создать таблицу базы данных, не используя Database Desktop 3

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

uses DB, DBTables, StdCtrls;

procedure TForm1.Button1Click(Sender: TObject);

var

tSource, TDest: TTable;

begin

TSource := TTable.create(self);

with TSource do

begin

DatabaseName := ‘dbdemos’;

TableName := ‘customer.db’;

open;

end;

TDest := TTable.create(self);

with TDest do

begin

DatabaseName := ‘dbdemos’;

TableName := ‘MyNewTbl.db’;

FieldDefs.Assign(TSource.FieldDefs);

IndexDefs.Assign(TSource.IndexDefs);

CreateTable;

end;

TSource.close;

end;

{/codecitation}

Как создать таблицу базы данных, не используя Database Desktop 2

Опубликовал newfork, . Категория Базы данных. Оставить комментарий

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

sql := «CREATE TABLE «employee.db»( Last_Name CHAR(20),

First_Name CHAR(15), Salary NUMERIC(10,2),

Dept_No SMALLINT, PRIMARY KEY (Last_Name, First_Name))»;

Query1.sql.text:=sql;

Query1.ExecSQL;

{/codecitation}