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

Автор: Пенов Сергей
WEB-сайт: http://delphibase.endimus.com

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

Компонент доступа к данным,потомок TADOStoredProc.
Предназначен для написания клиента для MS SQL Server 2000 (можно использовать и
для более ранних версий, но придется поработать над шаблоном хранимой
процедуры).
Позволяет управлять операциями добавления, редактирования и
удаления (и некоторыми другими)на клиенте со стороны сервера однообразно для
всех данных. Тем самым достигается некоторая стандартизация клиента и при
изменении серверной части не придется изменять клиента(конечно же в разумных
пределах).
Для большей красоты не помешает создать некоторые другие прибамбасы, например,
форму, исходную для всех форм проекта.
Но это уже не относится к данному разделу.

Зависимости: Windows, Messages, SysUtils, Classes, DB, ADODB
Автор:       Пенов Сергей, spenov@narod.ru, ICQ:122597033, Москва
Copyright:   Пенов Сергей
Дата:        07 мая 2002 г.
***************************************************** }

//Шаблон хранимой процедуры
{
CREATE PROCEDURE [upTemplateProcedure]
   @KeyValue INT = NULL -- требуется для обновления измененной записи в клиенте.
AS
-- Data (Требуемая информация)
SELECT ColumnList
  FROM TheTable
  WHERE @KeyValue IS NULL OR TheKey=@KeyValue -- возвращаем либо все(операция
открытия), либо конкретную запись (операция обновления)

IF @KeyValue IS NULL BEGIN -- если операция открытия, то возвращаем необходимую
дополнительную информацию для настройки клиента
   -- Properties -- динамические свойства TADOStoredProc, список формируется
таким образом. В большинстве случаев изменять его не приходится.
   SELECT 'Property'='Unique Table' , 'Value'='TheTable' UNION
   SELECT 'Property'='Resync Command' , 'Value'='EXEC upTemplateProcedure ?' --
 !!! команда обновления измененной записи !!!
   -- Table Operations
      -- Здесь формируется набор данных, возвращающий какие операции может
совершать текущий пользователь с этими данными. Это, естественно, простейший
пример и возможно под конкретную ситуацию его надо будет изменить (запрос)
   SELECT DISTINCT PRIVILEGE_TYPE AS [Operation], 1 AS [Value] -- 1 - можно, 0
(или нет записи) - нельзя. Operation = INSERT,UPDATE,DELETE
     FROM INFORMATION_SCHEMA.TABLE_PRIVILEGES
     WHERE TABLE_NAME = 'TheTable'
   -- Columns Operations -- возможность редактирования столбцов пользователем
   SELECT DISTINCT COLUMN_NAME AS [Column], 0 AS [ReadOnly] 0 - может
редактировать, 1 ( или нет записи) - не может.
     FROM INFORMATION_SCHEMA.COLUMN_PRIVILEGES
     WHERE TABLE_NAME = 'TheTable'
       AND PRIVILEGE_TYPE = 'UPDATE'

   -- Далее можно добавлять свои дополнительные данные для более детальной
настройки клиета. В клиенте к ним доступ через свойство
TADOApostrofStoredProc .Recordsets.

END
}

unit Un_TApostrofStoredProc;

interface

uses
  Windows, Messages, SysUtils, Classes, DB, ADODB;

type
  TADOApostrofStoredProc = class(TADOStoredProc)
  private
    FCanINSERT: Boolean;
    FCanUPDATE: Boolean;
    FCanDELETE: Boolean;
    FRecordsets: TInterfaceList;
    FOpenTime: TDateTime;
    function GetRecordset(I: Integer): _Recordset;
    function GetRecordsetCount: Integer;
  protected
    procedure DoBeforeOpen; override;
    procedure DoBeforeClose; override;
    procedure DoAfterOpen; override;
    procedure OpenCursor(InfoQuery: Boolean = False); override;
    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat:
      Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    property CanINSERT: Boolean read FCanINSERT;
    property CanUPDATE: Boolean read FCanUPDATE;
    property CanDELETE: Boolean read FCanDELETE;
    property Recordsets[I: Integer]: _Recordset read
    GetRecordset; //Дополнительные наборы данных, возвращенные хранимой процедурой
    property RecordsetCount: Integer read GetRecordsetCount;
    property OpenTime: TDateTime read FOpenTime write FOpenTime; //Время
    открытия процедуры.
  end;

