How to: create DLL file for Windows 10 64-Bit Pro

[paule32]

Hello @rvk,

since the project is open source, yet - you can provide an version that can be used for all developers.
Then I could see, to involve you in the project development.
So, you are part of my (our) team.

As such, you could provide a unit developer test case with scripting a PowerShell GUI application.
So, the normal user don't need know all the underlying things of the compiler stage.

As such, you could provide a base developer setup based on the available tools under Windows
like the PowerShell (it is free and for Windows, a great tool).

Then, you could make a setup for the sed, awk, and other tools, set the current paths...

This are not trivial things for normal developer or for beginners that would look behind the stages
of FPC - since I doing reverse engineering a while, and begin to think, to understand the one and
the other things that/what the ideas stand for.

For me, FPC and the internals are very great things for learning reverse engineering.
But they are not trivial - so you have to understood the assembly, and the three-addressing coding
and the 3-coding assembly converting to 2-coding assembly.

This can be limited by the different CPU's instruction set's.

Not to say to the eastern egg's in the internals of the FP Compiler... 

[KodeZwerg]

But when binary filesize the only reason that you worry about, why not do it with a compiler that produce smallest files?
In my experiences assembler and/or C compilers resulting, after exepacked, to be the smallest binaries.
While assembler needs an experienced developer C is pretty easy to learn for any average developer.
In both cases you do not need to modify a working RTL, while in assembly only what you typed will be compiled in C the variant about sizes is really good.
The assembly compiled without exepacking may result in a bigger filesize due padding than the C compiler does do but after packing the winner is asm.

While we talk about sizes, what are the filesizes in your experimental setup?
Compile size original FPC: X byte
Compile size modified FPC: X byte
where original means a total unmodified setup with same compiler version, eg, 3.2.2.2, just compiled in a normal way
and modified stand for your custom RTL and the way how you compile and link but with same compiler version

[paule32]

@KodeZwerg:

- I use FPC 3.2.0 in it's original version - no changes, no patches,
- I let FPC to compile my own customized system.pas

- the size of EXE including debugger symbols is about: 10.600 Bytes
- after strip: 7.160 Bytes
- after upx: 4.096 Bytes

- the size of DLL including debugger symbols is about: 31.100 Bytes
- after strip: 15.360 Bytes

[marcov]

If you really are concerned with size, why don't try 16-bit windows? 64-bit is relatively bulky and trunk supports win3.x

[paule32]

@markov:
don't think over of what I do.
It is my hobby to waste time with doing not standard thinks, and things. 

I did some research and found following gap:

I have the following code snippet:

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

1. {$mode delphi}
2. program test1;
3.  
4. type
5.     TTestTest = procedure(); stdcall;
6.    
7. procedure Entry; stdcall; public name '_mainCRTStartup';
8. var
9.     s1, s2: String;
10.     p1, p2: PChar;
11.     hm: HMODULE;
12.     ap: TTestTest;
13.     p : Pointer;
14. begin
15.     s1 := 'mufo   Lo aalo';
16.     s2 := 'Hello World  --> ' + s1;
17.     MessageBox(0,s2,s1,0);
18.  
19.     HM := LoadLibrary('fpc_rtl.dll');
20.     if @HM = nil then begin
21.         MessageBox(0,'dll error','Error',0);
22.         ExitProcess(0);
23.     end else begin
24.         MessageBox(0,'dll load ok','Information',0);
25.         p := GetProcAddress(hm, 'P$FPC_RTL_$$_TESTTEST');
26.         ap := @P;
27.         if @p = nil then begin
28.             MessageBox(0,'getprocaddress error','Error',0);
29.             FreeLibrary(HM);
30.             ExitProcess(0);
31.         end else begin
32.             MessageBox(0,'start22','info',0);
33.  
34. // !!!
35. // take care of the methods above, and below:
36. // !!!
37.             ap;   // <-- this line;
38.  
39.             MessageBox(0,'start2 1111 222','info',0);
40.         end;
41.     end;
42.     FreeLibrary(HM);
43.    
44.     ExitProcess(0);
45. end;
46.  
47. begin
48. end.

The following snippet shows the disassembly of this snippet:

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

