(****************************************************
******* OBJECT SOFTWARE DESIGN *******
*******                     Paul Kuijer                       ******
****************************************************)


unit OSD_CD;

interface

type
  CD_Record = record
                Status  : Word;
                DrvChar : Char;
                DrvNo   : Byte;
                HSG_RB  : Byte;
                Sector  : LongInt;
                VolInfo : array[1..8] of Byte;
                DevPar : LongInt;
                RawMode : Boolean;
                SecSize : Word;
                VolSize : LongInt;
                MedChg : Byte;
                LoAuTr : Byte;
                HiAuTr : Byte;
                EndAdr : LongInt;
                TrkNo : Byte;
                TrkAdr : LongInt;
                TrkInf : Byte;
                CntAdr,
                CTrk,
                CIndx,
                CMin,
                CSec,
                CFrm,
                CZero,
                CAMin,
                CASec,
                CAFrm : Byte;
                QFrm,
                QTrfs,
                QCnt : LongInt;
                UCtrl : Byte;
                Upn : array[1..7] of Byte;
                UZero : Byte;
                UFrm : Byte;
              end;
  OneTrack  = record
                Title : string[20];
                RunMin,
                RunSec : Byte;
                Start : LongInt;
              end;
  VolTable  = record
                DiskName : string[20];
                UAN_Code : string[13];
                TrackCnt : Byte;
                Titles   : array[1..99] of OneTrack;
              end;
  TrkInfo  = record
                Nummer : Byte;
                Start : LongInt;
                Cntrl2 : Byte;
              end;

var
  CD        : CD_Record;
  CD_Avail  : Boolean;
  VtoC      : VolTable;
  CD_RedPos : string;
  CD_HSGPos : string;

function CD_Reset : Boolean;
function CD_HeadAdr : Boolean;
function CD_Position : Boolean;
function CD_MediaChanged : Boolean;

function CD_Open : Boolean;
function CD_Close : Boolean;
function CD_Eject : Boolean;

function CD_Play( no:Byte; len : Integer ) : Boolean;
function CD_Stop : Boolean;
function CD_Resume : Boolean;
function CD_SetVol : Boolean;
function CD_GetVol : Boolean;

procedure CD_Info;
procedure CD_TrackInfo( Nr:Byte; VAR T : TrkInfo );

function Red2Time( VAR Inf : TrkInfo ) : Word;

implementation

uses Dos;

const
  IOCtlRead   = $4402;
  IOCtlWrite  = $4403;
  DevDrvReq   = $1510;
  All:LongInt = $0F00;

type
  IOCtlBlk = array[0..200] of Byte;

var
  R : Registers;
  H : Text;
  Handle : Word;
  Old_Exit : Pointer;
  CtlBlk : IOCtlBlk;
  Tracks : Array[0..100] of TrkInfo;

procedure CD_Exit;
begin
  if Old_Exit <> NIL then
    ExitProc := Old_Exit;
{$I-}
  Close( H );
  if IOResult = 0 then;
{$I+}
end;

function CD_Init : Boolean;
begin
  FillChar( CD, SizeOf( CD ), 0 );
  With R do
  begin
    AX := $1500;
    BX := $0000;
    CX := $0000;
    Intr( $2F, R );
    CD_Init := (BX > 0);
    if BX > 0 then
    begin
      CD.DrvChar := Char( CL + Byte( 'A' ) );
      CD.DrvNo := CL;
      if CD_HeadAdr then
        if CD_GetVol then;
    end else CD.DrvChar := '?';
  end;
end;

procedure CD_TrackInfo( Nr : Byte; VAR T : TrkInfo );
begin
  T := Tracks[nr];
end;

function OpenCDHandle : Word;
const
  Name : string[8] = 'WP_CDROM';
begin
  Assign( H, Name );
(*$I-*)
  Reset(H);
(*$I+*)
  if IOResult = 0 then
  begin
    Handle := TextRec(H).Handle;
    Old_Exit := ExitProc;
    ExitProc := @CD_Exit;
  end else Handle := 0;
  OpenCDHandle := Handle;
end;

procedure CloseCDHandle;
begin
  if TextRec(H).Mode <> fmClosed then ExitProc := Old_Exit;
  Old_Exit := NIL;
{$I-}
  Close( H );
  if IOResult = 0 then;
{$I+}
end;

