home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / PASLIBR.ZIP / FPDOS1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-15  |  6.8 KB  |  168 lines
  1. {------------------------------------------------------------}
  2. {-      FlashPac Pascal Library (Dos1 Unit) - V3.5        -}
  3. {-      (c) Copyright 1986-1991 - All Rights Reserved       -}
  4. {-                     SimpleSoft Inc                       -}
  5. {-                     1209 Poplar St                       -}
  6. {-                 La Crescent, MN 55947                    -}
  7. {------------------------------------------------------------}
  8.  
  9. Unit FPDos1;
  10. Interface
  11. {$B-,F+}
  12. {$IFNDEF VER40}
  13. {D-}
  14. {$ENDIF}
  15. Uses Dos;
  16.  
  17. {--------------------------------------------------------------------}
  18.  
  19.    Procedure Beep(Freq,Dur : Word);
  20.  
  21. {$IFNDEF VER60}
  22.    Function  DosExec( CommandLine : String ) : integer;
  23. {$ENDIF}
  24.  
  25.  
  26. Implementation
  27.  
  28. Const
  29.    Copyright1 = 'FlashPac Pascal Library (Dos Unit) - V3.5';
  30.    Copyright2 = '(c) Copyright 1986-1991 - All Rights Reserved';
  31.    Copyright3 = 'SimpleSoft, Inc.';
  32.    Copyright4 = '1209 Poplar St';
  33.    Copyright5 = 'La Crescent, MN 55947';
  34.  
  35.    {$L dos1\beep }
  36.  
  37. {--------------------------------------------------------------------}
  38.  
  39.    Procedure Beep;   External;
  40.  
  41. {$IFNDEF VER60}
  42. {---------------------------------------------------------------------}
  43. {- This function gives a programmer the ability to execute any       -}
  44. {- program from Turbo Pascal 4.0/5.0 without having to specify the   -}
  45. {- maximum heap limit.  This function uses the DOS function call     -}
  46. {- 4ah to return the unused memory in the heap to DOS.  The CmdLine  -}
  47. {- contains the full filespec of the program to be executed and the  -}
  48. {- command line parameters for the program being executed.  The      -}
  49. {- maximum length for the CmdLine is 127 characters.                 -}
  50. {-                                                                   -}
  51. {- 1. Program saves the contents of the Free list onto the heap.     -}
  52. {- 2. Frees up unsed memory area between the current HeapPtr and     -}
  53. {-    the top of memory and returns it to DOS.                       -}
  54. {- 3. Parses the CmdLine and passes the parameters into Turbo's      -}
  55. {-    Exec command.                                                  -}
  56. {- 4. On return the program reclaims the memory left in DOS          -}
  57. {- 5. Restores the Free memory block list to high memory             -}
  58. {- 6. Returns a termination code to the calling statement.           -}
  59. {-                                                                   -}
  60. {- Return Codes:                                                     -}
  61. {-    0  - Normal termination                                        -}
  62. {-    1  - Invalid function number                                   -}
  63. {-    2  - File not found                                            -}
  64. {-    5  - Access denied                                             -}
  65. {-    8  - insufficient memory                                       -}
  66. {-   10  - invalid envoronment                                       -}
  67. {-   11  - invalid format                                            -}
  68. {-  999  - Length of command line string is to long                  -}
  69. {-                                                                   -}
  70. {---------------------------------------------------------------------}
  71.  
  72. Function DosExec( CommandLine : String ) : Integer;
  73. Const
  74.    ReturnCode : Integer = 0;
  75.    FreeSize   : Word    = 0;
  76. Var
  77.    FreeCopy   : ^Byte;
  78.    i          : Integer;
  79.    Path       : String;
  80.    CmdLine    : String;
  81.    Regs       : Registers;
  82.  
  83. Begin
  84.  
  85.    {------------------------------------------------------------------}
  86.    {- check parm string length                                       -}
  87.    {------------------------------------------------------------------}
  88.  
  89.    If Length( CommandLine ) > 127 Then
  90.       DosExec := 999
  91.    Else Begin
  92.  
  93.       {---------------------------------------------------------------}
  94.       {- save Free list if need be                                   -}
  95.       {---------------------------------------------------------------}
  96.  
  97.       If Ofs(FreePtr^) <> 0 Then Begin
  98.          FreeSize := 0 - Ofs( FreePtr^ );
  99.          GetMem( FreeCopy, FreeSize + 16 );
  100.          move( FreePtr^, FreeCopy^, FreeSize );
  101.       End;
  102.  
  103.       {---------------------------------------------------------------}
  104.       {- realloc memory block to minimum amount needed.              -}
  105.       {---------------------------------------------------------------}
  106.  
  107.       Regs.es := PrefixSeg;
  108.       Regs.bx := Seg( HeapPtr^ ) - PrefixSeg + 1;
  109.       Regs.ah := $4a;
  110.       Intr( $21, Regs );
  111.  
  112.       {---------------------------------------------------------------}
  113.       {- Parse command line                                          -}
  114.       {---------------------------------------------------------------}
  115.  
  116.       FillChar( Path, SizeOf( Path ) , 0 );
  117.       FillChar( CmdLine, SizeOf( CmdLine ), 0 );
  118.       i := Pos( ' ', CommandLine );
  119.       If i = 0 Then
  120.          Path := Copy( CommandLine, 1, Length( CommandLine ) )
  121.       Else Begin
  122.          Path    := Copy( CommandLine, 1, i-1 );
  123.          CmdLine := Copy( CommandLine, i+1, Length( CommandLine ) - i );
  124.       End;
  125.  
  126.       {---------------------------------------------------------------}
  127.       {- execute the child process                                   -}
  128.       {---------------------------------------------------------------}
  129.  
  130.       Exec( Path, CmdLine );         {- call child process           -}
  131.       If DosError = 0 Then
  132.          ReturnCode := DosExitCode   {- set return code              -}
  133.       Else
  134.          ReturnCode := DosError;
  135.  
  136.       {---------------------------------------------------------------}
  137.       {- reclaim child process's memory                              -}
  138.       {---------------------------------------------------------------}
  139.  
  140.       Regs.es := PrefixSeg;       {- ask for 1 meg of memory to find -}
  141.       Regs.bx := $0ffff;          {- out how many paragraphs are     -}
  142.       Regs.ah := $4a;             {- available.  Amount of memory    -}
  143.       Intr( $21, Regs );          {- available is returned in bx.    -}
  144.  
  145.       Regs.ah := $4a;             {- reclaim amount of memory        -}
  146.       Intr( $21, Regs );          {- available with this call.       -}
  147.  
  148.       {---------------------------------------------------------------}
  149.       {- reset the Free list if need be                              -}
  150.       {---------------------------------------------------------------}
  151.  
  152.       If FreeSize > 0 Then Begin
  153.          move( FreeCopy^, FreePtr^, FreeSize );
  154.          FreeMem ( FreeCopy, FreeSize + 16 );
  155.       End;
  156.  
  157.       {---------------------------------------------------------------}
  158.       {- set the return code                                         -}
  159.       {---------------------------------------------------------------}
  160.  
  161.       DosExec := ReturnCode;
  162.    End;
  163. End;
  164. {$ENDIF}
  165.  
  166. Begin
  167. End.
  168.