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 >
Pascal/Delphi Source File  |  2000-08-15  |  14KB  |  413 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples. Version 2.1.            █}
  4. {█      SysUtils demonstration example                   █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1996-2000 vpascal.com              █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. program SysDemo;
  11.  
  12. {&X+,H+,Delphi+,Use32-}
  13.  
  14. Uses
  15.   SysUtils;
  16.  
  17. Const
  18.   IndentLvl = 40;
  19.   BoolStr : Array[Boolean] of String = ( 'False', 'True' );
  20.  
  21. Function Indent( const s : String ) : String;
  22. begin
  23.   Result := Copy( '  ' + s + ' .....................................', 1, IndentLvl ) + ' ';
  24. end;
  25.  
  26. procedure Key;
  27. begin
  28.   Write( '  Press Enter ---> ' );
  29.   Readln;
  30. end;
  31.  
  32. Procedure ShowS( s1 : String; Const s2 : String );
  33. begin
  34.   Writeln( Indent( s1 ), s2 );
  35. end;
  36.  
  37. Procedure ShowL( s1 : String; i : LongInt );
  38. begin
  39.   Writeln( Indent( s1 ), i );
  40. end;
  41.  
  42. Procedure ShowExt( s1 : String; x : Extended );
  43. begin
  44.   Writeln( Indent( s1 ), x );
  45. end;
  46.  
  47. //
  48. // Display system settings extracted from the OS by SysUtils
  49. //
  50. Procedure ShowSettings;
  51. Var
  52.   i : integer;
  53. begin
  54.   Writeln;
  55.   Writeln( 'System Settings:' );
  56.   ShowL( 'Win32Platform', Win32Platform );
  57.   ShowS( 'CurrencyString', CurrencyString );
  58.   ShowL( 'CurrencyFormat', CurrencyFormat );
  59.   ShowL( 'NegCurrFormat', NegCurrFormat );
  60.   ShowS( 'ThousandSeparator', ThousandSeparator );
  61.   ShowS( 'DecimalSeparator', DecimalSeparator );
  62.   ShowL( 'CurrencyDecimals', CurrencyDecimals );
  63.   ShowS( 'DateSeparator', DateSeparator );
  64.   ShowS( 'ShortDateFormat', ShortDateFormat );
  65.   ShowS( 'LongDateFormat', LongDateFormat );
  66.   ShowS( 'TimeSeparator', TimeSeparator );
  67.   ShowS( 'TimeAMString', TimeAMString );
  68.   ShowS( 'TimePMString', TimePMString );
  69.   ShowS( 'ShortTimeFormat', ShortTimeFormat );
  70.   ShowS( 'LongTimeFormat', LongTimeFormat );
  71.   Write( '  ShortMonthNames  ' );
  72.   For i := 1 to 12 do Write( ShortMonthNames[i],' ' ); Writeln;
  73.   Write( '  LongMonthNames   ' );
  74.   For i := 1 to 12 do Write( LongMonthNames[i],' ' );  Writeln;
  75.   Write( '  ShortDayNames    ' );
  76.   for i := 1 to 7 do Write( ShortDayNames[i],' ' );    Writeln;
  77.   Write( '  LongDayNames     ' );
  78.   for i := 1 to 7 do Write( LongDayNames[i],' ' );     Writeln;
  79.   Key;
  80. end;
  81.  
  82. //
  83. // Show different uses of the Format function
  84. //
  85. procedure ShowFormat;
  86. var
  87.   x : Extended;
  88. begin
  89.   Writeln;
  90.   Writeln( 'Testing the Format function:' );
  91.   x := 100.12;
  92.   ShowS( 'Format %f     [100.12]', Format( '%f', [x] )) ;
  93.   ShowS( 'Format %14f   [100.12]', Format( '%14f', [x] )) ;
  94.   ShowS( 'Format %14.3f [100.12]', Format( '%14.3f', [x] )) ;
  95.   ShowS( 'Format %*.3f  [14,100.12]', Format( '%*.3f', [14,x] )) ;
  96.   ShowS( 'Format %14.*f [3,100.12]', Format( '%14.*f', [3,x] )) ;
  97.   ShowS( 'Format %*.*f  [14,3,100.12]', Format( '%*.*f', [14,3,x] )) ;
  98.   ShowS( 'Format %g     [100.12]', Format( '%g', [x] )) ;
  99.   ShowS( 'Format %14g   [100.12]', Format( '%14g', [x] )) ;
  100.   ShowS( 'Format %.3g   [100.12]', Format( '%.3g', [x] )) ;
  101.   ShowS( 'Format %14.3g [100.12]', Format( '%14.3g', [x] )) ;
  102.   ShowS( 'Format %n     [100.12]', Format( '%n', [x] )) ;
  103.   ShowS( 'Format %14n   [100.12]', Format( '%14n', [x] )) ;
  104.   ShowS( 'Format %.3n   [100.12]', Format( '%.3n', [x] )) ;
  105.   ShowS( 'Format %14.3n [100.12]', Format( '%14.3n', [x] )) ;
  106.   ShowS( 'Format %e     [100.12]', Format( '%e', [x] )) ;
  107.   ShowS( 'Format %14e   [100.12]', Format( '%14e', [x] )) ;
  108.   ShowS( 'Format %.3e   [100.12]', Format( '%.3e', [x] )) ;
  109.   ShowS( 'Format %14.3e [100.12]', Format( '%14.3e', [x] )) ;
  110.   ShowS( 'Format %m     [100.12]', Format( '%m', [x] )) ;
  111.   ShowS( 'Format %14m   [100.12]', Format( '%14m', [x] )) ;
  112.   ShowS( 'Format %.3m   [100.12]', Format( '%.3m', [x] )) ;
  113.   ShowS( 'Format %14.3m [100.12]', Format( '%14.3m', [x] )) ;
  114.   Key;
  115. end;
  116.  
  117. //
  118. // Demonstrate various conversion functions
  119. //
  120. procedure ShowConversion;
  121. var
  122.   x : Extended;
  123.   m : Currency;
  124. begin
  125.   Writeln;
  126.   Writeln( 'Testing conversion functions:' );
  127.   x := -38.17;
  128.   m := 3012.91;
  129.   ShowS( 'Extended as FloatToStr', FloatToStr( x ) );
  130.   ShowS( 'Extended as CurrToStr', CurrToStr( x ) );
  131.   ShowS( 'Currency as FloatToStr', FloatToStr( m ) );
  132.   ShowS( 'Currency as CurrToStr', CurrToStr( m ) );
  133.   ShowS( 'Currency as CurrToStrF Gen', CurrToStrF( m, ffGeneral, 3 ) );
  134.   ShowS( 'Currency as CurrToStrF Exp', CurrToStrF( m, ffExponent, 3 ) );
  135.   ShowS( 'Currency as CurrToStrF Fix', CurrToStrF( m, ffFixed, 3 ) );
  136.   ShowS( 'Currency as CurrToStrF Num', CurrToStrF( m, ffNumber, 3 ) );
  137.   ShowS( 'Currency as CurrToStrF Curr', CurrToStrF( m, ffCurrency, 3 ) );
  138.   Writeln;
  139.  
  140.   ShowS( 'Extended as FloatToStrF Gen', FloatToStrF( x, ffGeneral, 10, 3 ) );
  141.   ShowS( 'Extended as FloatToStrF Exp', FloatToStrF( x, ffExponent, 10, 3 ) );
  142.   ShowS( 'Extended as FloatToStrF Fix', FloatToStrF( x, ffFixed, 10, 3 ) );
  143.   ShowS( 'Extended as FloatToStrF Num', FloatToStrF( x, ffNumber, 10, 3 ) );
  144.   ShowS( 'Extended as FloatToStrF Cur', FloatToStrF( x, ffCurrency, 10, 3 ) );
  145.   Writeln;
  146.  
  147.   ShowS( 'Currency as FloatToStrF Gen', FloatToStrF( m, ffGeneral, 10, 3 ) );
  148.   ShowS( 'Currency as FloatToStrF Exp', FloatToStrF( m, ffExponent, 10, 3 ) );
  149.   ShowS( 'Currency as FloatToStrF Fix', FloatToStrF( m, ffFixed, 10, 3 ) );
  150.   ShowS( 'Currency as FloatToStrF Num', FloatToStrF( m, ffNumber, 10, 3 ) );
  151.   ShowS( 'Currency as FloatToStrF Cur', FloatToStrF( m, ffCurrency, 10, 3 ) );
  152.   Key;
  153. end;
  154.  
  155. //
  156. // Demonstrate the different Currency formats
  157. //
  158. procedure ShowCurrencyFormats;
  159. Var
  160.   m : Currency;
  161.   i : integer;
  162. begin
  163.   Writeln;
  164.   Writeln( 'Testing currency formats:' );
  165.   m := 9912.33;
  166.   For i := 0 to 3 do
  167.     begin
  168.       CurrencyFormat := i;
  169.       ShowS( Format( 'CurrencyFormat %d', [i] ), FloatToStrF( m, ffCurrency, 10, 3 ) );
  170.     end;
  171.  
  172.   Writeln;
  173.   m := -3891.01;
  174.   For i := 0 to 15 do
  175.     begin
  176.       NegCurrFormat := i;
  177.       ShowS( Format( 'NegCurrFormat %d', [i] ), FloatToStrF( m, ffCurrency, 10, 3 ) );
  178.     end;
  179.   Key;
  180. end;
  181.  
  182. //
  183. // Date/Time information and formatting functions
  184. //
  185. procedure ShowDateFunctions;
  186. Var
  187.   t1, t2   : tDateTime;
  188.   ts       : tTimeStamp;
  189.   d,m,y    : Word;
  190.   h,n,s,s100 : Word;
  191.   St       : String;
  192. begin
  193.   Writeln;
  194.   Writeln( 'Testing date/time functions:' );
  195.   t1 := EncodeDate( 1996, 3, 23 );
  196.   t2 := EncodeTime( 16, 37, 51, 02 );
  197.   try
  198.     Write( '  Illegal EncodeData call: ' );
  199.     t1 := EncodeDate( 19996, 3, 23 );
  200.     t2 := EncodeTime( 16, 327, 51, 02 );
  201.   except
  202.     on E:EConvertError do
  203.       Writeln( 'Exception: "', E.Message, '" ') ;
  204.   else
  205.     Writeln('Unexpected exception!');
  206.   end;
  207.   DecodeDate( t1, y, m, d );
  208.   DecodeTime( t2, h,n,s,s100 );
  209.   try
  210.     ShowS( 'Date is ',Format( '(d-m-y) %d-%d-%d', [ d,m,y ] ) );
  211.     ShowS( 'Date is ',DateToStr( t1 ) );
  212.     ShowS( 'Time is ',Format( '(h:m:s.s100) %2d:%2d:%2d.%d', [ h,n,s,s100 ] ) );
  213.     ShowS( 'Time is ',TimeToStr( t2 ) );
  214.     ShowL( 'DayOfWeek', DayOfWeek( t1 ) );
  215.     ShowS( 'Today', DateToStr( Date ) );
  216.     ShowS( 'This Time', TimeToStr( Time ) );
  217.     ShowS( 'Now', DateTimeToStr( Now ) );
  218.     DateTimeToString( St, 'dddd, mmmm d, yyyy, "at" hh:mm AM/PM', Now );
  219.     ShowS( 'Now DateTimeToString', St );
  220.     ts := DateTimeToTimeStamp( Now );
  221.     ShowS( 'TimeStampTomSecs', Format( '%g', [ TimeStampTomSecs( ts ) ] ) );
  222.     ShowS( 'TimeStampToDateTime', DateTimeToStr( TimeStampToDateTime( ts ) ) );
  223.     ts := MSecsToTimeStamp( 1000000 );
  224.     ShowS( 'TimeStampToDateTime', DateTimeToStr( TimeStampToDateTime( ts ) ) );
  225.   except
  226.     on E:Exception do Writeln( 'Unexpected exception: "',E.Message,'"' );
  227.   end;
  228.   Key;
  229.   Writeln;
  230.   Writeln( 'DateTime formatting: ' );
  231.  
  232.   try
  233.     t1 := StrToDate( DateToStr( t1 ) );
  234.     t2 := StrToTime( TimeToStr( t2 ) );
  235.     ShowS( 'FormatDateTime c', FormatDateTime( 'c', t1 ) );
  236.     ShowS( 'FormatDateTime ddd d/m yyyy', FormatDateTime( 'ddd d/m yyyy', t1 ) );
  237.     ShowS( 'FormatDateTime dddd dd/mm yy', FormatDateTime( 'dddd dd/mm yy', t1 ) );
  238.     ShowS( 'FormatDateTime dddd d. mmm yy', FormatDateTime( 'dddd d. mmm yy', t1 ) );
  239.     ShowS( 'FormatDateTime dddd d. mmmm yy', FormatDateTime( 'dddd d. mmmm yy', t1 ) );
  240.     ShowS( 'FormatDateTime ddddd', FormatDateTime( 'ddddd', t1 ) );
  241.     ShowS( 'FormatDateTime dddddd', FormatDateTime( 'dddddd', t1 ) );
  242.     ShowS( 'FormatDateTime t', FormatDateTime( 't', t2 ) );
  243.     ShowS( 'FormatDateTime tt', FormatDateTime( 'tt', t2 ) );
  244.     ShowS( 'FormatDateTime hh:nn:ss', FormatDateTime( 'hh:nn:ss', t2 ) );
  245.     ShowS( 'FormatDateTime h:n:s', FormatDateTime( 'h:n:s', t2 ) );
  246.     ShowS( 'FormatDateTime hh:n:s AM/PM', FormatDateTime( 'hh:n:s AM/PM', t2 ) );
  247.     ShowS( 'FormatDateTime hh:n:s ampm', FormatDateTime( 'hh:n:s ampm', t2 ) );
  248.     ShowS( 'FormatDateTime hh:n:s a/p', FormatDateTime( 'hh:n:s a/p', t2 ) );
  249.     ShowS( 'FormatDateTime hh:n:s A/P', FormatDateTime( 'hh:n:s A/P', t2 ) );
  250.   except
  251.     on E:Exception do Writeln( 'Unexpected exception: "',E.Message,'"' );
  252.   end;
  253.   key;
  254. end;
  255.  
  256. //
  257. // String functions
  258. //
  259. procedure ShowStringRoutines;
  260. Var
  261.   s1, s2, s3 : String;
  262.  
  263. begin
  264.   Writeln;
  265.   Writeln( 'String routines:' );
  266.   s1 := 'First ';
  267.   s2 := 'Second ';
  268.   s3 := s1 + s2;
  269.   AppendStr( s1, s2 );
  270.   ShowS( 's1 + s2', s3 );
  271.   ShowS( 'AppendStr(s1,s2)',s1 );
  272.   s1 := ' "Nls": ''ABC abc æ¢å Æ¥Å äöüñëê'' '#9' ';
  273.   s2 := UpperCase( s1 );
  274.   ShowS( 'Original', s1 );
  275.   ShowS( 'UpperCase', s2 );
  276.   ShowS( 'LowerCase', LowerCase( s1 ) );
  277.   ShowS( 'AnsiUpperCase', AnsiUpperCase( s1 ) );
  278.   ShowS( 'AnsiLowerCase', AnsiLowerCase( s1 ) );
  279.   ShowL( 'CompareStr', CompareStr( s1, s2 ) );
  280.   ShowL( 'CompareText', CompareText( s1, s2 ) );
  281.   ShowL( 'AnsiCompareStr', AnsiCompareStr( s1, s2 ) );
  282.   ShowL( 'AnsiCompareText', AnsiCompareText( s1, s2 ) );
  283.   ShowS( 'Trim', '"'+Trim(s1)+'"' );
  284.   ShowS( 'TrimLeft', '"'+TrimLeft(s1)+'"' );
  285.   ShowS( 'TrimRight', '"'+TrimRight(s1)+'"' );
  286.   ShowS( 'QuotedStr', QuotedStr( s1 ) );
  287.   ShowS( 'IsValidIdent (yep)', BoolStr[IsValidIdent( '_123499kkANN' )] );
  288.   ShowS( 'IsValidIdent (nope)', BoolStr[IsValidIdent( '$_123499kkANN' )] );
  289.   s1 := 'Line1'#10'Line2'#13'Line3';
  290.   ShowS( 'MultiLine', s1 );
  291.   ShowS( 'AdjustLineBreaks', AdjustLineBreaks( s1 ) );
  292.   Key;
  293. end;
  294.  
  295. //
  296. // More conversion routines
  297. //
  298. procedure ShowConversion2;
  299. var
  300.   b  : Boolean;
  301.   st : Extended;
  302.   cu : Currency;
  303.   p  : pChar;
  304.   s  : String;
  305.  
  306. begin
  307.   Writeln;
  308.   Writeln( 'More conversion routines:' );
  309.   ShowS( 'IntToStr 100', IntToStr( 100 ) );
  310.   ShowS( 'IntToHex 100,2', IntToHex( 100, 2 ) );
  311.   ShowS( 'IntToHex 300,8', IntToHex( 300, 8 ) );
  312.   ShowL( 'StrToInt 100', StrToInt( '100' ) );
  313.   ShowL( 'StrToInt -10000', StrToInt( '-10000' ) );
  314.   ShowL( 'StrToInt $19100', StrToInt( '$19100' ) );
  315.   ShowL( 'StrToIntDef 12xyz, 10', StrToIntDef( '12xyz', 10 ) );
  316.   ShowL( 'StrToIntDef 123, 10', StrToIntDef( '123', 10 ) );
  317.   s := '123'+DecimalSeparator+'456'#0;
  318.   p := @s[1];
  319.   St := 0; b := TextToFloat( p, St, fvExtended );
  320.   ShowS( 'TextToFloat Ext '+s, Format( '%6s  %g', [ BoolStr[b], St ] ) );
  321.   St := 0; b := TextToFloat( p, Cu, fvCurrency );
  322.   ShowS( 'TextToFloat Cur '+s, Format( '%6s  %g', [ BoolStr[b], Cu ] ) );
  323.   St := 0; b := TextToFloat( '123X456', St, fvExtended );
  324.   ShowS( 'TextToFloat Ext 123X456', Format( '%6s  %g', [ BoolStr[b], St ] ) );
  325.   key;
  326. end;
  327.  
  328. //
  329. // File I/O and file name functions
  330. //
  331. procedure ShowFileFunctions;
  332. var
  333.   fn : string;
  334.   rc : Longint;
  335. begin
  336.   Writeln;
  337.   Writeln( 'File functions:' );
  338.   fn := ParamStr(0);
  339.   ShowS( 'FileExists '+fn, BoolStr[FileExists(fn)] );
  340.   rc := FileOpen( fn, $40 ); // Readonly, Deny none
  341.   ShowL( 'FileOpen', rc );
  342.   if rc > 0 then
  343.     begin
  344.       ShowL( 'FileGetDate', FileGetDate( rc ) );
  345.       ShowS( 'FileGetDate', FormatDateTime( 'c', FileDateToDateTime( FileGetDate( rc ) ) ) );
  346.       fileclose( rc );
  347.       ShowL( 'FileAge', FileAge( fn ) );
  348.       ShowS( 'FileAge', FormatDateTime( 'c', FileDateToDateTime( FileAge( fn ) ) ) );
  349.       ShowS( 'FileGetAttr', IntToHex( FileGetAttr( fn ), 4 ) );
  350.     end;
  351.  
  352.   ShowS( 'ChangeFileExt', ChangeFileExt( fn, '.TXT' ) );
  353.   ShowS( 'ChangeFileExt', ChangeFileExt( fn, '.Hello' ) );
  354.   ShowS( 'ChangeFileExt', ChangeFileExt( fn, '' ) );
  355.   ShowS( 'ExtractFilePath', ExtractFilePath( fn ) );
  356.   ShowS( 'ExtractFileDir', ExtractFileDir( fn ) );
  357.   ShowS( 'ExtractFileDrive', ExtractFileDrive( fn ) );
  358.   ShowS( 'ExtractFileName', ExtractFileName( fn ) );
  359.   ShowS( 'ExtractFileExt', ExtractFileExt( fn ) );
  360.   ShowS( 'ExpandFileName', ExpandFileName( fn ) );
  361.   ShowS( 'FileSearch', FileSearch( ExtractFileName(fn), 'C:\;F:\;.;E:\OS2' ) );
  362. end;
  363.  
  364. //
  365. // Disk related functions
  366. //
  367. procedure ShowDisks;
  368. var
  369.   S : String;
  370.   i,size : Longint;
  371. begin
  372.   Writeln;
  373.   Writeln( 'Disk functions:' );
  374.   S := '';
  375.   For i := 3 to 26 do
  376.     begin
  377.       size := DiskFree( i );
  378.       If Size <> -1 then
  379.         S := Format( '%s  %s:%d', [s, chr(i+ord('A')-1), Size shr 20] );
  380.     end;
  381.   ShowS( 'DiskFree', S );
  382.   S := '';
  383.   For i := 3 to 26 do
  384.     begin
  385.       size := DiskSize( i );
  386.       If Size <> -1 then
  387.         S := Format( '%s  %s:%d', [s, chr(i+ord('A')-1), Size shr 20] );
  388.     end;
  389.   ShowS( 'DiskSize', S );
  390.   ShowS( 'GetCurrentDir', GetCurrentDir );
  391. end;
  392.  
  393. begin
  394.   {$IFDEF LINUX}
  395.   FileSystem := fsDos;
  396.   {$ENDIF}
  397.  
  398.   WriteLn('Virtual Pascal SysUtils Demo  Version 2.1 Copyright (C) 1996-2000 vpascal.com');
  399.   ShowSettings;
  400.   ShowFormat;
  401.   ShowConversion;
  402.   ShowConversion2;
  403.   ShowCurrencyFormats;
  404.   ShowDateFunctions;
  405.   ShowStringRoutines;
  406.   ShowFileFunctions;
  407.   ShowDisks;
  408. end.
  409.  
  410.  
  411.  
  412.  
  413.