function Red2HSG( VAR Inf:TrkInfo ) : LongInt;
var
  l : LongInt;
begin
  l := LongInt(( Inf.Start shr 16 ) and $FF ) * 4500;
  l := l + LongInt(( Inf.Start shr 8 ) and $FF ) *75;
  l := l + LongInt( Inf.Start ) and $FF;
  Red2HSG := l-2;
end;

function Red2Time( VAR inf:TrkInfo ) : Word;
begin
  Red2Time := ((Inf.Start shr 24 ) and $FF ) shl 8
              +((Inf.Start shr 16 ) and $FF );
end;

function HSG2Red(L:LongInt) : LongInt;
begin
end;

function CD_IOCtl( Func : Word ) : Boolean;
begin
  with R do
  begin
    AX := Func;
    BX := OpenCDHandle;
    CX := 129;
    DS := DSeg;
    ES := DS;
    DX := Ofs(CtlBlk);
    MsDos( R );
    CD.Status := AX;
    CD_IOCtl := (Flags and FCARRY ) = 0;
    CloseCDHandle;
  end;
end;

function CD_Reset : Boolean;
begin
  CtlBlk[0] := 2;
  CD_Reset := CD_IOCtl( IOCtlWrite );
end;

function DieTuer( AufZu:Byte ) : Boolean;
begin
  CtlBlk[0] := 1;
  CtlBlk[1] := AufZu;
  DieTuer := CD_IOCtl( IOCtlWrite );
end;

function CD_Open : Boolean;
const
  Auf = 0;
begin
  CD_Open := DieTuer( 0 );
end;

function CD_Close : Boolean;
const
  Zu = 1;
begin
  CD_Close := DieTuer( Zu );
end;

function CD_Eject : Boolean;
begin
  CtlBlk[0] := 0;
  CD_Eject := CD_IOCtl( IOCtlWrite );
end;

function CD_Play( no:Byte; len:Integer) : Boolean;
begin
  FillChar( CtlBlk, SizeOf(CtlBlk), 0 );
  CtlBlk[0] := 22;
  CtlBlk[1] := 0;
  CtlBlk[2] := $84;
  CtlBlk[3] := 0;
  CtlBlk[4] := 0;
  CtlBlk[5] := 0;
  CtlBlk[13] := CD.HSG_RB;
  CD.Sector := VtoC.Titles[no].Start;
  Move( CD.Sector, CtlBlk[14], 4 );
  if len = -1 then All := $FFFF
    else All := len;
  Move( All, CtlBlk[18], 4 );
  asm
    mov   ax, $1510
    push  ds
    pop   es
    xor   cx, cx
    mov   cl, CD.DrvNo
    mov   bx, offset CtlBlk
    int   $2F
  end;
  CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
  CD_Play := CD.Status and $8000 = 0;
end;

function CD_VtoC : Boolean;
var
  i : Byte;
  l : LongInt;
begin
  FillChar( Tracks, SizeOf(Tracks), 0 );
  CtlBlk[0] := 10;
  CD_IOCtl( IOCtlRead );
  Move( CtlBlk[1], CD.LoAuTr, 6 );
  i := CD.HiAuTr+1;
  Move( CtlBlk[3], Tracks[i], 4 );
  Tracks[i].Start := Red2HSG(Tracks[i]);
  for i := CD.LoAuTr to CD.HiAuTr do
  begin
    FillChar( CtlBlk, SizeOf(CtlBlk), 0 );
    CtlBlk[0] := 11;
    CtlBlk[1] := i;
    CD_IOCtl( IOCtlRead );
    Move( CtlBlk[1], Tracks[i], 6 );
  end;
  with VtoC do
  begin
    DiskName := '';
    UAN_Code := '';
    TrackCnt := CD.HiAuTr;
    for i := CD.LoAuTr to CD.HiAuTr do
    begin
      with Titles[i] do
      begin
        L := longInt((Tracks[i+1].Start shr 16) and $FF) * 60
             + (Tracks[i+1].Start shr 8) and $FF
             - ( LongInt((Tracks[i].Start shr 16) and $FF) * 60
             + (Tracks[i].Start shr 8) and $FF);
        Title := '???';
        RunMin := l Div 60;
        RunSec := l - RunMin * 60;
        Start := Red2HSG(Tracks[i]);
      end;
    end;
  end;
end;

