home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a016 / 1.ddi / PAS / SWAPDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-15  |  2.8 KB  |  84 lines
  1. {*
  2.  *
  3.  *  SWAPDEMO.PAS - MS PASCAL 4.0
  4.  *               - Demonstration progam for Blinker swap function
  5.  *
  6.  *
  7.  *  Copyright (c) 1992, ASM inc.
  8.  *
  9.  *  Compile:  PAS1 swapdemo;
  10.  *            PAS2
  11.  *
  12.  *
  13.  *
  14.  *}
  15.  
  16. program swapdemo(input,output);
  17.  
  18. {$include : 'blinker.inc'}
  19.  
  20. const
  21.   ON  = 1 ;
  22.   OFF = 0 ;
  23.  
  24. var
  25.   i      : integer ;
  26.  
  27. begin
  28.  
  29.   writeln (output,'Pascal Swap example') ;
  30.   writeln (output,'===================') ;
  31.   writeln (output,' ') ;
  32.   writeln (output,'Swap defaults      ') ;
  33.   writeln (output,' ') ;
  34.   writeln (output,'Use EMS memory                  : ',SWPUSEEMS(OFF)) ;
  35.   writeln (output,'Use XMS memory                  : ',SWPUSEXMS(OFF)) ;
  36.   writeln (output,'Use UMBs                        : ',SWPUSEUMB(OFF)) ;
  37.   writeln (output,'Save/restore video mode         : ',SWPVIDMDE(OFF)) ;
  38.   writeln (output,'Save/restore directory          : ',SWPCURDIR(OFF)) ;
  39.   writeln (output,'Display message                 : ',SWPDISMSG(OFF)) ;
  40.   writeln (output,'Wait for keypress               : ',SWPGETKEY(OFF)) ;
  41.   writeln (output,'Suppress <Ctrl><Alt><Del>       : ',SWPNOBOOT(OFF)) ;
  42.   writeln (output,' ') ;
  43.  
  44.   { need to pass a far pointer to an ASCIIZ string to bligetpid, and blisetpid }
  45.  
  46.   writeln (output,'Program already running?        : ',SWPGETPID(ads('swapdemo.pas'*chr(0)))) ;
  47.   writeln (output,'Set program ID to swapdemo.pas  : ',SWPSETPID(ads('swapdemo.pas'*chr(0)))) ;
  48.   writeln (output,' ') ;
  49.  
  50.   { enable ems / xms / umbs }
  51.  
  52.   i := SWPUSEEMS(ON) ;
  53.   i := SWPUSEXMS(ON) ;
  54.   i := SWPUSEUMB(ON) ;
  55.  
  56.   { save / restore current directory and video mode }
  57.   { video buffer contents are not saved }
  58.  
  59.   i := SWPCURDIR(ON) ;
  60.   i := SWPVIDMDE(ON) ;
  61.  
  62.   if (SWPGETPID(ADS('swapdemo.pas')) = 0) THEN { if we're not running already }
  63.      begin
  64.        writeln (output,'Shelling to DOS...');
  65.        writeln (output,'Run swapdemo again to see SWPGETPID.');
  66.        writeln (output,'-------------------------------------------------------------------------');
  67.  
  68.        { status = SWPRUNCMD(ChildProg, Memory, Shell Directory, Temporary directory) }
  69.  
  70.        i := SWPRUNCMD(ADS(chr(0)), 0, ADS(chr(0)),ADS(chr(0)) ) ;
  71.  
  72.        writeln (output,'-------------------------------------------------------------------------');
  73.        writeln (output,'Back from shell, status is      : ',i);
  74.        writeln (output,'Major error code is             : ',SWPERRMAJ) ;
  75.        writeln (output,'Minor error code is             : ',SWPERRMIN) ;
  76.        writeln (output,'Child process return code was   : ',SWPERRLEV) ;
  77.      end
  78.   else { we're already running, terminate the program }
  79.     begin
  80.       writeln(output,'Terminating (swapdemo.pas already executing)') ;
  81.       writeln(output,'Type EXIT to return to previous swapdemo.pas') ;
  82.     end
  83. end.
  84.