RegisterClassA SegFault

[paule32]

Hello,
how can I call RegisterClassA to register a window class ?

Code: Pascal  [Select][+][-]

1. type
2.   TWndClassA = packed record
3.     style: UINT;
4.     lpfnWndProc: TFNWndProc;
5.     cbClsExtra: Integer;
6.     cbWndExtra: Integer;
7.     hInstance: HINST;
8.     hIcon: HICON;
9.     hCursor: HCURSOR;
10.     hbrBackground: HBRUSH;
11.     lpszMenuName: PAnsiChar;
12.     lpszClassName: PAnsiChar;
13.   end;
14.   PWndClassA = ^TWndClassA;
15.  
16. function RegisterClassA(const lpWndClass: PWNDCLASSA): ATOM; stdcall; external 'user32.dll' name 'RegisterClassA';
17.  
18. function TWinControl_Create(p: TWinControl): TWinControl; stdcall; export;
19. var
20.   _msg: TMsg;
21.   err : DWORD;
22.   WndClass: TWndClassA;
23.   className: AnsiString;
24.  
25.   function IsClassRegistered(cName: PAnsiChar; hInst: HINSTANCE): BOOL;
26.   begin
27.     if GetClassInfoA(hInst, cName, @WndClass) then
28.     begin
29.       writeln('ClassInfo: ' + IntToStr(GetLastError));
30.       Exit(true);
31.     end else
32.     Exit(false);
33.   end;
34. begin
35.   {$ifdef DLLDEBUG}
36.   writeln('TWinControl: Create');
37.   {$endif DLLDEBUG}
38.  
39.   if p = nil then
40.   begin
41.     ShowError(sError_TWinControl_ref);
42.     exit(nil);
43.   end;
44.  
45.   className := 'MyWindowClass';
46.  
47.   //FillChar(WndClass, sizeof(TWndClassA), 0);
48.   //WndClass.cbSize          := sizeof(TWndClassExA);
49.   WndClass.style           := CS_HREDRAW or CS_VREDRAW;
50.   WndClass.lpfnWndProc     := @GlobalWndProc;
51.   WndClass.cbClsExtra      := 0;
52.   WndClass.cbWndExtra      := 0;
53.   WndClass.hInstance       := hInstanceDLL;
54.   WndClass.hIcon           := LoadIconA  (0, PAnsiChar(32512));
55.   WndClass.hCursor         := LoadCursorA(0, PAnsiChar(32512));
56.   WndClass.hbrBackground   := HBRUSH(COLOR_WINDOW + 1);
57.   WndClass.lpszMenuName    := nil;
58.   WndClass.lpszClassName   := PAnsiChar(className);
59.   //WndClass.hIconSm         := 0;
60.  
61.   if WndClass.hInstance <> 0 then
62.   ShowMessage('size: ' + IntToStr(Integer(hInstanceDLL)));
63.  
64.   if @WndClass.lpfnWndProc = nil then
65.   ShowMessage('gfe = nil');
66.  
67.   ShowMessage('len: ' + IntToStr(StrLen(WndClass.lpszClassName)));
68.  
69.   //if IsClassRegistered(WndClass.lpszClassName, hInstanceDLL) then
70.   begin
71.     writeln('unregister class.');
72.     UnregisterClassA(PAnsiChar(ClassName), hInstanceDLL);
73.   end;
74.  
75. writeln('last error   : ' + IntToStr(GetLastError));
76. //writeln('cbSize       : ' + IntToStr(WndClass.cbSize));
77. writeln('lpfnWndProc  : ' + IntToStr(Integer(PtrUInt(@WndClass.lpfnWndProc))));
78. writeln('lpszClassName: ' + WndClass.lpszClassName);
79. writeln('hInstance    : ' + IntToStr(Integer(WndClass.hInstance)));
80.  
81.  
82.   if RegisterClassA(@WndClass) = 0 then
83.   begin
84.     writeln('DLL error: ' + IntToStr(GetLastError));
85.     Halt(255);
86.   end;
87. end;

