Recent

Author Topic: Code compile in Delphi but not in Lazarus  (Read 10518 times)

antekgla

  • New Member
  • *
  • Posts: 22
Code compile in Delphi but not in Lazarus
« on: June 20, 2017, 09:51:25 pm »
Hi, I am new to Lazarus, before i was a begginer Delphi programmer.
I have a code compiled and tested in Delphi what give a error in Lazarus.
I want to know why.

Remarks: I have read the Code Conversion Guide and I convert the code with Lazarus automatic Delphi converted but not success.
However if I replace {$mode objfpc}{$H+} with {$Mode Delphi} the code compile fine in Lazarus, but I am curious and I want to know how to write properly in Lazarus.
The code is this:
Code: Pascal  [Select][+][-]
  1. function EnumChildProc(AHandle: hWnd; ASList: TStringList): BOOL; stdcall;
  2. // callback for EnumChildWindows.
  3. var
  4.   tmpS: string;
  5.   theClassName: string;
  6.   theWinText: string;
  7. begin
  8.       Result := True;
  9.       SetLength(theClassName, 256);
  10.       GetClassName(AHandle, PChar(theClassName), 255);
  11.       SetLength(theWinText, 256);
  12.       GetWindowText(AHandle, PChar(theWinText), 255);
  13.       SetLength(tmpS, FGLevel * 2);
  14.       FillChar(tmpS[1], Length(tmpS), ' ');
  15.       tmpS := tmpS + StrPas(PChar(theClassName));
  16.       if theWinText <> EmptyStr then
  17.         tmpS := tmpS + ' <'
  18.                 + StrPas(PChar(theWinText)) + '>'
  19.       else
  20.          tmpS := tmpS + '""';
  21.       ASList.Add(tmpS);
  22. end;
  23.  
  24. function EnumWindowsProc(AHandle: hWnd; ASList: TStringList): BOOL; stdcall;
  25. // callback for EnumWindows.
  26. var
  27.   theClassName: string;
  28.   theWinText: string;
  29.   tmpS: string;
  30. begin
  31.   Result := True;
  32.   SetLength(theClassName, 256);
  33.   GetClassName(AHandle, PChar(theClassName), 255);
  34.         SetLength(theWinText, 256);
  35.         GetWindowText(AHandle, PChar(theWinText), 255);
  36.         tmpS := StrPas(PChar(theClassName));
  37.  
  38.         if (theWinText <> EmptyStr) then
  39.            tmpS := tmpS + ' <' + StrPas(PChar(theWinText)) + '>'
  40.            else
  41.            tmpS := tmpS + '""';
  42.         ASList.Add(tmpS);
  43.         Inc(FGLevel);
  44.         EnumChildWindows(AHandle, @EnumChildProc, longInt((ASList)));
  45.         Dec(FGLevel);
  46. end;
  47.  

The error is Error: Illegal type conversion: "TStringList" to "LongInt" in the line 44.
:
Code: Pascal  [Select][+][-]
  1. EnumChildWindows(AHandle, @EnumChildProc, longInt((ASList)));

more precisely in
Code: Pascal  [Select][+][-]
  1. longInt((ASList))

I know what ASList is a StringList but what is the function of LonInt()? and why give me error in Lazarus but not in Delphi.

Thanks in advance.


marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11352
  • FPC developer.
Re: Code compile in Delphi but not in Lazarus
« Reply #1 on: June 20, 2017, 10:43:15 pm »
Well, first using {$mode delphi} is just fine.

Second any type cast of a pointer/reference type to longint (and all classes are references/pointers) is unsafe on 64-bit systems.

The proper way would be to cast to ptrint, but I'm not entirely sure that is the problem here.

Is your Delphi code already validated for 64-bit (IOW XE2, and testing it) ? Do you compile with 32-bit or 64-bit Windows here?

antekgla

  • New Member
  • *
  • Posts: 22
