Thursday, May 9, 2013

Delphi enumerator for IEnumVariant

IEnumVariant is the common way to enumerate collections in COM interfaces. However this interface is very inconvenient to use in Delphi. So I decided to write simple generic wrapper, to make possible to enumerate such collections in Delphi style, like this:

var
  I: ICollectionItem;
begin
  for I in EnumVariant do
    I.DoSomething();
end;

To do this we need two objects, first one returns our Enumerator:
  TOleEnumerable<T: IInterface> = record
  private
    FEnum: IUnknown;
  public
    constructor Create(ANewEnum: IUnknown);
    function GetEnumerator: IOleEnumerator<T>;
  end;

constructor TOleEnumerable<T>.Create(ANewEnum: IInterface);
begin
  FEnum := ANewEnum;
end;

function TOleEnumerable<T>.GetEnumerator: IOleEnumerator<T>;
begin
  Result := TOleEnumerator<T>.Create(FEnum);
end;


As you see, I made the GetEnumerator function returning interface, so that we don't need to free wrappers manually.

The second is our enumerator interface and its implementation:

  IOleEnumerator<T: IInterface> = interface
    function MoveNext: Boolean;
    function GetCurrent: T;
    procedure Reset;
    property Current: T read GetCurrent;
  end;

  TOleEnumerator<T: IInterface> = class(TInterfacedObject, IOleEnumerator<T>)
  private
    FEnum: IEnumVARIANT;
    FCurrent: T;
  public
    constructor Create(ANewEnum: IUnknown);
    function GetCurrent: T;
    function MoveNext: Boolean;
    procedure Reset;
    property Current: T read GetCurrent;
  end;

constructor TOleEnumerator<T>.Create(ANewEnum: IInterface);
begin
  FCurrent := nil;
  if not Supports(ANewEnum, IEnumVariant, FEnum) then
    raise Exception.Create('Enumeration type not supported');
end;

function TOleEnumerator<T>.GetCurrent: T;
begin
  Result := FCurrent;
end;

function TOleEnumerator<T>.MoveNext: Boolean;
var
  OleVar: OleVariant;
  Num: Cardinal;
begin
  Result := FEnum.Next(1, OleVar, Num) = S_OK;
  if Result then
    IUnknown(OleVar).QueryInterface(GetTypeData(TypeInfo(T)).Guid, FCurrent);
end;

procedure TOleEnumerator<T>.Reset;
begin
  FEnum.Reset;
end;
Thats it! Now you could iterate your COM collections like this:
var
  Man: INetworkManager;
  I: INetworkConnection;
begin
  Man := CoNetworkManager.Create;
  for I in TOleEnumerable<INetworkConnection>.Create(Man._NewEnum) do
    I.DoSomething();
end;

How to query generic interface

Suppose you have an object, and would like to query interface from it, but interface is generic type T: IInterface. You could query an interface using TypeInfo:

  Obj.QueryInterface(GetTypeData(TypeInfo(T)).Guid, Result);

Tuesday, June 15, 2010

Гибкий расширяемый код, который легко тестировать. Часть 1.

Кодирование

Используйте говорящие имена переменных

Описание

Используйте имена переменных, одного взгляда на которые достаточно, чтобы понять, для чего они используются. Помните: программист пишет программу, которую прежде всего должны понимать люди, и он сам в том числе. Не заводите, 1-2-буквенные имена для переменных имеющих самостоятельный смысл, и, наоборот, используйте простые однобуквенные имена для циклов. Используйте понятные, лаконичные сокращения. Сравните: “ClbMng” и “ClipboardMan” (“ClipboardManager”).

Плохой код


var
S: string;
B: Boolean;
begin
. . .
B := TMetaItemsCollection(TMetaItem(Owner).Collection).Refreshing;
. . .
if B then
Result := Result + ', c.relname';
. . .
S := ' LEFT OUTER JOIN pg_proc p ON p.oid = i.indproc';

Хороший код


var
QueryTail: string;
Refreshing: Boolean;
I: Integer;
begin
. . .
Refreshing := TMetaItemsCollection(TMetaItem(Owner).Collection).Refreshing;
. . .
if Refreshing then
Result := Result + ', c.relname';
. . .
QueryTail := ' LEFT OUTER JOIN pg_proc p ON p.oid = i.indproc';
for I := 1 to 5 do
. . .

Не используйте многофункциональные переменные