and I get this debug bt:

Code: Bash  [Select][+][-]

1. unregister class.
2. last error   : 1411
3. lpfnWndProc  : 268457792
4. lpszClassName: MyWindowClass
5. hInstance    : 268435456
6.  
7. Thread 1 received signal SIGSEGV, Segmentation fault.
8. 0x00007ff814d9a496 in USER32!MBToWCSEx () from C:\Windows\System32\user32.dll
9. (gdb) bt
10. #0  0x00007ff814d9a496 in USER32!MBToWCSEx () from C:\Windows\System32\user32.dll
11. #1  0x00007ff814d81597 in USER32!CreateWindowExW () from C:\Windows\System32\user32.dll
12. #2  0x00007ff814d965b5 in USER32!RegisterClassA () from C:\Windows\System32\user32.dll
13. #3  0x00007ff814d9651f in USER32!RegisterClassA () from C:\Windows\System32\user32.dll
14. #4  0x0000000110005b86 in TWINCONTROL_CREATE (P=0x11001d598) at Forms.pas:502
15. #5  0x0000000100001b1d in CREATE (this=0x11001d598, vmt=0x0) at Forms.pas:779
16. #6  0x0000000100001c14 in CREATE (this=0x11001d598, vmt=0x0) at Forms.pas:802
17. #7  0x0000000100001d14 in CREATE (this=0x11001d598, vmt=0x0) at Forms.pas:815
18. #8  0x0000000100001e14 in CREATE (this=0x11001d598, vmt=0x1) at Forms.pas:830
19. #9  0x00000001000012aa in main () at test.pas:17
20. (gdb)

[Remy Lebeau]

Win32 API structures use quadword (8-byte) alignment, not byte (1-byte) alignment. Get rid of the packed directive on your TWndClassA type.

That being said, why are you manually registering a window class that is later created by a TWinControl? TWinControl does its own class registration.  If you want to customize that registration, then derive a new component from TWinControl and override its virtual CreateParams() method.

[Khrys]

In addition to what @Remy said, I'd also recommend using  {$packrecords C}  since Win32 is a C-based API:

Code: Pascal  [Select][+][-]

1. {$push}{$packrecords C}
2.  
3. TWndClassA = record
4.     style: UINT;                // SizeOf(UINT = Cardinal)      -> 4
5.     lpfnWndProc: TFNWndProc;    // SizeOf(TFNWndProc = Pointer) -> 8
6.     cbClsExtra: Integer;        // SizeOf(Integer)              -> 4
7.     cbWndExtra: Integer;        // SizeOf(Integer)              -> 4
8.     hInstance: HINST;           // SizeOf(HINST = Cardinal)     -> 4
9.     hIcon: HICON;               // SizeOf(HICON = Cardinal)     -> 4
10.     hCursor: HCURSOR;           // SizeOf(HCURSOR = Cardinal)   -> 4
11.     hbrBackground: HBRUSH;      // SizeOf(HBRUSH = Cardinal)    -> 4
12.     lpszMenuName: PAnsiChar;    // SizeOf(PAnsiChar = ^Char)    -> 8
13.     lpszClassName: PAnsiChar;   // SizeOf(PAnsiChar = ^Char)    -> 8
14.   end;
15.  
16. {$pop}

Seeing that the segfault is ultimately caused by  USER32!MBToWCSEx  (multi-byte string to wide string conversion) as indicated by the stack trace, here's what I think must've happened. Look how the layout of the record fields in memory changes between packed and unpacked variants:

Code: Text  [Select][+][-]