procedure Register;

implementation

uses
  ADOint, DBConsts;

procedure Register;
begin
  RegisterComponents('ADOApostrof', [TADOApostrofStoredProc]);
end;

function TADOApostrofStoredProc.GetRecordset(I: Integer): _Recordset;
begin
  Result := _Recordset(FRecordsets[I]);
end;

function TADOApostrofStoredProc.GetRecordsetCount: Integer;
begin
  Result := FRecordsets.Count;
end;

constructor TADOApostrofStoredProc.Create(AOwner: TComponent);
begin
  inherited;
  FRecordsets := TInterfaceList.Create;
end;

procedure TADOApostrofStoredProc.DoBeforeOpen;
begin
  FCanINSERT := False;
  FCanUPDATE := False;
  FCanDELETE := False;
  inherited;
end;

procedure TADOApostrofStoredProc.DoBeforeClose;
begin
  inherited;
  FRecordsets.Clear;
end;

procedure TADOApostrofStoredProc.DoAfterOpen;
var
  R: _Recordset;
  RecordsAffected, I: Integer;
begin
  //Все столбцы в ReadOnly!
  for I := 0 to Fields.Count - 1 do
    Fields[I].ReadOnly := True;
  //Установка некоторых свойств
  Properties['Update Criteria'].Value := adCriteriaKey;
  Properties['Update Resync'].Value := adResyncAll;
  //Свойства из базы
  R := NextRecordset(RecordsAffected);
  while Assigned(R) do
  begin
    FRecordsets.Add(R);
    if (R.Fields.Count = 2) and (UpperCase(R.Fields[0].Name) = 'PROPERTY') and
      (UpperCase(R.Fields[1].Name) = 'VALUE') then
    begin //Properties
      if R.RecordCount > 0 then
      begin
        R.MoveFirst;
        while not R.EOF do
        begin
          Properties[R.Fields[0].Value].Value := R.Fields[1].Value;
          R.MoveNext;
        end;
      end;
    end
    else if (R.Fields.Count = 2) and (UpperCase(R.Fields[0].Name) = 'OPERATION')
      and (UpperCase(R.Fields[1].Name) = 'VALUE') then
    begin //Операции над таблицей
      if R.RecordCount > 0 then
      begin
        R.MoveFirst;
        while not R.EOF do
        begin
          if R.Fields[0].Value = 'INSERT' then
            FCanINSERT := (R.Fields[1].Value = 1)
          else if R.Fields[0].Value = 'UPDATE' then
            FCanUPDATE := (R.Fields[1].Value = 1)
          else if R.Fields[0].Value = 'DELETE' then
            FCanDELETE := (R.Fields[1].Value = 1);
          R.MoveNext;
        end;
      end;
    end
    else if (R.Fields.Count = 2) and (UpperCase(R.Fields[0].Name) = 'COLUMN')
      and (UpperCase(R.Fields[1].Name) = 'READONLY') then
    begin //Операции над столбцами
      if R.RecordCount > 0 then
      begin
        R.MoveFirst;
        while not R.EOF do
        begin
          if Assigned(FindField(R.Fields[0].Value)) then
            FieldByName(R.Fields[0].Value).ReadOnly := (R.Fields
              [1].Value = 1);
          R.MoveNext;
        end;
      end;
    end;
    R := NextRecordset(RecordsAffected);
  end;
  inherited;
end;

procedure TADOApostrofStoredProc.SetFieldData(Field: TField; Buffer: Pointer;
  NativeFormat: Boolean);
var
  Buf: Boolean;
begin
  Buf := Field.ReadOnly;
  Field.ReadOnly := Field.ReadOnly and (State <> dsInsert);
  try
    inherited;
  finally
    Field.ReadOnly := Buf;
  end;
end;

procedure TADOApostrofStoredProc.OpenCursor(InfoQuery: Boolean);
var
  TheTime: TDateTime;
begin
  TheTime := Time;
  inherited;
  FOpenTime := Time - TheTime;
end;

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