Описание

«Одна переменная – одна задача»

Плохой код


var
Flag: Boolean;
begin
Flag := Database.Connected;
if Flag then
. . .
Flag := Database.Refreshed;
if Flag then
. . .
end;

Хороший код


var
DBConnected: Boolean;
DBRefreshed: Boolean;

begin
DBConnected := Database.Connected;
if DBConnected then
. . .
DBRefreshed := Database.Refreshed;
if DBRefreshed then
. . .
end;

Минимизируйте глобальные и совместно используемые данные

Описание

Минимизируйте количество локальных переменных

Описание

Большое количество локальных переменных в функции, в большинстве случаев говорит о том, что эта функция берет на себя слишком много обязанностей. Разбейте большую функцию на несколько меньших, несущих самостоятельный смысл, и используйте результат их выполнения вместо локальных переменных.

Рефакторинг

  • Выделение метода (Extract Method)
  • Встраивание метода (Inline Method)
  • Замена временной переменной вызовом метода (Replace Temp with Query)
  • Замещение алгоритма (Substitute Algorithm)

Плохой код


procedure TSomeObject.DoSomething();
var
B: Boolean;
begin
. . .
B := False;
if Assigned(Database) then
if Assigned(Database.Tables) then
if Database.Tables.Count > 0 then
B := True;
. . .
if B then // Have tables in database
. . .
if B then // Have tables in database
. . .
end;

Хороший код


procedure TSomeObject.HaveTables(ADb: TDb);
begin
Result :=False;
if Assigned(Database) then
if Assigned(Database.Tables) then
if Database.Tables.Count > 0 then
Result := True;
end;

procedure TSomeObject.DoSomething();
begin
. . .
if HaveTables(Database) then
. . .
if HaveTables(Database) then
. . .
end;

Избегайте длинных методов

Описание

Очень сложно поддерживать код, в котором есть большие методы (функции). Скорее всего такой метод, не тестируется, содержит большое количество локальных переменных и берет на себя слишком много обязанностей. Такой винегрет, будет непонятен не только вашим коллегам – он будет не понятен вам, уже через пару дней. Он также провоцирует дублировать код и никакое комментирование не поможет ему стать более читабельным. В начале своего обучения пользуйтесь правилом «15-20» - пусть ваши методы не содержат более 15-20 строк кода. Исключения составляют спецалгоритмы.

Изучите код метода. Вероятно, из него можно выделить не просто цепочку логически-самостоятельных методов, но и самостоятельный класс.

Рефакторинг

  • Выделение метода (Extract Method)
  • Замена метода объектом методов (Replace Method with Method Object)
  • Замена временной переменной вызовом метода (Replace Temp with Query)
  • Выделение класса (Extract Class)
Рассмотрим реальный пример.

Плохой код


function TPgField.ChangeFieldIndexSQL(Value: Boolean; IsPriKey: Boolean;
const OldName: string): string;
var
Ind: TPgIndex;
Tbl: TPgTable;
I: Integer;
begin
Result := '';
Tbl := TPgTable(TPgFields(Collection).Owner);
if not Tbl.Indices.Refreshed then
Tbl.Indices.Refresh;
if Value then // Создать
begin
Ind := TPgIndex.Create(Tbl.Indices);
Ind.Parts.Add.FieldName := Name;
if IsPriKey then
Ind.Primary := True
else
Ind.Unique := True;
Result := Ind.Script;
try
Ind.Rollback;
except
end;
end
else begin // Удалить
for I := 0 to Tbl.Indices.Count - 1 do
begin
if IsPriKey then
begin
if not Tbl.Indices[I].Primary then
Continue;
end
else
if not Tbl.Indices[I].Unique then
Continue;
if (Tbl.Indices[I].Parts.Count = 1) and
(AnsiCompareText(Tbl.Indices[I].Parts[0].FieldName, OldName) = 0) then
begin
Ind := Tbl.Indices[I];
Result := Ind.DropSql(Ind.Name);
Break;
end;
end;
end;
end;

Анализ и рефакторинг

И хотя этот метод не претендует на рекорд по длине и непонятности, он тоже подлежит рефакторингу. Невооруженным глазом видно, что в один метод было записано два. Для понятности код был прокомментирован. Одна часть выполняет «создание», вторая – «удаление». В идеале такой метод вообще не должен существовать, должны быть два, отдельных метода. Однако рефакторинг – это последовательное преобразование кода, не меняющего его поведение. Поэтому на этом этапе мы оставим его.

