CRT functions/procedures made safe with overloaded Write/WriteLn implementations

This commit is contained in:
Владислав Джавадов 2020-06-09 03:30:39 +03:00
parent 023d565b81
commit 6ee928a133
6 changed files with 208 additions and 57 deletions

View File

@ -19,8 +19,8 @@ begin
repeat
with GetSystemDate, GetSystemTime do
begin
Write('%02x.%02x.%02x', Day, Month, Year);
Write(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
Write('%02x.%02x.%02x', [Day, Month, Year]);
Write(' - %02x:%02x:%02x', [Hours, Minutes, Seconds]);
end;
GotoXY(CursorXY);
Delay(500);

View File

@ -10,14 +10,14 @@ const
BUFFER_SIZE = 256;
var
Buffer: array[0..BUFFER_SIZE - 1] of Char;
Buffer: array[0..BUFFER_SIZE - 1] of KolibriChar;
begin
InitConsole('Get Current Directory', False);
GetCurrentDirectory(Buffer, BUFFER_SIZE);
Write('AppPath is "%s"'#10, AppPath^);
Write('CmdLine is "%s"'#10, CmdLine^);
Write('Current Directory is "%s"'#10, Buffer);
WriteLn('AppPath is "%s"', [AppPath^]);
WriteLn('CmdLine is "%s"', [CmdLine^]);
WriteLn('Current Directory is "%s"', [Buffer]);
end.

View File

@ -10,5 +10,5 @@ var
begin
InitConsole('Load File', False);
Buffer := LoadFile('/sys/example.asm', FileSize);
WriteText(Buffer, FileSize);
WriteLn(Buffer, FileSize);
end.

View File

@ -21,36 +21,36 @@ begin
if ReadFolder(FolderPath, FolderInformation, 0, 0, 0, BlocksRead) = 0 then
with FolderInformation do
Write('Folder "%s" contains %u files and/or folders.'#10#10, FolderPath, FileCount)
WriteLn('Folder "%s" contains %u files and/or folders.', [FolderPath, FileCount], 2)
else
Write('Folder "%s" can not be read.'#10, FolderPath);
WriteLn('Folder "%s" can not be read.', [FolderPath]);
Pos := 0;
while ReadFolder(FolderPath, FolderInformation, 1, Pos, 0, BlocksRead) = 0 do
begin
with FolderInformation, FileInformation[0] do
begin
Write('FileName = %s'#10, Name);
WriteLn('FileName = %s', [Name]);
with Attributes do
begin
Write( 'SizeLo = %u'#10, TInt64Rec(Size).Lo);
Write( 'SizeHi = %u'#10, TInt64Rec(Size).Hi);
WriteLn( 'SizeLo = %u', [TInt64Rec(Size).Lo]);
WriteLn( 'SizeHi = %u', [TInt64Rec(Size).Hi]);
with Modify.Date do
Write('Modify Date = %02d.%02d.%02d'#10, Day, Month, Year);
WriteLn('Modify Date = %02d.%02d.%02d', [Day, Month, Year]);
with Modify.Time do
Write('Modify Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
WriteLn('Modify Time = %02d:%02d:%02d', [Hours, Minutes, Seconds]);
with Access.Date do
Write('Access Date = %02d.%02d.%02d'#10, Day, Month, Year);
WriteLn('Access Date = %02d.%02d.%02d', [Day, Month, Year]);
with Access.Time do
Write('Access Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
WriteLn('Access Time = %02d:%02d:%02d', [Hours, Minutes, Seconds]);
with Creation.Date do
Write('Creation Date = %02d.%02d.%02d'#10, Day, Month, Year);
WriteLn('Creation Date = %02d.%02d.%02d', [Day, Month, Year]);
with Creation.Time do
Write('Creation Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
Write( 'Attributes = 0x%08x'#10, Attributes);
WriteLn('Creation Time = %02d:%02d:%02d', [Hours, Minutes, Seconds]);
WriteLn( 'Attributes = 0x%08x', [Attributes]);
end;
end;
Write(#10);
WriteLn;
Inc(Pos);
end;
end.

View File

@ -49,8 +49,18 @@ function TextBackground(Color: Byte): LongWord; overload;
function TextColor: Byte; overload;
function TextColor(Color: Byte): LongWord; overload;
function WriteLn(LineBreaks: Integer = 1): LongInt; overload;
function WriteLn(Text: PKolibriChar; LineBreaks: Integer = 1): LongInt; overload;
procedure ClrScr;
procedure Write(Str: PKolibriChar); overload;
procedure Write(Str: PKolibriChar; Length: LongWord); overload;
procedure Write(const Str: ShortString); overload;
function Write(Format: PKolibriChar; const Args: array of const): Integer; overload;
procedure WriteLn(LineBreaks: Integer = 1); overload;
procedure WriteLn(Str: PKolibriChar; LineBreaks: Integer = 1); overload;
procedure WriteLn(Str: PKolibriChar; Length: LongWord; LineBreaks: Integer = 1); overload;
procedure WriteLn(const Str: ShortString; LineBreaks: Integer = 1); overload;
function WriteLn(Format: PKolibriChar; const Args: array of const; LineBreaks: Integer = 1): Integer; overload;
function CursorBig: Integer;
function CursorHeight: Integer; overload;
@ -58,69 +68,54 @@ function CursorHeight(Height: Integer): Integer; overload;
function CursorOff: Integer;
function CursorOn: Integer;
procedure Delay(Milliseconds: LongWord); // absolute Sleep(Milliseconds);
function KeyPressed: Boolean;
function ReadKey: KolibriChar;
var
ClrScr: procedure; stdcall;
FontHeight: function: Integer; stdcall;
KeyPressed: function: Boolean;
ReadKey: function: KolibriChar; stdcall;
Write: function(const Text: PKolibriChar): LongInt; cdecl varargs;
WriteText: procedure(Text: PKolibriChar; Length: LongWord); stdcall;
function FontHeight: Integer;
procedure Delay(Milliseconds: LongWord); // absolute Sleep(Milliseconds);
implementation
var
CloseWindow: Boolean;
function WriteLn(LineBreaks: Integer): LongInt;
var
I: Integer;
begin
Result := 0;
for I := 0 to LineBreaks - 1 do
Inc(Result, Write(#10));
end;
function WriteLn(Text: PKolibriChar; LineBreaks: Integer): LongInt;
begin
Result := Write(Text) + WriteLn(LineBreaks);
end;
procedure Delay(Milliseconds: LongWord);
begin
Sleep(Milliseconds div 10);
end;
var
hConsole: Pointer;
ClrScrProc: procedure; stdcall;
ConsoleExit: procedure(CloseWindow: Boolean); stdcall;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PKolibriChar); stdcall;
GetCursorHeight: function: Integer; stdcall;
GetFlags: function: LongWord; stdcall;
GetFontHeight: function: Integer; stdcall;
GotoXYProc: procedure(X, Y: Integer); stdcall;
KeyPressedFunc: function: Boolean;
PrintF: function(const Str: PKolibriChar): Integer; cdecl varargs;
ReadKeyFunc: function: KolibriChar; stdcall;
SetFlags: function(Flags: LongWord): LongWord; stdcall;
SetCursorHeight: function(Height: Integer): Integer; stdcall;
WhereXYProc: procedure(var X, Y: Integer); stdcall;
WritePChar: procedure(Str: PKolibriChar); stdcall;
WritePCharLen: procedure(Str: PKolibriChar; Length: LongWord); stdcall;
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean;
WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord);
begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ClrScr := GetProcAddress(hConsole, 'con_cls');
ClrScrProc := GetProcAddress(hConsole, 'con_cls');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
FontHeight := GetProcAddress(hConsole, 'con_get_font_height');
GetCursorHeight := GetProcAddress(hConsole, 'con_get_cursor_height');
GetFlags := GetProcAddress(hConsole, 'con_get_flags');
GetFontHeight := GetProcAddress(hConsole, 'con_get_font_height');
GotoXYProc := GetProcAddress(hConsole, 'con_set_cursor_pos');
KeyPressed := GetProcAddress(hConsole, 'con_kbhit');
ReadKey := GetProcAddress(hConsole, 'con_getch');
KeyPressedFunc := GetProcAddress(hConsole, 'con_kbhit');
PrintF := GetProcAddress(hConsole, 'con_printf');
ReadKeyFunc := GetProcAddress(hConsole, 'con_getch');
SetCursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height');
SetFlags := GetProcAddress(hConsole, 'con_set_flags');
WhereXYProc := GetProcAddress(hConsole, 'con_get_cursor_pos');
Write := GetProcAddress(hConsole, 'con_printf');
WriteText := GetProcAddress(hConsole, 'con_write_string');
WritePChar := GetProcAddress(hConsole, 'con_write_asciiz');
WritePCharLen := GetProcAddress(hConsole, 'con_write_string');
ConsoleInit(WndWidth, WndHeight, ScrWidth, ScrHeight, Caption);
CloseWindow := CloseWindowOnExit;
@ -212,6 +207,102 @@ begin
Result := SetCursorHeight(2);
end;
procedure ClrScr;
begin
ClrScrProc;
end;
procedure Write(Str: PKolibriChar);
begin
WritePChar(Str);
end;
procedure Write(Str: PKolibriChar; Length: LongWord);
begin
WritePCharLen(Str, Length);
end;
procedure Write(const Str: ShortString);
begin
WritePCharLen(@Str[1], Length(Str));
end;
function Write(Format: PKolibriChar; const Args: array of const): Integer;
const
VarArgSize = SizeOf(TVarRec);
asm
PUSH EDI
PUSH EBX
MOV EBX, ESP
INC ECX
JZ @@call
@@arg:
MOV EDI, [EDX + ECX * VarArgSize - VarArgSize]
PUSH EDI
LOOP @@arg
@@call:
PUSH ESP
PUSH EAX
CALL PrintF
MOV ESP, EBX
POP EBX
POP EDI
end;
procedure WriteLn(LineBreaks: Integer);
var
I: Integer;
begin
for I := 0 to LineBreaks - 1 do
WritePCharLen(#10, 1);
end;
procedure WriteLn(Str: PKolibriChar; LineBreaks: Integer);
begin
WritePChar(Str);
WriteLn(LineBreaks);
end;
procedure WriteLn(Str: PKolibriChar; Length: LongWord; LineBreaks: Integer);
begin
WritePCharLen(Str, Length);
WriteLn(LineBreaks);
end;
procedure WriteLn(const Str: ShortString; LineBreaks: Integer);
begin
WritePCharLen(@Str[1], Length(Str));
WriteLn(LineBreaks);
end;
function WriteLn(Format: PKolibriChar; const Args: array of const; LineBreaks: Integer = 1): Integer;
begin
Result := Write(Format, Args);
WriteLn(LineBreaks);
end;
function KeyPressed: Boolean;
begin
Result := KeyPressedFunc;
end;
function ReadKey: KolibriChar;
begin
Result := ReadKeyFunc;
end;
function FontHeight: Integer;
begin
Result := GetFontHeight;
end;
procedure Delay(Milliseconds: LongWord);
begin
Sleep(Milliseconds div 10);
end;
initialization
finalization

View File

@ -6,12 +6,50 @@ unit System;
interface
const
// Open array VarType values
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
vtExtended = 3;
vtString = 4;
vtPointer = 5;
vtPChar = 6;
vtObject = 7;
vtClass = 8;
vtWideChar = 9;
vtPWideChar = 10;
vtAnsiString = 11;
vtCurrency = 12;
vtVariant = 13;
vtInterface = 14;
vtWideString = 15;
vtInt64 = 16;
type
PPAnsiChar = ^PAnsiChar;
PInteger = ^Integer;
THandle = LongWord;
PByte = ^Byte;
PWord = ^Word;
PLongWord = ^LongWord;
PLongInt = ^LongInt;
PInt64 = ^Int64;
{$IF CompilerVersion > 14}
// PUInt64 = ^UInt64;
{$IFEND}
PCardinal = ^Cardinal;
PInteger = ^Integer;
PExtended = ^Extended;
PCurrency = ^Currency;
PShortString = ^ShortString;
PVariant = ^Variant;
TGUID = record
D1: LongWord;
D2: Word;
@ -41,6 +79,28 @@ type
OuterContext: PInitContext;
end;
PVarRec = ^TVarRec;
TVarRec = record { do not pack this record; it is compiler-generated }
case Byte of
vtInteger: (VarInteger: Integer; VarType: Byte);
vtBoolean: (VarBoolean: Boolean);
vtChar: (VarChar: Char);
vtExtended: (VarExtended: PExtended);
vtString: (VarString: PShortString);
vtPointer: (VarPointer: Pointer);
vtPChar: (VarPChar: PChar);
vtObject: (VarObject: Pointer);
vtClass: (VarClass: Pointer);
vtWideChar: (VarWideChar: WideChar);
vtPWideChar: (VarPWideChar: PWideChar);
vtAnsiString: (VarAnsiString: PAnsiChar);
vtCurrency: (VarCurrency: PCurrency);
vtVariant: (VarVariant: PVariant);
vtInterface: (VarInterface: Pointer);
vtWideString: (VarWideString: PWideChar);
vtInt64: (VarInt64: PInt64);
end;
procedure _Halt0;
procedure _HandleFinally;
procedure _StartExe(InitTable: PPackageInfo);