Re: Code compile in Delphi but not in Lazarus
« Reply #2 on: June 20, 2017, 10:48:17 pm »
Hi!
I compiled in my Windows 7 64bits with Delphi 7 and works Ok (at least for my needs).
My Lazarus is 1.6.

bobihot

  • New Member
  • *
  • Posts: 35
Re: Code compile in Delphi but not in Lazarus
« Reply #3 on: June 21, 2017, 12:22:03 am »
Delphi 7 is x32bit code system. Probably your Lazarus by default is x64. And this double size of pointer.

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: Code compile in Delphi but not in Lazarus
« Reply #4 on: June 21, 2017, 02:16:46 am »
It's easy to get it running with {$MODE OBJFPC}... but if this is the preferred way... I don't know  :)

Code: Pascal  [Select][+][-]
  1. Unit Unit1;
  2.  {$MODE OBJFPC}{$H+}
  3.  
  4. Interface
  5.  USES
  6.   Classes, SysUtils, Forms, Controls,
  7.   Windows;
  8.  
  9.  TYPE
  10.   TForm1 = Class(TForm)
  11.    Procedure FormCreate  (Sender: TObject);
  12.    Procedure FormDestroy (Sender: TObject);
  13.  
  14.     PRIVATE
  15.      ASList: TStringList;
  16.   End;
  17.  
  18.  VAR
  19.   Form1: TForm1;
  20.  
  21. Implementation
  22.  {$R *.LFM}
  23.  
  24.  
  25. Function EnumChildProc(AHandle: hWnd; LP: LParam): BOOL; StdCall;
  26.   Var
  27.    tmpS,
  28.    theWinText,
  29.    theClassName: String;
  30.  Begin
  31.   Result:= True;
  32.    SetLength     (theClassName, 256);
  33.    GetClassName  (AHandle, PChar(theClassName), 255);
  34.    SetLength     (theWinText, 256);
  35.    GetWindowText (AHandle, PChar(theWinText), 255);
  36.     //SetLength(tmpS, FGLevel);
  37.    FillChar      (tmpS[1], Length(tmpS), ' ');
  38.     tmpS:= tmpS+StrPas(PChar(theClassName));
  39.  
  40.     If theWinText <> EmptyStr
  41.     Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
  42.     Else tmpS:= tmpS+'""';
  43.  
  44.    Form1.ASList.Add(tmpS);
  45.  End;
  46.  
  47.  
  48. Function EnumWindowsProc(AHandle: hWnd; LP: LParam): BOOL; StdCall;
  49.   Var
  50.    tmpS,
  51.    theWinText,
  52.    theClassName: String;
  53.  Begin
  54.   Result := True;
  55.    SetLength     (theClassName, 256);
  56.    GetClassName  (AHandle, PChar(theClassName), 255);
  57.    SetLength     (theWinText, 256);
  58.    GetWindowText (AHandle, PChar(theWinText), 255);
  59.  
  60.     tmpS:= StrPas(PChar(theClassName));
  61.  
  62.     If (theWinText <> EmptyStr)
  63.     Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
  64.     Else tmpS:= tmpS+'""';
  65.  
  66.    Form1.ASList.Add(tmpS);
  67.     //Inc(FGLevel);
  68.    EnumChildWindows(AHandle, @EnumChildProc, 0);
  69.     //Dec(FGLevel);
  70.  End;
  71.  
  72.  
  73. Procedure TForm1.FormCreate(Sender: TObject);
  74.  Begin
  75.   ASList:= TStringList.Create;
  76.  End;
  77.  
  78. Procedure TForm1.FormDestroy(Sender: TObject);
  79.  Begin
  80.   ASList.Free;
  81.  End;
  82.  
  83. END.
  84.  
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

antekgla

  • New Member
  • *
  • Posts: 22
Re: Code compile in Delphi but not in Lazarus
« Reply #5 on: June 21, 2017, 05:25:02 am »
It's easy to get it running with {$MODE OBJFPC}... but if this is the preferred way... I don't know  :)


Thanks!
I would study this code...

