home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / XMSLIBR1.ZIP / XMSTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-08-11  |  4.9 KB  |  155 lines
  1. (******************************************************************************
  2. *                                   xmsTest                                   *
  3. * test xmsLib, and report on XMS                                              *
  4. ******************************************************************************)
  5. program xmsTest;
  6. {$X+}
  7. uses
  8.    xmsLib,
  9.    dos,
  10.    crt
  11.    ;
  12. var
  13.    lb, tik, sik : word;
  14.    fh, lc : byte;
  15.     textBufferOrigin : pointer; {pointer to text buffer}
  16.    s : string;
  17.    blockHandle : word;
  18.    var sourceArray : array [1 .. 8192] of byte absolute $40:0;
  19.    xx, yy : byte; 
  20. type
  21.     adapterType = (none,mda,cga,egaMono,egaColor,vgaMono,
  22.                  vgaColor,mcgaMono,mcgaColor);
  23.  
  24. (******************************************************************************
  25. *                              queryAdapterType                               *
  26. * Code adapted from DDJ Structured Programming Column by Jeff Duntemann.      *
  27. ******************************************************************************)
  28. function queryAdapterType : adapterType;
  29.  
  30. var     
  31.    regs : Registers;
  32.     code : byte;
  33.  
  34. begin
  35.     regs.ah := $1a; {vga identify}
  36.     regs.al := $0;  {clear}
  37.     intr($10,regs);
  38.     if regs.al = $1a then { is this a bug ???? }
  39.     begin {ps/2 bios search for ..}
  40.         case regs.bl of {code back in here}
  41.             $00 : queryAdapterType := none;
  42.             $01 : queryAdapterType := mda;
  43.             $02 : queryAdapterType := cga;
  44.             $04 : queryAdapterType := egaColor;
  45.             $05 : queryAdapterType := egaMono;
  46.             $07 : queryAdapterType := vgaMono;
  47.             $08 : queryAdapterType := vgaColor;
  48.             $0A,$0C : queryAdapterType := mcgaColor;
  49.             $0B : queryAdapterType := mcgaMono;
  50.             else queryAdapterType := cga;
  51.         end; {case}
  52.     end {ps/2 search}
  53.     else 
  54.     begin {look for ega bios}
  55.         regs.ah := $12;
  56.         regs.bx := $10; {bl=$10 retrn ega info if ega}
  57.         intr($10,regs);
  58.         if regs.bx <> $10 then {bx unchanged mean no ega}
  59.         begin
  60.             regs.ah := $12; {ega call again}
  61.             regs.bl := $10; {recheck}
  62.             intr($10,regs);
  63.             if (regs.bh = 0) then 
  64.                 queryAdapterType := egaColor
  65.             else
  66.                 queryAdapterType := egaMono;
  67.         end {ega identification}
  68.     else {mda or cga}
  69.     begin
  70.         intr($11,regs); {get eqpt.}
  71.         code := (regs.al and $30) shr 4;
  72.         case code of
  73.             1,2 : queryAdapterType := cga;
  74.             3   : queryAdapterType := mda;
  75.             else queryAdapterType := none;
  76.         end; {case}
  77.     end {mda, cga}
  78.     end;
  79. end; {quertAdapterType}
  80.  
  81. (******************************************************************************
  82. *                             getTextBufferOrigin                             *
  83. ******************************************************************************)
  84. function getTextBufferOrigin : pointer; {segment}
  85. begin
  86.     case queryAdapterType of
  87.         cga
  88.         ,mcgaColor
  89.         ,egaColor
  90.         ,vgaColor : getTextBufferOrigin := ptr($b800,0);
  91.         mda
  92.         ,mcgaMono
  93.         ,egaMono
  94.         ,vgaMono    : getTextBufferOrigin := ptr($b000,0);
  95.     end; {case}
  96. end; {getTextBufferOrigin}
  97.  
  98. begin
  99.    writeln('XMSTEST - XMSLIB test program, Ron Loewy, 1991');
  100.    if (not xmsPresent) then begin
  101.       writeln('XMS memory manager not detected');
  102.       halt(1);
  103.    end;
  104.    writeln('XMS Version ', printXmsVersion, ', Memory Manager ', printXmmVersion);
  105.    write('HMA ');
  106.    if (hmaPresent) then 
  107.       write('Present')
  108.    else
  109.       write('Not present');
  110.    write(', A20 ');
  111.    if (queryA20) then
  112.       writeln('Enabled')
  113.    else
  114.       writeln('Disabled');
  115.    queryFreeExtendedMemory(lb, tik);
  116.    writeln('Largest available block ', lb, 'K, Total free extended memory ', tik,'K');
  117.    textBufferOrigin := getTextBufferOrigin;
  118.    writeln('Detected text buffer origin at segment : ', seg(textBufferOrigin^));
  119.    writeln('Press Enter to test XMS memory moves, XMSTEST will :');
  120.    writeln('   1. Copy the text screen image to extended memory');
  121.    writeln('   2. Create random images on the screen');
  122.    writeln('   3. Wait for ANOTHER ENTER to continue');
  123.    writeln('   4. Restore the original screen image from extended memory');
  124.    readln(s);
  125.    if (not allocateXMB(8, blockHandle)) then begin
  126.       writeln(xmsErrorStr);
  127.       halt(77);
  128.    end;
  129.    if (not mainstgToXMB(8192, textBufferOrigin, blockHandle, 0)) then begin
  130.       writeln(xmsErrorStr);
  131.       halt(78);
  132.    end;
  133.    xx := whereX;
  134.    yy := wherey;
  135.    move(sourceArray, textBufferOrigin^, 8192);
  136.    writeln('  *** Press Enter to restore screen and continue XMSTEST ***  ');
  137.    readln(s);
  138.    if (not XMBtoMainstg(8192, textBufferOrigin, blockHandle, 0)) then begin
  139.       writeln(xmsErrorStr);
  140.       halt(80);
  141.    end;
  142.    gotoXy(xx, yy);
  143.    writeln('Screen restored succesfully from extended memory');
  144.    if (not getXMBInformation(blockHandle, lc, fh, sik)) then begin
  145.       writeln(xmsErrorStr);
  146.       halt(81);
  147.    end;
  148.    writeln('Handle ', blockHandle, ' locks ', lc, ' Size in K ', sik);
  149.    writeln('Free handles ', fh);
  150.    if (not freeXMB(blockHandle)) then begin
  151.       writeln(xmsErrorStr);
  152.       halt(82);
  153.    end;
  154. end.
  155.