home *** CD-ROM | disk | FTP | other *** search
/ Doom I/II Collection / DM12.ISO / edit / dhtk100 / swap.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  6KB  |  153 lines
  1. unit swap;
  2.  
  3. interface
  4.  
  5. uses DOS, Ems, WadDecl, Crt;
  6.  
  7. function ExecPrg    ( Command : string ) : byte;
  8. function ExecCommand( Command : string ) : byte;
  9.  
  10. const SwapPath : string[ 80 ] = 'c:\';
  11.  
  12.       SwapErrOk       = 0;                     { no error, everything O.K. }
  13.       SwapErrStore    = 1;      { Turbo Pascal program could not be stored }
  14.       SwapErrNotFound = 2;                             { program not found }
  15.       SwapErrNoAccess = 5;                      { access to program denied }
  16.         SwapErrNoRAM    = 8;                             { not enough memory }
  17.  
  18.         AllowEMSswap:boolean = True;
  19.  
  20. implementation
  21.  
  22. {$L swapa}                                      { include assembler module }
  23.  
  24. function SwapOutAndExec( Command,
  25.                          CmdPara : string;
  26.                          ToDisk  : boolean;
  27.                          Handle  : word;
  28.                          Len     : longint ) : byte ; external;
  29.  
  30. function InitSwapa : word ; external;
  31.  
  32.  
  33. var Len : longint;                          { number of bytes to be stored }
  34.  
  35. function NewExec( CmdLine, CmdPara : string ) : byte;
  36.  
  37. var Regs,                          { processor register for interrupt call }
  38.      Regs1    : Registers;
  39.      SwapFile : string[ 81 ];             { name of the temporary Swap-file }
  40.      ToDisk   : boolean;                 { store on disk or in EMS-memory ? }
  41.      Handle   : integer;                               { EMS or file handle }
  42.      Pages    : integer;                     { number of EMS pages required }
  43.  
  44. begin
  45.  
  46.   ToDisk := TRUE;                                          { store on disk }
  47.   if AllowEMSswap then begin
  48.       if ( EmsInst ) then                                  { is EMS available? }
  49.          begin                                                            { Yes }
  50.             Pages  := ( Len + 16383 ) div 16384;        { determine pages needed }
  51.             Handle := EmsAlloc( Pages );                        { allocate pages }
  52.             ToDisk := ( EmsError <> EmsErrOk );        { allocation successful ? }
  53.             if not ToDisk then
  54.               EmsSaveMapping( Handle );                           { save mapping }
  55.          end;
  56.   end;
  57.  
  58.   if ToDisk then                                    { store in EMS memory? }
  59.      begin                                                    { no, on disk }
  60.  
  61.  
  62.         SwapFile := SwapPath;
  63.         SwapFile[ byte(SwapFile[0]) + 1 ] := #0;{ conv. string to DOS format }
  64.         Regs.AH := $5A;            { function number for "create temp. file" }
  65.         Regs.CX := Hidden or SysFile;                       { file attribute }
  66.         Regs.DS := seg( SwapFile );           { address of SwapPath to DS:DX }
  67.         Regs.DX := ofs( SwapFile ) + 1;
  68.         MsDos( Regs );                              { call DOS interrupt $21 }
  69.         if ( Regs.Flags and FCarry = 0 ) then                 { file opened? }
  70.           Handle := Regs.AX                               { yes, note handle }
  71.         else                            { no, terminate function prematurely }
  72.           begin
  73.              NewExec := SwapErrStore;   { error during storage of the program }
  74.              exit;                                       { terminate function }
  75.           end;
  76.      end;
  77.  
  78.      SwapVectors;                                 { reset interrupt vectors }
  79.     NewExec := SwapOutAndExec( CmdLine, CmdPara, ToDisk, Handle, Len );
  80.     SwapVectors;                         { install Turbo-Int-Handler again }
  81.  
  82.     if ToDisk then                                { was it stored on disk? }
  83.         begin                                                          { yes }
  84.  
  85.           Regs1.AH := $3E;                { function number for "close file" }
  86.           Regs1.BX := Regs.AX;                         { load handle into BX }
  87.           MsDos( Regs1 );                           { call DOS interrupt $21 }
  88.           Regs.AH := $41;                 { function number for "erase file" }
  89.           MsDos( Regs );
  90.         end
  91.      else                                       { no, storage in EMS memory }
  92.         begin
  93.           EmsRestoreMapping( Handle );               { restore mapping again }
  94.           EmsFree( Handle );            { release allocated EMS memory again }
  95.         end;
  96. end;
  97.  
  98. function ExecCommand( Command : string ) : byte;
  99.  
  100. var ComSpec : string;                             { command processor path }
  101.  
  102. begin
  103.   ComSpec := GetEnv( 'COMSPEC' );             { get command processor path }
  104.   ExecCommand := NewExec( ComSpec, '/c'+ Command  ); { execute prg/command }
  105. end;
  106.  
  107. function ExecPrg( Command : string ) : byte;
  108.  
  109. const Text_Sep : set of char = [ ' ',#9,'-','/','>','<',#0,'|' ];
  110.  
  111. var i        : integer;                           { index in source string }
  112.      CmdLine,                                             { accepts command }
  113.      Para     : string;                                 { accepts parameter }
  114.  
  115. begin
  116.  
  117.   CmdLine := '';                                        { clear the string }
  118.   i := 1;               { begin with the first letter in the source string }
  119.   while not ( (Command[i] in Text_Sep) or ( i > length( Command ) ) ) do
  120.      begin                                      { character is not Text_Sep }
  121.         CmdLine := CmdLine + Command[ i ];                { accept in string }
  122.         inc( i );                    { set I to next character in the string }
  123.      end;
  124.  
  125.   Para := '';                                      { no parameter detected }
  126.  
  127.   while (i<=length(Command)) and ( (Command[i]=#9) or (Command[i]=' ') ) do
  128.      inc( i );
  129.  
  130.   while i <= length( Command ) do
  131.      begin
  132.         Para := Para + Command[ i ];
  133.         inc( i );
  134.      end;
  135.  
  136.   ExecPrg := NewExec( CmdLine, Para );   { execute command through NewExec }
  137. end;
  138.  
  139. var TempStr:string;
  140.  
  141. begin
  142.   Len := ( longint(Seg(HeapEnd^)-(PrefixSeg+$10)) * 16 ) - (InitSwapa + (Ofs (HeapEnd^)));
  143.   Str(Len, TempStr);
  144.   {$IFDEF DFE}
  145.   writeln('SysSwap_Init: Progam Swap Init '+TempStr);
  146.   delay(300);
  147.   Writeln('   HDD_Check: ',Hex_String(DiskFree(3)),'  ');
  148.   IF DiskFree(3) < Len then begin
  149.         writeln('   HDD_Check: Insufficient Drive Space for Init_Swap');
  150.         halt(1);
  151.   end;
  152.   {$ENDIF}
  153. end.