Статьи Королевства Дельфи

       

Прошло некоторое время, клавиатура остыла


Hello, MiniProg 2
Раздел Подземелье Магов
Продолжение, .

Прошло некоторое время, клавиатура остыла после тестирования и писательства, можно продолжать.
Попробуем сделать так, что бы программа следила за тем, что бы она была запущена в единственном экземпляре. Пока мы не углубились в обсуждение деталей реализации, хотелось бы объяснить, для чего такое "суровое" требование единственности и неповторимости. Дело в том, что если пользователям удобнее использовать одновременно несколько копий одной и той же программы, то это верный признак того, что изначально был спроектирован неверный интерфейс, скорее всего больше подошел бы MDI. Это первое, второе - считается, что чаще всего запуск второй копии происходит по ошибке, когда приложение свернуто и его просто не видно.

Данная тема уже не раз поднималась на просторах , например, или . Огромное множество материала, на данную тематику, чьей то щедрой рукой, разбросано по интернету. Правда, все методы однотипные и сводятся к тому, что программа, при запуске, проверяет какой-нибудь признак, если он не обнаружен - то запускается, если же присутствует... В этом месте возможны самые различные реакции, от сообщений, с требованием ответа/нажатия кнопки, до коварнейших систем оповещения создателей (например, как у M$ XP :). Признаком может служить, либо проверка наличия определенного окна, либо отметка в конфигурационном файле/регистре, либо банальный файл, создаваемый при запуске приложения и удаляемый при выходе из него. Более сложные системы, профессионального уровня, обращаются за советом, "можно, или нельзя", к специализированным лицензионным серверам.
Мы пойдем другим путем, наверное, самым простым, будем проверять наличие определенного мьютекса, реакция же будет вежливая - просто активизация окна. Данный метод не нов. Определенно, он работоспособен, но не мешало бы создать тест, который бы нас убедил, что это так. И это еще одна рекомендация XtremeProgramming - не лениться и стараться тестировать как можно больше. Вообще, если бы программисты знали, как много ошибок может быть, в казалось бы, в надежном и простом коде: Откроем testMiniProg.dpr и в файле testAppl.pas создадим следующую процедуру:

Const StrFailedTest = 'failure test'; ... procedure TTestUnitAppl.TestFindPrevInstance; var Test1, Test2: boolean; Temp: THandle; begin Temp := Mutex; Test1 := not FindPrevInstance('Test'); Test2 := FindPrevInstance('Test'); StopPrevInstance; Check(Test1 and Test2, strFailedTest); Mutex := Temp; end;
Сами функции располагаются в Appl.pas и выглядят так:

Var Mutex: THandle = 0; ... function FindPrevInstance(Name: string): boolean; var Temp: THandle; begin Temp := CreateMutex(nil, False, PChar(Name)); Result := (GetLastError = ERROR_ALREADY_EXISTS); if Result then CloseHandle(Temp) else Mutex := Temp; end; procedure StopPrevInstance; begin if Mutex > 0 then CloseHandle(Mutex); end;


Теперь посмотрим, как можно будет показать найденную первую копию. Вариантов 'поискать и показать форму', в интернете, огромная масса. Тестовая процедура и сама функция выглядят так:

Unit testAppl; ... procedure TTestUnitAppl.TestShowPrevInstance; begin Check(ShowPrevInstance('DUnit'), strFailedTest); end; unit Appl; ... function ShowPrevInstance(Name: string): boolean; var PrevInstance: HWND; begin Result := False; PrevInstance := FindWindow('TApplication', PChar(Name)); if PrevInstance <> 0 then begin if IsIconic(PrevInstance) then ShowWindow(PrevInstance, SW_RESTORE); SetForegroundWindow(PrevInstance); Result := True; end; end;
Компилируем, запускаем, проверяем - все работает, как требуется. Следует отметить, что в данном случае, тестировалось только возвращаемое ShowPrevInstance значение, сам эффект 'показа' незаметен. По этому, что бы ни уподобляться тому сапожнику, который без сапог, внесем в testMiniProg.dpr изменения, добавим в секцию uses модуль Appl и следующий код:

program testMiniProg; uses Appl in '..\SOURCE\Appl.pas', Forms, TestFrameWork, GUITestRunner, testAppl in 'testAppl.pas', testUnit in 'testUnit.pas' {testForm}; {$R *.res} begin if FindAndShowPrevInstance('DUnit') then Halt else try Application.Initialize; Application.Title := 'DUnit'; GUITestRunner.RunRegisteredTests; finally StopPrevInstance; end; end.
В модуль Appl.pas, поместим функцию FindAndShowPrevInstance, которая будет искать и активизировать предыдущую копию программы. Её тестирование проведем на функциональном уровне, так как технологическое тестирование, хоть и возможно, но реализовывать его будет обременительно. Впрочем, желающие могут попробовать, не забудьте только мне показать, очень интересно.

