Delphi SDK для Колибри

Wed Oct 05, 2016 9:29 pm

Ок, и между модулями работает. Скриншоты нннада?

unit abc;
interface
const
  user32 = 'user32.dll';
  kernel32 = 'kernel32.dll';

procedure Test123(var a: integer);
function MessageBox(hWnd: Cardinal; lpText, lpCaption: Pchar; uType: Cardinal): Integer; stdcall;
function Func1(AParam: integer): boolean; overload;
function Func1(AParam: boolean): boolean; overload;
function Func1(AParam: byte): boolean; overload;

implementation

function Func1(AParam: integer): boolean; overload;
begin
  MessageBox(0,'Header','TinyPE in Delphi',0);
end;

function Func1(AParam: boolean): boolean; overload;
begin
  MessageBox(0,'Header','TinyPE in Delphi',0);
end;

function Func1(AParam: byte): boolean; overload;
begin
  MessageBox(0,'Header','TinyPE in Delphi',0);
end;

procedure test123(var a: integer);
begin
  a:= a + 1;
end;

function MessageBox; stdcall; external user32 name '_MessageBoxA@16';

end.

Code: Select all

unit Hello;

interface
uses
  abc;
function Start(hModule, hReason, hReserved: DWORD): LongBool; stdcall;


implementation


function Start(hModule, hReason, hReserved: DWORD): LongBool;
begin
  Func1(3);
  Func1(True);
  Result:= TRUE;
end;

end.

Code: Select all

Borland Delphi Version 15.0
Copyright (c) 1983,2002 Borland Software Corporation

hello.pas(1) 
hello.pas(1) 
hello.pas(1) 
abc.pas(1)   
abc.pas(18) Warning: Return value of function 'Func1' might be undefined

abc.pas(23) Warning: Return value of function 'Func1' might be undefined

abc.pas(28) Warning: Return value of function 'Func1' might be undefined

abc.pas(39) 

hello.pas(6) 
hello.pas(19) 
60 lines, 0.00 seconds, 78 bytes code, 4 bytes data.

Code: Select all

Microsoft (R) Incremental Linker Version 7.00.9210
Copyright (C) Microsoft Corporation.  All rights reserved.

Hello.obj : warning LNK4033: converting object format from OMF to COFF
abc.obj : warning LNK4033: converting object format from OMF to COFF
system.obj : warning LNK4033: converting object format from OMF to COFF
LINK : warning LNK4078: multiple '.text' sections found with different attributes (C0000040)
LINK : warning LNK4078: multiple '.text' sections found with different attributes (C0000040)

Wed Oct 05, 2016 10:16 pm

//DG wrote:Ок, и между модулями работает. Скриншоты нннада?

Map-файла будет достаточно.

Wed Oct 05, 2016 10:41 pm

Freeman wrote:
//DG wrote:Ок, и между модулями работает. Скриншоты нннада?
Map-файла будет достаточно.

Пожалуйста. (А с фига ли extension map is not allowed на форуме?)

Wed Oct 19, 2016 10:22 am

Ну попробовал я эту вашу omf2d. После неё у меня LD чем-то недоволен.
Исходник:

Spoiler:

Code: Select all

Program Project1;

Type

  Dword = Cardinal;

Var
  hConsole: Pointer;
  ConsoleInit:       Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
  ConsoleExit:       Procedure(bCloseWindow: Cardinal); StdCall;
  Write:             Procedure(Str: PChar); StdCall;
  ConsoleSetCaption: Procedure(Const Caption: PChar); StdCall;
  GetCh:             Function: Char; StdCall;
  GetS:              Function(Buffer: PChar; Count: Cardinal): PChar; StdCall;
  printf:            Function(Const Format: PChar): Integer; CDecl VarArgs;
(* -------------------------------------------------------- *)
  Procedure Main; Forward;
  Function  CreateFile(Path: PChar): Integer; StdCall; Forward;
  Function  RunFile(Path, Params: PChar): Integer; StdCall; Forward;
  Procedure ThreadTerminate; Forward;
  Function  LoadLibrary(Path: PChar): Pointer; StdCall; Forward;
  Function  GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer; StdCall; Forward;
(* -------------------------------------------------------- *)
Procedure Main();
Var
   i: Cardinal;
   S: array[1..100] of char;
