tw2177.pp 1.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465
  1. { %version=1.1 }
  2. { Source provided for Free Pascal Bug Report 2177 }
  3. { Submitted by "Rimgaudas" on 2002-10-14 }
  4. { e-mail: [email protected] }
  5. {$ifdef fpc}{$mode delphi}{$endif}
  6. uses
  7. SysUtils;
  8. type
  9. ii= interface
  10. ['{616D9683-88DC-4D1C-B847-1293DDFBACF7}']
  11. procedure Show;stdcall;
  12. end;
  13. Twii= class(TObject, ii)
  14. s: string;
  15. function QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
  16. function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
  17. function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
  18. procedure Show;stdcall;
  19. end;
  20. {________doomy interfaces______}
  21. function Twii.QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
  22. begin
  23. result:= -1;
  24. end;
  25. function Twii._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
  26. begin
  27. result:= -1;
  28. end;
  29. function Twii._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
  30. begin
  31. result:= -1;
  32. end;
  33. {________doomy interfaces______}
  34. procedure Twii.Show;stdcall;
  35. begin
  36. WriteLn(s);
  37. end;
  38. var
  39. wii: twii;
  40. i: ii;
  41. begin
  42. try
  43. wii:= Twii.create;
  44. wii.s:='OK';
  45. i:= ii(wii);
  46. i.Show;
  47. except //excepts
  48. on EInvalidCast do WriteLn('Invalid Cast');
  49. else
  50. WriteLn('Problem');
  51. halt(1);
  52. end;
  53. end.