function CD_Stop : Boolean;
begin
  FillChar( CtlBlk, SizeOf(CtlBlk), 0 );
  CtlBlk[0] := 5;
  CtlBlk[1] := 0;
  CtlBlk[2] := $85;
  CtlBlk[3] := 0;
  CtlBlk[4] := 0;
  CtlBlk[5] := 0;
  asm
    mov   ax, $1510
    push  ds
    pop   es
    xor   cx, cx
    mov   cl, CD.DrvNo
    mov   bx, offset CtlBlk
    int   $2F
  end;
  CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
  CD_Stop := CD.Status and $8000 = 0;
end;

function CD_Resume : Boolean;
begin
  CtlBlk[0] := 3;
  CtlBlk[1] := 0;
  CtlBlk[2] := $88;
  CtlBlk[3] := 0;
  CtlBlk[4] := 0;
  asm
    mov   ax, Seg @Data
    mov   es,  ax
    mov   ax, DevDrvReq
    lea   bx, CtlBlk
    int   $2F
  end;
  CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
  CD_Resume := CD.Status and $8000 = 0;
end;

function CD_GetVol : Boolean;
begin
  CtlBlk[0] := 4;
  CD_GetVol := CD_IOCtl( IOCtlRead );
  if ((R.Flags and FCARRY)=0) then
    Move( CtlBlk[1], CD.VolInfo, 8 ) else
    FillChar( CD.VolInfo, 8, 0 );
end;

function CD_SetVol : Boolean;
begin
  CtlBlk[0] := 3;
  CD_SetVol := Cd_IOCtl( IOCtlWrite );
end;

function CD_HeadAdr : Boolean;
var
  l : LongInt;
  s : string;
begin
  FillChar( CtlBlk, SizeOf(CtlBlk), 0 );
  CtlBlk[0] := 1;
  CtlBlk[1] := 1;
  CD_HeadAdr := CD_IOCtl( IOCtlRead  );
  if (( R.Flags and FCARRY) = 0) then
  begin
    Move( CtlBlk[2], l, 4 );
    if CtlBlk[4] = 1 then
    begin
      STR( CtlBlk[4]:2, s );
      STR( CtlBlk[3]:2, s );
      CD.Sector := LongInt( CtlBlk[4])*4500
                   + LongInt( CtlBlk[3])*75
                   + LongInt( CtlBlk[2]) - 150;
    end else
    begin
      CD.Sector := l;
      STR( L:0, CD_HSGPos );
    end;
  end else
    FillChar( CD.Sector, 4, 0 );
end;

function CD_Position : Boolean;
var
  l : longint;
begin
  CtlBlk[0] := 12;
  CD_Position:= CD_IOCtl( IOCtlRead );
  Move( CtlBlk[1], CD.CntAdr, 10 );
end;

procedure CD_GetUAN;
begin
  CtlBlk[0] := 14;
  if CD_IOCtl(IOCtlRead ) then
    Move( CtlBlk[1], CD.UCtrl, 10 );
end;

function CD_MediaChanged : Boolean;
begin
  CtlBlk[0] := 9;
  if CD_IOCtl(IOCtlRead ) then
    Move( CtlBlk[1], CD.MedChg, 1 );
    CD_MediaChanged := CD.MedChg <> 1;
end;

procedure CD_Info;
begin
  if CD_HeadAdr then;
  CtlBlk[0] := 6;
  if CD_IOCtl( IOCtlRead ) then
    Move( CtlBlk[1], Cd.DevPar, 4 );
  CtlBlk[0] := 7;
  if CD_IOCtl( IOCtlRead ) then
    Move( CtlBlk[1], Cd.RawMode, 3 );
  CtlBlk[0] := 8;
  if CD_IOCtl( IOCtlRead ) then
    Move( CtlBlk[1], Cd.VolSize, 4 );
  CtlBlk[0] := 12;
  if CD_IOCtl( IOCtlRead ) then
    Move( CtlBlk[1], Cd.CntAdr, 10 );
  CtlBlk[0] := 11;
  if CD_IOCtl( IOCtlRead) then
    Move( CtlBlk[1], Cd.TrkNo, 6 );
  CD_VtoC;
end;

begin
  CD_Avail := CD_Init;
  if CD_Avail then CD_Info;
end.


    Source: geocities.com/~franzglaser/tpsrc

               ( geocities.com/~franzglaser)