Delphi Code Coverage moved to SourceForge

Due to Google Code shutdown I moved Delphi Code Coverage project to SourceForge

Delphi Code Coverage 1.0 RC10

Created Delphi Code Coverage 1.0 RC10 with following changes

• Fixed emma report generation 
• Fixed -tec switch thanks to Sergiy Kheylyk 
• Added support for Emma version 2.1 with new switch -emma21 
• Fixed some bugs
• File hosting moved to SourceForge

Download

Getting gesture distance in Delphi

There are two types of touch screens supported in Windows - one that detect gestures natively and uses special messages for them and another that uses mouse emulation and sends standard mouse messages on touch events. Delphi detects both these types and uses appropriate gesture engine internally. There is however a problem with mouse gesture engine in that it does not report distance that you swiped on the screen. This means that there could be false positives when user just wanted to press button but system detects it as gesture. Fortunately it is pretty easy to replace mouse gesture engine with custom implementation. This implementation will be almost exactly the same as standard TMouseGestureEngine. Since it is a sealed class we cannot inherit from it so we will need to copy it completely to new unit from Vcl.Touch.Gestures and call it for example TMouseGestureEngineEx Here are modifications that are needed for this class

// function that calculates distance between to points
function Distance(Point1, Point2: TPoint): Integer;
begin
  Result := Round(Sqrt(Sqr(Point1.X - Point2.X) + Sqr(Point1.Y - Point2.Y)));
end;

procedure TMouseGestureEngineEx.Notification(const Message: TMessage);

// .....

            if (LGestureList.Count > 0) and
               TGestureEngine.IsGesture(Points, LGestureList, [gtStandard] + [gtRecorded, gtRegistered], LEventInfo) then
            begin
              // add this line to set distance
              LEventInfo.Distance := Distance(Points[Low(Points)], Points[High(Points)]);
              BroadcastGesture(TargetControl, LEventInfo);
            end;

// ...

// registering our new gesture engine
initialization
  TGestureEngine.DefaultEngineClass := TMouseGestureEngineEx;
end.

Now in gesture event we can check EventInfo.Distance field

procedure TForm1.FormGesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
  Label1.Caption := 'Distance ' + IntToStr(EventInfo.Distance);
end;

This kind of calculation will work only for simple gestures because it calculates distance only between first and last points of swipe.

SQL Server express silent installation

SQL server setup supports silent installation options but it may be inconvenient to distribute this installation. One simple solution to this is to create your own installer as self extracting archive that embeds SQL server installation. There are different programs that support this functionality, I used 7-zip because it is open source. So here is an example of batch file that creates silent installation of SQL server 2014 express, it's pretty much the same for all older versions. Assumption is that downloaded SQLEXPR_x64_ENU.exe is located in the same folder as batch file. As a result it creates SQLServerExpress2014x64.exe which can be run to install SQL server.

set InstallName=SQLServerExpress2014x64.exe
set ArchiveName=SQLEXPR_x64_ENU.7z
if exist %InstallName% del /Q %InstallName%
if exist %ArchiveName% del /Q %ArchiveName%
"%PROGRAMFILES%\7-zip\7z.exe" a -t7z -r0 %ArchiveName% SQLEXPR_x64_ENU.exe

@echo ;!@Install@!UTF-8! >config.txt
@echo Title="SQL Server Express version 2014 64-bit">>config.txt
@echo BeginPrompt="Do you want to install SQL Server Express version 2014 64-bit?">>config.txt
:: here you can change options for SQL server installation, full list of options is here http://msdn.microsoft.com/en-us/library/ms144259.aspx
@echo RunProgram="SQLEXPR_x64_ENU.exe /q /ACTION=Install /SECURITYMODE=SQL /TCPENABLED=1 /INSTANCENAME=MSSQLSERVER /IACCEPTSQLSERVERLICENSETERMS /SAPWD=gfhjkm856 /ADDCURRENTUSERASSQLADMIN=True /SQLSVCACCOUNT=\"NT AUTHORITY\\Network Service\"">>config.txt
@echo ;!@InstallEnd@!>>config.txt

::SFX module can be downloaded from here http://downloads.sourceforge.net/sevenzip/7z920_extra.7z
copy /b "%ProgramFiles%\7-Zip\Extra\7zS.sfx" + config.txt + %ArchiveName% %InstallName%
if exist %ArchiveName% del /Q %ArchiveName%
if exist config.txt del /Q config.txt