Begin

   hConsole          := LoadLibrary('/sys/lib/console.obj');
   ConsoleInit       := GetProcAddress(hConsole, 'con_init');
   ConsoleExit       := GetProcAddress(hConsole, 'con_exit');
   Write             := GetProcAddress(hConsole, 'con_write_asciiz');
   ConsoleSetCaption := GetProcAddress(hConsole, 'con_set_title');
   GetCh             := GetProcAddress(hConsole, 'con_getch');
   GetS              := GetProcAddress(hConsole, 'con_gets');
   printf            := GetProcAddress(hConsole, 'con_printf');


   ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
   Write('Hello,'#10'Console!'#10#10);
   Write('Enter something:');
   GetS(@S, 30);
   Write('You entered:');
   Write(@S);
   Write(#10);

   Write('Press key to see printf output'#10#10);
   GetCh();

   printf('Characters: %c %c '#10, 'a', 65);
   printf('Decimals: %d %ld'#10, 1977, 650000);
   printf('Preceding with blanks: %10d'#10, 1977);
   printf('Preceding with zeros: %010d'#10, 1977);
   printf('Some different radices: %d %x %o %#x %#o '#10, 100, 100, 100, 100, 100);
   printf('Width trick: %*d'#10, 5, 10);
   printf('%s'#10, 'A string');

   printf(#10);

   printf('Do you want to create new file?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter file path then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     If CreateFile(@S) = 0 Then
       printf('File created.'#10)
     Else
       printf('CreateFile Error!'#10);
   End
   Else
     printf('You do not want to create new file.'#10);

   printf(#10);

   printf('Maybe you need a calc?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
     RunFile('/sys/calc', '')
   Else
     printf('You do not need a calc.'#10);

   printf(#10);

   printf('Do you want to set a new caption?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter new caption then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     ConsoleSetCaption(@S);
   End
   Else
     printf('You do not want to set a new caption.');

   ConsoleExit(0);
   ThreadTerminate;
End;
(* -------------------------------------------------------- *)
Procedure ThreadTerminate();
Asm
        mov    eax, $FFFFFFFF;
        int    64
End;
(* -------------------------------------------------------- *)
Function CreateFile(Path: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte[esp], 0
        push   0
        push   0
        push   0
        push   0
        push   2
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function RunFile(Path, Params: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte [esp], 0
        push   0
        push   0
        push   Params
        push   0
        push   7
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer;
Asm
        push   esi
        push   edi
        push   ebx
        mov    edx, hLib
        xor    eax, eax
        test   edx, edx
        jz     @end
        mov    edi, ProcName
        mov    ecx, $FFFFFFFF
        repne scasb
        mov    ebx, ecx
        not    ebx
@next:
        mov    esi, [edx]
        test   esi, esi
        jz     @end
        mov    ecx, ebx
        mov    edi, ProcName
        add    edx, 8
        repe cmpsb
        jne    @next
        mov    eax, [edx - 4]
@end:
        pop    ebx
        pop    edi
        pop    esi
End;
(* -------------------------------------------------------- *)
Function LoadLibrary(Path: PChar): Pointer;
Asm
        push   ebx
        mov    eax, 68
        mov    ebx, 19
        mov    ecx, Path
        int    64
        pop    ebx
End;
(* -------------------------------------------------------- *)
Begin Main; End.

Я вот это просто задефайнил, чтобы линкер не ругался на их отсутствие:

Spoiler:

Code: Select all

@@Halt0
@@InitExe      
@Finalization  
@@HandleFinally
@initialization

Spoiler:

dcc32 -J project1.dpr

Borland Delphi Version 15.0
Copyright (c) 1983,2002 Borland Software Corporation
Project1.dpr(182)
183 lines, 0.01 seconds, 1638 bytes code, 32 bytes data.

omf2d project1.obj

OMF2D 1.01 converts 32bit OMF to Delphi linkable OMF
Copyright (C) 2003 Radim Picha, http://www.anticracking.sk/EliCZ
Converting "project1.obj" to "project1.obj"

link -edit project1.obj

Microsoft (R) COFF Binary File Editor Version 5.12.8078
Copyright (C) Microsoft Corp 1992-1998. All rights reserved.

project1.obj : warning LNK4033: converting object format from OMF to COFF

LINK : warning LNK4041: no edit options specified

ld -T LScript.x project1.obj -o project1.kex

Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x62c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5ec): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5b3): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x58b): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x564): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x55c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here
Project1.obj:project1.dpr:(.text+0x604): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here

А тем извращенским способом viewtopic.php?f=9&t=2318#p66300 приложение запускается и работает, результат — это вот:

Spoiler:

Подобное в принципе можно собрать и FreePascal-ем, и Delphi2(только она VarArgs не понимает, и Cardinal там на самом деле 31-битный — в некоторых случаях достаточно просто заменить на Integer).
Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.

Wed Oct 19, 2016 1:30 pm

0CodErr wrote:Ну попробовал я эту вашу omf2d. После неё у меня LD чем-то недоволен.
Исходник:
Spoiler:
Code: Select all
Program Project1;

Type

  Dword = Cardinal;

Var
  hConsole: Pointer;
  ConsoleInit:       Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
  ConsoleExit:       Procedure(bCloseWindow: Cardinal); StdCall;
  Write:             Procedure(Str: PChar); StdCall;
  ConsoleSetCaption: Procedure(Const Caption: PChar); StdCall;
  GetCh:             Function: Char; StdCall;
  GetS:              Function(Buffer: PChar; Count: Cardinal): PChar; StdCall;
  printf:            Function(Const Format: PChar): Integer; CDecl VarArgs;
(* -------------------------------------------------------- *)
  Procedure Main; Forward;
  Function  CreateFile(Path: PChar): Integer; StdCall; Forward;
  Function  RunFile(Path, Params: PChar): Integer; StdCall; Forward;
  Procedure ThreadTerminate; Forward;
  Function  LoadLibrary(Path: PChar): Pointer; StdCall; Forward;
  Function  GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer; StdCall; Forward;
(* -------------------------------------------------------- *)
Procedure Main();
Var
   i: Cardinal;
   S: array[1..100] of char;
Begin

   hConsole          := LoadLibrary('/sys/lib/console.obj');
   ConsoleInit       := GetProcAddress(hConsole, 'con_init');
   ConsoleExit       := GetProcAddress(hConsole, 'con_exit');
   Write             := GetProcAddress(hConsole, 'con_write_asciiz');
   ConsoleSetCaption := GetProcAddress(hConsole, 'con_set_title');
   GetCh             := GetProcAddress(hConsole, 'con_getch');
   GetS              := GetProcAddress(hConsole, 'con_gets');
   printf            := GetProcAddress(hConsole, 'con_printf');


   ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
   Write('Hello,'#10'Console!'#10#10);
   Write('Enter something:');
   GetS(@S, 30);
   Write('You entered:');
   Write(@S);
   Write(#10);

   Write('Press key to see printf output'#10#10);
   GetCh();

   printf('Characters: %c %c '#10, 'a', 65);
   printf('Decimals: %d %ld'#10, 1977, 650000);
   printf('Preceding with blanks: %10d'#10, 1977);
   printf('Preceding with zeros: %010d'#10, 1977);
   printf('Some different radices: %d %x %o %#x %#o '#10, 100, 100, 100, 100, 100);
   printf('Width trick: %*d'#10, 5, 10);
   printf('%s'#10, 'A string');

   printf(#10);

   printf('Do you want to create new file?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter file path then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     If CreateFile(@S) = 0 Then
       printf('File created.'#10)
     Else
       printf('CreateFile Error!'#10);
   End
   Else
     printf('You do not want to create new file.'#10);

   printf(#10);

   printf('Maybe you need a calc?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
     RunFile('/sys/calc', '')
   Else
     printf('You do not need a calc.'#10);

   printf(#10);

   printf('Do you want to set a new caption?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter new caption then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     ConsoleSetCaption(@S);
   End
   Else
     printf('You do not want to set a new caption.');

   ConsoleExit(0);
   ThreadTerminate;
End;
(* -------------------------------------------------------- *)
Procedure ThreadTerminate();
Asm
        mov    eax, $FFFFFFFF;
        int    64
End;
(* -------------------------------------------------------- *)
Function CreateFile(Path: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte[esp], 0
        push   0
        push   0
        push   0
        push   0
        push   2
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function RunFile(Path, Params: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte [esp], 0
        push   0
        push   0
        push   Params
        push   0
        push   7
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer;
Asm
        push   esi
        push   edi
        push   ebx
        mov    edx, hLib
        xor    eax, eax
        test   edx, edx
        jz     @end
        mov    edi, ProcName
        mov    ecx, $FFFFFFFF
        repne scasb
        mov    ebx, ecx
        not    ebx
@next:
        mov    esi, [edx]
        test   esi, esi
        jz     @end
        mov    ecx, ebx
        mov    edi, ProcName
        add    edx, 8
        repe cmpsb
        jne    @next
        mov    eax, [edx - 4]
@end:
        pop    ebx
        pop    edi
        pop    esi
End;
(* -------------------------------------------------------- *)
Function LoadLibrary(Path: PChar): Pointer;
Asm
        push   ebx
        mov    eax, 68
        mov    ebx, 19
        mov    ecx, Path
        int    64
        pop    ebx
End;
(* -------------------------------------------------------- *)
Begin Main; End.
Я вот это просто задефайнил, чтобы линкер не ругался на их отсутствие:
Spoiler:
Code: Select all
@@Halt0
@@InitExe      
@Finalization  
@@HandleFinally
@initialization
Spoiler:
dcc32 -J project1.dpr

Borland Delphi Version 15.0
Copyright (c) 1983,2002 Borland Software Corporation
Project1.dpr(182)
183 lines, 0.01 seconds, 1638 bytes code, 32 bytes data.

omf2d project1.obj

OMF2D 1.01 converts 32bit OMF to Delphi linkable OMF
Copyright (C) 2003 Radim Picha, http://www.anticracking.sk/EliCZ
Converting "project1.obj" to "project1.obj"

link -edit project1.obj

Microsoft (R) COFF Binary File Editor Version 5.12.8078
Copyright (C) Microsoft Corp 1992-1998. All rights reserved.

project1.obj : warning LNK4033: converting object format from OMF to COFF

LINK : warning LNK4041: no edit options specified

ld -T LScript.x project1.obj -o project1.kex

Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x62c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5ec): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5b3): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x58b): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x564): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x55c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here
Project1.obj:project1.dpr:(.text+0x604): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here
А тем извращенским способом viewtopic.php?f=9&t=2318#p66300 приложение запускается и работает, результат — это вот:
Spoiler:
Подобное в принципе можно собрать и FreePascal-ем, и Delphi2(только она VarArgs не понимает, и Cardinal там на самом деле 31-битный — в некоторых случаях достаточно просто заменить на Integer).
Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.

А их надо было дефайнить иначе - инициализация и финализация referenceятся компилятором, их надо дефайнить в null. Можно было посмотреть мой пример:

omf2d abc.obj abc2.obj /U- /U_* /CP@initialization$qqrv=@2junk /CP@Finalization$qqrv=@2junk2

Если хочешь, я пришлю тебе пакет TinyPeInDelphi настроенный.

Wed Oct 19, 2016 1:37 pm

0CodErr wrote: Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.

Решают сейчас проблему с субаллокатором для FPC. Пока изучаю ваши библиотеки, как вы работаете со своими obj/dll

Wed Oct 19, 2016 1:38 pm

А, еще вспомнил: при таком методе все строится на unitах, без program.

Wed Oct 19, 2016 4:24 pm

//DG wrote:при таком методе все строится на unitах, без program.

Это похоже, что ключевой момент.

А зачем мне TinyPeInDelphi? Я ведь делаю приложение под KolibriOS.

//DG wrote:А их надо было дефайнить иначе - инициализация и финализация referenceятся компилятором, их надо дефайнить в null.

Я в скрипте для линкера написал просто вот так:

Code: Select all

"@@Halt0"         = 0;
"@@InitExe"       = 0;
"@@HandleFinally" = 0;
"@initialization" = 0;

А в случае с FreePascal пришлось так:

Code: Select all

"RTTI_SYSTEM_WORD"=0;
"FPC_INITIALIZEUNITS"=0;
"FPC_DO_EXIT"=0;
"INIT$_SYSTEM"=0;
"INIT$_FPINTRES"=0;
"INIT$_OBJPAS"=0;
"FINALIZE$_OBJPAS"=0;
"THREADVARLIST_SYSTEM"=0;
"THREADVARLIST_FPINTRES"=0;
"THREADVARLIST_OBJPAS"=0;
"THREADVARLIST_SYSINITPAS"=0;

На Unit-ах попроще, конечно. Значит, буду делать Unit-ы с Main.