Hi,

I try to make COM notification with ActiveSync on Windows.

http://msdn.microsoft.com/en-us/library/aa454843.aspx

This work well on FreePascal program but crash on Lazarus program, I have this error or nothing (juste close form fast)
COM event and Lazarus is conflicting ???

An unhandled exception occurred at $00447E9C :
EAccessViolation : Access violation
$00447E9C TTHEMESERVICES__GETTHEMESENABLED, line 555 of themes.pas $004CBACD WINDOWPROC, line 2534 of win32callback.inc $7E418734
$7E41D05B
$7E41B4C0
$7E41B50C
$7C90E473
$00409B82
$00411A18
$0040B7E4
$00422163
$0041CFCA
$00402B64

Command line program work but same on Lazarus crash.

Perhaps the statements of COM are different between Delphi and Lazarus? If someone work on this ?

I'm based of this
http://etutorials.org/Programming/Pocket+pc+network+programming/Chapter+9.+Desktop+Synchronization/Desktop+Connection+Notifications/

I add backtrace and some info
[code]
type

  PIDccManSink = ^IDccManSink;
  IDccManSink = interface(IUnknown)
    ['{A7B88840-A812-11cf-8011-00A0C90A8F78}']
    function OnLogIpAddr(dwIpAddr: DWORD): HResult; stdcall;
    function OnLogTerminated: HResult; stdcall;
    function OnLogActive: HResult; stdcall;
    function OnLogInactive: HResult; stdcall;
    function OnLogAnswered: HResult; stdcall;
    function OnLogListen: HResult; stdcall;
    function OnLogDisconnection: HResult; stdcall;
    function OnLogError: HResult; stdcall;
  end;
  IIDccMan = interface(IUnknown)
    ['{A7B88841-A812-11cf-8011-00A0C90A8F78}']
    function Advise(pDccSink: PIDccManSink; var pdwContext: DWORD): HResult;
stdcall;
    function Unadvise(dwContext: DWORD): HResult; stdcall;
    function ShowCommSettings: HResult; stdcall;
  end;
{$M+}
  TDccMan = class;
  { TDccEventSink }
  TDccEventSink = class(IUnknown, IDccManSink)
  private
    FNbRef:      integer;
    FOnLogEtat:  string;
    FOnLogIndex: integer;
    FOwner:      TDccMan;
  public
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: integer; stdcall;
    function _Release: integer; stdcall;
    { IDccManSink}
    function OnLogIpAddr(dwIpAddr: DWORD): HResult; stdcall;
    function OnLogTerminated: HResult; stdcall;
    function OnLogActive: HResult; stdcall;
    function OnLogInactive: HResult; stdcall;
    function OnLogAnswered: HResult; stdcall;
    function OnLogListen: HResult; stdcall;
    function OnLogDisconnection: HResult; stdcall;
    function OnLogError: HResult; stdcall;
    constructor Create(AOwner: TDccMan);
    destructor Destroy; override;
    property OnLogEtat: string Read FOnLogEtat;
    property OnLogIndex: integer Read FOnLogIndex;
  end;
  { TDccMan }
  TDccMan = class(TObject)
  private
    FIDccMan: IIDccMan;
    FdwContext: DWORD;
    FDccSync: TDccEventSink;
    FIDccManSink: PIDccManSink;
    FComLib: boolean;
    FQI:     boolean;
    FAdvise: boolean;
    FOnChange: TNotifyEvent;
    procedure DoChange(Sender: TObject);
    function GetStatusStr: string;
    function GetStatusIndex: integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Advise;
    procedure Unadvise;
    procedure ShowCommSettings;
    property StatusStr: string Read GetStatusStr;
    property StatusIndex: integer Read GetStatusIndex;
  published
    property OnChange: TNotifyEvent Read FOnChange Write FOnChange;
  end;
[/code]

The procedure associed to OnChange (this make crash)

[code]
procedure TForm1.Change(Sender: TObject);
begin
  Label1.Caption:=DccMan.StatusStr;
end;
[code]

[bt]
C:\lazarus\project\wince\test>..\..\..\mingw\bin\gdb project1.exe GNU gdb 6.8
Copyright (C) 2008 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html

This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law. Type "show copying" and "show warranty" for details.
This GDB was configured as "i686-pc-mingw32"...
(gdb) r
Starting program: C:\lazarus\project\wince\test/project1.exe [New thread 2080.0x66c]
[New thread 2080.0xe40]
warning: Lowest section in C:\WINWKS\system32\xpsp2res.dll is .rsrc at 20001000
[New thread 2080.0xf74]
[New thread 2080.0xc2c]
[New thread 2080.0x7a8]
[New thread 2080.0xf04]

Program received signal SIGSEGV, Segmentation fault. 0x0040a341 in fpc_popaddrstack ()
(gdb) bt
#0 0x0040a341 in fpc_popaddrstack ()
#1 0x000e62b8 in ?? ()
#2 0x004cd6df in SENDPAINTMESSAGE (CONTROLDC=0, parentfp=0x1ecfce8) at win32callback.inc:553
#3 0x004ca7d1 in WINDOWPROC (WINDOW=7800458, MSG=15, WPARAM=0, LPARAM=0) at win32callback.inc:2152
#4 0x7e418734 in USER32!GetDC () from C:\WINWKS\system32\user32.dll #5 0x0077068a in ?? ()
#6 0x0000000f in ?? ()
#7 0x00000000 in ?? ()
(gdb)
[bt]

If someone can try this exemple and return some info if work, what version Please try more connection and deconnection ...

I am competing with delphi, I want to win :)
(It works with delphi, I am wrong part :'( )

Necessary : Windows, ActiveSync and pda.

It works if you don't update the caption but rather write the string to a field or to the console. So one can assume that you cannot update the LCL from this callback, for whatever reason.

You can build a list of updates to be done and fill it and then unfill it with a timer.

This code worked for me:

  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
    DccMan: TDccMan;
    StatusStr: string;
    procedure Change(Sender: TObject);
  public
    { public declarations }
  end;

.............

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := StatusStr;
end;
procedure TForm1.Change(Sender: TObject);
begin
  StatusStr := DccMan.StatusStr;
end;

Hmmm, not very great but thanks Felipe, what version you use? I have tried with 0.9.28/FPC 2.2.4 and last svn/FPC 2.2.5 same.

I tried like you and this strange behavior when there is an event. I found a workaround, I hope this does not too unstable with the LCL

2009/10/7 Felipe Monteiro de Carvalho