home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
SWAPTP.ZIP
/
SWAP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-11-12
|
11KB
|
211 lines
{***************************************************************************
* S W A P : A unit which makes available an alternative Exec procedure *
* for calling any program from a Turbo Pascal program. Unlike *
* the normal Exec procedure, the Turbo program is stored in EMS *
* memory or hard disk before the new program is executed. This *
* saves memory for the execution of the new program. *
**------------------------------------------------------------------------**
* Author : MICHAEL TISCHER *
* developed on : 06/09/1989 *
* last update on : 03/01/1990 *
***************************************************************************}
unit swap;
interface
uses DOS, Ems;
{-- Declaration of functions and procedures which can be called ---------}
{-- from another program ---------}
function ExecPrg ( Command : string ) : byte;
function ExecCommand( Command : string ) : byte;
{-- Constants, public -----------------------------------------------------}
const SwapPath : string[ 80 ] = 'c:\';
{------------------------ Error codes of ExecPrg & ExecCommand ------}
SwapErrOk = 0; { no error, everything O.K. }
SwapErrStore = 1; { Turbo Pascal program could not be stored }
SwapErrNotFound = 2; { program not found }
SwapErrNoAccess = 5; { access to program denied }
SwapErrNoRAM = 8; { not enough memory }
implementation
{$L swapa} { include assembler module }
{-- Declaration of procedures from SWAPA assembler module -----------------}
function SwapOutAndExec( Command,
CmdPara : string;
ToDisk : boolean;
Handle : word;
Len : longint ) : byte ; external;
function InitSwapa : word ; external;
{-- Global variables, internal to this module -----------------------------}
var Len : longint; { number of bytes to be stored }
{***************************************************************************
* NewExec : Controls current Turbo Pascal program's memory, and the *
* call for the program indicated. *
**------------------------------------------------------------------------**
* Input : CmdLine = String containing name of the program to be called *
* CmdPara = String containing command line parameters for the *
* program to be called *
* Output : One of the SwapErr... error codes *
***************************************************************************}
function NewExec( CmdLine, CmdPara : string ) : byte;
var Regs, { processor register for interrupt call }
Regs1 : Registers;
SwapFile : string[ 81 ]; { name of the temporary Swap-file }
ToDisk : boolean; { store on disk or in EMS-memory ? }
Handle : integer; { EMS or file handle }
Pages : integer; { number of EMS pages required }
begin
{-- Test if storage is possible in EMS memory ---------------------------}
ToDisk := TRUE; { store on disk }
if ( EmsInst ) then { is EMS available? }
begin { Yes }
Pages := ( Len + 16383 ) div 16384; { determine pages needed }
Handle := EmsAlloc( Pages ); { allocate pages }
ToDisk := ( EmsError <> EmsErrOk ); { allocation successful ? }
if not ToDisk then
EmsSaveMapping( Handle ); { save mapping }
end;
if ToDisk then { store in EMS memory? }
begin { no, on disk }
{- Open temporary file in SwapPath with attributes SYSTEM & HIDDEN --}
SwapFile := SwapPath;
SwapFile[ byte(SwapFile[0]) + 1 ] := #0;{ conv. string to DOS format }
Regs.AH := $5A; { function number for "create temp. file" }
Regs.CX := Hidden or SysFile; { file attribute }
Regs.DS := seg( SwapFile ); { address of SwapPath to DS:DX }
Regs.DX := ofs( SwapFile ) + 1;
MsDos( Regs ); { call DOS interrupt $21 }
if ( Regs.Flags and FCarry = 0 ) then { file opened? }
Handle := Regs.AX { yes, note handle }
else { no, terminate function prematurely }
begin
NewExec := SwapErrStore; { error during storage of the program }
exit; { terminate function }
end;
end;
{-- Execute program through assembler routine -------------------------}
SwapVectors; { reset interrupt vectors }
NewExec := SwapOutAndExec( CmdLine, CmdPara, ToDisk, Handle, Len );
SwapVectors; { install Turbo-Int-Handler again }
if ToDisk then { was it stored on disk? }
begin { yes }
{-- close temporary file and delete it ----------------------------}
Regs1.AH := $3E; { function number for "close file" }
Regs1.BX := Regs.AX; { load handle into BX }
MsDos( Regs1 ); { call DOS interrupt $21 }
Regs.AH := $41; { function number for "erase file" }
MsDos( Regs );
end
else { no, storage in EMS memory }
begin
EmsRestoreMapping( Handle ); { restore mapping again }
EmsFree( Handle ); { release allocated EMS memory again }
end;
end;
{***************************************************************************
* ExecCommand : Executes a program as if its name was indicated in the *
* user interface of DOS. *
**------------------------------------------------------------------------**
* Input : Command = String with the name of the program to be executed *
* and the parameters which are to be passed in the *
* command line. *
* Output : One of the error codes SwapErr... *
* Info : Since the call of the program occurs through the command *
* processor, this procedure permits the execution of resident *
* DOS commands (DIR etc.) and batch files. *
***************************************************************************}
function ExecCommand( Command : string ) : byte;
var ComSpec : string; { command processor path }
begin
ComSpec := GetEnv( 'COMSPEC' ); { get command processor path }
ExecCommand := NewExec( ComSpec, '/c'+ Command ); { execute prg/command }
end;
{***************************************************************************
* ExecPrg : Executes a program through NewExec whose name and extension *
* must be specified. *
**------------------------------------------------------------------------**
* Input : Command = String containing the name of the program to be *
* executed, as well as the parameters passed to the *
* command line. *
* Output : One of the SwapErr... error codes *
* Info : This procedure can execute EXE and COM programs, but not batch *
* files or resident DOS commands. The program's path and *
* extension must be provided since no search is made through *
* the PATH command for the program. *
***************************************************************************}
function ExecPrg( Command : string ) : byte;
const Text_Sep : set of char = [ ' ',#9,'-','/','>','<',#0,'|' ];
var i : integer; { index in source string }
CmdLine, { accepts command }
Para : string; { accepts parameter }
begin
{-- Isolate the command from the command string -------------------------}
CmdLine := ''; { clear the string }
i := 1; { begin with the first letter in the source string }
while not ( (Command[i] in Text_Sep) or ( i > length( Command ) ) ) do
begin { character is not Text_Sep }
CmdLine := CmdLine + Command[ i ]; { accept in string }
inc( i ); { set I to next character in the string }
end;
Para := ''; { no parameter detected }
{-- search for next "non-space character" -------------------------------}
while (i<=length(Command)) and ( (Command[i]=#9) or (Command[i]=' ') ) do
inc( i );
{-- copy the rest of the strings into the para string -------------------}
while i <= length( Command ) do
begin
Para := Para + Command[ i ];
inc( i );
end;
ExecPrg := NewExec( CmdLine, Para ); { execute command through NewExec }
end;
{**----------------------------------------------------------------------**}
{** Starting code of the unit **}
{**----------------------------------------------------------------------**}
begin
{-- Calculate the number of bytes to be stored -------------------------}
Len := ( longint(Seg(FreeList^)+$1000-(PrefixSeg+$10)) * 16 ) - InitSwapa;
end.