1. ...
2. ..@j13:
3.                 xor     r9d,r9d
4.                 lea     r8,[..@d6]
5.                 lea     rdx,[..@d7]
6.                 xor     ecx,ecx
7.                 call    _$dll$user32$MessageBoxA
8.                 mov     rcx,qword [rbp-24]
9.                 lea     rdx,[..@d8]
10.                 call    _$dll$kernel32$GetProcAddress
11.                 mov     qword [rbp-32],rax
12.                 lea     rbx,[rbp-32]   <--- then only place where [b]RBX[/b] is assigned
13.                 lea     rax,[rbp-32]
14.                 test    rax,rax
15.                 jne     ..@j16
16.  
17. ...
18. .text:000000014000111A __@j16:                                 ; CODE XREF: P$TEST1_$$_ENTRY+CB↑j
19. .text:000000014000111A                 xor     r9d, r9d
20. .text:000000014000111D                 lea     r8, __@d10      ; "info"
21. .text:0000000140001124                 lea     rdx, __@d11     ; "start22"
22. .text:000000014000112B                 xor     ecx, ecx
23. .text:000000014000112D                 call    _$dll$user32$MessageBoxA
24.  
25. // !!!
26. // the following line is the above described line of:   ap;
27. // !!!
28. .text:0000000140001132                 call    rbx
29.  
30. .text:0000000140001134                 xor     r9d, r9d
31. .text:0000000140001137                 lea     r8, __@d10      ; "info"
32. .text:000000014000113E                 lea     rdx, __@d12     ; "start2 1111 222"
33. .text:0000000140001145                 xor     ecx, ecx
34. .text:0000000140001147                 call    _$dll$user32$MessageBoxA

where, and who is calling RBX ?

This is, what GDB says to me:

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

1. Type "apropos word" to search for commands related to "word"...
2. Reading symbols from ./test1.exe...
3. (No debugging symbols found in ./test1.exe)
4. (gdb) bt
5. No stack.
6. (gdb) r
7. Starting program: E:\Projekte\fpc-qt\src\tests\test1.exe
8. [New Thread 2748.0x5884]
9. [New Thread 2748.0x5878]
10. [New Thread 2748.0x47fc]
11. [New Thread 2748.0x5ef4]
12. [New Thread 2748.0x5a18]
13.  
14. Thread 1 received signal SIGSEGV, Segmentation fault.
15. 0x00000000005fff00 in ?? ()
16. (gdb) bt
17. #0  0x00000000005fff00 in ?? ()
18.  
19.  
20. ###################################
21. # there, the back trace is 2 counts before afte "call rbx" is called:
22.  
23. #1  0x00007ff65b851134 in _mainCRTStartup ()
24. (gdb) disassemble
25. No function contains program counter for selected frame.
26. (gdb)

[paule32]

on building a DLL, I get in next trouble, and I don't know why:
- I have an extra file where the type def's of some custom types are present.
- in foo.pas, I have a line:  type NTSTATUS = LongInt;

- in a second file: bar.pas, a library declared file
- in bar.pas, I include the foo.pas with {$I foo.pas}
- the file will be include
- the file path settings are okay

- when I try to use NTSTATUS within a procedure:

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

1. procedure test;
2. var
3.   status: NTSTATUS;
4. begin
5. end;

I get fpc error, that NTSTATUS is not declared identifier.

- when I (re-declare) the type NTSTATUS = LongInt; in bar.pas, I get no errors.

What is going on there ?
A next eastern egg of the compiler ?

[paule32]

how can I implement WriteFile ?

I have:

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

1. type PVOID = Pointer;
2. type LPVOID = ^PVOID;
3. type LPCVOID = ^LPVOID;
4.  
5. function WriteFile(
6.     hFile         : HANDLE;
7.     lpBuffer      : LPCVOID;
8.     nBytesToWrite : DWORD;
9.     nBytesWritten : DWORD;
10.     lpOverlapped  : DWORD): BOOL;
11.     stdcall; external 'kernel32.dll' name 'WriteFile';
12. ...
13. hFile := CreateFile(
14. 'fpc_rtl.$$$',          // name of the file
15. GENERIC_WRITE,          // open for writing
16. 0,                      // do not share
17. 0,                      // default security
18. CREATE_NEW,             // create new file only
19. FILE_ATTRIBUTE_NORMAL,  // normal file
20. 0);
21. if GetLastError = ERROR_INVALID_HANDLE then begin
22.     MessageBox(0,
23.     'file: fpc_rtl.$$$ could not be write.',
24.     'Error', 0);
25.     ExitProcess(1);
26. end;
27. bytesRead := 6;
28. buff := 'buffer';
29. MessageBox(0,'xxxx','dsddd',0);
30. WriteFile(hFile, LPCVOID(@buff[1]), bytesRead, bytesWritten, 0);
31. MessageBox(0,'xxxx','dsddd',0);
32. CloseHandle(hFile);
33. ...