One problem with this approach is that installer window is hidden so you can't see when it's finished, the only way to check for it is to see %temp%\SqlSetup.log file. You will also need to check this file to see if installation was successful, in this case exit code will be 0.

Mocking IDispatch interfaces in Delphi

Sometimes it is needed to write unit tests for code that uses third party ActiveX control. In this case we have to create mock of this ActiveX control. This is easy to do with standard Delphi TObjectDispatch class which creates IDispatch interface from normal class. Here is simple example

{$APPTYPE CONSOLE}

program TestDispatch;

uses System.Win.ObjComAuto;

{$METHODINFO ON}

type
  TTestWriter = class
    procedure Write(const Data: string); 
  end;

procedure TTestWriter.Write(const Data: string); 
begin
  Writeln(Data);
end;

var
  Dispatch: IDispatch;
  OleDispatch: OleVariant;
  TestWriter: TTestWriter;
begin
  TestWriter := TTestWriter.Create;
  Dispatch := TObjectDispatch.Create(TestWriter, True);
  OleDispatch := Dispatch;
  OleDispatch.Write('test');
end.

This works when we use OleVariant and late binding of IDispatch methods, but if we use dispinterface this will not work because TObjectDispatch generates dispid's for methods internally and does not allow to modify them. To overcome this problem we can create following TObjectDispatch extension class that will map real dispid values to auto generated ones.

unit uObjectDispatchWrapper;
interface

uses System.Win.ObjComAuto, System.Generics.Collections, System.Types, System.SysUtils;

type
  TObjectDispatchWrapper = class(TObjectDispatch)
  strict private
    FDispIDsMapping: TDictionary<Integer, Integer>;
  public
    constructor Create(Instance: TObject; const AMethods: TStringDynArray; const AMethodDispIDs: TIntegerDynArray);
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
      ArgErr: Pointer): HRESULT; override; stdcall;
    destructor Destroy; override;
  end;

implementation

constructor TObjectDispatchWrapper.Create(Instance: TObject; const AMethods: TStringDynArray; const AMethodDispIDs: TIntegerDynArray);
var
  i: Integer;
  MethodName: string;
  DispatchIdentifier: Integer;
begin
  Assert(Length(AMethods) = Length(AMethodDispIDs));
  inherited Create(Instance, True);
  FDispIDsMapping := TDictionary<Integer, Integer>.Create;

  // call GetIDsOfNames for all methods to populate internal TObjectDispatch data
  // this is needed because when used with dispinterfaces GetIDsOfNames method is not called.
  for i := Low(AMethods) to High(AMethods) do
  begin
    MethodName := AMethods[i];
    GetIDsOfNames(GUID_NULL, @MethodName, 1, SysLocale.DefaultLCID, @DispatchIdentifier);
    FDispIDsMapping.Add(AMethodDispIDs[i], DispatchIdentifier);
  end;
end;

destructor TObjectDispatchWrapper.Destroy;
begin
  FDispIDsMapping.Free;
  inherited;
end;

function TObjectDispatchWrapper.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
  ArgErr: Pointer): HRESULT;