function FindAndShowPrevInstance(Name: string): boolean; begin Result := FindPrevInstance(Name); if Result then ShowPrevInstance(Name); end;
Компилируем, запускаем, пробуем запустить вторую копию - у меня всё, как и предполагалось. Ну что же, можем считать, что функциональные тесты данная функция прошла. Есть один момент, который нужно учитывать. Не очень удобно то, что 'DUnit', или какое-то другое, милое вашему сердцу заветное слово, приходится писать два раза. Мне, к сожалению, так и не удалось приравнять Application.Title ни константе, ни переменной. Все время возникала ошибка dcc32.exe, по-видимому, из-за того, что данное значение используется самим Delphi. Возможно изменение, в виде переноса проверки FindAndShowPrevInstance в секцию initialization модуля Appl.pas, StopPrevInstance в секцию finalization, а сам unit прописать в uses dpr вашей программы самым ПЕРВЫМ. В принципе, я обычно так и делаю, в данном же случае пример просто показательный, потому и несколько упрощенный. Не сомневаюсь, даже данный подход можно улучшить. Особенность передаваемого FindAndShowPrevInstance значения в том, что оно должно быть такое же, как и имя главной формы программы, в противном случае невозможно будет правильное выполнение StopPrevInstance. Конечно, проверка мьютекса будет выполнена, и 'лишнее' приложение буде закрыто, но активизации первой копии не произойдет. Если кого-то не устраивает такое положение дел, например, этот кто-то, всегда дает одно и тоже имя главному модулю своих программ, то всё можно поправить. Просто расширьте число предаваемых функции параметров - отдельно имя мьютекса, отдельно имя главного окна.



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

Способность сохранять в конфигурационном файле какие-нибудь значения, например, положение и размеры окна, так же была освещена в интернет очень широко. В , есть неплохой компонент, умеющий многое, я сам пользовался им когда-то. По этому не будем изобретать ничего нового, но просто воспользуемся уже известными приемами. Почему именно ini-файл, а не регистр, или не способ хранение свойств компонентов, так как это делает Delphi? Свои плюсы и минусы есть у всех подходов, но для наших целей вполне хватит возможностей ini-файла. Будем считать, что ini-файл располагается в директории вместе с программой и имеет такое же имя, но другое расширение, например "ini" :). Традиционно, свойства окна хранят в отдельной секции ini-файла, с уникальным, для данного приложения именем. Используем для этого имя формы. И так, тесты:

procedure TTestUnitAppl.TestGetIniFileName; begin Check(ExtractFileName(GetIniFileName) = 'testMiniProg' + cfgFileExt, strFailedTest); end; procedure TTestUnitAppl.TestGetSectionName; begin Check(GetSectionName(Screen.Forms[0]) = 'GUITestRunner', strFailedTest); end;
Сами же функции очень просты. В принципе, GetSectionName можно было бы расширить, включив возможность генерации имени секции для любого компонента, с учетом формы-владельца, но пока не будем этого делать:

Const cfgFileExt = '.ini'; ... function GetIniFileName: string; begin Result := ChangeFileExt(Application.ExeName, cfgFileExt); end; function GetSectionName(Component: TComponent): string; begin Result := Component.Name; end;


Необходимо решить, какие именно значения свойств окна будут сохраняться и восстанавливаться. Вероятно состояние окна: свернуто, максимизировано и т.д. и позицию окна, т.е. положение левого верхнего угла и, либо положение правого нижнего угла, либо размеры окна. Необходимо еще предусмотреть, как средство защиты программы от пользователей - любителей запускать одно и то же приложение при разных значениях PPI, возможности, на выбор:
1) отказа от восстановления параметров окна и установка значений по умолчанию,
2) изменение этих параметров в соответствии с изменением используемого шрифта.
Мне, больше по душе метод 'нумбер 2'. Что нужно сделать? вроде бы совсем не многое - всегда хранить размеры окна приведенными в соответствие с PPI времени создания, и при восстановлении проводить коррекцию, в соответствии с PPI времени выполнения. Положение левого верхнего угла формы изменять не следует, этого не делает Delphi, не будем делать и мы. В первой части статьи, говорилось, что величина масштабирования размеров окна зависит от отношения PPI's времен создания и выполнения, и такого понимания, тогда, было достаточно. Настало время все уточнить. На самом деле все обстоит несколько сложнее. Отношение PPI's используется для масштабирования высоты шрифта, после этого вычисляется высота образцового текста (у Delphi это строка '0' :). Ну а далее, для масштабирования, используется отношение старой и новой высот текста. Это отношение будет равно отношению PPI's в случае использования стандартных, для Windows, установок 'Крупный/Мелкий шрифт'. Размеры обычных экранных шрифтов строго фиксированы, по этому, использование нестандартных значений PPI' s может приводить к возникновению неприятных эффектов. В таких случаях, иногда, способен помочь шрифт TTF, например, как предлагается . Следует отметить еще одну особенность масштабирования форм: непосредственно изменяются не сами размеры формы, а размеры клиентской части.



