home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / memory / swap / swap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-11-12  |  10.4 KB  |  211 lines
  1. {***************************************************************************
  2. *  S W A P : A unit which makes available an alternative Exec procedure    *
  3. *            for calling any program from a Turbo Pascal program. Unlike   *
  4. *            the normal Exec procedure, the Turbo program is stored in EMS *
  5. *            memory or hard disk before the new program is executed. This  *
  6. *            saves memory for the execution of the new program.            *
  7. **------------------------------------------------------------------------**
  8. *  Author          : MICHAEL TISCHER                                       *
  9. *  developed on    :  06/09/1989                                           *
  10. *  last update on  :  03/01/1990                                           *
  11. ***************************************************************************}
  12.  
  13. unit swap;
  14.  
  15. interface
  16.  
  17. uses DOS, Ems;
  18.  
  19. {-- Declaration of functions and procedures which can be called   ---------}
  20. {-- from another program                                          ---------}
  21.  
  22. function ExecPrg    ( Command : string ) : byte;
  23. function ExecCommand( Command : string ) : byte;
  24.  
  25. {-- Constants, public -----------------------------------------------------}
  26.  
  27. const SwapPath : string[ 80 ] = 'c:\';
  28.  
  29.       {------------------------ Error codes of ExecPrg & ExecCommand ------}
  30.  
  31.       SwapErrOk       = 0;                     { no error, everything O.K. }
  32.       SwapErrStore    = 1;      { Turbo Pascal program could not be stored }
  33.       SwapErrNotFound = 2;                             { program not found }
  34.       SwapErrNoAccess = 5;                      { access to program denied }
  35.       SwapErrNoRAM    = 8;                             { not enough memory }
  36.  
  37. implementation
  38.  
  39. {$L swapa}                                      { include assembler module }
  40.  
  41. {-- Declaration of procedures from SWAPA assembler module -----------------}
  42.  
  43. function SwapOutAndExec( Command,
  44.                          CmdPara : string;
  45.                          ToDisk  : boolean;
  46.                          Handle  : word;
  47.                          Len     : longint ) : byte ; external;
  48.  
  49. function InitSwapa : word ; external;
  50.  
  51. {-- Global variables, internal to this module -----------------------------}
  52.  
  53. var Len : longint;                          { number of bytes to be stored }
  54. {***************************************************************************
  55. *  NewExec : Controls current Turbo Pascal program's memory, and the       *
  56. *            call for the program indicated.                               *
  57. **------------------------------------------------------------------------**
  58. *  Input : CmdLine = String containing name of the program to be called    *
  59. *          CmdPara = String containing command line parameters for the     *
  60. *                    program to be called                                  *
  61. *  Output : One of the SwapErr... error codes                              *
  62. ***************************************************************************}
  63.  
  64. function NewExec( CmdLine, CmdPara : string ) : byte;
  65.  
  66. var Regs,                          { processor register for interrupt call }
  67.     Regs1    : Registers;
  68.     SwapFile : string[ 81 ];             { name of the temporary Swap-file }
  69.     ToDisk   : boolean;                 { store on disk or in EMS-memory ? }
  70.     Handle   : integer;                               { EMS or file handle }
  71.     Pages    : integer;                     { number of EMS pages required }
  72.  
  73. begin
  74.   {-- Test if storage is possible in EMS memory ---------------------------}
  75.  
  76.   ToDisk := TRUE;                                          { store on disk }
  77.   if ( EmsInst ) then                                  { is EMS available? }
  78.     begin                                                            { Yes }
  79.       Pages  := ( Len + 16383 ) div 16384;        { determine pages needed }
  80.       Handle := EmsAlloc( Pages );                        { allocate pages }
  81.       ToDisk := ( EmsError <> EmsErrOk );        { allocation successful ? }
  82.       if not ToDisk then
  83.         EmsSaveMapping( Handle );                           { save mapping }
  84.     end;
  85.  
  86.   if ToDisk then                                    { store in EMS memory? }
  87.     begin                                                    { no, on disk }
  88.  
  89.       {- Open temporary file in SwapPath with attributes SYSTEM & HIDDEN --}
  90.  
  91.       SwapFile := SwapPath;
  92.       SwapFile[ byte(SwapFile[0]) + 1 ] := #0;{ conv. string to DOS format }
  93.       Regs.AH := $5A;            { function number for "create temp. file" }
  94.       Regs.CX := Hidden or SysFile;                       { file attribute }
  95.       Regs.DS := seg( SwapFile );           { address of SwapPath to DS:DX }
  96.       Regs.DX := ofs( SwapFile ) + 1;
  97.       MsDos( Regs );                              { call DOS interrupt $21 }
  98.       if ( Regs.Flags and FCarry = 0 ) then                 { file opened? }
  99.         Handle := Regs.AX                               { yes, note handle }
  100.       else                            { no, terminate function prematurely }
  101.         begin
  102.           NewExec := SwapErrStore;   { error during storage of the program }
  103.           exit;                                       { terminate function }
  104.         end;
  105.     end;
  106.  
  107.     {-- Execute program through assembler routine -------------------------}
  108.  
  109.     SwapVectors;                                 { reset interrupt vectors }
  110.     NewExec := SwapOutAndExec( CmdLine, CmdPara, ToDisk, Handle, Len );
  111.     SwapVectors;                         { install Turbo-Int-Handler again }
  112.  
  113.     if ToDisk then                                { was it stored on disk? }
  114.       begin                                                          { yes }
  115.         {-- close temporary file and delete it ----------------------------}
  116.  
  117.         Regs1.AH := $3E;                { function number for "close file" }
  118.         Regs1.BX := Regs.AX;                         { load handle into BX }
  119.         MsDos( Regs1 );                           { call DOS interrupt $21 }
  120.  
  121.         Regs.AH := $41;                 { function number for "erase file" }
  122.         MsDos( Regs );
  123.       end
  124.     else                                       { no, storage in EMS memory }
  125.       begin
  126.         EmsRestoreMapping( Handle );               { restore mapping again }
  127.         EmsFree( Handle );            { release allocated EMS memory again }
  128.       end;
  129. end;
  130. {***************************************************************************
  131. *  ExecCommand : Executes a program as if its name was indicated in the    *
  132. *                user interface of DOS.                                    *
  133. **------------------------------------------------------------------------**
  134. *  Input   : Command = String with the name of the program to be executed  *
  135. *                      and the parameters which are to be passed in the    *
  136. *                      command line.                                       *
  137. *  Output  : One of the error codes SwapErr...                             *
  138. *  Info    : Since the call of the program occurs through the command      *
  139. *            processor, this procedure permits the execution of resident   *
  140. *            DOS commands (DIR etc.) and batch files.                      *
  141. ***************************************************************************}
  142.  
  143. function ExecCommand( Command : string ) : byte;
  144.  
  145. var ComSpec : string;                             { command processor path }
  146.  
  147. begin
  148.   ComSpec := GetEnv( 'COMSPEC' );             { get command processor path }
  149.   ExecCommand := NewExec( ComSpec, '/c'+ Command  ); { execute prg/command }
  150. end;
  151. {***************************************************************************
  152. *  ExecPrg : Executes a program through NewExec whose name and extension   *
  153. *            must be specified.                                            *
  154. **------------------------------------------------------------------------**
  155. *  Input : Command = String containing the name of the program to be       *
  156. *                    executed, as well as the parameters passed to the     *
  157. *                    command line.                                         *
  158. *  Output : One of the SwapErr... error codes                              *
  159. *  Info   : This procedure can execute EXE and COM programs, but not batch *
  160. *           files or resident DOS commands. The program's path and         *
  161. *           extension must be provided since no search is made through     *
  162. *           the PATH command for the program.                              *
  163. ***************************************************************************}
  164.  
  165. function ExecPrg( Command : string ) : byte;
  166.  
  167. const Text_Sep : set of char = [ ' ',#9,'-','/','>','<',#0,'|' ];
  168.  
  169. var i        : integer;                           { index in source string }
  170.     CmdLine,                                             { accepts command }
  171.     Para     : string;                                 { accepts parameter }
  172.  
  173. begin
  174.   {-- Isolate the command from the command string -------------------------}
  175.  
  176.   CmdLine := '';                                        { clear the string }
  177.   i := 1;               { begin with the first letter in the source string }
  178.   while not ( (Command[i] in Text_Sep) or ( i > length( Command ) ) ) do
  179.     begin                                      { character is not Text_Sep }
  180.       CmdLine := CmdLine + Command[ i ];                { accept in string }
  181.       inc( i );                    { set I to next character in the string }
  182.     end;
  183.  
  184.   Para := '';                                      { no parameter detected }
  185.  
  186.   {-- search for next "non-space character" -------------------------------}
  187.  
  188.   while (i<=length(Command)) and ( (Command[i]=#9) or (Command[i]=' ') ) do
  189.     inc( i );
  190.  
  191.   {-- copy the rest of the strings into the para string -------------------}
  192.  
  193.   while i <= length( Command ) do
  194.     begin
  195.       Para := Para + Command[ i ];
  196.       inc( i );
  197.     end;
  198.  
  199.   ExecPrg := NewExec( CmdLine, Para );   { execute command through NewExec }
  200. end;
  201.  
  202. {**----------------------------------------------------------------------**}
  203. {** Starting code of the unit                                            **}
  204. {**----------------------------------------------------------------------**}
  205.  
  206. begin
  207.   {-- Calculate the number of bytes to be  stored -------------------------}
  208.  
  209.   Len := ( longint(Seg(FreeList^)+$1000-(PrefixSeg+$10)) * 16 ) - InitSwapa;
  210. end.
  211.