home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
XMSLIBR1.ZIP
/
XMSTEST.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-08-11
|
5KB
|
155 lines
(******************************************************************************
* xmsTest *
* test xmsLib, and report on XMS *
******************************************************************************)
program xmsTest;
{$X+}
uses
xmsLib,
dos,
crt
;
var
lb, tik, sik : word;
fh, lc : byte;
textBufferOrigin : pointer; {pointer to text buffer}
s : string;
blockHandle : word;
var sourceArray : array [1 .. 8192] of byte absolute $40:0;
xx, yy : byte;
type
adapterType = (none,mda,cga,egaMono,egaColor,vgaMono,
vgaColor,mcgaMono,mcgaColor);
(******************************************************************************
* queryAdapterType *
* Code adapted from DDJ Structured Programming Column by Jeff Duntemann. *
******************************************************************************)
function queryAdapterType : adapterType;
var
regs : Registers;
code : byte;
begin
regs.ah := $1a; {vga identify}
regs.al := $0; {clear}
intr($10,regs);
if regs.al = $1a then { is this a bug ???? }
begin {ps/2 bios search for ..}
case regs.bl of {code back in here}
$00 : queryAdapterType := none;
$01 : queryAdapterType := mda;
$02 : queryAdapterType := cga;
$04 : queryAdapterType := egaColor;
$05 : queryAdapterType := egaMono;
$07 : queryAdapterType := vgaMono;
$08 : queryAdapterType := vgaColor;
$0A,$0C : queryAdapterType := mcgaColor;
$0B : queryAdapterType := mcgaMono;
else queryAdapterType := cga;
end; {case}
end {ps/2 search}
else
begin {look for ega bios}
regs.ah := $12;
regs.bx := $10; {bl=$10 retrn ega info if ega}
intr($10,regs);
if regs.bx <> $10 then {bx unchanged mean no ega}
begin
regs.ah := $12; {ega call again}
regs.bl := $10; {recheck}
intr($10,regs);
if (regs.bh = 0) then
queryAdapterType := egaColor
else
queryAdapterType := egaMono;
end {ega identification}
else {mda or cga}
begin
intr($11,regs); {get eqpt.}
code := (regs.al and $30) shr 4;
case code of
1,2 : queryAdapterType := cga;
3 : queryAdapterType := mda;
else queryAdapterType := none;
end; {case}
end {mda, cga}
end;
end; {quertAdapterType}
(******************************************************************************
* getTextBufferOrigin *
******************************************************************************)
function getTextBufferOrigin : pointer; {segment}
begin
case queryAdapterType of
cga
,mcgaColor
,egaColor
,vgaColor : getTextBufferOrigin := ptr($b800,0);
mda
,mcgaMono
,egaMono
,vgaMono : getTextBufferOrigin := ptr($b000,0);
end; {case}
end; {getTextBufferOrigin}
begin
writeln('XMSTEST - XMSLIB test program, Ron Loewy, 1991');
if (not xmsPresent) then begin
writeln('XMS memory manager not detected');
halt(1);
end;
writeln('XMS Version ', printXmsVersion, ', Memory Manager ', printXmmVersion);
write('HMA ');
if (hmaPresent) then
write('Present')
else
write('Not present');
write(', A20 ');
if (queryA20) then
writeln('Enabled')
else
writeln('Disabled');
queryFreeExtendedMemory(lb, tik);
writeln('Largest available block ', lb, 'K, Total free extended memory ', tik,'K');
textBufferOrigin := getTextBufferOrigin;
writeln('Detected text buffer origin at segment : ', seg(textBufferOrigin^));
writeln('Press Enter to test XMS memory moves, XMSTEST will :');
writeln(' 1. Copy the text screen image to extended memory');
writeln(' 2. Create random images on the screen');
writeln(' 3. Wait for ANOTHER ENTER to continue');
writeln(' 4. Restore the original screen image from extended memory');
readln(s);
if (not allocateXMB(8, blockHandle)) then begin
writeln(xmsErrorStr);
halt(77);
end;
if (not mainstgToXMB(8192, textBufferOrigin, blockHandle, 0)) then begin
writeln(xmsErrorStr);
halt(78);
end;
xx := whereX;
yy := wherey;
move(sourceArray, textBufferOrigin^, 8192);
writeln(' *** Press Enter to restore screen and continue XMSTEST *** ');
readln(s);
if (not XMBtoMainstg(8192, textBufferOrigin, blockHandle, 0)) then begin
writeln(xmsErrorStr);
halt(80);
end;
gotoXy(xx, yy);
writeln('Screen restored succesfully from extended memory');
if (not getXMBInformation(blockHandle, lc, fh, sik)) then begin
writeln(xmsErrorStr);
halt(81);
end;
writeln('Handle ', blockHandle, ' locks ', lc, ' Size in K ', sik);
writeln('Free handles ', fh);
if (not freeXMB(blockHandle)) then begin
writeln(xmsErrorStr);
halt(82);
end;
end.