{ --------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.               }
{ (c) 1991-1999 Peter Mandrella                                   }
{ (c) 2000-2001 OpenXP-Team                                       }
{ (c) 2002-2005 FreeXP, http://www.freexp.de                      }
{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.     }
{                                                                 }
{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der }
{ Datei SLIZENZ.TXT oder auf www.crosspoint.de/oldlicense.html.   }
{ --------------------------------------------------------------- }
{ $Id: xms.pas,v 1.8 2005/01/01 11:16:28 mw Exp $ }

(***********************************************************)
(*                                                         *)
(*                        UNIT XMS                         *)
(*                                                         *)
(*                 LIM/XMS - Schnittstelle                 *)
(*                                                         *)
(***********************************************************)


UNIT XMS;

{$I XPDEFINE.INC }

{$IFNDEF BP }
  !! Diese Routine kann nur unter Borland Pascal compiliert werden˙
{$ENDIF }

{$I XPDEFINE.INC }
{$F+}

{  ==================  Interface-Teil  ===================  }

INTERFACE

uses  xpglobal, dos;

function  XmsTest:boolean;                          { XMS vorhanden ?       }
function  XmsVersion:word;
function  XmsTotal:word;                            { XMS-Speicher in KB    }
function  XmsAvail:word;                            { freier Speicher in KB }
function  XmsResult:byte;                           { 0 = ok                }

function  XmsAlloc(KB:word):word;                   { liefert Handle        }
procedure XmsRealloc(handle:word; KB:word);         { Blockgráe ndern     }
procedure XmsFree(handle:word);                     { Speicher freigeben    }
procedure XmsRead(handle:word; var data; offset,size:longint);
procedure XmsWrite(handle:word; var data; offset,size:longint);

{ Achtung: size wird immer auf eine gerade Zahl aufgerundet! }


{ ================= Implementation-Teil ==================  }

IMPLEMENTATION


var xmsok   : boolean;      { XMS installiert }
    xmscall : pointer;
    result  : byte;


procedure xmsinit;
var regs : registers;
begin
  with regs do begin
    ax:=$4300;
    intr($2f,regs);
    xmsok:=(al=$80);
    if xmsok then begin
      ax:=$4310;
      intr($2f,regs);
      xmscall:=ptr(es,bx);
      end;
    end;
end;


function XmsTest:boolean;                          { XMS vorhanden ?       }
begin
  XmsTest:=xmsok;
end;


function XmsResult:byte;
begin
  XmsResult:=result;
end;

{ Result-Codes:

  00h   ok
  80h   Funktion ist nicht implementiert
  81h   VDISK-Gert entdeckt. Aus Sicherheitsgrnden wird die Funktion
        nicht ausgefhrt.
  8Eh   genereller Treiberfehler
  8Fh   nicht behebbarer Treiberfehler
  A0h   kein XMS mehr frei
  A1h   keine Handles mehr frei
  A2h   ungltiges Handle
  A3h   ungltiges Quellhandle
  A4h   ungltiges Quelloffest
  A5h   ungltiges Zielhandle
  A6h   ungltiges Zieloffset
  A7h   ungltige Blocklnge
  A8h   Quelle und Ziel berlappen sich
  A9h   Parity-Fehler  }



{$L xms.obj}
function XmsVersion:word; external;
function XmsTotal:word; external;
function XmsAvail:word; external;
function  XmsAlloc(KB:word):word; external;
procedure XmsRealloc(handle:word; KB:word);  external;
procedure XmsFree(handle:word); external;
procedure XmsRead(handle:word; var data; offset,size:longint); external;
procedure XmsWrite(handle:word; var data; offset,size:longint);  external;


begin
  xmsinit;
  result:=0;
end.
{
  $Log: xms.pas,v $
  Revision 1.8  2005/01/01 11:16:28  mw
  MW: - Willkommen im Jahr 2005

  Revision 1.7  2004/01/09 16:18:57  mw
  MW: - Wir haben jetzt 2004!!

  Revision 1.6  2003/07/30 23:09:49  my
  MY:- Source-Header auf "FreeXP" aktualisiert, einige Detailkorrekturen
       an CVS-Logs vorgenommen und hier und da CVS-Loginfos implementiert.

  Revision 1.5  2000/04/13 12:48:33  mk
  - Anpassungen an Virtual Pascal
  - Fehler bei FindFirst behoben
  - Bugfixes bei 32 Bit Assembler-Routinen
  - Einige unkritische Memory Leaks beseitigt
  - Einge Write-Routinen durch Wrt/Wrt2 ersetzt
  - fehlende CVS Keywords in einigen Units hinzugefuegt
  - ZPR auf VP portiert
  - Winxp.ConsoleWrite provisorisch auf DOS/Linux portiert
  - Automatische Anpassung der Zeilenzahl an Consolengroesse in Win32

}