Для начала выделим два метода, заодно переименуем параметры и локальные переменные в более читаемые.


function TPgField.ChangeFieldIndexSQL(DoCreate: Boolean; IsPrimary: Boolean;
const OldName: string): string;
begin
if DoCreate then
Result := CreateIndexSQL(IsPrimary)
else
Result := DropIndexSQL(IsPrimary)
end;

function TPgField.CreateIndexSQL(IsPrimary: Boolean): string;
var
Index: TPgIndex;
Table: TPgTable;
begin
Table := TPgTable(TPgFields(Collection).Owner);
if not Table.Indices.Refreshed then
Table.Indices.Refresh;

Index := TPgIndex.Create(Table.Indices);
Index.Parts.Add.FieldName := Name;
if IsPrimary then
Index.Primary := True
else
Index.Unique := True;
Result := Index.Script;
try
Index.Rollback;
except
end;
end;

function TPgField.DropIndexSql(IsPrimary: Boolean;
const OldName: string): string;
var
I: Integer;
Index: TPgIndex;
Table: TPgTable;
begin
Table := TPgTable(TPgFields(Collection).Owner);
if not Table.Indices.Refreshed then
Table.Indices.Refresh;
for I := 0 to Table.Indices.Count - 1 do
begin
if IsPrimary then
begin
if not Table.Indices[I].Primary then
Continue;
end
else
if not Table.Indices[I].Unique then
Continue;
if (Table.Indices[I].Parts.Count = 1) and
(AnsiCompareText(Tbl.Indices[I].Parts[0].FieldName, OldName) = 0) then
begin
Index := Tbl.Indices[I];
Result := Index.DropSql(Index.Name);
Break;
end;
end;
end;

Взглянем на этот дублирующийся участок кода:


var
Table: TPgTable;

Table := TPgTable(TPgFields(Collection).Owner);
if not Table.Indices.Refreshed then
Table.Indices.Refresh;

Таблица, переменную на которую мы держим, не используется в коде. На деле, нам нужны два следующих метода: получение списка индексов в таблице, в которой находятся наши поля и обновление этого списка. Правильность того, что весь метод получения скрипта для индексов находится в классе полей, мы, по ходу рефакторинга, тоже поставим под сомнение, но здесь разбирать не будем.



function TPgField.GetIndices: TPgIndices;
begin
Result := TPgTable(TPgFields(Collection).Owner).Indices;
end;

procedure TPgField.RefreshIndices;
begin
if not GetIndices.Refreshed then
GetIndices.Refresh;
end;

Посмотрим как изменились наши функции.



function TPgField.CreateIndexSQL(IsPrimary: Boolean): string;
var
Index: TPgIndex;
begin
RefreshIndices;
Index := TPgIndex.Create(GetIndices);
Index.Parts.Add.FieldName := Name;
if IsPrimary then
Index.Primary := True
else
Index.Unique := True;
Result := Index.Script;
try
Index.Rollback;
except
end;
end;

function TPgField.DropIndexSql(IsPrimary: Boolean;
const OldName: string): string;
var
I: Integer;
begin
RefreshIndices;
for I := 0 to GetIndices.Count - 1 do
begin
if IsPrimary then
begin
if not GetIndices[I].Primary then
Continue;
end
else
if not GetIndices[I].Unique then
Continue;
if (GetIndices[I].Parts.Count = 1) and
(AnsiCompareText(GetIndices[I].Parts[0].FieldName, OldName) = 0) then
begin
Result := GetIndices[I].DropSql(GetIndices[I].Name);
Break;
end;
end;
end;

Ну и наконец, взглянем на это сложное условие, что там происходит очевидным не является:


if IsPrimary then
begin
if not GetIndices[I].Primary then
Continue;
end // если ищем Primary - пропускаем
else
if not GetIndices[I].Unique then
Continue; // если ищем не Primary - пропускаем
if (GetIndices[I].Parts.Count = 1) and
// если не пропустили, и у индекса один Part,
// который содержит одно поле, с нужным, старым именем – это то что нам надо
(AnsiCompareText(GetIndices[I].Parts[0].FieldName, OldName) = 0) then
. . .

Выделим сложное условие в отдельный метод:


