{ ------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                   }
{ (c) 1991-1999 Peter Mandrella                                       }
{ (c) 2000-2001 OpenXP-Team                                           }
{ (c) 2002-2025 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 http://www.crosspoint.de/oldlicense.html }
{ ------------------------------------------------------------------- }

(***********************************************************)
(*                                                         *)
(*                       UNIT dosx                         *)
(*                                                         *)
(*        Erweiterungen von DOS; BIOS-Schnittstelle        *)
(*                                                         *)
(***********************************************************)

UNIT dosx;

{$I XPDEFINE.INC}


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

INTERFACE

uses 
  xpglobal, 
  dos;

function  GetDrive:char;
function  alldrives:string;
function  DriveType(drive:char):byte;       { 0=nix, 1=Disk, 2=RAM, 3=Subst }
                                            { 4=Device, 5=Netz              }
function  dospath(d:byte):pathstr;
procedure GoDir(path:pathstr);


function  OutputRedirected:boolean;
procedure StandardIO;
function  ConfigFILES:byte;                  { FILES= .. }
function  FreeFILES(maxfiles:byte):word;     { freie Files; max. 255 }
function  IsDevice(const fn:pathstr):boolean;

procedure XIntr(intno:byte; var regs:registers);   { DPMI-kompatibler Intr }
function  DPMIallocDOSmem(paras:word; var segment:word):word;
procedure DPMIfreeDOSmem(selector:word);


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

implementation

uses clip;
const DPMI   = $31;

function GetDrive:char;
var regs : registers;
begin
  with regs do begin
    ax:=$1900;
    msdos(regs);
    getdrive:=chr(al+65);
  end;
end;

{ 0=aktuell, 1=A, .. }

function dospath(d:byte):pathstr;
var s : string;
begin
  getdir(d,s);
  dospath:=s;
end;

procedure SetDrive(drive:char);
var regs : registers;
begin
  with regs do begin
    ah:=$e;
    dl:=ord(UpCase(drive))-65;
    msdos(regs);
    end;
end;

procedure GoDir(path:pathstr);
begin
  if path='' then exit;
  SetDrive(path[1]);
  if (length(path)>3) and (path[length(path)]=DirSepa) then
    Delete(path, Length(path), 1); { dec(byte(path[0])); }
  chdir(path);
end;

procedure StandardIO;
BEGIN
     ASSIGN( Input, '' );
     RESET( Input );
     ASSIGN( Output, '' );
     REWRITE( Output );
END;

function OutputRedirected:boolean;
var
  regs : registers;
begin
  with regs do begin
    ax:=$4400;
    bx:=textrec(output).handle;
    intr($21,regs);
    OutputRedirected:=(flags and fcarry=0) and (dx and 128=0);
  end;
end;

{ Buf sollte im Datensegment liegen }
{ bentigt DOS ab Version 3.0       }
{ pro Handle wird 1 Byte bentigt   }

{ 0=nix, 1=Disk, 2=RAM, 3=Subst, 4=Device, 5=Netz, 6=CD-ROM, 7=Diskette }
function DriveType(drive:char):byte;
var regs : registers;

  function laufwerke:byte;
  var regs : registers;
  begin
    intr($11,regs);
    if not odd(regs.ax) then laufwerke:=0
    else laufwerke:=(regs.ax shr 6) and 3 + 1;
  end;

  Function CDDrives:String;assembler;
  asm
      les di,@result
      mov si,di
      mov ax,$BFBF      { String loeschen. $BF + 'A' =0 !!!}
      mov cx,16
      rep stosw
      xor bx,bx
      mov ax,$150C      { Version-Check }
      int 2fh
      cmp bx,0          { >0 Installiert und 150D erlaubt }
      je @e
      mov ax,$150D      { Liste der CD-Laufwerke nach ES:BX }
      lea bx,[si+1]
      int 2fh
      mov bx,si
  @1: inc bx
      mov al,[es:bx]
      add al,'A'        { und umrechnen von C:=2 zu C:='C' }
      mov [es:bx],al
      jne @1
      dec bx
      sub bx,si
  @e: mov es:[si],bl
  end;

  function Is_Ramdrive(c:char):boolean;assembler;
  var
    Sektor : array[0..511] of Byte;
  asm
      push ds
      push ss                   { Sektorpuffer loeschen }
      pop es
      lea di,sektor[0]
      xor ax,ax
      mov cx,256
      rep stosw
      mov ax,$4408              { Medium wechselbar ? }
      mov bl,c
      sub bl,64
      int 21h
      jc @1
      cmp al,0
      je @1
      mov al,bl                 { Bootsektor laden }
      dec ax
      mov cx,$FFFF
      push ss
      pop ds
      lea bx,sektor[0]
      mov byte ptr [bx+4],1
      mov [bx+6],bx
      mov [bx+8],ds
      int 25h
      popf
  @1: mov al,0
      cmp byte ptr [bx+$10],1   { 1 Fat ? }
      jne @2
      cmp byte ptr [bx+$1A],1   { 1 Kopf ? }
      jne @2
      inc ax
  @2: pop ds
  end;

begin
  if pos(drive,CDDrives)>0 then drivetype:=6
  else
    with regs do begin
      ax:=$4409;
      bl:=ord(drive)-64;
      msdos(regs);
      if flags and fcarry<>0 then
        drivetype:=0
      else
        if dx and $8000<>0 then drivetype:=3 else
        if dx and $1000<>0 then drivetype:=5 else
        if ord(drive)-64 <= Laufwerke then drivetype:=7 else
        if dx and $4000<>0 then drivetype:=4 else    
{$IFNDEF NO386}	
        if drive<='B' then drivetype:=0 else
          if Winversion<>4 then begin
            {RamDisk-Erkennung unter WinNT unsicher bzw. so nicht erlaubt}
            if (dx and $8ff=$800) then drivetype:=2 else       
            if is_Ramdrive(drive) then drivetype:=2 else
            drivetype:=1;
          end else begin
             if xp_ntvdm_ok=false then drivetype:=1 else
             begin
               if NTDiskType(ord(drive)-64)=6 then drivetype:=2 else  
               drivetype:=1;
             end;
          end;
{$ENDIF}
    end;
end;

function alldrives:string;

  function GetMaxDrive:char;
  var regs : registers;
  begin
    with regs do begin
      ah:=$19;
      msdos(regs);        { aktuelles LW abfragen; 0=A, 1=B usw. }
      ah:=$e; dl:=al;
      msdos(regs);        { aktuelles LW setzen; liefert lastdrive in al }
      GetMaxDrive:=chr(al+64);
    end;
  end;

var b : byte;
    s : string;
    c : char;
begin
  b:=0;
  for c:='A' to GetMaxdrive do
    if drivetype(c)>0 then begin
      inc(b);
      s[b]:=c;
    end;
  s[0]:=chr(b);
  alldrives:=s;
end;

function ConfigFILES:byte;                  { FILES= .. - DOS >= 2.0! }
type wa   = array[0..2] of word;
var  regs : registers;
     wp   : ^wa;
     n    : word;
begin
  with regs do begin
    ah:=$52;             { Get List of Lists }
    msdos(regs);
    wp:=ptr(es,bx+4);
    wp:=ptr(wp^[1],wp^[0]);
    n:=0;
    while ofs(wp^)<>$ffff do begin
      inc(n,wp^[2]);
      wp:=ptr(wp^[1],wp^[0]);
    end;
    if n>255 then n:=255;
    ConfigFILES:=n;
  end;
end;

function FreeFILES(maxfiles:byte):word;
var f  : array[1..255] of ^file;
    i  : integer;
    fm : byte;
begin
  i:=0;
  fm:=filemode;
  filemode:=$40;
  repeat
    inc(i);
    new(f[i]);
    assign(f[i]^,'nul');
    reset(f[i]^,1);
  until (i=maxfiles) or (inoutres<>0);
  if ioresult<>0 then begin
    dispose(f[i]); dec(i); end;
  FreeFILES:=i;
  while i>0 do begin
    close(f[i]^);
    dispose(f[i]);
    dec(i);
  end;
  filemode:=fm;
end;

procedure XIntr(intno:byte; var regs:registers);   { DPMI-kompatibler Intr }
var dpmistruc : record
                  edi,esi,ebp,reserved : longint;
                  ebx,edx,ecx,eax      : longint;
                  flags,es,ds,fs,gs    : word;
                  ip,cs,sp,ss          : word;
                end;
    regs2     : registers;
begin
  {$IFNDEF DPMI}
    intr(intno,regs);
  {$ELSE}
    with dpmistruc do begin       { Register-Translation-Block aufbauen }
      edi:=regs.di; esi:=regs.si;
      ebp:=regs.bp; reserved:=0;
      ebx:=regs.bx; edx:=regs.dx;
      ecx:=regs.cx; eax:=regs.ax;
      flags:=$200;
      es:=regs.es; ds:=regs.ds;
      fs:=regs.es; gs:=regs.es; cs:=regs.es;
      sp:=0; ss:=0;      { neuen Real-Mode-Stack anlegen }
    end;
    with regs2 do begin           { Protected-Mode-Int aufrufen }
      ax:=$300;
      bx:=intno;
      cx:=0;
      es:=seg(dpmistruc);
      di:=ofs(dpmistruc);
      intr(DPMI,regs2);
    end;
    with dpmistruc do begin       { Real-Mode-Register zurckkopieren }
      regs.ax:=eax and $ffff; regs.bx:=ebx and $ffff;
      regs.cx:=ecx and $ffff; regs.dx:=edx and $ffff;
      regs.bp:=ebp and $ffff;
      regs.si:=esi and $ffff; regs.di:=edi and $ffff;
      regs.ds:=ds; regs.es:=es; regs.flags:=flags;
    end;
  {$ENDIF}
end;

function DPMIallocDOSmem(paras:word; var segment:word):word;
var regs : registers;
begin
  with regs do begin
    ax:=$100;
    bx:=paras;
    intr(DPMI,regs);
    if flags and fcarry<>0 then begin
      segment:=0;
      DPMIallocDOSmem:=0;
    end
    else begin
      segment:=regs.ax;
      DPMIallocDOSmem:=dx;
    end;
  end;
end;

procedure DPMIfreeDOSmem(selector:word);
var regs : registers;
begin
  regs.ax:=$101;
  regs.dx:=selector;
  intr(DPMI,regs);
end;


function IsDevice(const fn:pathstr):boolean;
var f    : file;
    regs : registers;
begin
  assign(f,fn);
  reset(f);
  if ioresult<>0 then
    IsDevice:=false
  else begin
    with regs do begin
      ax:=$4400;        { IOCTL Get device data }
      bx:=filerec(f).handle;
      msdos(regs);
      IsDevice:=(flags and fcarry=0) and (dx and 128<>0);
      end;
    close(f);
    end;
end;

end.