ccrause

  • Hero Member
  • *****
  • Posts: 843
Re: Code compile in Delphi but not in Lazarus
« Reply #6 on: June 21, 2017, 10:27:28 am »
Quote
I know what ASList is a StringList but what is the function of LonInt()? and why give me error in Lazarus but not in Delphi.

I suspect your main issue in mode objfpc is that implicit pointer conversion of a reference is not allowed, so the following should work in mode objfpc (untested though):
Code: [Select]
EnumChildWindows(AHandle, @EnumChildProc, longint(@ASList));
This also compiles in Delphi 2007.  Also take note of marcov's message about 32/64 bit pointer issues, so following marcov's suggestion you probably need to use something more or less as follows:
Code: [Select]
EnumChildWindows(AHandle, @EnumChildProc, ptrint(@ASList));or alternatively
Code: [Select]
EnumChildWindows(AHandle, @EnumChildProc, LPARAM(@ASList));
All this casting to pointers/integers is because the EnumChildProc definition in \rtl\wininc\func.inc is:
Code: [Select]
function EnumChildWindows(hWndParent:HWND; lpEnumFunc:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL;and the LPARAM definition according to \rtl\wininc\base.inc is
Code: [Select]
LONG_PTR = PtrInt;
LPARAM = LONG_PTR;
so one can only pass some kind of pointer/integer as parameter.

To ensure that everything ties up I would also change the EnumChildProc callback as follows to show the explicit type conversions:
Code: Pascal  [Select][+][-]
  1. function EnumChildProc(AHandle: hWnd; ASListPtr: LPARAM): BOOL; stdcall;
  2. ...
  3.   TStringList(ASListPtr).Add(tmpS);
  4. end;

Note this is all untested on fpc though.

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: Code compile in Delphi but not in Lazarus
« Reply #7 on: June 21, 2017, 11:47:14 am »
Thank you very much ...
Compiles fine in LAZARUS.

Code: Pascal  [Select][+][-]
  1. Unit Unit1;
  2.  {$MODE OBJFPC}{$H+}
  3.  
  4. Interface
  5.  USES
  6.   Classes, SysUtils, Forms, Controls,
  7.   Windows;
  8.  
  9.  TYPE
  10.   TForm1 = Class(TForm)
  11.   End;
  12.  
  13.  VAR
  14.   Form1: TForm1;
  15.  
  16. Implementation
  17.  {$R *.LFM}
  18.  
  19.  
  20. Function EnumChildProc(AHandle: hWnd; ASListPtr: LPARAM): BOOL; StdCall;
  21.   Var
  22.    tmpS,
  23.    theWinText,
  24.    theClassName: String;
  25.  Begin
  26.   Result:= True;
  27.    SetLength     (theClassName, 256);
  28.    GetClassName  (AHandle, PChar(theClassName), 255);
  29.    SetLength     (theWinText, 256);
  30.    GetWindowText (AHandle, PChar(theWinText), 255);
  31.     //SetLength(tmpS, FGLevel);
  32.    FillChar      (tmpS[1], Length(tmpS), ' ');
  33.     tmpS:= tmpS+StrPas(PChar(theClassName));
  34.  
  35.     If theWinText <> EmptyStr
  36.     Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
  37.     Else tmpS:= tmpS+'""';
  38.  
  39.    TStringList(ASListPtr).Add(tmpS);
  40.  End;
  41.  
  42.  
  43. Function EnumWindowsProc(AHandle: hWnd; ASList: TStringList): BOOL; StdCall;
  44.   Var
  45.    tmpS,
  46.    theWinText,
  47.    theClassName: String;
  48.  Begin
  49.   Result:= True;
  50.    SetLength     (theClassName, 256);
  51.    GetClassName  (AHandle, PChar(theClassName), 255);
  52.    SetLength     (theWinText, 256);
  53.    GetWindowText (AHandle, PChar(theWinText), 255);
  54.  
  55.     tmpS:= StrPas(PChar(theClassName));
  56.  
  57.     If (theWinText <> EmptyStr)
  58.     Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
  59.     Else tmpS:= tmpS+'""';
  60.  
  61.    ASList.Add(tmpS);
  62.     //Inc(FGLevel);
  63.    EnumChildWindows(AHandle, @EnumChildProc, LPARAM(@ASList));
  64.     //Dec(FGLevel);
  65.  End;
  66. END.
  67.  
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

ccrause

  • Hero Member
  • *****
  • Posts: 843
Re: Code compile in Delphi but not in Lazarus
« Reply #8 on: June 21, 2017, 12:01:03 pm »
Thank you very much ...
Compiles fine in LAZARUS.
I should have tested before posting, just because it compiles doesn't mean it will work. I mixed up references and pointers to references in my previous post. Simply pass the object reference typcasted as LPARAM to the enumproc:
Code: Pascal  [Select][+][-]
  1. function EnumChildProc(AHandle: hWnd; ASList: LPARAM): BOOL; stdcall;
  2. begin
  3.   TStringList(ASList).Add('x');
  4. end;
  5.  
  6. EnumChildWindows(AHandle, @EnumChildProc, LPARAM(ASList));
  7.  

Alternatively pass a pointer, but then remember to dereference the pointer again:
Code: Pascal  [Select][+][-]
  1. function EnumChildProc(AHandle: hWnd; ASList: LPARAM): BOOL; stdcall;
  2. begin
  3.   TStringList(pointer(ASList)^).Add('x');
  4. end;
  5.  
  6. EnumChildWindows(AHandle, @EnumChildProc, LPARAM(@ASList));
  7.  

The first option seems cleaner to me.

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: Code compile in Delphi but not in Lazarus
« Reply #9 on: June 21, 2017, 12:34:55 pm »
Quote
...just because it compiles doesn't mean it will work...
Indeed...  :D
This is not my code, but now it's working fine... at least the memo is filled !!!

So thank you very much again... !!!
Code: Pascal  [Select][+][-]
  1. Unit Unit1;
  2.  {$MODE OBJFPC}{$H+}
  3.  
  4. Interface
  5.  USES
  6.   Classes, SysUtils, Forms, Controls,
  7.   Windows, StdCtrls;
  8.  
  9.  TYPE
  10.   TForm1 = Class(TForm)
  11.  
  12.    Button1: TButton;
  13.    Memo1  : TMemo;
  14.  
  15.    Procedure FormCreate   (Sender: TObject);
  16.    Procedure Button1Click (Sender: TObject);
  17.  
  18.     PRIVATE
  19.      FGLevel: Integer;
  20.   End;
  21.  
  22.  VAR
  23.   Form1: TForm1;
  24.  
  25. Implementation
  26.  {$R *.LFM}
  27.  
  28.  
  29. Function EnumChildProc(AHandle: hWnd; ASList: LPARAM): BOOL; StdCall;
  30.   Var
  31.    tmpS,
  32.    theWinText,
  33.    theClassName: String;
  34.  Begin
  35.   Result:= True;
  36.    SetLength     (theClassName, 256);
  37.    GetClassName  (AHandle, PChar(theClassName), 255);
  38.    SetLength     (theWinText, 256);
  39.    GetWindowText (AHandle, PChar(theWinText), 255);
  40.    SetLength     (tmpS, Form1.FGLevel);
  41.    FillChar      (tmpS[1], Length(tmpS), ' ');
  42.  
  43.     tmpS:= tmpS+StrPas(PChar(theClassName));
  44.  
  45.     If theWinText <> EmptyStr
  46.     Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
  47.     Else tmpS:= tmpS+'""';
  48.  
  49.    TStringList(ASList).Add(tmpS);
  50.  End;
  51.  
  52.  
  53. Function EnumWindowsProc(AHandle: hWnd; ASList: LPARAM): BOOL; StdCall;
  54.   Var
  55.    tmpS,
  56.    theWinText,
  57.    theClassName: String;
  58.  Begin
  59.   Result:= True;
  60.    SetLength     (theClassName, 256);
  61.    GetClassName  (AHandle, PChar(theClassName), 255);
  62.    SetLength     (theWinText, 256);
  63.    GetWindowText (AHandle, PChar(theWinText), 255);
  64.  
  65.     tmpS:= StrPas(PChar(theClassName));
  66.  
  67.     If (theWinText <> EmptyStr)
  68.     Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
  69.     Else tmpS:= tmpS+'""';
  70.  
  71.    TStringList(ASList).Add(tmpS);
  72.    Inc(Form1.FGLevel);
  73.    EnumChildWindows(AHandle, @EnumChildProc, LPARAM(ASList));
  74.    Dec(Form1.FGLevel);
  75.  End;
  76.  
  77.  
  78. Procedure TForm1.Button1Click(Sender: TObject);
  79.   Var
  80.    sl: TStringlist;
  81.  Begin
  82.   sl:= TStringlist.Create;
  83.    Try
  84.     EnumWindows(@EnumWindowsProc, LPARAM(sl));
  85.  
  86.     Memo1.Text:= sl.Text;
  87.    Finally
  88.     sl.Free;
  89.    End;
  90.  End;
  91.  
  92.  
  93. Procedure TForm1.FormCreate(Sender: TObject);
  94.  Begin
  95.   FGLevel:= 0;
  96.  End;
  97.  
  98. END.
  99.  

EDIT:
little snapshot...
« Last Edit: June 21, 2017, 12:41:06 pm by RAW »
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

taazz

  • Hero Member
  • *****
  • Posts: 5368
Re: Code compile in Delphi but not in Lazarus
« Reply #10 on: June 21, 2017, 02:09:47 pm »
Code: Pascal  [Select][+][-]
  1. function EnumChildProc(AHandle: hWnd; ASList: LPARAM): BOOL; stdcall;
  2. begin
  3.   TStringList(ASList).Add('x');
  4. end;
  5.  

Here is a small tip to avoid typecasting all over the procedure.
Code: Pascal  [Select][+][-]
  1. function EnumChildProc(AHandle: hWnd; ASList: LPARAM): BOOL; stdcall;
  2. var
  3.   vList :TStringList absolute ASList;
  4. begin
  5.   vList.Add('X');
  6. end;
  7.  
use it with care and preferably in long procedures with multiple type casts.
« Last Edit: June 21, 2017, 02:11:39 pm by taazz »
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: Code compile in Delphi but not in Lazarus
« Reply #11 on: June 21, 2017, 02:27:42 pm »
Thanks, nice tip... now I remember molly told me this once... this ABSOLUTE-thing...  :)
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

