Перейти к содержанию
Fire Monkey от А до Я

Aptem

Пользователи
  • Постов

    55
  • Зарегистрирован

  • Посещение

  • Победитель дней

    1

Весь контент Aptem

  1. а клиенты работают по локалке или через инет? Декстопные по локалке, на тонком клиенте через глобальную корпоративную сеть, считай через инет. т.е. в любом случае логин\пароль записан в клиенте и любой кто занимается или разбирается во взломах может получить вашу пару и полный доступ к БД? правильно я понимаю? Логин/пароль знает только пользователь и вводит его при запуске приложения. Доступ можно получить только к объектам определенной пользовательской роли, а не ко всей БД. Приложения функционируют в выделенной демилитаризованной зоне, IP-адреса АРМ-ов прописаны в межсетевом экране, а сам линк идете через ключ ПКЗИ. В тонком клиенте полноценная трехзвенка.
  2. а клиенты работают по локалке или через инет? Декстопные по локалке, на тонком клиенте через глобальную корпоративную сеть, считай через инет.
  3. Если есть коннект до БД, значит есть возможность и приложение обновить. В моем случае бизнес-логика размазана между приложением и БД и разработка прослоек для преобразования XML-данных только снизит скорость. Ваш вариант безусловно тоже хороший, и у нас некоторые приложения примерно так и работают. каждый клиент имеет прямой коннект к базе? Все десктопные приложения - да. На тонком клиенте - по запросу.
  4. Если есть коннект до БД, значит есть возможность и приложение обновить. В моем случае бизнес-логика размазана между приложением и БД и разработка прослоек для преобразования XML-данных только снизит скорость. Ваш вариант безусловно тоже хороший, и у нас некоторые приложения примерно так и работают.
  5. По трудозатратам это примерно одинаково. По сути ничего не меняется - появилась новая БД - перепиши провайдер или перепиши сервак. Одно и тоже. В JSON/XML меня отпугивает работа с BLOB-полями.
  6. DAL - data access layer - слой доступа к данным. Это модули, которые непосредственно передают запрос в БД и возвращают результат выше. BL - business layer - слой бизнес-логики. Это, по сути, вся логика приложения. Управляет потоками данных, их обработкой. UI - user interface - пользовательский интерфейс. Формы, кнопки, мемо, гриды и прочее. Все слои по максимуму изолированы друг от друга. Каждый слой знает о существовании только нижнего слоя, но не наоборот. Все это всего лишь один из архитектурных подходов, коих десятки. Разные бывают ситуации. Могу привести свой пример. Есть у нас приложение для работы со СКУД (система контроля и управления доступом), турникет на дверях в здании, грубо говоря. База на MS SQL, все отлично работало 5 лет, а потом в одном из зданий заменили старое оборудование на новое, ну и софт соответственно (системный). А там база вообще на Firebird. Что мы сделали - написали новый "провайдер" и подсунули его приложению. Оно (приложение) и не почувствовало разницы. Сигнатура методов не поменялась, поменялась только внутренняя реализация модулей DAL - слоя доступа к данным. Скажу честно, разрабатываю исключительно для себя или для своего учереждения, поэтому таких глобальных вопросов не решал. Поэтому, мой вопрос покажется вам глупый, но я его все таки хочу задать. Как решаются проблемы синтаксиса языка программирования? например с моим 20 летним знанием о MySQl всегда делал Limit 10, 10, и на днях случайно оказался в положении, что такое же нужно было сделать и для MsSQl, так вот, там это делается через TOP. Или в некоторых БД нет функций, триггеров и тд. Как решается такое несоответствие синтаксисов? Вопрос очень нетривиальный. Все зависит от конкретного случая. Бывают ситуации когда нельзя полностью заменить конструкции одного языка на другой. Если в случае с MSSQL вы смогли воспользоваться TOP, то в том же Oracle все иначе. Как таковой команды на получения первых n-строк там нет. Есть конечно ROWCOUNT, но это немного другое и его нельзя назвать аналогом TOP или LIMIT. Иногда подобные несоответствия решаются с помощью хранимых процедур, иногда усложнением текста запроса. Повторюсь, все индивидуально и зависит от возникшей проблемы. Миграция на другую платформу вообще дело неблагодарное и непредсказуемое.
  7. DAL - data access layer - слой доступа к данным. Это модули, которые непосредственно передают запрос в БД и возвращают результат выше. BL - business layer - слой бизнес-логики. Это, по сути, вся логика приложения. Управляет потоками данных, их обработкой. UI - user interface - пользовательский интерфейс. Формы, кнопки, мемо, гриды и прочее. Все слои по максимуму изолированы друг от друга. Каждый слой знает о существовании только нижнего слоя, но не наоборот. Все это всего лишь один из архитектурных подходов, коих десятки. Разные бывают ситуации. Могу привести свой пример. Есть у нас приложение для работы со СКУД (система контроля и управления доступом), турникет на дверях в здании, грубо говоря. База на MS SQL, все отлично работало 5 лет, а потом в одном из зданий заменили старое оборудование на новое, ну и софт соответственно (системный). А там база вообще на Firebird. Что мы сделали - написали новый "провайдер" и подсунули его приложению. Оно (приложение) и не почувствовало разницы. Сигнатура методов не поменялась, поменялась только внутренняя реализация модулей DAL - слоя доступа к данным.
  8. Провайдером в данном случае я называю обертку для стандартных компонентов доступа к данным с целью выдержать изоляцию слоев DAL, BL и UI. Для приложения не должно быть разницы какой именно компонент используется для доступа к данным. Если вместо FireDAC использовать что-то другое, то достаточно будет лишь заменить "мой" провайдер (обертку) на другой, а все остальное (BL и UI) останется неизменным. Если хотите, то это логический провайдер. И я не писал, что это выгоднее по ресурсам
  9. Он менее причесан, чем провайдер для Oracle, но тем не менее отлично работает. Интерфейс: unit SQLLiteProviderInterface; interface uses Classes, DB; /// <summary> /// Interface for database provider /// </summary> type IDatabaseProvider<T1> = interface ( IInterface ) {$REGION 'Methods'} /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function ExecuteQuery ( query : String; const parameters : T1 ) : TDataSet; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function ExecuteNonQuery ( query : String; const parameters : T1 ) : Integer; /// <summary> /// Begins session transaction /// </summary> procedure BeginTransaction (); /// <summary> /// Commits current session transaction /// </summary> procedure CommitTransaction (); /// <summary> /// Rollbacks current session transaction /// </summary> procedure RollbackTransaction (); {$ENDREGION} end; implementation end. Реализация: unit SQLLiteProvider; interface uses Classes, FireDAC.Comp.Client, DB, FireDAC.Stan.Param, FireDAC.Stan.Intf, FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Stan.ExprFuncs, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.FMXUI.Wait, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.DataSet, System.Generics.Collections, //BL SQLLiteProviderInterface ; /// <summary> /// Data provider parameter /// </summary> type TSQLLiteParam = class private {$REGION 'Private fields'} /// <summary> /// Name /// </summary> _name : String; /// <summary> /// Value /// </summary> _value : Variant; /// <summary> /// Type /// </summary> _paramType : TParamType; {$ENDREGION} public {$REGION 'Properties'} /// <summary> /// Gets or sets name /// </summary> property Name : String read _name write _name; /// <summary> /// Gets or sets value /// </summary> property Value : Variant read _value write _value; /// <summary> /// Gets or sets type /// </summary> property ParamType : TParamType read _paramType write _paramType; {$ENDREGION} end; /// <summary> /// Data provider to SQL Lite database /// </summary> type TSQLLiteProvider = class ( TInterfacedObject, IDatabaseProvider<TObjectList<TSQLLiteParam>> ) private {$REGION 'Private fields'} /// <summary> /// Database session /// </summary> _connection : TFDConnection; /// <summary> /// Query /// </summary> _query : TFDQuery; {$ENDREGION} public {$REGION 'Implementation of IDatabaseProvider'} /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function ExecuteQuery ( query : String; const parameters : TObjectList<TSQLLiteParam> = nil ) : TDataSet; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function ExecuteNonQuery ( query : String; const parameters : TObjectList<TSQLLiteParam> = nil ) : Integer; /// <summary> /// Begins session transaction /// </summary> procedure BeginTransaction (); /// <summary> /// Commits current session transaction /// </summary> procedure CommitTransaction (); /// <summary> /// Rollbacks current session transaction /// </summary> procedure RollbackTransaction (); {$ENDREGION} {$REGION 'Constructors'} /// <summary> /// Creates TSQLLiteProvider instance /// </summary> /// <param name="databaseFile">Database file path</param> constructor Create ( databaseFilePath : String ); {$ENDREGION} {$REGION 'Destructors'} /// <summary> /// Safely destroys TSQLLiteProvider instance /// </summary> destructor Destroy (); override; {$ENDREGION} {$REGION 'Public methods'} /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <returns>Binded parameter</returns> function CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput ) : TSQLLiteParam; /// <summary> /// Open connection /// </summary> procedure OpenConnection (); /// <summary> /// Close connection /// </summary> procedure CloseConnection (); {$ENDREGION} end; implementation {TSQLLiteProvider} /// <summary> /// Creates TSQLLiteProvider instance /// </summary> /// <param name="databaseFile">Database file path</param> constructor TSQLLiteProvider.Create ( databaseFilePath : String ); begin _connection := TFDConnection.Create ( nil ); _connection.DriverName := 'SQLite'; _connection.Params.Values['Database'] := databaseFilePath; _connection.FetchOptions.Mode := fmAll; _query := TFDQuery.Create ( nil ); _query.Connection := _connection; end; /// <summary> /// Safely destroys TSQLLiteProvider instance /// </summary> destructor TSQLLiteProvider.Destroy (); begin if _query.Active then begin _query.Close; end; _query.Free (); _query := nil; if _connection.Connected then begin _connection.Close (); end; _connection.Free (); _connection := nil; inherited; end; /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function TSQLLiteProvider.ExecuteQuery ( query : String; const parameters : TObjectList<TSQLLiteParam> = nil ) : TDataSet; var i : Integer; dataSet : TDataSet; begin dataSet := TDataSet.Create ( nil ); _query.Close (); _query.SQL.Text := query; if parameters <> nil then begin with _query.Params do begin Clear (); for i := 0 to parameters.Count - 1 do begin with Add do begin Name := TSQLLiteParam ( parameters[i] ).Name; Value := TSQLLiteParam ( parameters[i] ).Value; ParamType := TSQLLiteParam ( parameters[i] ).ParamType; end; end; end; end; if _connection.Connected then begin _query.Open (); dataSet := _query.Fields.DataSet; dataSet.Active := true; end; Result := dataSet; end; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function TSQLLiteProvider.ExecuteNonQuery ( query : String; const parameters : TObjectList<TSQLLiteParam> = nil ) : Integer; var i : Integer; begin _query.Close (); _query.SQL.Text := query; if parameters <> nil then begin with _query.Params do begin Clear (); for i := 0 to parameters.Count - 1 do begin with Add do begin Name := TSQLLiteParam ( parameters[i] ).Name; Value := TSQLLiteParam ( parameters[i] ).Value; ParamType := TSQLLiteParam ( parameters[i] ).ParamType; end; end; end; end; if _connection.Connected then begin _query.ExecSQL (); Result := _query.RowsAffected; end else begin Result := 0; end; end; /// <summary> /// Open connection /// </summary> procedure TSQLLiteProvider.OpenConnection (); begin try if ( _connection <> nil ) AND ( not _connection.Connected ) then begin _connection.Connected := true; end; except raise; end; end; /// <summary> /// Close connection /// </summary> procedure TSQLLiteProvider.CloseConnection (); begin try if ( _connection <> nil ) AND ( _connection.Connected ) then begin _connection.Connected := false; end; except raise; end; end; /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <returns>Binded parameter</returns> function TSQLLiteProvider.CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput ) : TSQLLiteParam; var parameter : TSQLLiteParam; begin parameter := TSQLLiteParam.Create (); parameter.Name := name; parameter.ParamType := paramType; parameter.Value := value; Result := parameter; end; /// <summary> /// Begins session transaction /// </summary> procedure TSQLLiteProvider.BeginTransaction (); begin _connection.StartTransaction (); end; /// <summary> /// Commits current session transaction /// </summary> procedure TSQLLiteProvider.CommitTransaction (); begin if _connection.InTransaction then begin _connection.Commit (); end; end; /// <summary> /// Rollbacks current session transaction /// </summary> procedure TSQLLiteProvider.RollbackTransaction (); begin if _connection.InTransaction then begin _connection.Rollback (); end; end; end.
  10. Судя по тому, что ответов не было, опишу как это получилось у меня. Получилось настроить все как я и писал выше, но пока без UI-тестов. FinalBuilder оказался действительно мощным инструментов, который позволяет делать очень много и решать одни и те же задачи разными способами. Итак, приступим к описанию. У меня 17 модулей в группе проектов. Часть кода является общей для всех проектов и вынесена отдельно из проекта. Тесты созданы на каждый проект и на общий код. Пока не будут без ошибок скомпилированы и пройдены тесты, дальнейший процесс сборки пройти не может. Смысл в том, что если общий код с ошибками, то и код каждого из проектов может дать ошибки, поэтому продолжать сборку нет смысла. Алгоритм сборки: 1. Компилирование тестов общей части кода. 2. Если компилирование без ошибок, то запускаем тесты. Если с ошибками, то прерываем весь процесс и высылаем электронное письмо с логом компилятора. 3. Если тесты пройдены без ошибок, то приступаем к компиляции проектов. Если с ошибками, то прерываем весь процесс и высылаем электронное письмо с логом тестов. 4. Тоже самое с проектами. Сначала компилируем тесты и запускаем их. Если без ошибок, то компилируем сами проекты. Если с ошибками, то весь процесс уже не прерываем, а просто пропускаем проект с ошибками и также высылаем лог компилятора или тестов на почту. 5. Сборка проходит каждую ночь в течении недели, а в воскресенье в конце сборки происходит дистрибуция бинарников на сервер обновлений. Во время дистрибуции в бинарники записывается информация о версии, последней компиляции и прочая информация. И все это происходит автоматически из одного окна FinalBuilder. Пока все нравится, полет две недели. А вот как это дерево, которое я описал, выглядит в FinalBuilder. Во вложении. Если кого-то интересуют подробности, то пишите, с удовольствием расскажу.
  11. Здравствуйте, коллеги. В своих разработках мы придерживаемся принципа разделения приложения на слои: 1. Слой доступа к данным - DAL 2. Слой бизнес-логики - BL 3. Слой представления - UI В связи с этим большую часть модулей приложений мы разрабатываем вручную, не прибегая к использованию визуальных компонентов. Все визуальные компоненты (кнопки, гриды, мемо и т. п.) только в слое UI. Также мы поступили и со слоем DAL, разработав собственный провайдер для доступа к базе данных Oracle. Активно используем его уже лет 5 и пока он покрывает все наши нужды. Представляю его вашему вниманию и прошу объективной критики по любому поводу. Интерфейс провайдера: unit OracleProviderInterface; interface uses Ora, DB, Variants, SysUtils, Classes, Contnrs, Spring.Collections ; /// <summary> /// Parameters data type enumeration /// </summary> type TParamDataType = ( pdtDefault = 1, pdtBlob = 2, pdtTable = 3, pdtClob = 4 ); /// <summary> /// Class for CDB database parameter /// </summary> type TCDBOraParam = Class ( TOraParam ) public {$REGION 'Fields'} /// <summary> /// Gets or sets parameter data type /// </summary> ParamDataType : TParamDataType; {$ENDREGION} {$REGION 'Constructors'} /// <summary> /// Creates TCDBOraParam instance /// </summary> constructor Create (); {$ENDREGION} end; /// <summary> /// Interface for database provider /// </summary> type IDatabaseProvider = interface ( IInterface ) ['{BF277F9C-D046-4015-8E17-6B4C67CC021B}'] {$REGION 'Methods'} /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function ExecuteQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : TDataSet; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function ExecuteNonQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : Integer; /// <summary> /// Executes stored procedure with particular parameters /// </summary> /// <param name="procedureName">Stored procedure name</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Execution results</returns> function ExecuteProcedure ( procedureName : String; const parameters : IList<TCDBOraParam> = nil ) : TOraParams; /// <summary> /// Begins session transaction /// </summary> procedure BeginTransaction (); /// <summary> /// Commits current session transaction /// </summary> procedure CommitTransaction (); /// <summary> /// Rollbacks current session transaction /// </summary> procedure RollbackTransaction (); /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <param name="paramDataType">Parameter data type (e.g. default or BLOB)</param> /// <returns>Binded parameter</returns> function CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput; paramDataType : TParamDataType = pdtDefault ) : TCDBOraParam; overload; /// <summary> /// Connects to the server /// </summary> procedure OpenSession (); /// <summary> /// Disconnects from the server /// </summary> procedure CloseSession (); /// <summary> /// Gets session /// </summary> /// <returns>Connection session</returns> function GetSession () : TOraSession; {$ENDREGION} {$REGION 'Properties'} /// <summary> /// Connection session /// </summary> property Session : TOraSession read GetSession; {$ENDREGION} end; implementation { TCDBOraParam } /// <summary> /// Creates TCDBOraParam instance /// </summary> constructor TCDBOraParam.Create (); begin inherited Create ( nil ); ParamDataType := pdtDefault; end; end. Реализация: unit OracleProvider; interface uses Ora, DB, Variants, SysUtils, Classes, Contnrs, MemData, DBAccess, Spring.Container, Spring.Collections, //BL OracleProviderInterface ; /// <summary> /// Data provider to Oracle database /// </summary> type TOracleProvider = class ( TInterfacedObject, IDatabaseProvider ) private {$REGION 'Fields'} /// <summary> /// Database session /// </summary> _session : TOraSession; /// <summary> /// Query /// </summary> _query : TOraQuery; /// <summary> /// SQL-expression /// </summary> _sql : TOraSQL; /// <summary> /// Stored procedure /// </summary> _storedProcedure : TOraStoredProc; /// <summary> /// Flag to understand who owns session /// </summary> _isOwnSession : Boolean; /// <summary> /// Connection string /// </summary> _connectionString : String; {$ENDREGION} {$REGION 'Methods'} /// <summary> /// Gets parameter's field type by Variant value /// </summary> /// <param name="value">value</param> /// <returns>Field type for TOraParam</returns> function GetFieldType ( value : Variant ) : TFieldType; /// <summary> /// Initializes class inner objects /// </summary> /// <param name="isOwnSession">Flag to understand who owns session</param> procedure Initialize ( isOwnSession : Boolean ); /// <summary> /// Gets session /// </summary> /// <returns>Connection session</returns> function GetSession () : TOraSession; {$ENDREGION} public {$REGION 'Methods'} /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function ExecuteQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : TDataSet; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function ExecuteNonQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : Integer; /// <summary> /// Executes stored procedure with particular parameters /// </summary> /// <param name="procedureName">Stored procedure name</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Execution results</returns> function ExecuteProcedure ( procedureName : String; const parameters : IList<TCDBOraParam> = nil ) : TOraParams; /// <summary> /// Begins session transaction /// </summary> procedure BeginTransaction (); /// <summary> /// Commits current session transaction /// </summary> procedure CommitTransaction (); /// <summary> /// Rollbacks current session transaction /// </summary> procedure RollbackTransaction (); /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <param name="paramDataType">Parameter data type (e.g. default or BLOB)</param> /// <returns>Binded parameter</returns> function CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput; paramDataType : TParamDataType = pdtDefault ) : TCDBOraParam; overload; /// <summary> /// Connects to the server /// </summary> procedure OpenSession (); /// <summary> /// Disconnects from the server /// </summary> procedure CloseSession (); {$ENDREGION} {$REGION 'Constructors'} /// <summary> /// Creates TOracleProvider instance with particular connection string /// </summary> /// <param name="connectionString">Connection string</param> constructor Create ( const connectionString : String ); overload; /// <summary> /// Creates TOracleProvider instance with particular session /// </summary> /// <param name="oracleSession">Connection session</param> constructor Create ( const oracleSession : TOraSession ); overload; {$ENDREGION} {$REGION 'Destructors'} /// <summary> /// Safely destroys TOracleProvider instance /// </summary> destructor Destroy (); override; {$ENDREGION} {$REGION 'Properties'} /// <summary> /// Connection session /// </summary> property Session : TOraSession read GetSession; {$ENDREGION} end; implementation {TOracleProvider} /// <summary> /// Creates TOracleProvider instance with particular connection string /// </summary> /// <param name="connectionString">Connection string</param> constructor TOracleProvider.Create ( const connectionString : String ); begin _connectionString := connectionString; Initialize ( true ); end; /// <summary> /// Creates TOracleProvider instance with particular session /// </summary> /// <param name="oracleSession">Connection session</param> constructor TOracleProvider.Create ( const oracleSession : TOraSession ); begin _session := oracleSession; Initialize ( false ); end; /// <summary> /// Initializes class inner objects /// </summary> /// <param name="isOwnSession">Flag to understand who owns session</param> procedure TOracleProvider.Initialize ( isOwnSession : Boolean ); begin if isOwnSession then begin _session := TOraSession.Create ( nil ); _session.ConnectString := _connectionString; _session.Connected := false; _session.LoginPrompt := false; _session.Options.Direct := true; _session.AutoCommit := false; _session.Options.NeverConnect := true; _session.Pooling := true; end; _query := TOraQuery.Create ( nil ); _query.Session := _session; _query.AutoCommit := false; _query.FetchAll := true; _sql := TOraSQL.Create ( nil ); _sql.Session := _session; _sql.AutoCommit := false; _storedProcedure := TOraStoredProc.Create ( nil ); _storedProcedure.Session := _session; _storedProcedure.AutoCommit := false; _storedProcedure.FetchAll := true; _isOwnSession := isOwnSession; end; /// <summary> /// Safely destroys TOracleProvider instance /// </summary> destructor TOracleProvider.Destroy (); begin if _query.Active then begin _query.Close (); end; _query.Free (); if _storedProcedure.Active then begin _storedProcedure.Close (); end; _storedProcedure.Free (); if _isOwnSession then begin if _session.Connected then begin _session.Close (); end; _session.Free (); end; inherited; end; /// <summary> /// Connects to the server /// </summary> procedure TOracleProvider.OpenSession (); begin if _session <> nil then begin try _session.Open (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; /// <summary> /// Disconnects from the server /// </summary> procedure TOracleProvider.CloseSession (); begin if _isOwnSession then begin if ( _session <> nil ) AND ( _session.Connected ) then begin try _session.Close (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; end; /// <summary> /// Begins session transaction /// </summary> procedure TOracleProvider.BeginTransaction (); begin try _session.StartTransaction (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; /// <summary> /// Commits current session transaction /// </summary> procedure TOracleProvider.CommitTransaction (); begin if _session.InTransaction then begin try _session.Commit (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; /// <summary> /// Rollbacks current session transaction /// </summary> procedure TOracleProvider.RollbackTransaction (); begin if _session.InTransaction then begin try _session.Rollback (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function TOracleProvider.ExecuteQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : TDataSet; var i : Integer; param : TOraParam; dataSet : TDataSet; begin dataSet := TDataSet.Create ( nil ); _query.Close (); _query.SQL.Text := query; if Assigned ( parameters ) then begin _query.Params.Clear (); for i := 0 to parameters.Count - 1 do begin param := TOraParam.Create ( nil ); param.Name := TOraParam ( parameters[i] ).Name; param.Value := TOraParam ( parameters[i] ).Value; param.ParamType := TOraParam ( parameters[i] ).ParamType; _query.Params.AddParam ( param ); end; end; try if _session.Connected then begin _query.Execute (); dataSet := _query.Fields.DataSet; dataSet.Active := true; end; except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; Result := dataSet; end; /// <summary> /// Executes stored procedure with particular parameters /// </summary> /// <param name="procedureName">Stored procedure name</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Execution results</returns> function TOracleProvider.ExecuteProcedure ( procedureName : String; const parameters : IList<TCDBOraParam> = nil ) : TOraParams; var i : Integer; j : Integer; begin _storedProcedure.Close (); _storedProcedure.StoredProcName := procedureName; _storedProcedure.Prepare (); if Assigned ( parameters ) then begin for i := 0 to parameters.Count - 1 do begin for j := 0 to _storedProcedure.Params.Count - 1 do begin if _storedProcedure.Params[j].Name = TOraParam ( parameters[i] ).Name then begin _storedProcedure.Params[j] := TOraParam ( parameters[i] ); if TCDBOraParam ( parameters[i] ).ParamDataType = pdtBlob then begin if ( ( TOraParam ( parameters[i] ).Value <> Null ) AND ( TOraParam ( parameters[i] ).Value <> '') ) then begin _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).DataType := ftOraBlob; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).ParamType := TOraParam ( parameters[i] ).ParamType; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).AsOraBlob.LoadFromFile ( TOraParam ( parameters[i] ).Value ); end else begin _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).DataType := ftOraBlob; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).ParamType := TOraParam ( parameters[i] ).ParamType; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).AsOraBlob.FreeBlob (); end; end; if TCDBOraParam ( parameters[i] ).ParamDataType = pdtClob then begin if ( ( TOraParam ( parameters[i] ).Value <> Null ) AND ( TOraParam ( parameters[i] ).Value <> '') ) then begin _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).DataType := ftOraClob; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).ParamType := TOraParam ( parameters[i] ).ParamType; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).Value := TOraParam ( parameters[i] ).Value; end; end; end; end; end; end; if _session.Connected then begin try _storedProcedure.Execute (); Result := _storedProcedure.Params; except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end else begin Result := TOraParams.Create ( nil ); end; end; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function TOracleProvider.ExecuteNonQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : Integer; var i : Integer; begin _query.Close (); _query.SQL.Clear (); _query.SQL.Text := query; if Assigned ( parameters ) then begin _query.Params.Clear (); for i := 0 to parameters.Count - 1 do begin _query.Params.AddParam ( TOraParam ( parameters[i] ) ); end; end; if _session.Connected then begin _query.ExecSQL (); Result := _query.RowsAffected; end else begin Result := 0; end; end; /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <param name="paramDataType">Parameter data type (e.g. default or BLOB)</param> /// <returns>Binded parameter</returns> function TOracleProvider.CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput; paramDataType : TParamDataType = pdtDefault ) : TCDBOraParam; var parameter : TCDBOraParam; begin parameter := TCDBOraParam.Create (); parameter.Name := UpperCase ( name ); parameter.ParamType := paramType; parameter.DataType := GetFieldType ( value ); case paramDataType of pdtDefault: begin parameter.Value := value; end; pdtBlob: begin parameter.Value := value; end; pdtClob: begin parameter.Value := value; end; pdtTable: begin parameter.Table := true; parameter.DataType := ftFloat; parameter.Value := value; end; end; parameter.ParamDataType := paramDataType; Result := parameter; end; /// <summary> /// Gets parameter's field type by Variant value /// </summary> /// <param name="value">value</param> /// <returns>Field type for TOraParam</returns> function TOracleProvider.GetFieldType ( value : Variant ) : TFieldType; var fieldType : TFieldType; begin case VarType ( value ) AND VarTypeMask of varString : fieldType := TFieldType.ftWideString; varUString : fieldType := TFieldType.ftWideString; varInteger : fieldType := TFieldType.ftInteger; varByte : fieldType := TFieldType.ftInteger; varDate : fieldType := TFieldType.ftDate; else fieldType := TFieldType.ftUnknown; end; Result := fieldType; end; /// <summary> /// Gets session /// </summary> /// <returns>Connection session</returns> function TOracleProvider.GetSession () : TOraSession; begin Result := _session; end; initialization GlobalContainer.RegisterType<TOracleProvider>.Implements<IDatabaseProvider> ( 'Oracle' ); end. Использование: 1. Объявляем: var _provider : IDatabaseProvider; 2. Инициализируем: var _connectionString := login + '/' + password + '@' + HostName + ':' + Port + ':' + SID; _provider := GlobalContainer.Resolve<IDatabaseProvider> ( 'Oracle', [connectionString] ); _provider.OpenSession (); 3. Собственно использование: 3.1 Получаем выборку (SELECT): function TVSPHelper.GetVSPListByWellId ( wellId : Integer ) : IList<IVSP>; var list : IList<IVSP>; item : IVSP; query : String; dataSet : TDataSet; i : Integer; j : Integer; parameters: IList<TCDBOraParam>; report : IReport; begin query := 'SELECT ' + 'id, ' + 'comments, ' + 'wellbore_id, ' + 'wellbore_name, ' + 'wellbore_comments, ' + 'wellbore_depth, ' + 'begin_date, ' + 'end_date, ' + 'expedition_id, ' + 'expedition_name, ' + 'organization_id, ' + 'organization_name, ' + 'subject_id, ' + 'subject_name, ' + 'well_id, ' + 'well_name, ' + 'well_comments, ' + 'well_x, ' + 'well_y, ' + 'well_altitude, ' + 'well_rotary_table_elevation ' + ' FROM ' + 'seis.v_vsp ' + ' WHERE ' + 'well_id = :ID '; parameters := TCollections.CreateList<TCDBOraParam> ( true ); parameters.Add ( _provider.CreateParameter ( 'ID', wellId ) ); dataSet := _provider.ExecuteQuery ( query, parameters ); list := TCollections.CreateList<IVSP>; dataSet.First (); for i := 0 to dataSet.RecordCount - 1 do begin item := GlobalContainer.Resolve<IVSP>; item.Id := dataSet.FieldByName ( 'id' ).AsInteger; item.Comments := dataSet.FieldByName ( 'comments' ).AsString; item.BeginDate := dataSet.FieldByName ( 'begin_date' ).AsDateTime; item.EndDate := dataSet.FieldByName ( 'end_date' ).AsDateTime; item.Wellbore.Id := dataSet.FieldByName ( 'wellbore_id' ).AsInteger; item.Wellbore.Name := dataSet.FieldByName ( 'wellbore_name' ).AsString; item.Wellbore.Comments := dataSet.FieldByName ( 'wellbore_comments' ).AsString; item.Wellbore.Depth := dataSet.FieldByName ( 'wellbore_depth' ).AsFloat; item.Expedition.Id := dataSet.FieldByName ( 'expedition_id' ).AsInteger; item.Expedition.Name := dataSet.FieldByName ( 'expedition_name' ).AsString; item.Organization.Id := dataSet.FieldByName ( 'organization_id' ).AsInteger; item.Organization.Name := dataSet.FieldByName ( 'organization_name' ).AsString; item.Wellbore.Well.Subject.Id := dataSet.FieldByName ( 'subject_id' ).AsInteger; item.Wellbore.Well.Subject.Name := dataSet.FieldByName ( 'subject_name' ).AsString; item.Wellbore.Well.Id := dataSet.FieldByName ( 'well_id' ).AsInteger; item.Wellbore.Well.Name := dataSet.FieldByName ( 'well_name' ).AsString; item.Wellbore.Well.Comments := dataSet.FieldByName ( 'well_comments' ).AsString; item.Wellbore.Well.X := dataSet.FieldByName ( 'well_x' ).AsFloat; item.Wellbore.Well.Y := dataSet.FieldByName ( 'well_y' ).AsFloat; item.Wellbore.Well.Altitude := dataSet.FieldByName ( 'well_altitude' ).AsFloat; item.Wellbore.Well.RotaryTableElevation := dataSet.FieldByName ( 'well_rotary_table_elevation' ).AsFloat; list.Add ( item ); dataSet.Next (); end; Result := list; end; 3.2 Вызов хранимой процедуры: function TVSPHelper.GetShotpointMap ( shotpoint : IVSPShotpoint ) : String; var procedureName : String; parameters: IList<TCDBOraParam>; returnParameters : TOraParams; imageURL : String; errorCode : Integer; errorMessage : String; begin procedureName := 'seis.geometric_functions.p_get_shotpoint_map'; parameters := TCollections.CreateList<TCDBOraParam> ( true ); parameters.Add ( _provider.CreateParameter ( 'operation', 0 ) ); parameters.Add ( _provider.CreateParameter ( 'shotpoint_id_in', shotpoint.Id ) ); parameters.Add ( _provider.CreateParameter ( 'image_url', '', ptOutput ) ); parameters.Add ( _provider.CreateParameter ( 'error_code', 0, ptOutput ) ); parameters.Add ( _provider.CreateParameter ( 'error_message', '', ptOutput ) ); try _provider.BeginTransaction (); returnParameters := _provider.ExecuteProcedure ( procedureName, parameters ); imageURL := returnParameters.ParamByName ( 'image_url' ).AsString; errorCode := returnParameters.ParamByName ( 'error_code' ).AsInteger; errorMessage := returnParameters.ParamByName ( 'error_message' ).AsString; if errorCode = 0 then begin _provider.CommitTransaction (); end else begin _provider.RollbackTransaction (); end; except _provider.RollbackTransaction (); raise; end; imageURL := AnsiReplaceStr ( imageURL, 'https', 'http' ); Result := imageURL; end; 3.3 Выполнение операций CRUD: procedure TAdministrationUserHelper.SetUserStatus ( userId : Integer; status : Integer ); var query : String; begin query := 'UPDATE seis.users SET status_id = ' + IntToStr ( status ); try Provider.BeginTransaction (); Provider.ExecuteNonQuery ( query ); Provider.CommitTransaction (); except Provider.RollbackTransaction (); raise; end; end; Стоит заметить, что данный провайдер прекрасно подходит как для десктоп-приложений, так и для мобильных приложений. Конечно с небольшими изменениями, но принцип и структура не меняются. Кому будет интересно, могу выложить код провайдера для работы с БД SQLite, который я использовал для приложений под iOS.
  12. Коллеги, прошу поделиться опытом релиза своих приложений. Точнее процессом его предшествующим. Как сделано у меня сейчас: 1. Программисты пишут код, небольшие тесты (DUnit) и заливают на SVN. 2. Тестировщики пишут UI-тесты в TestComplete и сами же их гоняют. 3. Старший разработчик сливает последние изменения с коммита, компилит все проекты, прогоняет модульные тесты, и заливает новые билды на сервер обновлений. 4. Сервер обновлений уже сам раздает новые версии приложений пользователям. Как я хочу сделать (хочу попробовать непрерывную интеграцию): 1. Без изменений. 2. Без изменений. 3. Настраиваю FinalBuilder, который сам раз в неделю сливает с SVN последние версии кода, компилирует, запускает модульные и UI-тесты и заливает новые версии на сервер обновлений. Технически сделать это проблем нет, все проверял, все работает по отдельности. Собственно вопрос в том, а как подобные процессы устроены у вас? Может я упускаю какую-то стадию или вообще все делаю не так. Прошу поделиться опытом. Очень интересно.
  13. Решение нашлось более элегантное. Коллеги, со stackoverflow подсказали: Main menu -> Project -> Synatx Check Оригинал: http://stackoverflow.com/questions/32454899/delphi-how-to-get-warnings-list-after-second-compilation
  14. Не помогает. Помогает только ручное удаление всех dcu-файлов.
  15. У меня в настройках проекта установлен автоматический инкремент версии билда. А к этой версии завязан весь процесс дистрибуции. Руками делать декремент после каждого билда не хочется.
  16. Мы используем атрибуты для проверки через RTTI заполнено ли поле значением или нет: unit TopologyPoint; interface uses SysUtils, Classes, Rtti, Spring.Container, //BL TopologyPointInterface, //Modules WhatElementAttribute ; /// <summary> /// Class for point primitive /// </summary> type TTopologyPoint = Class ( TInterfacedObject, ITopologyPoint ) private {$REGION 'Fields'} /// <summary> /// Gets or sets X coordinate /// </summary> [TWhatElementAttribute ( TWhatElement.PublicField )] _x : Variant; /// <summary> /// Gets or sets Y coordinate /// </summary> [TWhatElementAttribute ( TWhatElement.PublicField )] _y : Variant; /// <summary> /// Gets or sets Z coordinate /// </summary> _z : Variant; {$ENDREGION} {$REGION 'Methods'} /// <summary> /// Gets X /// </summary> /// <returns>X</returns> function GetX () : Variant; /// <summary> /// Sets X /// </summary> /// <param name="value">X</param> procedure SetX ( const value : Variant ); /// <summary> /// Gets Y /// </summary> /// <returns>Y</returns> function GetY () : Variant; /// <summary> /// Sets Y /// </summary> /// <param name="value">y</param> procedure SetY ( const value : Variant ); /// <summary> /// Gets Z /// </summary> /// <returns>Z</returns> function GetZ () : Variant; /// <summary> /// Sets Z /// </summary> /// <param name="value">Z</param> procedure SetZ ( const value : Variant ); /// <summary> /// Gets empty flag of coordinates /// </summary> /// <returns>True if all coordinates are 0, false otherwise</returns> function GetEmptyFlag () : Boolean; {$ENDREGION} public {$REGION 'Properties'} /// <summary> /// X coordinate /// </summary> property X : Variant read GetX write SetX; /// <summary> /// Y coordinate /// </summary> property Y : Variant read GetY write SetY; /// <summary> /// Z coordinate /// </summary> property Z : Variant read GetZ write SetZ; /// <summary> /// Gets empty flag of coordinates /// </summary> property IsEmpty : Boolean read GetEmptyFlag; {$ENDREGION} end; implementation {TTopologyPoint} /// <summary> /// Gets empty flag of coordinates /// </summary> /// <returns>True if all coordinates are 0, false otherwise</returns> function TTopologyPoint.GetEmptyFlag () : Boolean; var context : TRttiContext; objectType : TRttiType; field : TRttiField; attribute : TCustomAttribute; found : Boolean; begin context := TRTTIContext.Create (); objectType := context.GetType ( Self.ClassInfo ); found := false; for field in objectType.GetFields do begin for attribute in field.GetAttributes do begin if attribute is TWhatElementAttribute then begin if ( attribute as TWhatElementAttribute ).Element = TWhatElement.PublicField then begin if field.FieldType.Handle = TypeInfo ( String ) then begin if field.GetValue ( self ).ToString <> '' then begin found := true; break; end; end; if field.FieldType.Handle = TypeInfo ( Integer ) then begin if field.GetValue ( self ).ToString <> '0' then begin found := true; break; end; end; if field.FieldType.Handle = TypeInfo ( Extended ) then begin if field.GetValue ( self ).ToString <> '0' then begin found := true; break; end; end; end; end; end; end; Result := not found; end; /// <summary> /// Gets X /// </summary> /// <returns>X</returns> function TTopologyPoint.GetX () : Variant; begin Result := _x; end; /// <summary> /// Sets X /// </summary> /// <param name="value">X</param> procedure TTopologyPoint.SetX ( const value : Variant ); begin _x := value; end; /// <summary> /// Gets Y /// </summary> /// <returns>Y</returns> function TTopologyPoint.GetY () : Variant; begin Result := _y; end; /// <summary> /// Sets Y /// </summary> /// <param name="value">y</param> procedure TTopologyPoint.SetY ( const value : Variant ); begin _y := value; end; /// <summary> /// Gets Z /// </summary> /// <returns>Z</returns> function TTopologyPoint.GetZ () : Variant; begin Result := _z; end; /// <summary> /// Sets Z /// </summary> /// <param name="value">Z</param> procedure TTopologyPoint.SetZ ( const value : Variant ); begin _z := value; end; initialization GlobalContainer.RegisterType<TTopologyPoint>.Implements<ITopologyPoint>; end. А вот сам класс TWhatElement: unit WhatElementAttribute; interface uses SysUtils, Classes; /// <summary> /// Attribute type enumeration /// </summary> type TWhatElement = ( PublicField, PublicProperty, PublicMethod ); /// <summary> /// Class for attribute types /// </summary> type TWhatElementAttribute = class ( TCustomAttribute ) private {$REGION 'Private fields'} /// <summary> /// Element type instance /// </summary> _element : TWhatElement; {$ENDREGION} public {$REGION 'Properties'} /// <summary> /// Property for element type instance /// </summary> property Element : TWhatElement read _element write _element; {$ENDREGION} {$REGION 'Constructors'} /// <summary> /// Creates TWhatElementAttribute instance /// </summary> constructor Create ( const element : TWhatElement ); {$ENDREGION} end; implementation /// <summary> /// Creates TWhatElementAttribute instance /// </summary> constructor TWhatElementAttribute.Create ( const element : TWhatElement ); begin _element := element; end; end. Смысл в том, что когда полей очень много, то писать проверку всех полей очень затруднительно. В случае использования атрибутов, достаточно указать атрибут поля и он будет включен в проверку автоматически.
  17. Здравствуйте, коллеги. Интересует следующий вопрос. При первой компиляции проекта при наличии предупреждений (warnings) все они вываливаются во вкладку Messages. Однако, если откомпилировать проект еще раз, то список уже пустой. Как принудительно заставить среду всегда выводить список этих предупреждений. Закрывать и повторно открывать проект не вариант. Использую Delphi XE5 Enterprise Edition.
  18. Своих модулей очень много. Без них нет смысла собирать проект. Еще попробовал провести рефакторинг (смена имени процедуры) через всю группу проектов. Одну итерацию прошел. Запустил рефакторинг уже другой процедуры - та же песня.
  19. Здравствуйте, коллеги. Использую Delphi XE5 Enterprise Edition. Имею группу проектов из 17-ти проектов. При попытке компиляции сразу всех проектов где-то после 7-8 проекта среда выкидывает ошибку: [Fatal Error] Exception of type 'System.OutOfMemoryException' was thrown. Если компилировать по одному проекту, то примерно также к 7-8-му проекту вылетает таже ошибка. Что делать? Как исправить?
  20. Лямбда-выражение реализуется в Delphi через анонимные методы. Думаю, что они присутствуют и в Builder. Попробуйте почитать вот здесь: http://docwiki.embarcadero.com/RADStudio/XE7/en/How_to_Handle_Delphi_Anonymous_Methods_in_C%2B%2B В Delphi анонимные методы реализуются так. Объявление: type TSearchFunction = reference to function ( criteria : Integer ) : IDictionary<String, Integer>; ... LeftFunction : TSearchFunction; Использование: fmSearch.LeftFunction := function ( criteria : Integer ) : IDictionary<String, Integer> begin Result := searchHelper.GetItems ( criteria ); end;
  21. Спасибо, Ярослав. Это помогло. Иногда бывает полезным заглянуть в документацию.
×
×
  • Создать...