Freeman/SDK
1
0
Fork 0
mirror of https://github.com/vapaamies/KolibriOS.git synced 2024-09-19 17:41:01 +02:00
Code Issues Actions Packages Projects Releases Wiki Activity

KoW for console applications added

Browse Source
This commit is contained in:
Владислав Джавадов 2021-01-08 18:39:17 +03:00
parent 305cd924f7
commit 5f3fca1705
29 changed files with 824 additions and 134 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Examples/.dof
View File

@ -1,5 +1,6 @@
[Directories]
OutputDir=..\..\..\Bin
UnitOutputDir=..\..\..\Bin\DCU
SearchPath=..\..\..\Lib;..\..\..\Bin\DCU
OutputDir=..\..\..\Bin\KoW
UnitOutputDir=..\..\..\Bin\KoW\DCU
SearchPath=..\..\..\Lib;..\..\..\Bin\KoW\DCU
UnitAliases=
UsePackages=0

6
Examples/Console/CharMap/CharMap.dpr
View File

@ -7,14 +7,16 @@ var
CharLine: array[$0..$F] of KolibriChar;
Line, Ch: Byte;
begin
InitConsole('Character map');
InitConsole('CharMap', False, 20, 19, 20, 19);
con_write_asciiz(' ');
con_write_asciiz(#10);
con_write_asciiz(' ');
con_write_string(HexDigits, Length(HexDigits));
con_write_asciiz(#10);
for Line := Low(HexDigits) to High(HexDigits) do
begin
con_write_asciiz(' ');
con_write_string(@HexDigits[Line], 1);
con_write_asciiz(' ');
for Ch := Low(CharLine) to High(CharLine) do

2
Examples/Console/ConsoleColors/ConsoleColors.dpr
View File

@ -13,7 +13,7 @@ var
Color: Byte;
begin
InitConsole('Console Colors');
InitConsole('Console Colors', False, 30, 33, 30, 33);
for Color := Low(ColorName) to High(ColorName) do
begin

12
Examples/Console/DateTime/DateTime.dpr
View File

@ -7,20 +7,18 @@ var
CursorXY: TCursorXY;
begin
InitConsole('Date/Time');
InitConsole('Date/Time', True, 80, 25, 80, 25);
CursorOff;
GotoXY(27, 11);
GotoXY(27, 12);
Write(
'System Date and System Time'#10 +
' '
' '
);
CursorXY := WhereXY;
repeat
with GetSystemDate do
con_printf('%02x.%02x.%02x', Day, Month, Year);
with GetSystemTime do
con_printf(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
with GetSystemDate, GetSystemTime do
con_printf('%02x.%02x.%02x - %02x:%02x:%02x', Day, Month, Year, Hours, Minutes, Seconds);
GotoXY(CursorXY);
Delay(500);
until KeyPressed;

11
Examples/Console/LoadFile/LoadFile.dpr
View File

@ -3,12 +3,19 @@ program LoadFileApp;
uses
KolibriOS, CRT;
const
{$IFDEF KolibriOS}
FileName = '/sys/example.asm';
{$ELSE}
FileName = '..\..\Lib\KoW\CRT.inc';
{$ENDIF}
var
FileSize: LongWord;
Buffer: Pointer;
Buffer: PKolibriChar;
begin
InitConsole('Load File');
Buffer := LoadFile('/sys/example.asm', FileSize);
Buffer := LoadFile(FileName, FileSize);
con_write_string(Buffer, FileSize);
end.

41
Examples/Console/ReadFolder/ReadFolder.dpr
View File

@ -4,45 +4,38 @@ uses
KolibriOS, CRT, SysUtils;
const
FolderPath = '/sys';
Path = '/sys';
var
FolderInformation: TFolderInformation;
Info: TFolderInformation;
BlocksRead: LongWord;
Pos: LongWord;
begin
InitConsole('Read Folder');
if ReadFolder(FolderPath, FolderInformation, 0, 0, 0, BlocksRead) = 0 then
with FolderInformation do
con_printf('Folder "%s" contains %u files and/or folders.'#10#10, FolderPath, FileCount)
if ReadFolder(Path, Info, 0, 0, 0, BlocksRead) = 0 then
con_printf('Folder "%s" contains %u files and/or folders.'#10#10, Path, Info.FileCount)
else
con_printf('Folder "%s" can not be read.'#10, FolderPath);
con_printf('Folder "%s" cannot be read.'#10, Path);
Pos := 0;
while ReadFolder(FolderPath, FolderInformation, 1, Pos, 0, BlocksRead) = 0 do
while ReadFolder(Path, Info, 1, Pos, 0, BlocksRead) = 0 do
begin
with FolderInformation, FileInformation[0] do
with Info, FileInformation[0] do
begin
con_printf( 'File Name = %s'#10, Name);
con_printf( 'File Name = %s'#10, Name);
with Attributes do
begin
con_printf( 'SizeLo = %u'#10, Int64Rec(Size).Lo);
con_printf( 'SizeHi = %u'#10, Int64Rec(Size).Hi);
with Modify.Date do
con_printf('Modify Date = %02d.%02d.%02d'#10, Day, Month, Year);
with Modify.Time do
con_printf('Modify Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
with Access.Date do
con_printf('Access Date = %02d.%02d.%02d'#10, Day, Month, Year);
with Access.Time do
con_printf('Access Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
with Creation.Date do
con_printf('Creation Date = %02d.%02d.%02d'#10, Day, Month, Year);
with Creation.Time do
con_printf('Creation Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
con_printf( 'Attributes = 0x%08x'#10#10, Attributes);
with Int64Rec(Size) do
con_printf('Size = %u:%u'#10, Hi, Lo);
with Creation, Date, Time do
con_printf('Created = %02d.%02d.%02d %02d:%02d:%02d'#10, Day, Month, Year, Hours, Minutes, Seconds);
with Modify, Date, Time do
con_printf('Modified = %02d.%02d.%02d %02d:%02d:%02d'#10, Day, Month, Year, Hours, Minutes, Seconds);
with Access, Date, Time do
con_printf('Accessed = %02d.%02d.%02d %02d:%02d:%02d'#10, Day, Month, Year, Hours, Minutes, Seconds);
con_printf( 'Attributes = 0x%08x'#10#10, Attributes);
end;
end;
Inc(Pos);

7
Examples/GUI/DrawImage/build.bat
View File

@ -1,3 +1,8 @@
@echo off
call "%~dp0..\..\..\Tools\build.bat" "%~dp0DrawImage"
copy "%~dp0*.tga" "%~dp0..\..\..\Bin" >nul
if errorlevel 1 goto exit
call "%~dp0init.bat"
:exit

11
Examples/GUI/DrawImage/init.bat Normal file
View File

@ -0,0 +1,11 @@
@echo off
for %%f in ("%~dp0*.tga") do (
if not exist "%~dp0..\..\..\Bin\%1\%%~nxf" (
echo Copying "%%f"
copy "%%f" "%~dp0..\..\..\Bin\%1" >nul
if errorlevel 1 goto exit
)
)
:exit

7
Examples/GUI/DrawImageEx/build.bat
View File

@ -1,3 +1,8 @@
@echo off
call "%~dp0..\..\..\Tools\build.bat" "%~dp0DrawImageEx"
copy "%~dp0*.bmp" "%~dp0..\..\..\Bin" >nul
if errorlevel 1 goto exit
call "%~dp0init.bat"
:exit

11
Examples/GUI/DrawImageEx/init.bat Normal file
View File

@ -0,0 +1,11 @@
@echo off
for %%f in ("%~dp0*.bmp") do (
if not exist "%~dp0..\..\..\Bin\%1\%%~nxf" (
echo Copying "%%f"
copy "%%f" "%~dp0..\..\..\Bin\%1" >nul
if errorlevel 1 goto exit
)
)
:exit

7
Examples/GUI/SetCursor/build.bat
View File

@ -1,3 +1,8 @@
@echo off
call "%~dp0..\..\..\Tools\build.bat" "%~dp0SetCursor"
copy "%~dp0*.bmp" "%~dp0..\..\..\Bin" >nul
if errorlevel 1 goto exit
call "%~dp0init.bat"
:exit

11
Examples/GUI/SetCursor/init.bat Normal file
View File

@ -0,0 +1,11 @@
@echo off
for %%f in ("%~dp0*.bmp") do (
if not exist "%~dp0..\..\..\Bin\%1\%%~nxf" (
echo Copying "%%f"
copy "%%f" "%~dp0..\..\..\Bin\%1" >nul
if errorlevel 1 goto exit
)
)
:exit

16
Lib/CRT.pas
View File

@ -1,5 +1,7 @@
(*
KolibriOS CRT unit
Copyright (c) 2020-2021 Delphi SDK for KolibriOS team
*)
unit CRT;
@ -72,7 +74,11 @@ procedure Delay(Milliseconds: LongWord);
implementation
uses
{$IFDEF KolibriOS}
KolibriOS;
{$ELSE}
Windows;
{$ENDIF}
var
ClrEOLWidth: Integer = 80;
@ -234,6 +240,7 @@ begin
Result := con_get_font_height;
end;
{$IFDEF KolibriOS}
procedure Delay(Milliseconds: LongWord);
begin
Sleep((Milliseconds + 10 div 2) div 10);
@ -241,8 +248,12 @@ end;
var
hConsole: Pointer;
{$ELSE}
{$I KoW\CRT.inc}
{$ENDIF}
initialization
{$IFDEF KolibriOS}
hConsole := LoadLibrary('/sys/lib/console.obj');
Pointer(@con_cls) := GetProcAddress(hConsole, 'con_cls');
@ -263,12 +274,15 @@ initialization
Pointer(@con_set_title) := GetProcAddress(hConsole, 'con_set_title');
Pointer(@con_write_asciiz) := GetProcAddress(hConsole, 'con_write_asciiz');
Pointer(@con_write_string) := GetProcAddress(hConsole, 'con_write_string');
{$ELSE}
InitKoW;
{$ENDIF}
if IsConsole then
InitConsole(AppPath);
finalization
if Assigned(con_exit) then
if Assigned(System.con_exit) then
con_exit(CloseWindow);
end.

11
Lib/FastMM.pas
View File

@ -106,8 +106,6 @@ Change log:
the main application's MM.
}
{$define KolibriOS}
unit FastMM;
interface
@ -1904,12 +1902,11 @@ end;
{$endif}
initialization
{$ifndef KolibriOS}
{Has another MM been set, or has the Borland MM been used? If so, this file
is not the first unit in the uses clause of the project's .dpr file.}
if IsMemoryManagerSet or (GetHeapStatus.TotalAllocated <> 0) then
System.Error(reInvalidPtr);
{$endif KolibriOS}
if IsMemoryManagerSet {or (GetHeapStatus.TotalAllocated <> 0)} then
RunError(ERROR_INVALID_POINTER){System.Error(reInvalidPtr)};
{Install the memory manager}
InstallMemoryManager;
@ -1922,4 +1919,4 @@ finalization
{Restore the old memory manager}
UninstallMemoryManager;
end.
end.

243
Lib/KoW/CRT.inc Normal file
View File

@ -0,0 +1,243 @@
(*
KolibriOS on Windows (KoW) CRT unit
Copyright (c) 2021 Delphi SDK for KolibriOS team
*)
type
TConsoleFontInfo = packed record
Number: LongWord;
Size: TCoord;
end;
var
// Console.obj defaults
ScrSize: TCoord = (X: 80; Y: 300);
WndPos: TPoint = (X: 200; Y: 50);
WndSize: TPoint = (X: 80; Y: 25);
SaveInputCP, SaveOutputCP: Word;
const
msvcrt = 'msvcrt.dll';
function GetCurrentConsoleFont(hConsole: THandle; MaximumWindow: LongBool; var Info: TConsoleFontInfo): LongBool; stdcall;
external kernel32 name 'GetCurrentConsoleFont';
function GetConsoleWindow: THandle; stdcall;
external kernel32 name 'GetConsoleWindow';
function _cgets_s(Buffer: PKolibriChar; Count: Cardinal; var Read: Cardinal): PKolibriChar; cdecl;
external msvcrt name '_cgets_s';
function _cputs(Str: PKolibriChar): Integer; cdecl;
external msvcrt name '_cputs';
function _getch: KolibriChar; cdecl;
external msvcrt name '_getch';
function gets: PKolibriChar; cdecl;
external msvcrt name 'gets';
function _kbhit: Integer; cdecl;
external msvcrt name '_kbhit';
function _cprintf(Fmt: PKolibriChar): Integer; cdecl varargs;
external msvcrt name '_cprintf';
procedure con_set_cursor_pos(X, Y: Integer); stdcall; forward; // call local proc from con_cls
procedure con_cls; stdcall;
var
Info: TConsoleScreenBufferInfo;
Point: TCoord;
Written: LongWord;
begin
if GetConsoleScreenBufferInfo(TTextRec(Output).Handle, Info) then
begin
Point.X := 0;
Point.Y := 0;
with Info.dwSize do
FillConsoleOutputCharacter(TTextRec(Output).Handle, ' ', X * Y, Point, Written);
end;
con_set_cursor_pos(0, 0);
end;
procedure con_exit(CloseWindow: Boolean); stdcall;
begin
if not CloseWindow then
begin
CursorOff;
_getch;
end;
SetConsoleCP(SaveInputCP);
SetConsoleOutputCP(SaveOutputCP);
TTextRec(Input).Handle := 0;
TTextRec(Output).Handle := 0;
end;
procedure con_init(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Title: PKolibriChar); stdcall;
var
Font: TConsoleFontInfo;
R: TSmallRect;
begin
if not IsConsole then
AllocConsole;
TTextRec(Input).Handle := System.GetStdHandle(STD_INPUT_HANDLE);
TTextRec(Output).Handle := System.GetStdHandle(STD_OUTPUT_HANDLE);
SaveInputCP := GetConsoleCP;
SetConsoleCP(CP_KOLIBRIOS);
SaveOutputCP := GetConsoleOutputCP;
SetConsoleOutputCP(CP_KOLIBRIOS);
SetConsoleTitleA(Title);
if WndWidth <> LongWord(-1) then
WndSize.X := WndWidth;
if WndHeight <> LongWord(-1) then
WndSize.Y := WndHeight;
GetCurrentConsoleFont(TTextRec(Output).Handle, False, Font);
SetWindowPos(GetConsoleWindow, 0, WndPos.X, WndPos.Y,
Font.Size.X * WndSize.X + GetSystemMetrics(SM_CXVSCROLL), Font.Size.Y * WndSize.Y + GetSystemMetrics(SM_CYHSCROLL), 0);
if ScrWidth <> LongWord(-1) then
ScrSize.X := ScrWidth;
if ScrHeight <> LongWord(-1) then
ScrSize.Y := ScrHeight;
SetConsoleScreenBufferSize(TTextRec(Output).Handle, ScrSize);
with R do
begin
Left := 0;
Top := 0;
Right := ScrSize.X - 1;
Bottom := ScrSize.Y - 1;
end;
SetConsoleWindowInfo(TTextRec(Output).Handle, True, R);
end;
function con_get_cursor_height: Integer; stdcall;
var
Info: TConsoleCursorInfo;
begin
GetConsoleCursorInfo(TTextRec(Output).Handle, Info);
Result := Info.dwSize;
end;
procedure con_get_cursor_pos(var X, Y: Integer); stdcall;
var
Info: TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(TTextRec(Output).Handle, Info);
with Info do
begin
X := dwCursorPosition.X;
Y := dwCursorPosition.Y;
end;
end;
function con_get_flags: LongWord; stdcall
var
Info: TConsoleScreenBufferInfo;
begin
GetConsoleScreenBufferInfo(TTextRec(Output).Handle, Info);
Result := Info.wAttributes;
end;
function con_get_font_height: Integer; stdcall;
var
Font: TConsoleFontInfo;
begin
GetCurrentConsoleFont(TTextRec(Output).Handle, False, Font);
Result := Font.Size.Y;
end;
function con_getch: KolibriChar; stdcall;
begin
Result := _getch;
end;
function con_gets(Str: PKolibriChar; Length: Integer): PKolibriChar; stdcall;
var
LF: KolibriChar;
Read: Cardinal;
begin
_cgets_s(Str, Length, Read);
_cgets_s(@LF, SizeOf(LF), Read);
Result := Str;
end;
function con_gets2(Callback: con_gets2_callback; Str: PKolibriChar; Length: Integer): PKolibriChar; stdcall;
begin
Result := con_gets(Str, Length);
end;
function con_kbhit: Boolean; stdcall;
begin
Result := _kbhit <> 0;
end;
function con_set_cursor_height(Height: Integer): Integer; stdcall;
var
Info: TConsoleCursorInfo;
begin
GetConsoleCursorInfo(TTextRec(Output).Handle, Info);
Result := Info.dwSize;
if Height <> 0 then
Info.dwSize := Height;
Info.bVisible := Height <> 0;
SetConsoleCursorInfo (TTextRec(Output).Handle, Info);
end;
procedure con_set_cursor_pos(X, Y: Integer); stdcall;
var
Coord: TCoord;
begin
Coord.X := X;
Coord.Y := Y;
SetConsoleCursorPosition(TTextRec(Output).Handle, Coord);
end;
function con_set_flags(Flags: LongWord): LongWord; stdcall;
begin
Result := con_get_flags;
SetConsoleTextAttribute(TTextRec(Output).Handle, Flags and $FF);
end;
procedure con_write_string(Str: PKolibriChar; Length: LongWord); stdcall;
var
Written: Cardinal;
begin
System.WriteFile(TTextRec(Output).Handle, Str^, Length, Written, nil);
end;
procedure con_write_asciiz(Str: PKolibriChar); stdcall;
begin
_cputs(Str);
end;
procedure Delay(Milliseconds: LongWord);
begin
Sleep(Milliseconds);
end;
procedure InitKoW;
begin
Pointer(@System.con_cls) := @con_cls;
Pointer(@System.con_exit) := @con_exit;
Pointer(@System.con_init) := @con_init;
Pointer(@System.con_getch) := @con_getch;
Pointer(@System.con_get_flags) := @con_get_flags;
Pointer(@System.con_get_cursor_height) := @con_get_cursor_height;
Pointer(@System.con_get_cursor_pos) := @con_get_cursor_pos;
Pointer(@System.con_get_font_height) := @con_get_font_height;
Pointer(@System.con_gets) := @con_gets;
Pointer(@System.con_gets2) := @con_gets2;
Pointer(@System.con_kbhit) := @con_kbhit;
Pointer(@System.con_printf) := @_cprintf;
Pointer(@System.con_set_cursor_height) := @con_set_cursor_height;
Pointer(@System.con_set_cursor_pos) := @con_set_cursor_pos;
Pointer(@System.con_set_flags) := @con_set_flags;
Pointer(@System.con_set_title) := @Windows.SetConsoleTitleA;
Pointer(@System.con_write_asciiz) := @con_write_asciiz;
Pointer(@System.con_write_string) := @con_write_string;
end;

110
Lib/KoW/KolibriOS.inc Normal file
View File

@ -0,0 +1,110 @@
(*
KolibriOS on Windows (KoW) unit
Copyright (c) 2021 Delphi SDK for KolibriOS team
*)
type
TOSVersionInfoA = packed record
dwOSVersionInfoSize: LongWord;
dwMajorVersion: LongWord;
dwMinorVersion: LongWord;
dwBuildNumber: LongWord;
dwPlatformId: LongWord;
szCSDVersion: array[0..127] of KolibriChar;
end;
function GetFileSizeEx(hFile: THandle; var FileSize: UInt64): LongBool; stdcall;
external kernel32 name 'GetFileSizeEx';
function GetVersionExA(var Info: TOSVersionInfoA): LongBool; stdcall;
external kernel32 name 'GetVersionExA';
procedure ExitThread; stdcall;
begin
Windows.ExitProcess(0);
end;
function GetCurrentDirectory(Buffer: PKolibriChar; Count: LongWord): LongWord;
begin
Result := GetCurrentDirectoryA(Count, Buffer);
end;
procedure GetKernelVersion(var Buffer: TKernelVersion);
var
Info: TOSVersionInfoA;
begin
FillChar(Buffer, SizeOf(Buffer), 0);
Info.dwOSVersionInfoSize := SizeOf(Info);
if GetVersionExA(Info) then
with Buffer, Info do
begin
A := dwMajorVersion;
B := dwMinorVersion;
Revision := dwBuildNumber;
end;
end;
function GetSystemDate: KolibriOS.TSystemDate;
var
Date: Windows.TSystemTime;
begin
GetLocalTime(Date);
with Result, Date do
begin
Year := wYear mod 100;
Year := Year div 10 shl 4 or Year mod 10;
Month := wMonth div 10 shl 4 or wMonth mod 10;
Day := wDay div 10 shl 4 or wDay mod 10;
end;
end;
function GetSystemTime: KolibriOS.TSystemTime;
var
Time: Windows.TSystemTime;
begin
GetLocalTime(Time);
with Result, Time do
begin
Hours := wHour div 10 shl 4 or wHour mod 10;
Minutes := wMinute div 10 shl 4 or wMinute mod 10;
Seconds := wSecond div 10 shl 4 or wSecond mod 10;
end;
end;
function GetTickCount: LongWord; stdcall;
asm
JMP Windows.GetTickCount
end;
function GetTickCount64: UInt64; stdcall;
asm
CALL Windows.GetTickCount
XOR EDX, EDX
end;
function LoadFile(FileName: PKolibriChar; var Size: LongWord): Pointer;
var
hFile: THandle;
QSize: UInt64;
begin
hFile := CreateFileA(FileName, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if (hFile <> INVALID_HANDLE_VALUE) and GetFileSizeEx(hFile, QSize) then
begin
Size := QSize;
GetMem(Result, Size);
Windows.ReadFile(hFile, Result^, Size, Size, nil);
Exit;
end;
Size := 0;
Result := nil;
end;
procedure SetCurrentDirectory(Path: PKolibriChar);
begin
SetCurrentDirectoryA(Path);
end;
procedure Sleep(Time: LongWord);
begin
Windows.Sleep(Time * 10);
end;

43
Lib/KoW/SysAPI.inc Normal file
View File

@ -0,0 +1,43 @@
(*
KolibriOS on Windows (KoW) RTL definitions
Copyright (c) 2021 Delphi SDK for KolibriOS team
*)
type
HRESULT = type LongInt;
HINST = THandle;
HMODULE = THandle;
HRSRC = THandle;
var
MainWindow: THandle;
const
kernel32 = 'kernel32.dll';
user32 = 'user32.dll';
procedure ExitProcess(ExitCode: Cardinal); stdcall;
external kernel32 name 'ExitProcess';
function GetCommandLine: PKolibriChar; stdcall;
external kernel32 name 'GetCommandLineA';
function GetModuleFileName(hModule: THandle; Buffer: PKolibriChar; Count: Cardinal): Cardinal; stdcall;
external kernel32 name 'GetModuleFileNameA';
function GetProcessHeap: THandle; stdcall;
external kernel32 name 'GetProcessHeap';
function GetStdHandle(Code: LongWord): THandle; stdcall;
external kernel32 name 'GetStdHandle';
function HeapAlloc(hHeap: THandle; Flags, Bytes: Cardinal): Pointer; stdcall;
external kernel32 name 'HeapAlloc';
function HeapReAlloc(hHeap: THandle; Flags: Cardinal; Mem: Pointer; Bytes: Cardinal): Pointer; stdcall;
external kernel32 name 'HeapReAlloc';
function HeapFree(hHeap: THandle; Flags: Cardinal; Mem: Pointer): LongBool; stdcall;
external kernel32 name 'HeapFree';
function WriteFile(hFile: THandle; const Buffer; Count: Cardinal; var BytesWritten: Cardinal; Overlapped: Pointer): LongBool; stdcall;
external kernel32 name 'WriteFile';
procedure MessageBox(Wnd: THandle; Text, Caption: PKolibriChar; Flags: Cardinal); stdcall;
external user32 name 'MessageBoxA';
procedure __lldiv;

73
Lib/KoW/System.inc Normal file
View File

@ -0,0 +1,73 @@
(*
KolibriOS on Windows (KoW) RTL System unit
Copyright (c) 2021 Delphi SDK for KolibriOS team
*)
const
HEAP_NO_SERIALIZE = $00001;
var
ModuleFileName: array[0..1023] of KolibriChar;
HeapHandle: THandle;
procedure InitKoW;
begin
GetModuleFileName(0, ModuleFileName, Length(ModuleFileName));
AppPath := @ModuleFileName;
CmdLine := GetCommandLine;
if IsConsole then
TTextRec(Output).Handle := GetStdHandle(LongWord(-11));
HeapHandle := GetProcessHeap;
end;
procedure _Halt0;
asm
PUSH EAX
CALL FinalizeUnits
CALL ExitProcess
end;
procedure ErrorMessage(Msg: PKolibriChar; Count: Byte);
const
MB_ICONERROR = $0010;
MB_TASKMODAL = $2000;
EOL: array[0..1] of KolibriChar = #13#10;
var
Buf: array[Low(Byte)..High(Byte) + 1] of KolibriChar;
BytesWritten, Flags: Cardinal;
begin
if TTextRec(Output).Handle <> 0 then
begin
WriteFile(TTextRec(Output).Handle, Msg^, Count, BytesWritten, nil);
WriteFile(TTextRec(Output).Handle, EOL, SizeOf(EOL), BytesWritten, nil);
end
else
begin
if MainWindow <> 0 then
Flags := MB_ICONERROR
else
Flags := MB_ICONERROR or MB_TASKMODAL;
Move(Msg^, Buf, Count);
Msg[Count] := #0;
MessageBox(MainWindow, Msg, nil, Flags);
end;
end;
function SysFreeMem(P: Pointer): Integer;
begin
Result := Integer(not HeapFree(HeapHandle, HEAP_NO_SERIALIZE, P));
end;
function SysGetMem(Size: Integer): Pointer;
begin
Result := HeapAlloc(HeapHandle, 2, Size);
end;
function SysReallocMem(P: Pointer; Size: Integer): Pointer;
begin
Result := HeapReAlloc(HeapHandle, HEAP_NO_SERIALIZE, P, Size);
end;

80
Lib/KoW/__lldiv.inc Normal file
View File

@ -0,0 +1,80 @@
procedure __lldiv; // needed for FastMM under Windows, copied from CodeGear
asm
push ebp
push ebx
push esi
push edi
xor edi,edi
mov ebx,20[esp]
mov ecx,24[esp]
or ecx,ecx
jnz @@slow_ldiv
or edx,edx
jz @@quick_ldiv
or ebx,ebx
jz @@quick_ldiv
@@slow_ldiv:
or edx,edx
jns @@onepos
neg edx
neg eax
sbb edx,0
or edi,1
@@onepos:
or ecx,ecx
jns @@positive
neg ecx
neg ebx
sbb ecx,0
xor edi,1
@@positive:
mov ebp,ecx
mov ecx,64
push edi
xor edi,edi
xor esi,esi
@@xloop:
shl eax,1
rcl edx,1
rcl esi,1
rcl edi,1
cmp edi,ebp
jb @@nosub
ja @@subtract
cmp esi,ebx
jb @@nosub
@@subtract:
sub esi,ebx
sbb edi,ebp
inc eax
@@nosub:
loop @@xloop
pop ebx
test ebx,1
jz @@finish
neg edx
neg eax
sbb edx,0
@@finish:
pop edi
pop esi
pop ebx
pop ebp
ret 8
@@quick_ldiv:
div ebx
xor edx,edx
jmp @@finish
end;

44
Lib/KolibriOS.pas
View File

@ -1,8 +1,9 @@
(************************************************************
(*
KolibriOS system functions and definitions
KolibriOS system functions and definitions
*************************************************************)
Copyright (c) 2017-2019 0CodErr
Copyright (c) 2020-2021 Delphi SDK for KolibriOS team
*)
unit KolibriOS;
@ -348,13 +349,18 @@ const
SHUTDOWN_RESTART = 4;
{-1} procedure ExitThread; stdcall;
{$IFDEF KolibriOS}
{0} procedure DrawWindow(Left, Top, Width, Height: LongInt; Caption: PKolibriChar; BackColor, Style, CapStyle: LongWord); stdcall;
{1} procedure SetPixel(X, Y: LongInt; Color: LongWord); stdcall;
{2} function GetKey: TKeyboardInput; stdcall;
{$ENDIF}
{3} function GetSystemTime: TSystemTime; stdcall;
{$IFDEF KolibriOS}
{4} procedure DrawText(X, Y: LongInt; Text: PKolibriChar; ForeColor, BackColor, Flags, Count: LongWord); stdcall;
{$ENDIF}
{5} procedure Sleep(Time: LongWord); stdcall;
{6} {UNDEFINED}
{$IFDEF KolibriOS}
{7} procedure DrawImage(const Image; X, Y: LongInt; Width, Height: LongWord); stdcall;
{8} procedure DrawButton(Left, Top, Width, Height: LongInt; BackColor, Style, ID: LongWord); stdcall;
{8} procedure DeleteButton(ID: LongWord); stdcall;
@ -389,7 +395,9 @@ const
{18.10} procedure MinimizeActiveWindow; stdcall;
{18.11} procedure GetDiskSystemInfo(var Buffer); stdcall;
{18.12} {UNDEFINED}
{$ENDIF}
{18.13} procedure GetKernelVersion(var Buffer: TKernelVersion); stdcall;
{$IFDEF KolibriOS}
{18.14} function WaitRetrace: LongInt; stdcall;
{18.15} function CenterMousePointer: LongInt; stdcall;
{18.16} function GetFreeMemory: LongWord; stdcall;
@ -443,13 +451,16 @@ const
{26.3} {UNDEFINED}
{26.4} {UNDEFINED}
{26.5} function GetSystemLanguage: LongWord; stdcall;
{$ENDIF}
{26.6} {UNDEFINED}
{26.7} {UNDEFINED}
{26.8} {UNDEFINED}
{26.9} function GetTickCount: LongWord; stdcall;
{26.10} function GetTickCount64: UInt64; stdcall;
{$IFDEF KolibriOS}
{26.11} function IsHDAccessAllowed: LongWord; stdcall;
{26.12} function IsPCIAccessAllowed: LongWord; stdcall;
{$ENDIF}
{27} {UNDEFINED}
{28} {UNDEFINED}
{29} function GetSystemDate: TSystemDate; stdcall;
@ -458,6 +469,7 @@ const
{31} {UNDEFINED}
{32} {UNDEFINED}
{33} {UNDEFINED}
{$IFDEF KolibriOS}
{34} function GetPointOwner(X, Y: LongInt): LongWord; stdcall;
{35} function GetPixel(X, Y: LongInt): LongWord; stdcall;
{36} procedure GetScreenImage(var Buffer; X, Y: LongInt; Width, Height: LongWord); stdcall;
@ -573,7 +585,9 @@ const
{68.24} function SetExceptionHandler(Handler: Pointer; Mask: LongWord; var OldMask: LongWord): Pointer; stdcall;
{68.25} function SetExceptionActivity(Signal, Activity: LongWord): LongInt; stdcall;
{68.26} procedure ReleaseMemoryPages(MemPtr: Pointer; Offset, Size: LongWord); stdcall;
{$ENDIF}
{68.27} function LoadFile(FileName: PKolibriChar; var Size: LongWord): Pointer; stdcall;
{$IFDEF KolibriOS}
{69.0} procedure SetDebugBuffer(const Buffer: TDebugBuffer); stdcall;
{69.1} procedure GetThreadContext(ID: LongWord; var Context: TThreadContext); stdcall;
{69.2} procedure SetThreadContext(ID: LongWord; const Context: TThreadContext); stdcall;
@ -653,9 +667,17 @@ const
{77.2} function WaitFutex(Handle: THandle; Value, Time: LongWord): LongInt; stdcall;
{77.3} function WakeFutex(Handle: THandle; Waiters: LongWord): LongWord; stdcall;
function GetProcAddress(hLib: Pointer; ProcName: PKolibriChar): Pointer; stdcall;
{$ENDIF}
implementation
{$IFNDEF KolibriOS}
uses
Windows;
{$ENDIF}
{$IFDEF KolibriOS}
procedure ExitThread; stdcall;
asm
or eax, -1
@ -1602,10 +1624,6 @@ asm
pop ebx
end;
{UNDEFINED}
{UNDEFINED}
function GetSystemDate: TSystemDate; stdcall;
asm
mov eax, 29
@ -1633,12 +1651,6 @@ asm
pop ebx
end;
{UNDEFINED}
{UNDEFINED}
{UNDEFINED}
function GetPointOwner(X, Y: LongInt): LongWord; stdcall;
asm
push ebx
@ -3720,4 +3732,8 @@ asm
pop esi
end;
{$ELSE}
{$I KoW\KolibriOS.inc}
{$ENDIF}
end.

4
Lib/SysInit.pas
View File

@ -1,5 +1,7 @@
(*
KolibriOS RTL System unit
KolibriOS RTL SysInit unit
Copyright (c) 2020 Delphi SDK for KolibriOS team
*)
unit SysInit;

4
Lib/SysUtils.pas
View File

@ -1,5 +1,7 @@
(*
KolibriOS SysUtils unit
KolibriOS RTL SysUtils unit
Copyright (c) 2020-2021 Delphi SDK for KolibriOS team
*)
unit SysUtils;

126
Lib/System.pas
View File

@ -1,5 +1,7 @@
(*
KolibriOS RTL System unit
Copyright (c) 2020-2021 Delphi SDK for KolibriOS team
*)
unit System;
@ -8,15 +10,22 @@ interface
const
UnicodeCompiler = CompilerVersion >= 20;
type
PPAnsiChar = ^PAnsiChar;
KolibriChar = AnsiChar;
PKolibriChar = PAnsiChar;
ERROR_OUT_OF_MEMORY = 203;
ERROR_INVALID_POINTER = 204;
type
PPAnsiChar = ^PAnsiChar;
PPWideChar = ^PWideChar;
KolibriChar = AnsiChar;
PKolibriChar = PAnsiChar;
PPKolibriChar = PPAnsiChar;
KolibriString = AnsiString;
{$IFNDEF UnicodeCompiler}
UnicodeString = WideString;
{$ENDIF}
{$IF CompilerVersion < 15}
UInt64 = Int64;
@ -24,30 +33,47 @@ type
THandle = LongWord;
PShortInt = ^ShortInt;
PSmallInt = ^SmallInt;
PLongInt = ^LongInt;
PInt64 = ^Int64;
PByte = ^Byte;
PWord = ^Word;
PLongWord = ^LongWord;
PLongInt = ^LongInt;
PInt64 = ^Int64;
{$IF CompilerVersion >= 15}
{$IF CompilerVersion < 15}
PUInt64 = PInt64;
{$ELSE}
PUInt64 = ^UInt64;
{$IFEND}
PCardinal = ^Cardinal;
PInteger = ^Integer;
PSingle = ^Single;
PDouble = ^Double;
PExtended = ^Extended;
PCurrency = ^Currency;
PShortString = ^ShortString;
PAnsiString = ^AnsiString;
PWideString = ^WideString;
{$IFDEF UnicodeCompiler}
PUnicodeString = ^UnicodeString;
PString = PUnicodeString;
{$ELSE}
PUnicodeString = PWideString;
PString = PAnsiString;
{$ENDIF}
PVariant = ^Variant;
PGUID = ^TGUID;
TGUID = record
D1: LongWord;
D2: Word;
D3: Word;
D4: array [0..7] of Byte;
D4: array[0..7] of Byte;
end;
PProcedure = procedure;
@ -147,7 +173,7 @@ procedure _Run0Error;
procedure _RunError(ErrorCode: Byte);
procedure _StartExe(InitTable: PPackageInfo);
procedure ErrorMessage(Msg: PKolibriChar; Count: Integer);
procedure ErrorMessage(Msg: PKolibriChar; Count: Byte);
function _FreeMem(P: Pointer): Integer;
function _GetMem(Size: Integer): Pointer;
@ -188,9 +214,12 @@ function _RandInt(Range: LongInt): LongInt;
function _RandExt: Extended;
procedure Randomize;
const
CP_KOLIBRIOS = 866;
function UpCase(Ch: KolibriChar): KolibriChar;
function _LStrLen(const S: KolibriString): LongInt;
function _LStrLen(const S: KolibriString): Cardinal;
function _LStrToPChar(const S: KolibriString): PKolibriChar;
var
@ -222,7 +251,8 @@ procedure _WriteLn(var T: TTextRec);
const
HexDigits: array[$0..$F] of KolibriChar = '0123456789ABCDEF';
var
var
AppPath, CmdLine: PKolibriChar;
{ Console Library API }
@ -248,17 +278,17 @@ const
con_cls: procedure; stdcall = nil;
con_exit: procedure(CloseWindow: Boolean); stdcall = nil;
con_getch: function: Integer; stdcall = nil;
con_getch2: function: Word; stdcall = nil;
con_get_cursor_pos: procedure(var X, Y: Integer); stdcall = nil;
con_get_cursor_height: function: Integer; stdcall = nil;
con_get_flags: function: LongWord; stdcall = nil;
con_get_font_height: function: Integer; stdcall = nil;
con_getch: function: Integer; stdcall = nil;
con_getch2: function: Word; stdcall = nil;
con_gets: function(Str: PKolibriChar; Length: Integer): PKolibriChar; stdcall = nil;
con_gets2: function(Callback: con_gets2_callback; Str: PKolibriChar; Count: Integer): PKolibriChar; stdcall = nil;
con_gets2: function(Callback: con_gets2_callback; Str: PKolibriChar; Length: Integer): PKolibriChar; stdcall = nil;
con_init: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Title: PKolibriChar); stdcall = nil;
con_kbhit: function: Boolean; stdcall = nil;
con_printf: function(Str: PKolibriChar): Integer; cdecl varargs = nil;
con_printf: function(Fmt: PKolibriChar): Integer; cdecl varargs = nil;
con_set_flags: function(Flags: LongWord): LongWord; stdcall = nil;
con_set_cursor_height: function(Height: Integer): Integer; stdcall = nil;
con_set_cursor_pos: procedure(X, Y: Integer); stdcall = nil;
@ -266,15 +296,15 @@ const
con_write_asciiz: procedure(Str: PKolibriChar); stdcall = nil;
con_write_string: procedure(Str: PKolibriChar; Length: LongWord); stdcall = nil;
{$IFNDEF KolibriOS}
{$I KoW\SysAPI.inc}
{$ENDIF}
implementation
uses
SysInit;
const
ERROR_OUT_OF_MEMORY = 203;
ERROR_INVALID_POINTER = 204;
var
InitContext: TInitContext;
@ -323,12 +353,14 @@ begin
InitUnits;
end;
{$IFDEF KolibriOS}
procedure _Halt0;
asm
CALL FinalizeUnits
OR EAX, -1
INT $40
end;
{$ENDIF}
procedure _HandleFinally;
asm
@ -345,6 +377,10 @@ procedure _RunError(ErrorCode: Byte);
const
Msg: array[0..28] of KolibriChar = 'Runtime error 000 at 00000000';
asm
{$IFNDEF KolibriOS}
PUSH EAX
{$ENDIF}
MOV EDX, $20202020
MOV CL, 10
XOR CH, CH
@ -364,7 +400,12 @@ asm
MOV EDX, [EAX+3] // ' at '
ADD EAX, ECX
MOV [EAX], EDX
MOV EBX, EAX // volatile
{$IFDEF KolibriOS}
// volatile
{$ELSE}
PUSH EBX
{$ENDIF}
MOV EBX, EAX
MOV CL, 4
ADD EBX, ECX
@ -373,12 +414,20 @@ asm
DEC CL
SHL CL, 3
{$IFDEF KolibriOS}
MOV EAX, [ESP]
{$ELSE}
MOV EAX, [ESP+8]
{$ENDIF}
ROR EAX, CL
AND EAX, $0F
MOV DH, [EAX+HexDigits]
{$IFDEF KolibriOS}
MOV EAX, [ESP]
{$ELSE}
MOV EAX, [ESP+8]
{$ENDIF}
ROR EAX, CL
MOVZX EAX, AL
SHR EAX, 4
@ -392,13 +441,20 @@ asm
MOV EAX, offset Msg
MOV EDX, EBX
{$IFNDEF KolibriOS}
POP EBX
{$ENDIF}
SUB EDX, EAX
CALL ErrorMessage
{$IFNDEF KolibriOS}
POP EAX
{$ENDIF}
JMP _Halt0
end;
procedure ErrorMessage(Msg: PKolibriChar; Count: Integer);
{$IFDEF KolibriOS}
procedure ErrorMessage(Msg: PKolibriChar; Count: Byte);
asm
PUSH EBX
PUSH ESI
@ -422,6 +478,7 @@ asm
POP ESI
POP EBX
end;
{$ENDIF}
var
MemoryManager: TMemoryManager = (
@ -490,6 +547,7 @@ begin
Result := (@GetMem <> @SysGetMem) or (@FreeMem <> @SysFreeMem) or (@ReallocMem <> @SysReallocMem);
end;
{$IFDEF KolibriOS}
function SysFreeMem(P: Pointer): Integer;
asm
PUSH EBX
@ -520,6 +578,7 @@ asm
INT $40
POP EBX
end;
{$ENDIF}
procedure _FillChar(var Dest; Count: Cardinal; Value: Byte);
asm
@ -702,12 +761,16 @@ type
{$IFDEF UnicodeCompiler}
CodePage, CharSize: Word;
{$ENDIF}
RefCount, Length: LongInt;
RefCount: Integer;
Length: Cardinal;
end;
function _LStrLen(const S: KolibriString): LongInt;
begin
Result := PStrRec(PKolibriChar(Pointer(S)) - SizeOf(TStrRec)).Length;
function _LStrLen(const S: KolibriString): Cardinal;
asm
TEST EAX, EAX
JZ @@exit
MOV EAX, [EAX-4]
@@exit:
end;
function _LStrToPChar(const S: KolibriString): PKolibriChar;
@ -830,6 +893,11 @@ begin
con_write_string(#10, 1);
end;
{$IFNDEF KolibriOS}
{$I KoW\__lldiv.inc}
{$I KoW\System.inc}
{$ENDIF}
initialization
asm
@ -837,15 +905,21 @@ initialization
FNINIT
FLDCW Default8087CW
{$IFDEF KolibriOS}
// HeapInit
PUSH EBX
MOV EAX, 68
MOV EBX, 11
INT $40
POP EBX
{$ENDIF}
end;
{$IFDEF KolibriOS}
AppPath := PPKolibriChar(32)^;
CmdLine := PPKolibriChar(28)^;
{$ELSE}
InitKoW;
{$ENDIF}
end.

7
My/.dof
View File

@ -1,5 +1,6 @@
[Directories]
OutputDir=..\..\Bin
UnitOutputDir=..\..\Bin\DCU
SearchPath=..\..\Lib;..\..\Bin\DCU
OutputDir=..\..\Bin\KoW
UnitOutputDir=..\..\Bin\KoW\DCU
SearchPath=..\..\Lib;..\..\Bin\KoW\DCU
UnitAliases=
UsePackages=0

12
Tools/build.bat
View File

@ -7,7 +7,7 @@ if #%Source%#==## (
goto exit
)
call "%~dp0init.bat"
call "%~dp0init.bat" -dKolibriOS
set Bin=%~dp0..\Bin
set DCU=%Bin%\DCU
@ -17,10 +17,16 @@ set Units=%~dp0..\Lib;%DCU%
if exist "%Source%.cfg" del "%Source%.cfg"
dcc32 %Source%.dpr -e"%Bin%" -n"%DCU%" -u"%Units%" %Options%
dcc32 -b %Source%.dpr -e"%Bin%" -n"%DCU%" -u"%Units%" %Options% -dKolibriOS
if errorlevel 1 goto exit
call "%~dp0convert.bat" "%Target%.exe"
"%~dp0..\Pet" -nologo -strip -trunc -dropsect .idata,.rsrc -rebase 0 -osver 0.7 -log brief -into "%Target%.exe"
if errorlevel 1 goto exit
"%~dp0..\exe2kos" "%Target%.exe"
if errorlevel 1 goto exit
"%~dp0..\kpack" "%Target%"
if errorlevel 1 goto exit
del "%Target%.exe"

8
Tools/convert-all.bat
View File

@ -1,8 +0,0 @@
@echo off
for %%f in ("%~dp0*.exe") do (
call "%~dp0..\Tools\convert.bat" "%%f" %*
if errorlevel 1 goto exit
)
:exit

16
Tools/convert.bat
View File

@ -1,16 +0,0 @@
@echo off
if #%1#==## (
echo Usage: %~n0 [source-file.exe [pet-options]]
goto exit
)
"%~dp0..\Pet" -nologo -strip -trunc -dropsect .idata,.rsrc -rebase 0 -osver 0.7 -log brief -into %*
if errorlevel 1 goto exit
"%~dp0..\exe2kos" %1
if errorlevel 1 goto exit
"%~dp0..\kpack" "%~dp1%~n1"
:exit

11
Tools/init.bat
View File

@ -6,13 +6,4 @@ set DCU=%Bin%\DCU
if not exist "%Bin%" mkdir "%Bin%"
if not exist "%DCU%" mkdir "%DCU%"
echo @call "%%~dp0..\Tools\convert.bat" %%* >"%Bin%\convert.bat"
if errorlevel 1 goto exit
copy "%~dp0convert-all.bat" "%Bin%" >nul
if errorlevel 1 goto exit
dcc32 -m -y -z "%~dp0..\Lib\System" -n"%DCU%"
if errorlevel 1 goto exit
:exit
dcc32 -m -y -z "%~dp0..\Lib\System" -n"%DCU%" %*

17
init-for-IDE.bat
View File

@ -1,9 +1,16 @@
@echo off
set DCU=%~dp0Bin\DCU
set KoW=%~dp0Bin\KoW\DCU
if #%1#==## (
call "%~dp0Tools\init.bat"
if errorlevel 1 goto exit
if not exist "%KoW%" mkdir "%KoW%"
move "%DCU%\SysInit.dcu" "%KoW%" >nul
move "%DCU%\System.dcu" "%KoW%" >nul
call %0 Examples Examples\Console
if errorlevel 1 goto exit
@ -17,8 +24,14 @@ if #%1#==## (
if exist "%~dp0%1\.dof" (
for /d %%f in ("%~dp0%2\*") do (
if not exist "%%f\%%~nf.dof" (
echo %%f\%%~nf.dof
copy "%~dp0%1\.dof" "%%f\%%~nf.dof" >nul
if exist "%%f\%%~nf.dpr" (
echo Initializing IDE settings for "%%f"
copy "%~dp0%1\.dof" "%%f\%%~nf.dof" >nul
if errorlevel 1 goto exit
)
)
if exist "%%f\init.bat" (
call "%%f\init.bat" KoW
if errorlevel 1 goto exit
)
)