function TPgField.IsIndexed(Index: TPgIndex; NeedPrimary: Boolean;
const Name: string): Boolean;
begin
Result := (NeedPrimary and Index.Primary) or
(not NeedPrimary and Index.Unique);
if Result then
Result := (Index.Parts.Count = 1) and
(AnsiCompareText(Index.Parts[0].FieldName, Name) = 0)
end;

Хороший код


function TPgField.ChangeFieldIndexSQL(DoCreate: Boolean; IsPrimary: Boolean;
const OldName: string): string;
begin
if DoCreate then
Result := CreateIndexSQL(IsPrimary)
else
Result := DropIndexSQL(IsPrimary, OldName)
end;

function TPgField.CreateIndexSQL(IsPrimary: Boolean): string;
var
Index: TPgIndex;
begin
RefreshIndices;
Index := TPgIndex.Create(GetIndices);
Index.Parts.Add.FieldName := Name;
if IsPrimary then
Index.Primary := True
else
Index.Unique := True;
Result := Index.Script;
try
Index.Rollback;
except
end;
end;

function TPgField.DropIndexSql(IsPrimary: Boolean;
const OldName: string): string;
var
I: Integer;
begin
RefreshIndices;
for I := 0 to GetIndices.Count - 1 do
if IsIndexed(GetIndices[I], IsPrimary, OldName)
begin
Result := GetIndices[I].DropSql(GetIndices[I].Name);
Break;
end;
end;

function TPgField.GetIndices: TPgIndices;
begin
Result := TPgTable(TPgFields(Collection).Owner).Indices;
end;

procedure TPgField.RefreshIndices;
begin
if not GetIndices.Refreshed then
GetIndices.Refresh;
end;

function TPgField.IsIndexed(Index: TPgIndex; NeedPrimary: Boolean;
const Name: string): Boolean;
begin
Result := (NeedPrimary and Index.Primary) or
(not NeedPrimary and Index.Unique);
if Result then
Result := (Index.Parts.Count = 1) and
(AnsiCompareText(Index.Parts[0].FieldName, Name) = 0)
end;

Разбор

  • Можно обратить внимание на увеличение количества кода, по сравнению с изначальным вариантом. Это происходит за счет определения новых функций. Однако тут действует принцип подобный тетрису. Так как получившиеся функции могут быть использованы повторно (а в коде есть участки дублирующие выделенную функциональность), мы уменьшаем дублирование, вместе с тем и количество кода будет уменьшаться.
  • Читаемость кода значительно улучшилась (взгляните еще раз на первоначальный вариант). Комментарии к нему излишни.
  • Такой код проще отлаживать. Количество возможных ошибок на одну функцию меньше(*). В случае возникновения ошибки подробный пошаговый call stack укажет как и с какими аргументами воспроизвести ошибку.
  • Код стал тестируемым, покрыть такой код автоматическими тестами значительно проще.
    *Объяснение: для понимания этого факта приведем простой пример. Представим, что в исходной функции было 4 зависимых условия IF THEN. Тогда, чтобы покрыть тестами такую функцию, в идеале, нужно написать 2*2*2*2 = 16 тестов. Тоже самое и при отладке, чтобы найти ошибку в такой функции программист вынужден проверить 16 вариантов ее выполнения. Теперь представим, что мы разбили эту функцию на 4 логически-самостоятельных функции. На каждую такую функцию достаточно написать 2 теста, таким образом всего тестов понадобится 2+2+2+2 = 8. т.е. при таком подходе мы получаем линейный рост сложности отладки и тестирования, а не экспоненциальный. В реальности даже в небольшом методе комбинаций ветвления значительно больше.

Friday, November 20, 2009

Практические навыки работы с DUnit

Здесь я поделюсь опытом работы с DUnit, его TestCase и TestSetup. Поговорим о передаче данных от TestSetup дочерним TestCase, TestSetup

Tuesday, October 13, 2009

Manifesto for Agile Software Development

Individuals and interactions over processes and tools
Working software over comprehensive documentation
Customer collaboration over contract negotiation
Responding to change over following a plan

Saturday, October 3, 2009

Автоматическое подключение к беспроводной сети в Windows Vista, Windows 7

Проблема.
В Windows XP можно было подключаться к беспроводной adhoc сети автоматически. Начиная с Windows Vista, такая возможность была отрезана. Намерения, возможно, были благими (безопасность), однако покупать точку доступа для сети из 2 - 3-х компьютеров все же не хочется.