1. OFFSET  PACKED (Size = 52)      NOT PACKED (Size = 56)
2.  
3. +0x00   +-------+               +-------+
4. +0x01   | style |               | style |
5. +0x02   |       |               |       |
6. +0x03   +-------+               +-------+
7. +0x04   +-------------+        
8. +0x05   |             |        
9. +0x06   |             |        
10. +0x07   | lpfnWndProc |        
11. +0x08   |             |         +-------------+
12. +0x09   |             |         |             |
13. +0x0A   |             |         |             |
14. +0x0B   +-------------+         | lpfnWndProc |
15. +0x0C   +------------+          |             |
16. +0x0D   | cbClsExtra |          |             |
17. +0x0E   |            |          |             |
18. +0x0F   +------------+          +-------------+
19. +0x10   +------------+          +------------+  
20. +0x11   | cbWndExtra |          | cbClsExtra |  
21. +0x12   |            |          |            |  
22. +0x13   +------------+          +------------+  
23. +0x14   +-----------+           +------------+  
24. +0x15   | hInstance |           | cbWndExtra |  
25. +0x16   |           |           |            |  
26. +0x17   +-----------+           +------------+  
27. +0x18   +-------+               +-----------+    
28. +0x19   | hIcon |               | hInstance |    
29. +0x1A   |       |               |           |    
30. +0x1B   +-------+               +-----------+    
31. +0x1C   +---------+             +-------+        
32. +0x1D   | hCursor |             | hIcon |        
33. +0x1E   |         |             |       |        
34. +0x1F   +---------+             +-------+        
35. +0x20   +---------------+       +---------+      
36. +0x21   | hbrBackground |       | hCursor |      
37. +0x22   |               |       |         |      
38. +0x23   +---------------+       +---------+      
39. +0x24   +--------------+        +---------------+
40. +0x25   |              |        | hbrBackground |
41. +0x26   |              |        |               |
42. +0x27   | lpszMenuName |        +---------------+
43. +0x28   |              |        +--------------+
44. +0x29   |              |        |              |
45. +0x2A   |              |        |              |
46. +0x2B   +--------------+        | lpszMenuName |
47. +0x2C   +---------------+       |              |
48. +0x2D   |               |       |              |
49. +0x2E   |               |       |              |
50. +0x2F   | lpszClassName |       +--------------+
51. +0x30   |               |       +---------------+
52. +0x31   |               |       |               |
53. +0x32   |               |       |               |
54. +0x33   +---------------+       | lpszClassName |
55. +0x34                           |               |
56. +0x35                           |               |
57. +0x36                           |               |
58. +0x37                           +---------------+

Since Win32 expects the record to be unpacked, it accesses memory at the offsets from the right column (e.g.  lpfnWndProc  is expected at offset  +0x08,  not  +0x04. This completely garbles and shifts the actual information:

• style  remains as it is
• lpfnWndProc  contains the high half of the intended address mixed with  cbClsExtra  - very bad, will  cause a segfault once the window procedure is called
• cbClsExtra  takes on the value of  cbWndExtra
• cbWndExtra  takes on the value of  hInstance
• hInstance  takes on the value of  hIcon
• hIcon  takes on the value of  hCursor
• hCursor  takes on the value of  hbrBackground
• hbrBackground  contains the low bits of  lpszMenuName  (address bits, aka garbage)
• lpszMenuName  combines the bits of two pointers in a very wrong way and will likely end up pointing to invalid memory; this is probably what causes the segfault when Win32 attempts to convert it into a wide string
• lpszClassName  like  lpszMenuName,  except that it contains random garbage from uninitialized memory past the end of the packed record as well

[paule32]

Thank you all for the replies.
I solved the Problem with my (okay in co operation with fibodev/fibonacci) system.pas by changing the types:

Code: Pascal  [Select][+][-]

1. type
2.   {$ifdef CPU64}
3.   THandle: NativeInt;
4.   {$else}
5.   THandle: LongWord;
6.   {$endif}
7.   HICON: THandle;
8.   ...

So, the TWndClassExA is now 80 Bytes as else before 64 Bytes.