the file will be created, but the text "buffer" is not included.
Why ?

[rvk]

LPCVOID is a pointer to a pointer to a pointer 

What type is buff?
What is the result of bytesWritten?

[440bx]

As @rvk pointed out above, there are several problems with your function definition. 

Try this one:

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

1. type
2.   { _OVERLAPPED                                                               }
3.  
4.   PPOVERLAPPED = ^POVERLAPPED;
5.   POVERLAPPED  = ^TOVERLAPPED;                        { kernel32 name         }
6.   TOVERLAPPED  = record
7.     Internal      : ptruint;
8.     InternalHigh  : ptruint;
9.  
10.     Union         : record
11.       case integer of
12.         1 : (
13.              Offset     : DWORD;
14.              OffsetHigh : DWORD;
15.             );
16.  
17.         2 : (
18.              ptr        : pointer;                   { renamed from "pointer" }
19.             );
20.     end;
21.  
22.     hEvent        : THANDLE;
23.   end;
24.  
25.   PDWORD = ^DWORD;
26.  
27. function WriteFile
28.            (
29.             { _in_              } InFile                  : THANDLE;
30.             { _in_        const } InBuffer                : pointer;
31.             { _in_              } InNumberOfBytesToWrite  : DWORD;
32.             { _out_             } OutNumberOfBytesWritten : PDWORD;
33.             { _inout_opt_       } InoutoptOverlapped      : POVERLAPPED
34.            )
35.          : BOOL; stdcall; external kernel32;

[TRon]

how can I implement WriteFile ?

Free Pascal comes with packages/units. Interesting reads there, including an answer to that question.

the file will be created, but the text "buffer" is not included.
Why ?

More interesting would be to know why your code did not crash (hint: it should have).

[KodeZwerg]

how can I implement WriteFile ?

By looking how microsoft has designed it to be.

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

1. type
2.   DWORD = Cardinal;
3.   ULONG_PTR = {$IFDEF WIN32} Cardinal {$ENDIF} {$IFDEF WIN64} UInt64 {$ENDIF};
4.   LongBool = False..Boolean(4294967295);
5.   BOOL = LongBool;
6.   THandle = {$IFDEF WIN32} Cardinal {$ENDIF} {$IFDEF WIN64} UInt64 {$ENDIF};
7.   POverlapped = ^TOverlapped;
8.   _OVERLAPPED = record
9.     Internal: ULONG_PTR;
10.     InternalHigh: ULONG_PTR;
11.     Offset: DWORD;
12.     OffsetHigh: DWORD;
13.     hEvent: THandle;
14.   end;
15.   TOverlapped = _OVERLAPPED;
16.  
17. // https://learn.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile
18. {BOOL WriteFile(
19.   [in]                HANDLE       hFile,
20.   [in]                LPCVOID      lpBuffer,
21.   [in]                DWORD        nNumberOfBytesToWrite,
22.   [out, optional]     LPDWORD      lpNumberOfBytesWritten,
23.   [in, out, optional] LPOVERLAPPED lpOverlapped
24. );}
25. // If the function succeeds, the return value is nonzero (TRUE).
26. function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external 'kernel32.dll' name 'WriteFile';

[440bx]

By looking how microsoft has designed it to be.

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

1. function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external 'kernel32.dll' name 'WriteFile';
2.  

And the definition of WriteFile you showed violates the advice you gave.

WriteFile's Buffer parameter should NOT be untyped.  That is incorrect.

Also, the lpNumberOfBytesWritten should NOT be a "var" parameter because, except in Windows 7, that parameter is optional, therefore it should be typed as a _pointer_ to DWORD.

[KodeZwerg]

Here is my working testcode, no units included.

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