Кроме того, что теперь приходится подключаться к сети вручную, стало невозможным пользоваться сервисами для удаленной работы с компьютерами такой сети, например, удаленное управление рабочим столом. Проблема заключается в том, что мы не можем подключиться к такому компьютеру, потому как его подключение к сети происходит в ручном режиме.

Решение.
Написать задание для планировщика. Коротко, это делается так: создаем задание; добавляем триггер: при входе в систему, на всякий случай включаем паузу в несколько секунд; указываем действие: запуск программы netsh с параметрами wlan connect name=имя_сети.

Этого будет достаточно для подключения к сети на компьютере-владельце этой сети. Для того, чтобы смогли подключиться остальные компьютеры, понадобится выполнить еще одну операцию.

Дело в том, что теперь, начиная с Vista, операционная система не сохраняет профиль временной сети, а именно таковой является adhoc сеть и выполнение планировщиком назначенной задачи не принесет положительных результатов. Если вы попытаетесь ввести ту же команду в командной строке, то узнаете почему: "Указанный профиль сети не назначен интерфейсу". Это и означает, что профиль не сохраняется. Эту проблему мы решим, добавив профиль вручную. Автоматически сделать это не получится, так как профиль сохранен будет до первой перезагрузки.

Итак, нам нужно достать XML файл профиля подключения к сети. Создать его самостоятельно не получится, так как будет не возможным задать хеш-код входа в сеть. Поэтому делаем так: подключаемся к сети вручную, как обычно. И находим этот файл в папке "c:\ProgramData\Microsoft\Wlansvc\Profiles\Interfaces". Если будут какие-то проблемы с нахождением файла, дам совет: просто устройте поиск по диску xml файлов, содержащих имя вашей сети. После того, как файл будет найден, скопируйте его в удобную для вас папку, поменяв заодно имя файла на более вменяемое.

Этот файл нужно будет поправить в двух местах. Во-первых, поменять тип сети с ESS (infrastructure) на IBSS (adhoc). И, во-вторых, тип подключения с auto на manual: manual. Сохраняем файл.

И, наконец, последняя операция: добавление профиля сети к интерфейсу. Для этого в командной строке вводим netsh wlan add profile filename="путь к xml файлу".

Все, теперь подключение к сети будет происходить автоматически :).

p.s. Либо воспользуйтесь программами типа Maxidix Wifi Suite (http://www.maxidix.com/products/wifi-suite). Она позволяет легко настроить автоматическое подключение к сетям компьютер-компьютер, выводит информацию о подключении и окружающих сетях, предоставляет геолокацию по беспроводным сетям и много чего еще.

Sunday, February 15, 2009

Making your own Aero glass windows

In this post, I will share you how to make your forms in Windows Vista (or Windows 7) glassy style. Like in Windows media player.

The example will be written on Delphi, but it will look similar on other languages. It's quite easy, all you need to do is to import the dwmapi.dll in your app. You can find all useful information about Desktop Window Manager on MSDN (http://msdn.microsoft.com/en-us/library/aa969540(VS.85).aspx). Shortly, DWM is the new Windows desktop composition feature. When it is enabled, individual windows drawing is redirected to off-screen surfaces in video memory, which are then rendered into a desktop image and presented on the display.

So you import this library, like this:

procedure InitDWM();
var
  Handle: THandle;
begin
  Handle := LoadLibrary('dwmapi.dll');
  if Handle = 0 then
    raise Exception.Create('Can''t load dwmapi.dll');
  @MakeDWM := GetProcAddress(Handle,
    'DwmExtendFrameIntoClientArea');
  if not Assigned(MakeDWM) then
    raise Exception.Create(
      'Can''t get DwmExtendFrameIntoClientArea');
end;

As you see the only function you need to import from this library is DwmExtendFrameIntoClientArea. This function allows to extend window border areas to a suitable view. 

It takes two parameters. The first one is window handle and the second one is pointer to a Margins structure.

HRESULT DwmExtendFrameIntoClientArea(  
  HWND hWnd,
  const MARGINS *pMarInset
);

In Delphi this function and structure defines like this:
type
  TMargins = record
    LeftWidth: Integer;
    RightWidth: Integer;
    TopHeight: Integer;
    BottomHeight: Integer;
  end;

var
  MakeDWM: function (Handle: THandle;
      var
AMargins: TMargins): Integer; stdcall;