begin
  Result := inherited Invoke(FDispIDsMapping[DispID], IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
end;

end.

And here is an example of its usage

{$APPTYPE CONSOLE}

program TestDisp;

uses System.Types, System.Win.ObjComAuto, uObjectDispatchWrapper;

{$METHODINFO ON}

type
  ITestWriter = dispinterface
    ['{4861977E-7E28-4195-BC7A-F45005536FEB}']
    procedure Write(const Data: string); dispid 5;
  end;

  TTestWriter = class
    procedure Write(const Data: string); 
  end;

procedure TTestWriter.Write(const Data: string); 
begin
  Writeln(Data);
end;

var
  Dispatch: IDispatch;
  TestWriter: TTestWriter;
begin
  TestWriter := TTestWriter.Create;
  Dispatch := TObjectDispatchWrapper.Create(TestWriter, 
    // method Write has dispid 5 
    TStringDynArray.Create('Write'), TIntegerDynArray.Create(5)
  );
  ITestWriter(Dispatch).Write('test');
end.

On a side note - dispinterfaces generated from ActiveX controls usually use WideString type for parameters, but there seems to be a bug in TObjectDispatch with WideString parameters so string type have to be used in mock class instead.
On another side note - word 'dispatch' in exe name seems to trigger Windows protection mechanism and it requires admin writes to run, so it is better to call project file TestDisp instead of TestDispatch.

nebohodimo - jabber клиент для Windows Mobile

После долгих поисков нашел нормальный open source джаббер для WM..

Добавил его в список существующих джаббер клиентов в википедии

ubuntu x86_64 + mono + oracle

Во первых нужно установить Oracle. У них нет 64-битного дистрибутива для ubuntu, но доработав напильником поставить можно практически все, я выбрал самый простой вариант - установить 32 битный Oracle Express 10g. Вот тут по моему самое удачное описание как это сделать.

Второй вопрос это непосредственно разработка. Поскольку Oracle 32 битный, по умолчанию можно компилировать только 32 битные программы для этого нужно добавить в ~/.bashrc

ORACLE_HOME=/usr/lib/oracle/xe/app/oracle/product/10.2.0/server
LD_LIBRARY_PATH=$ORACLE_HOME/lib:$LD_LIBRARY_PATH
export ORACLE_HOME
export ORACLE_SID=XE
export LD_LIBRARY_PATH

Чтобы скомпилировать программу на C добавить ключ -m32 для gcc чтобы использовались 32 битные библиотеки.

Поскольку для программ под mono такие ключи задать не получится, да и не надо, нужно поставить 64 битный клиент. Берется он отсюда и распаковывается в любую папку.
Соответственно нужно изменить LD_LIBRARY_PATH в .bashrc, например

LD_LIBRARY_PATH=/home/ekot/prg/instantclient_10_2:$LD_LIBRARY_PATH

another problem with dblinq on mono

Encountered another internal error with LINQ in mono C# compiler while building DBLinq. 

Hope they will fix it in before Mono 2.4.

предупреждение о libgtkembedmoz.so в monodevelop

Чтобы monodevelop не выдавал при старте такое предупреждение

WARNING: Cannot find Mozilla directory containing libgtkembedmoz.so. Some Addins may not be able to function. Please set MOZILLA_FIVE_HOME to your Mozilla directory.

под ubuntu 8.10 нужно поставить пакет libxul0d и установить 

MOZILLA_FIVE_HOME=/usr/lib/xulrunner

установка mono 2.4

Пытался собрать dblinq под mono 2.2. наткнулся на баг, который как оказалось уже исправлен в mono 2.4. Пришлось поставить preview 2.4. Тут модифицированный скрипт для установки 2.4. Нормально работает параллельно с 2.2.

Правда там уже нашелся новый баг, надеюсь быстро исправят, правда придется уже ставить из SVN :)

установка mono 2.2 из исходников

Поставил себе mono 2.2, поскольку в ubuntu похоже еще не скоро пакеты обновятся. Инструкции по установке версии 2.0 вот тут, а вот тут модифицированный скрипт для версии 2.2. Возникли только проблемы с monodoc, так что по умолчанию он отключен. 

Ставится в папку ~/opt/mono2.2 независимо от версии установленной из пакетов. На рабочем столе создается ярлык для запуска с этой версией.

Google Gadgets for Linux

Оказывается существуют Google Gadgets for Linux. По первым ощущениям гораздо менее глючно чем superkaramba.

mount drive via udev

Разобрался как всегда монтировать конкретный диск в конкретную папку.

1.

udevinfo -a -p $(udevinfo -q path -n /dev/sda) 

sda заменяем на нужный диск, в выводе находим строчки однозначно определяющие диск, например название, серийный номер и т.д.

2. создаем файл /etc/udev/rules.d/10-local.rules и добавляем в него найденные строчки, например

SUBSYSTEMS=="scsi" ATTRS{model}=="ST3500630AS " SYMLINK +="seagate500"

в результате получаем устройство /dev/seagate500

3. создаем файл /etc/udev/rules.d/11-mount-hdd.rules и добавляем в него строчку RUN+="/bin/mount -t ext3 /dev/seagate500 /mnt/seagate500"

для usb дисков нужно обрабатывать как подключение так и отключение, подробнее описано тут