1. program project1;
2.  
3. {$APPTYPE CONSOLE}
4.  
5. type
6.   LPCSTR = PAnsiChar;
7.   DWORD = Cardinal;
8.   ULONG_PTR = UInt64;
9.   LongBool = False..Boolean(4294967295);
10.   BOOL = LongBool;
11.   THandle = {$IFDEF WIN32} Cardinal {$ENDIF} {$IFDEF WIN64} UInt64 {$ENDIF};
12.   POverlapped = ^TOverlapped;
13.   _OVERLAPPED = record
14.     Internal: ULONG_PTR;
15.     InternalHigh: ULONG_PTR;
16.     Offset: DWORD;
17.     OffsetHigh: DWORD;
18.     hEvent: THandle;
19.   end;
20.   TOverlapped = _OVERLAPPED;
21.   PSecurityAttributes = ^TSecurityAttributes;
22.   _SECURITY_ATTRIBUTES = record
23.     nLength: DWORD;
24.     lpSecurityDescriptor: Pointer;
25.     bInheritHandle: BOOL;
26.   end;
27.   TSecurityAttributes = _SECURITY_ATTRIBUTES;
28.  
29. const
30.   GENERIC_WRITE = $40000000;
31.   FILE_SHARE_READ = $00000001;
32.   FILE_SHARE_WRITE = $00000002;
33.   CREATE_NEW = 1;
34.   OPEN_EXISTING = 3;
35.   FILE_END = 2;
36.   FILE_ATTRIBUTE_NORMAL = $00000080;
37.   INVALID_HANDLE_VALUE = THandle(-1);
38.  
39. function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external 'kernel32.dll' name 'WriteFile';
40. function CreateFileA(lpFileName: LPCSTR; dwDesiredAccess, dwShareMode: DWORD; lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD; hTemplateFile: THandle): THandle; stdcall; external 'kernel32.dll' name 'CreateFileA';
41. function SetFilePointer(hFile: THandle; lDistanceToMove: Longint; lpDistanceToMoveHigh: Pointer; dwMoveMethod: DWORD): DWORD; stdcall; external 'kernel32.dll' name 'SetFilePointer';
42. function CloseHandle(hObject: THandle): BOOL; stdcall; external 'kernel32.dll' name 'CloseHandle';
43.  
44. procedure AppendToFile(const AFileName: string; AData: PAnsiChar);
45. var
46.   hFile: THandle;
47.   cnt: Cardinal;
48.   DataSize: Integer;
49. begin
50.   DataSize := StrLen(AData);
51.   hFile := CreateFileA(PAnsiChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
52.              OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
53.   if (hFile = INVALID_HANDLE_VALUE) then
54.       hFile := CreateFileA(PAnsiChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
55.                  CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
56.   if (hFile <> INVALID_HANDLE_VALUE) then
57.     begin
58.       SetFilePointer(hFile, 0, nil, FILE_END);
59.       WriteFile(hFile, AData^, DataSize, cnt, nil);
60.       CloseHandle(hFile);
61.     end;
62. end;
63.  
64. begin
65.   AppendToFile('test.txt', 'Hello World.');
66.   ReadLn;
67. end.

[paule32]

Hello 

I did a 1:1 copy of @KodeZwerg's test case.
Under Microsoft Windows 11 64-Bit Professional, I get a crash, after the MessageBox at Line:
https://github.com/paule32/Qt_FPC/blob/main/src/tests/fpc_rtl.pas#L70

is reached.
So, something happends - but what ?

[KodeZwerg]

I did a 1:1 copy of @KodeZwerg's test case.

I am not aware about how you implemented MessageBox() so I added that and GetLastError and two constants to have a minimal feedback.
Now after each operation you get a messagebox saying success or failed.

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

1. program project1;
2.  
3. {$APPTYPE CONSOLE}
4.  
5. type
6.   LPCSTR = PAnsiChar;
7.   DWORD = Cardinal;
8.   LongWord = Cardinal;
9.   ULONG_PTR = UIntPtr;
10.   LongBool = False..Boolean(4294967295);
11.   BOOL = LongBool;
12.   UINT = LongWord;
13.   HWND = UIntPtr;
14.   THandle = UIntPtr;
15.   POverlapped = ^TOverlapped;
16.   _OVERLAPPED = record
17.     Internal: ULONG_PTR;
18.     InternalHigh: ULONG_PTR;
19.     Offset: DWORD;
20.     OffsetHigh: DWORD;
21.     hEvent: THandle;
22.   end;
23.   TOverlapped = _OVERLAPPED;
24.   PSecurityAttributes = ^TSecurityAttributes;
25.   _SECURITY_ATTRIBUTES = record
26.     nLength: DWORD;
27.     lpSecurityDescriptor: Pointer;
28.     bInheritHandle: BOOL;
29.   end;
30.   TSecurityAttributes = _SECURITY_ATTRIBUTES;
31.  
32. const
33.   GENERIC_WRITE = $40000000;
34.   FILE_SHARE_READ = $00000001;
35.   FILE_SHARE_WRITE = $00000002;
36.   CREATE_NEW = 1;
37.   OPEN_EXISTING = 3;
38.   FILE_END = 2;
39.   FILE_ATTRIBUTE_NORMAL = $00000080;
40.   INVALID_HANDLE_VALUE = THandle(-1);
41.   INVALID_SET_FILE_POINTER = DWORD(-1);
42.   NO_ERROR = 0;
43.  
44. function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external 'kernel32.dll' name 'WriteFile';
45. function CreateFileA(lpFileName: LPCSTR; dwDesiredAccess, dwShareMode: DWORD; lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD; hTemplateFile: THandle): THandle; stdcall; external 'kernel32.dll' name 'CreateFileA';
46. function SetFilePointer(hFile: THandle; lDistanceToMove: Longint; lpDistanceToMoveHigh: Pointer; dwMoveMethod: DWORD): DWORD; stdcall; external 'kernel32.dll' name 'SetFilePointer';
47. function CloseHandle(hObject: THandle): BOOL; stdcall; external 'kernel32.dll' name 'CloseHandle';
48. function MessageBoxA(hWnd: HWND; lpText, lpCaption: LPCSTR; uType: UINT): Integer; stdcall; external 'user32.dll' name 'MessageBoxA';
49. function GetLastError: DWORD; stdcall; external 'kernel32.dll' name 'GetLastError';
50.  
51. procedure PutDataToFile(const AFileName: string; AData: PAnsiChar);
52. var
53.   hFile: THandle;
54.   cnt: Cardinal;
55.   DataSize: Integer;
56.   dummy: DWORD;
57.   error: DWORD;
58. begin
59.   DataSize := StrLen(AData);
60.   hFile := CreateFileA(PAnsiChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
61.              OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
62.   if (hFile = INVALID_HANDLE_VALUE) then
63.     hFile := CreateFileA(PAnsiChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
64.                CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
65.   if (hFile <> INVALID_HANDLE_VALUE) then
66.     begin
67.       dummy := MessageBoxA(0, PAnsiChar('CreateFileA() success!'), PAnsiChar('Information'), 0);
68.       dummy := SetFilePointer(hFile, 0, nil, FILE_END);
69.       error := GetLastError;
70.       if ((dummy <> INVALID_SET_FILE_POINTER) and (error = NO_ERROR)) then
71.         begin
72.           dummy := MessageBoxA(0, PAnsiChar('SetFilePointer() success!'), PAnsiChar('Information'), 0);
73.           if WriteFile(hFile, AData^, DataSize, cnt, nil) then
74.             dummy := MessageBoxA(0, PAnsiChar('WriteFile() success!'), PAnsiChar('Information'), 0)
75.           else
76.             dummy := MessageBoxA(0, PAnsiChar('WriteFile() failed.'), PAnsiChar('Information'), 0)
77.         end
78.       else
79.         dummy := MessageBoxA(0, PAnsiChar('SetFilePointer() failed.'), PAnsiChar('Information'), 0);
80.       if CloseHandle(hFile) then
81.         dummy := MessageBoxA(0, PAnsiChar('CloseHandle() success!'), PAnsiChar('Information'), 0)
82.       else
83.         dummy := MessageBoxA(0, PAnsiChar('CloseHandle() failed.'), PAnsiChar('Information'), 0);
84.     end
85.   else
86.     dummy := MessageBoxA(0, PAnsiChar('CreateFileA() failed.'), PAnsiChar('Information'), 0);
87. end;
88.  
89. begin
90.   PutDataToFile('test.txt', 'Test file created');
91.   ReadLn;
92. end.

You can extend this code with more constants as the MSDN sites showing, right now I just encapsulated SetFilePointer as an example how-to work with the feedback correct and how GetLastError is involved.

Tested successful with Lazarus 3.99 (rev main_3_99-1801-gca71aeb4e4) FPC 3.2.2 x86_64-win64-win32/win64
(all original unmodified files including RTL)