[Lazarus] Lazarus COM Event on Windows

wile64 wile64 at gmail.com
Tue Oct 6 14:21:15 CEST 2009


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]

-- 
Laurent.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20091006/b501c25d/attachment-0004.html>


More information about the Lazarus mailing list