antekgla

  • New Member
  • *
  • Posts: 22
Re: Code compile in Delphi but not in Lazarus
« Reply #12 on: June 21, 2017, 03:51:49 pm »
Thanks all you guys!
This post was very educational....
I learn some few things  :D

Now what this code works, I find another small glitch  :-[
Sadly seems dont work with Unicode strings...
I need to extract the paths of all Explorer windows, and this works Ok but in the paths with Unicode strings only ??????? signs appear:

I made a tiny screenshots:
(my Windows is in Spanish that because the ToolbarWindow32 says "Direcci?n:" (Dirección) in your Memo probably says "Address".
« Last Edit: June 21, 2017, 03:59:16 pm by antekgla »

antekgla

  • New Member
  • *
  • Posts: 22
Re: Code compile in Delphi but not in Lazarus
« Reply #13 on: June 22, 2017, 05:33:44 am »
I manage to adapt this code to Unicode thanks to this post.

If anyone is interested this is the code. ( Based in the code of RAW )

Code: Pascal  [Select][+][-]
  1. Unit Unit1;
  2.  {$MODE OBJFPC}{$H+}
  3.  
  4. Interface
  5.  USES
  6.   Classes, SysUtils, Forms, Controls,
  7.   Windows, StdCtrls;
  8.  
  9.  TYPE
  10.   TForm1 = Class(TForm)
  11.  
  12.    Button1: TButton;
  13.    Memo1  : TMemo;
  14.  
  15.    Procedure FormCreate   (Sender: TObject);
  16.    Procedure Button1Click (Sender: TObject);
  17.  
  18.     PRIVATE
  19.      FGLevel: Integer;
  20.   End;
  21.  
  22.  VAR
  23.   Form1: TForm1;
  24.  
  25. Implementation
  26.  {$R *.LFM}
  27.  
  28.  
  29. Function EnumChildProc(AHandle: hWnd; ASList: LPARAM): BOOL; StdCall;
  30.   Var
  31.    tmpS,
  32.    theClassName: String;
  33.    theWinText: UnicodeString;
  34.    l: longInt;
  35.  Begin
  36.   Result:= True;
  37.    SetLength     (theClassName, 256);
  38.    GetClassName  (AHandle, PChar(theClassName), 255);
  39.  
  40.    l := Windows.GetWindowTextLengthW(AHandle);
  41.    SetLength(theWinText, l);
  42.    l := Windows.GetWindowTextW(AHandle, @theWinText[1], l+2);
  43.    SetLength(theWinText, l);
  44.  
  45.    SetLength     (tmpS, Form1.FGLevel);
  46.    FillChar      (tmpS[1], Length(tmpS), ' ');
  47.  
  48.     tmpS:= tmpS+StrPas(PChar(theClassName));
  49.  
  50.     If theWinText <> EmptyStr
  51.     Then tmpS:= tmpS+' <'+Utf8Encode(theWinText)+'>'
  52.     Else tmpS:= tmpS+'""';
  53.  
  54.    TStringList(ASList).Add(tmpS);
  55.  End;
  56.  
  57.  
  58. Function EnumWindowsProc(AHandle: hWnd; ASList: LPARAM): BOOL; StdCall;
  59.   Var
  60.    tmpS,
  61.    theClassName: String;
  62.    theWinText: UnicodeString;
  63.    l: longInt;
  64.  Begin
  65.   Result:= True;
  66.    SetLength     (theClassName, 256);
  67.    GetClassName  (AHandle, PChar(theClassName), 255);
  68.  
  69.    l := Windows.GetWindowTextLengthW(AHandle);
  70.    SetLength(theWinText, l);
  71.    l := Windows.GetWindowTextW(AHandle, @theWinText[1], l+2);
  72.    SetLength(theWinText, l);
  73.  
  74.     tmpS:= StrPas(PChar(theClassName));
  75.  
  76.     If (theWinText <> EmptyStr)
  77.     Then tmpS:= tmpS+' <'+Utf8Encode(theWinText)+'>'
  78.     Else tmpS:= tmpS+'""';
  79.  
  80.    TStringList(ASList).Add(tmpS);
  81.    Inc(Form1.FGLevel);
  82.    EnumChildWindows(AHandle, @EnumChildProc, LPARAM(ASList));
  83.    Dec(Form1.FGLevel);
  84.  End;
  85.  
  86.  
  87. Procedure TForm1.Button1Click(Sender: TObject);
  88.   Var
  89.    sl: TStringlist;
  90.  Begin
  91.   sl:= TStringlist.Create;
  92.    Try
  93.     EnumWindows(@EnumWindowsProc, LPARAM(sl));
  94.  
  95.     Memo1.Text:= sl.Text;
  96.    Finally
  97.     sl.Free;
  98.    End;
  99.  End;
  100.  
  101.  
  102. Procedure TForm1.FormCreate(Sender: TObject);
  103.  Begin
  104.   FGLevel:= 0;
  105.  End;
  106.  
  107. END.
  108.  

For some weird reason I have to modify lightly the code in the other post like this:

Quote
   l := Windows.GetWindowTextW(AHandle, @theWinText[1], l+2);

because the result was truncated in the last character (2 bytes).

Remy Lebeau

  • Hero Member
  • *****
  • Posts: 1311
    • Lebeau Software
Re: Code compile in Delphi but not in Lazarus
« Reply #14 on: June 22, 2017, 07:14:56 pm »
For some weird reason I have to modify lightly the code in the other post like this:

Quote
   l := Windows.GetWindowTextW(AHandle, @theWinText[1], l+2);

because the result was truncated in the last character (2 bytes).

GetWindowText() expects you to specify the size of the buffer, *in chars, including the null terminator*.  You need to use +1 instead of +2, otherwise you are giving GetWindowText() permission to copy more chars than you have actually allocated room for.  The return value of GetWindowTextLength() does not include the null terminator.

I would do something more like the following instead:

Code: [Select]
unit Unit1;

{$MODE OBJFPC}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls,
  Windows, StdCtrls;

type
  TForm1 = Class(TForm)
    Button1: TButton;
    Memo1  : TMemo;
    Procedure Button1Click (Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.LFM}

function GetWindowClassName(AHandle: HWND): string;
begin
  SetLength(Result, 255);
  SetLength(Result, GetClassName(AHandle, PChar(Result), Length(Result)+1));
end;

function GetWindowText(AHandle: HWND): UnicodeString;
var
  l: Integer;
begin
  Result := '';
  l := Windows.GetWindowTextLengthW(AHandle);
  if l > 0 then
  begin
    SetLength(Result, l);
    SetLength(Result, Windows.GetWindowTextW(AHandle, PWideChar(Result), l+1));
  end;
end;

type
  PMyEnumInfo = ^MyEnumInfo;
  MyEnumInfo = record
    Strings: TStrings;
    FGLevel: Integer;
  end;

procedure AddWindowToList(AHandle: HWND: var AInfo: MyEnumInfo);
var
  tmpS: string;
  theWinText: UnicodeString;
begin
  tmpS := StringOfChar(' ', AInfo.FGLevel) + GetWindowClassName(AHandle);
  theWinText := GetWindowText(AHandle);
  if theWinText <> '' Then
    tmpS := tmpS + ' <' + Utf8Encode(theWinText) + '>'
  else
    tmpS := tmpS + ' ""';
  AInfo.Strings.Add(tmpS);
end;

function EnumChildProc(AHandle: HWND; AParam: LPARAM): BOOL; stdcall;
begin
  Result := True;
  AddWindowToList(AHandle, PMyEnumInfo(AParam)^);
end;

function EnumWindowsProc(AHandle: HWND; AParam: LPARAM): BOOL; stdcall;
var
  MyInfo: PMyEnumInfo;
  { alternatively:
  MyInfo: PMyEnumInfo absolute AParam;
  }
begin
  Result := True;
  MyInfo := PMyEnumInfo(AParam); // <-- omit this if using 'absolute' above
  AddWindowToList(AHandle, MyInfo^);
  Inc(MyInfo.FGLevel);
  EnumChildWindows(AHandle, @EnumChildProc, AParam);
  Dec(MyInfo.FGLevel);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyInfo: MyEnumInfo;
begin
  MyInfo.Strings := TStringList.Create;
  try
    MyInfo.FGLevel := 0;
    EnumWindows(@EnumWindowsProc, LPARAM(@MyInfo));
    Memo1.Lines.Assign(MyInfo.Strings);
  finally
    MyInfo.Strings.Free;
  end;

  { alternatively:
  Memo1.Lines.BeginUpdate;
  try
    Memo1.Clear;
    MyInfo.Strings := Memo1.Lines;
    MyInfo.FGLevel := 0;
    EnumWindows(@EnumWindowsProc, LPARAM(@MyInfo));
  finally
    Memo1.Lines.EndUpdate;
  end;
  }
end;

end.
« Last Edit: June 23, 2017, 01:58:41 am by Remy Lebeau »
Remy Lebeau
Lebeau Software - Owner, Developer
Internet Direct (Indy) - Admin, Developer (Support forum)

 

TinyPortal © 2005-2018