Вооружившись этими знаниями можно придти к выводу, что придется вносить изменения в функцию RtmPPI и DsgnPPI, и вычислять их результат иначе, чем было сделано ранее. Идея проста, использовать для масштабирования высоту текста, времени создания формы и времени выполнения приложения. Судя по всему - это более корректный способ, однако, в названиях переменных и процедур сохранена аббревиатура PPI. Остается вопрос, где, во время исполнения, взять высоту текста времени создания, ведь при создании окна все размеры изменяются. В принципе, все интересующие нас числа хранятся в ресурсах программы и можно попробовать прочитать их оттуда. Но, все попытки обратиться к ресурсам формы в программе, использую стандартные и рекомендованные для этого средства, ни к чему не привели. Точнее, нужные ресурсы программы успешно читаются, но уже в измененном виде, так уж устроен метод TCustomForm.ReadState :(. По этому, попытаемся прочитать данные из ресурса, так же, как это делает Delphi, но в сильно упрощенном варианте. Если вы загляните в исходный код VCL и просмотрите всё, что хоть как-то касается загрузки ресурсов программы, то поймете, зачем эти упрощения. Сведений, в литературе и интернете, связанных с вопросами чтения ресурсов во время исполнения программы, без создания самих компонентов, очень мало. К моему сожалению, практически, я ничего не нашел, и если кто-то знает, где есть подобного рода информация - поделитесь ссылкой. Текст функции, которая читает ресурсы определенной формы, выглядит так:

unit Appl; ... function ReadFormRes(ResName: string; List: TStringList): boolean; var Prop, Value: string; Stream: TResourceStream; Reader: TReader; HRsrc: THandle; begin List.Clear; HRsrc := FindResource(HInstance, PChar(ResName), RT_RCDATA); Result := HRsrc <> 0; if not Result then Exit; Stream := TResourceStream.Create(HInstance, ResName, RT_RCDATA); Reader := TReader.Create(Stream, 4096); try Reader.ReadSignature; Reader.ReadStr; Reader.ReadStr; while not Reader.EndOfList do begin Prop := Reader.ReadStr; Value := strNil; case Reader.NextValue of vaInt8, vaInt16, vaInt32: Value := IntToStr(Reader.ReadInteger); vaString: Value := Reader.ReadString; else Reader.SkipValue; end; if Value <> strNil then List.Add(Format('%s = %s',[Prop,Value])); end; Reader.CheckValue(vaNull); finally Reader.Free; Stream.Free; end; end;


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

Procedure TtestUnitAppl.TestReadFormRes; var List: TStringList; Test: boolean; begin List := TStringList.Create; try ReadFormRes('TGUITestRunner', List); Test := List.Values['Caption'] = 'DUnit: An Xtreme testing framework'; finally List.Free; Check(Test, strFailedTest); end; end;
Изменим функцию RtmPPI таким образом, что бы она вычисляла, во время выполнения программы, высоту текста, для определенного нами окна. Соответственно DsgnPPI, изменится так, что вычисление её результата будет происходить с использованием ReadFormRes. Дополнительно, что бы избежать ошибок при определении RtmPPI, в ситуации, когда окно еще не создано, нам понадобится функция, которая по имени окна будет искать его в списке созданных форм и возвращать указатель на найденную форму, иначе nil.

Unit testAppl; ... procedure TTestUnitAppl.TestFindForm; var Test1, Test2, Test3: boolean; begin Test1 := FindForm('testForm') = nil; testForm := TtestForm.Create(Application); try Test2 := FindForm('testForm') <> nil; finally testForm.Free; Test3 := FindForm('testForm') = nil; end; Check(Test1 and Test2 and Test3, strFailedTest); end; unit Appl; ... function FindForm(FormName: string): TCustomForm; var I: integer; begin Result := nil; for I := 0 to Screen.FormCount - 1 do if Screen.Forms[I].Name = FormName then begin Result := Screen.Forms[I]; Break; end; end;


В принципе, если бы создатели VCL, придерживались простого правила, присвоения nil указателю, который ссылается на еще не созданный или уже удаленный объект, многое было бы проще, и методологически вернее. И я не вижу ни каких логических объяснений, почему до сих пор это не сделано.

unit Appl; ... const strDelphiMagicText = '0'; strResTextHeight = 'TextHeight'; ... function RtmPPI(FormName: string): integer; var Form: TCustomForm; begin Result := 0; Form := FindForm(FormName); if Form <> nil then Result := Form.Canvas.TextHeight(strDelphiMagicText); end; function DsgnPPI(FormName: string): integer; var List: TStringList; Form: TCustomForm; begin List := TStringList.Create; try Form := FindForm(FormName); if Form <> nil then begin ReadFormRes(Form.ClassName, List); Result := StrToInt(List.Values[strResTextHeight]); end; finally List.Free; end; end;
Эти функции проверяют наличие определенного окна . Если значение не равно nil, то считается, что форма уже создана, и у неё можно определить PPI's. Если форма еще не создана, то возвращается 0. В случае успешного выполнения функции, результатом будет значение высоты текста, отличное от 0. Так как сами функции несколько усложнились, то необходимо расширить их тестирование. Изменится так же, процедура TestDsgnVsRtmPPI, но функциональность её сохраниться, и даже несколько расшириться. Функция IsChangePPI удалена, из-за её несоответствия текущему моменту.

const testPPI = 16; ... procedure TTestUnitAppl.TestRtmPPI; var Test: boolean; begin testForm := TtestForm.Create(Application); try Test := RtmPPI('testForm') = testForm.Canvas.TextHeight(strDelphiMagicText); finally testForm.Free; Check(Test, strFailedTest); end; end; procedure TTestUnitAppl.TestDsgnPPI; var OldPPI, PPI: integer; begin testForm := TtestForm.Create(Application); try OldPPI := DsgnPPI('testForm'); finally testForm.Free; Check(OldPPI = testPPI, Format('DsgnPPI=%d, not %d', [OldPPI, testPPI])); end; end; procedure TTestUnitAppl.TestDsgnVsRtmPPI; var Test: boolean; Text: string; OldPPI, NewPPI: integer; begin Test := False; Text := strFailedTest; testForm := TtestForm.Create(Application); try OldPPI := RtmPPI('testForm'); NewPPI := DsgnPPI('testForm'); if (OldPPI > 0) and (NewPPI > 0) then begin Test := OldPPI = NewPPI; if not Test then Text := Format('DsgnPPI=%d not equal RtmPPI=%d DPI', [OldPPI, NewPPI]); end; finally testForm.Free; Check(Test, Text); end; end;


Вроде бы все подготовительные действия выполнены, можно попытаться сохранить/восстановить состояние формы. Текст тестовой функции TestSaveLoadFormState можно посмотреть в testAppl.pas. Логика проверки следующая, создается окно, с некоторой задержкой демонстрируется, запоминается состояние окна в локальной переменной и сохраняется в ini-файле. Устанавливаются другие значения состояния окна, перемещается, сворачивается в левый нижний угол, выжидается некоторое время. Восстанавливается состояние окна, сохраненное в ini-файле. Дополнительно, проводится проверка значений состояния окна, до и после сохранения/восстановления. Если же вас не убедят результаты тестов, то всегда можно будет заглянуть в файл ini и посмотреть всё своими глазами. Сами процедуры сохранения/восстановления, и все процедуры к которым они обращаются, приведены поименно ниже:

... procedure WriteIniShowCmd; procedure ReadIniShowCmd; procedure WriteIniFlags; procedure ReadIniFlags; procedure WriteIniWidth; procedure ReadIniWidth; procedure WriteIniHeight; procedure ReadIniHeight; procedure WriteIniLeft; procedure ReadIniLeft; procedure WriteIniTop; procedure ReadIniTop; procedure ScaleFormConstraints; procedure SaveFormState; procedure LoadFormState; ...
Полный текст процедур довольно велик по своим размерам, по этому здесь не приводится, но его можно посмотреть в Appl.pas, тестовые процедуры в testAppl.pas. Следует отметить, что при загрузке положения формы выполняется ScaleFormConstraints, которая корректирует значения Constraints окна, но другие элементы формы остаются без изменения. Желающие могут расширить её по своему усмотрению.

Те, кто смотрел исходники MiniProg1, заметят, что в исходных файлах MiniProg2 проведены некоторые 'косметические' изменения.

Продолжение следует ...

Declaimer aka Отмазка.
Я надеюсь, что люди, привыкшие читать академические труды, или слушать классические оперы, не станут осуждать простую и незатейливую песнь кочевника. Что делал - о том и пел.
Исходную партитуру и ноты можно взять здесь: (43K). Предложения будут рассмотрены, претензии - проигнорированы.
С особым вниманием будут рассмотрены уточнения списка требований и новые тесты.

Все копирайты, если они известны, указаны. Иначе, автор не известен или копирайт утерян.


Brodia@a
Специально для




Содержание раздела