home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
vp21beta.zip
/
AEXMPSRC.RAR
/
DELPHI
/
SYSDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
2000-08-15
|
14KB
|
413 lines
{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Examples. Version 2.1. █}
{█ SysUtils demonstration example █}
{█ ─────────────────────────────────────────────────█}
{█ Copyright (C) 1996-2000 vpascal.com █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
program SysDemo;
{&X+,H+,Delphi+,Use32-}
Uses
SysUtils;
Const
IndentLvl = 40;
BoolStr : Array[Boolean] of String = ( 'False', 'True' );
Function Indent( const s : String ) : String;
begin
Result := Copy( ' ' + s + ' .....................................', 1, IndentLvl ) + ' ';
end;
procedure Key;
begin
Write( ' Press Enter ---> ' );
Readln;
end;
Procedure ShowS( s1 : String; Const s2 : String );
begin
Writeln( Indent( s1 ), s2 );
end;
Procedure ShowL( s1 : String; i : LongInt );
begin
Writeln( Indent( s1 ), i );
end;
Procedure ShowExt( s1 : String; x : Extended );
begin
Writeln( Indent( s1 ), x );
end;
//
// Display system settings extracted from the OS by SysUtils
//
Procedure ShowSettings;
Var
i : integer;
begin
Writeln;
Writeln( 'System Settings:' );
ShowL( 'Win32Platform', Win32Platform );
ShowS( 'CurrencyString', CurrencyString );
ShowL( 'CurrencyFormat', CurrencyFormat );
ShowL( 'NegCurrFormat', NegCurrFormat );
ShowS( 'ThousandSeparator', ThousandSeparator );
ShowS( 'DecimalSeparator', DecimalSeparator );
ShowL( 'CurrencyDecimals', CurrencyDecimals );
ShowS( 'DateSeparator', DateSeparator );
ShowS( 'ShortDateFormat', ShortDateFormat );
ShowS( 'LongDateFormat', LongDateFormat );
ShowS( 'TimeSeparator', TimeSeparator );
ShowS( 'TimeAMString', TimeAMString );
ShowS( 'TimePMString', TimePMString );
ShowS( 'ShortTimeFormat', ShortTimeFormat );
ShowS( 'LongTimeFormat', LongTimeFormat );
Write( ' ShortMonthNames ' );
For i := 1 to 12 do Write( ShortMonthNames[i],' ' ); Writeln;
Write( ' LongMonthNames ' );
For i := 1 to 12 do Write( LongMonthNames[i],' ' ); Writeln;
Write( ' ShortDayNames ' );
for i := 1 to 7 do Write( ShortDayNames[i],' ' ); Writeln;
Write( ' LongDayNames ' );
for i := 1 to 7 do Write( LongDayNames[i],' ' ); Writeln;
Key;
end;
//
// Show different uses of the Format function
//
procedure ShowFormat;
var
x : Extended;
begin
Writeln;
Writeln( 'Testing the Format function:' );
x := 100.12;
ShowS( 'Format %f [100.12]', Format( '%f', [x] )) ;
ShowS( 'Format %14f [100.12]', Format( '%14f', [x] )) ;
ShowS( 'Format %14.3f [100.12]', Format( '%14.3f', [x] )) ;
ShowS( 'Format %*.3f [14,100.12]', Format( '%*.3f', [14,x] )) ;
ShowS( 'Format %14.*f [3,100.12]', Format( '%14.*f', [3,x] )) ;
ShowS( 'Format %*.*f [14,3,100.12]', Format( '%*.*f', [14,3,x] )) ;
ShowS( 'Format %g [100.12]', Format( '%g', [x] )) ;
ShowS( 'Format %14g [100.12]', Format( '%14g', [x] )) ;
ShowS( 'Format %.3g [100.12]', Format( '%.3g', [x] )) ;
ShowS( 'Format %14.3g [100.12]', Format( '%14.3g', [x] )) ;
ShowS( 'Format %n [100.12]', Format( '%n', [x] )) ;
ShowS( 'Format %14n [100.12]', Format( '%14n', [x] )) ;
ShowS( 'Format %.3n [100.12]', Format( '%.3n', [x] )) ;
ShowS( 'Format %14.3n [100.12]', Format( '%14.3n', [x] )) ;
ShowS( 'Format %e [100.12]', Format( '%e', [x] )) ;
ShowS( 'Format %14e [100.12]', Format( '%14e', [x] )) ;
ShowS( 'Format %.3e [100.12]', Format( '%.3e', [x] )) ;
ShowS( 'Format %14.3e [100.12]', Format( '%14.3e', [x] )) ;
ShowS( 'Format %m [100.12]', Format( '%m', [x] )) ;
ShowS( 'Format %14m [100.12]', Format( '%14m', [x] )) ;
ShowS( 'Format %.3m [100.12]', Format( '%.3m', [x] )) ;
ShowS( 'Format %14.3m [100.12]', Format( '%14.3m', [x] )) ;
Key;
end;
//
// Demonstrate various conversion functions
//
procedure ShowConversion;
var
x : Extended;
m : Currency;
begin
Writeln;
Writeln( 'Testing conversion functions:' );
x := -38.17;
m := 3012.91;
ShowS( 'Extended as FloatToStr', FloatToStr( x ) );
ShowS( 'Extended as CurrToStr', CurrToStr( x ) );
ShowS( 'Currency as FloatToStr', FloatToStr( m ) );
ShowS( 'Currency as CurrToStr', CurrToStr( m ) );
ShowS( 'Currency as CurrToStrF Gen', CurrToStrF( m, ffGeneral, 3 ) );
ShowS( 'Currency as CurrToStrF Exp', CurrToStrF( m, ffExponent, 3 ) );
ShowS( 'Currency as CurrToStrF Fix', CurrToStrF( m, ffFixed, 3 ) );
ShowS( 'Currency as CurrToStrF Num', CurrToStrF( m, ffNumber, 3 ) );
ShowS( 'Currency as CurrToStrF Curr', CurrToStrF( m, ffCurrency, 3 ) );
Writeln;
ShowS( 'Extended as FloatToStrF Gen', FloatToStrF( x, ffGeneral, 10, 3 ) );
ShowS( 'Extended as FloatToStrF Exp', FloatToStrF( x, ffExponent, 10, 3 ) );
ShowS( 'Extended as FloatToStrF Fix', FloatToStrF( x, ffFixed, 10, 3 ) );
ShowS( 'Extended as FloatToStrF Num', FloatToStrF( x, ffNumber, 10, 3 ) );
ShowS( 'Extended as FloatToStrF Cur', FloatToStrF( x, ffCurrency, 10, 3 ) );
Writeln;
ShowS( 'Currency as FloatToStrF Gen', FloatToStrF( m, ffGeneral, 10, 3 ) );
ShowS( 'Currency as FloatToStrF Exp', FloatToStrF( m, ffExponent, 10, 3 ) );
ShowS( 'Currency as FloatToStrF Fix', FloatToStrF( m, ffFixed, 10, 3 ) );
ShowS( 'Currency as FloatToStrF Num', FloatToStrF( m, ffNumber, 10, 3 ) );
ShowS( 'Currency as FloatToStrF Cur', FloatToStrF( m, ffCurrency, 10, 3 ) );
Key;
end;
//
// Demonstrate the different Currency formats
//
procedure ShowCurrencyFormats;
Var
m : Currency;
i : integer;
begin
Writeln;
Writeln( 'Testing currency formats:' );
m := 9912.33;
For i := 0 to 3 do
begin
CurrencyFormat := i;
ShowS( Format( 'CurrencyFormat %d', [i] ), FloatToStrF( m, ffCurrency, 10, 3 ) );
end;
Writeln;
m := -3891.01;
For i := 0 to 15 do
begin
NegCurrFormat := i;
ShowS( Format( 'NegCurrFormat %d', [i] ), FloatToStrF( m, ffCurrency, 10, 3 ) );
end;
Key;
end;
//
// Date/Time information and formatting functions
//
procedure ShowDateFunctions;
Var
t1, t2 : tDateTime;
ts : tTimeStamp;
d,m,y : Word;
h,n,s,s100 : Word;
St : String;
begin
Writeln;
Writeln( 'Testing date/time functions:' );
t1 := EncodeDate( 1996, 3, 23 );
t2 := EncodeTime( 16, 37, 51, 02 );
try
Write( ' Illegal EncodeData call: ' );
t1 := EncodeDate( 19996, 3, 23 );
t2 := EncodeTime( 16, 327, 51, 02 );
except
on E:EConvertError do
Writeln( 'Exception: "', E.Message, '" ') ;
else
Writeln('Unexpected exception!');
end;
DecodeDate( t1, y, m, d );
DecodeTime( t2, h,n,s,s100 );
try
ShowS( 'Date is ',Format( '(d-m-y) %d-%d-%d', [ d,m,y ] ) );
ShowS( 'Date is ',DateToStr( t1 ) );
ShowS( 'Time is ',Format( '(h:m:s.s100) %2d:%2d:%2d.%d', [ h,n,s,s100 ] ) );
ShowS( 'Time is ',TimeToStr( t2 ) );
ShowL( 'DayOfWeek', DayOfWeek( t1 ) );
ShowS( 'Today', DateToStr( Date ) );
ShowS( 'This Time', TimeToStr( Time ) );
ShowS( 'Now', DateTimeToStr( Now ) );
DateTimeToString( St, 'dddd, mmmm d, yyyy, "at" hh:mm AM/PM', Now );
ShowS( 'Now DateTimeToString', St );
ts := DateTimeToTimeStamp( Now );
ShowS( 'TimeStampTomSecs', Format( '%g', [ TimeStampTomSecs( ts ) ] ) );
ShowS( 'TimeStampToDateTime', DateTimeToStr( TimeStampToDateTime( ts ) ) );
ts := MSecsToTimeStamp( 1000000 );
ShowS( 'TimeStampToDateTime', DateTimeToStr( TimeStampToDateTime( ts ) ) );
except
on E:Exception do Writeln( 'Unexpected exception: "',E.Message,'"' );
end;
Key;
Writeln;
Writeln( 'DateTime formatting: ' );
try
t1 := StrToDate( DateToStr( t1 ) );
t2 := StrToTime( TimeToStr( t2 ) );
ShowS( 'FormatDateTime c', FormatDateTime( 'c', t1 ) );
ShowS( 'FormatDateTime ddd d/m yyyy', FormatDateTime( 'ddd d/m yyyy', t1 ) );
ShowS( 'FormatDateTime dddd dd/mm yy', FormatDateTime( 'dddd dd/mm yy', t1 ) );
ShowS( 'FormatDateTime dddd d. mmm yy', FormatDateTime( 'dddd d. mmm yy', t1 ) );
ShowS( 'FormatDateTime dddd d. mmmm yy', FormatDateTime( 'dddd d. mmmm yy', t1 ) );
ShowS( 'FormatDateTime ddddd', FormatDateTime( 'ddddd', t1 ) );
ShowS( 'FormatDateTime dddddd', FormatDateTime( 'dddddd', t1 ) );
ShowS( 'FormatDateTime t', FormatDateTime( 't', t2 ) );
ShowS( 'FormatDateTime tt', FormatDateTime( 'tt', t2 ) );
ShowS( 'FormatDateTime hh:nn:ss', FormatDateTime( 'hh:nn:ss', t2 ) );
ShowS( 'FormatDateTime h:n:s', FormatDateTime( 'h:n:s', t2 ) );
ShowS( 'FormatDateTime hh:n:s AM/PM', FormatDateTime( 'hh:n:s AM/PM', t2 ) );
ShowS( 'FormatDateTime hh:n:s ampm', FormatDateTime( 'hh:n:s ampm', t2 ) );
ShowS( 'FormatDateTime hh:n:s a/p', FormatDateTime( 'hh:n:s a/p', t2 ) );
ShowS( 'FormatDateTime hh:n:s A/P', FormatDateTime( 'hh:n:s A/P', t2 ) );
except
on E:Exception do Writeln( 'Unexpected exception: "',E.Message,'"' );
end;
key;
end;
//
// String functions
//
procedure ShowStringRoutines;
Var
s1, s2, s3 : String;
begin
Writeln;
Writeln( 'String routines:' );
s1 := 'First ';
s2 := 'Second ';
s3 := s1 + s2;
AppendStr( s1, s2 );
ShowS( 's1 + s2', s3 );
ShowS( 'AppendStr(s1,s2)',s1 );
s1 := ' "Nls": ''ABC abc æ¢å ƥŠäöüñëê'' '#9' ';
s2 := UpperCase( s1 );
ShowS( 'Original', s1 );
ShowS( 'UpperCase', s2 );
ShowS( 'LowerCase', LowerCase( s1 ) );
ShowS( 'AnsiUpperCase', AnsiUpperCase( s1 ) );
ShowS( 'AnsiLowerCase', AnsiLowerCase( s1 ) );
ShowL( 'CompareStr', CompareStr( s1, s2 ) );
ShowL( 'CompareText', CompareText( s1, s2 ) );
ShowL( 'AnsiCompareStr', AnsiCompareStr( s1, s2 ) );
ShowL( 'AnsiCompareText', AnsiCompareText( s1, s2 ) );
ShowS( 'Trim', '"'+Trim(s1)+'"' );
ShowS( 'TrimLeft', '"'+TrimLeft(s1)+'"' );
ShowS( 'TrimRight', '"'+TrimRight(s1)+'"' );
ShowS( 'QuotedStr', QuotedStr( s1 ) );
ShowS( 'IsValidIdent (yep)', BoolStr[IsValidIdent( '_123499kkANN' )] );
ShowS( 'IsValidIdent (nope)', BoolStr[IsValidIdent( '$_123499kkANN' )] );
s1 := 'Line1'#10'Line2'#13'Line3';
ShowS( 'MultiLine', s1 );
ShowS( 'AdjustLineBreaks', AdjustLineBreaks( s1 ) );
Key;
end;
//
// More conversion routines
//
procedure ShowConversion2;
var
b : Boolean;
st : Extended;
cu : Currency;
p : pChar;
s : String;
begin
Writeln;
Writeln( 'More conversion routines:' );
ShowS( 'IntToStr 100', IntToStr( 100 ) );
ShowS( 'IntToHex 100,2', IntToHex( 100, 2 ) );
ShowS( 'IntToHex 300,8', IntToHex( 300, 8 ) );
ShowL( 'StrToInt 100', StrToInt( '100' ) );
ShowL( 'StrToInt -10000', StrToInt( '-10000' ) );
ShowL( 'StrToInt $19100', StrToInt( '$19100' ) );
ShowL( 'StrToIntDef 12xyz, 10', StrToIntDef( '12xyz', 10 ) );
ShowL( 'StrToIntDef 123, 10', StrToIntDef( '123', 10 ) );
s := '123'+DecimalSeparator+'456'#0;
p := @s[1];
St := 0; b := TextToFloat( p, St, fvExtended );
ShowS( 'TextToFloat Ext '+s, Format( '%6s %g', [ BoolStr[b], St ] ) );
St := 0; b := TextToFloat( p, Cu, fvCurrency );
ShowS( 'TextToFloat Cur '+s, Format( '%6s %g', [ BoolStr[b], Cu ] ) );
St := 0; b := TextToFloat( '123X456', St, fvExtended );
ShowS( 'TextToFloat Ext 123X456', Format( '%6s %g', [ BoolStr[b], St ] ) );
key;
end;
//
// File I/O and file name functions
//
procedure ShowFileFunctions;
var
fn : string;
rc : Longint;
begin
Writeln;
Writeln( 'File functions:' );
fn := ParamStr(0);
ShowS( 'FileExists '+fn, BoolStr[FileExists(fn)] );
rc := FileOpen( fn, $40 ); // Readonly, Deny none
ShowL( 'FileOpen', rc );
if rc > 0 then
begin
ShowL( 'FileGetDate', FileGetDate( rc ) );
ShowS( 'FileGetDate', FormatDateTime( 'c', FileDateToDateTime( FileGetDate( rc ) ) ) );
fileclose( rc );
ShowL( 'FileAge', FileAge( fn ) );
ShowS( 'FileAge', FormatDateTime( 'c', FileDateToDateTime( FileAge( fn ) ) ) );
ShowS( 'FileGetAttr', IntToHex( FileGetAttr( fn ), 4 ) );
end;
ShowS( 'ChangeFileExt', ChangeFileExt( fn, '.TXT' ) );
ShowS( 'ChangeFileExt', ChangeFileExt( fn, '.Hello' ) );
ShowS( 'ChangeFileExt', ChangeFileExt( fn, '' ) );
ShowS( 'ExtractFilePath', ExtractFilePath( fn ) );
ShowS( 'ExtractFileDir', ExtractFileDir( fn ) );
ShowS( 'ExtractFileDrive', ExtractFileDrive( fn ) );
ShowS( 'ExtractFileName', ExtractFileName( fn ) );
ShowS( 'ExtractFileExt', ExtractFileExt( fn ) );
ShowS( 'ExpandFileName', ExpandFileName( fn ) );
ShowS( 'FileSearch', FileSearch( ExtractFileName(fn), 'C:\;F:\;.;E:\OS2' ) );
end;
//
// Disk related functions
//
procedure ShowDisks;
var
S : String;
i,size : Longint;
begin
Writeln;
Writeln( 'Disk functions:' );
S := '';
For i := 3 to 26 do
begin
size := DiskFree( i );
If Size <> -1 then
S := Format( '%s %s:%d', [s, chr(i+ord('A')-1), Size shr 20] );
end;
ShowS( 'DiskFree', S );
S := '';
For i := 3 to 26 do
begin
size := DiskSize( i );
If Size <> -1 then
S := Format( '%s %s:%d', [s, chr(i+ord('A')-1), Size shr 20] );
end;
ShowS( 'DiskSize', S );
ShowS( 'GetCurrentDir', GetCurrentDir );
end;
begin
{$IFDEF LINUX}
FileSystem := fsDos;
{$ENDIF}
WriteLn('Virtual Pascal SysUtils Demo Version 2.1 Copyright (C) 1996-2000 vpascal.com');
ShowSettings;
ShowFormat;
ShowConversion;
ShowConversion2;
ShowCurrencyFormats;
ShowDateFunctions;
ShowStringRoutines;
ShowFileFunctions;
ShowDisks;
end.