paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 23:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* cdrom

Browse Source 
git-svn-id: trunk@10001 -
This commit is contained in:
marco 2008-01-26 23:18:37 +00:00
parent fe10f55f6f
commit 40fe6d6b94
16 changed files with 5491 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
.gitattributes vendored
View File

@ -873,6 +873,21 @@ packages/bzip2/src/bzip2.pas svneol=native#text/plain
packages/bzip2/src/bzip2i386.inc svneol=native#text/plain
packages/cairo/Makefile.fpc svneol=native#text/plain
packages/cairo/src/cairo.pp svneol=native#text/plain
packages/cdrom/Makefile svneol=native#text/plain
packages/cdrom/Makefile.fpc svneol=native#text/plain
packages/cdrom/examples/getdiscid.pp svneol=native#text/plain
packages/cdrom/examples/showcds.pp svneol=native#text/plain
packages/cdrom/fpmake.pp svneol=native#text/plain
packages/cdrom/src/cdrom.pp svneol=native#text/plain
packages/cdrom/src/cdromioctl.pp svneol=native#text/plain
packages/cdrom/src/cdromlin.inc svneol=native#text/plain
packages/cdrom/src/cdromw32.inc svneol=native#text/plain
packages/cdrom/src/discid.pp svneol=native#text/plain
packages/cdrom/src/lincd.pp svneol=native#text/plain
packages/cdrom/src/major.pp svneol=native#text/plain
packages/cdrom/src/scsidefs.pp svneol=native#text/plain
packages/cdrom/src/wincd.pp svneol=native#text/plain
packages/cdrom/src/wnaspi32.pp svneol=native#text/plain
packages/chm/Makefile svneol=native#text/plain
packages/chm/Makefile.fpc svneol=native#text/plain
packages/chm/src/chmbase.pas svneol=native#text/plain

2450
packages/cdrom/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

26
packages/cdrom/Makefile.fpc Normal file
View File

@ -0,0 +1,26 @@
#
# Makefile.fpc for cdrom
#
[package]
name=cdrom
version=2.0.0
[target]
units=cdrom discid
implicitunits_win32=scsidefs wnaspi32 cdromioctl wincd
implicitunits_linux=major lincd
examples=showcds getdiscid
[install]
fpcpackage=y
[compiler]
includedir=src
sourcedir=src tests
[default]
fpcdir=../..
[rules]
.NOTPARALLEL:

43
packages/cdrom/examples/getdiscid.pp Normal file
View File

@ -0,0 +1,43 @@
{
Copyright (c) 1999-2000 by Michael Van Canneyt
Demonstrates DiscID unit usage.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
program getdiscid;
uses cdrom,discid;
Var
TheDiscID : cardinal;
Tracks, i : Integer;
Entries : Array[1..100] of TTocEntry;
Device : string;
begin
Case ParamCount of
0 : Device:='/dev/cdrom';
1 : Device:=Paramstr(1);
else
Writeln('Usage: getdiscid [devicefile]');
halt(1);
end;
Tracks := ReadCDTOC(Device,Entries);
If Tracks<0 then
Writeln('Error reading TOC of device ',device)
else
begin
Writeln('Disk has ',tracks,' tracks.');
TheDiscID := CDDBDiscID(Entries,Tracks);
Writeln('Disc ID : ',lowercase(HexStr(theDiscID,8)));
Writeln('CDDB Query : ',GetCDDBQueryString(Entries,Tracks));
end;
end.

22
packages/cdrom/examples/showcds.pp Normal file
View File

@ -0,0 +1,22 @@
program showcds;
{$mode objfpc}
{$h+}
uses cdrom,sysutils;
Var
Drives : Array[1..10] of String;
I,Count : Integer;
begin
Try
Count:=GetCDRomDevices(Drives);
Writeln('This PC has ',count,' CD-ROM drives');
For I:=1 to count do
Writeln('Drive ',i,' on device: ',Drives[i]);
Except
On E : exception do
Writeln(E.ClassName,' exception caught with message: ',E.Message);
end;
end.

45
packages/cdrom/fpmake.pp Normal file
View File

@ -0,0 +1,45 @@
{$ifndef ALLPACKAGES}
{$mode objfpc}{$H+}
program fpmake;
uses fpmkunit;
Var
P : TPackage;
T : TTarget;
begin
With Installer do
begin
{$endif ALLPACKAGES}
P:=AddPackage('cdrom');
{$ifdef ALLPACKAGES}
P.Directory:='cdrom';
{$endif ALLPACKAGES}
P.Version:='2.0.0';
P.SourcePath.Add('src');
T:=P.Targets.AddUnit('cdrom.pp');
with T.Dependencies do
begin
AddInclude('cdromlin.inc');
AddUnit('lincd');
end;
T:=P.Targets.AddUnit('discid.pp');
with T.Dependencies do
begin
AddUnit('cdrom');
end;
T:=P.Targets.AddUnit('lincd.pp');
with T.Dependencies do
begin
AddUnit('major');
end;
T:=P.Targets.AddUnit('major.pp');
{$ifndef ALLPACKAGES}
Run;
end;
end.
{$endif ALLPACKAGES}

39
packages/cdrom/src/cdrom.pp Normal file
View File

@ -0,0 +1,39 @@
{
Copyright (c) 1999-2000 by Michael Van Canneyt
Unit to read a CDROM disc TOC and get a list of CD Rom devices
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit cdrom;
{$mode objfpc}
{$h+}
interface
Type
TTocEntry = Record
min, sec, frame : Integer;
end;
PTocEntry = ^TTocEntry;
Function ReadCDTOC(Device : String; Var CDTOC : Array of TTocEntry) : Integer;
Function GetCDRomDevices(Var Devices : Array of string) : Integer;
Implementation
{$ifdef linux}
{$i cdromlin.inc}
{$else}
{$i cdromw32.inc}
{$endif}
end.

168
packages/cdrom/src/cdromioctl.pp Normal file
View File

@ -0,0 +1,168 @@
unit cdromioctl;
{$mode objfpc}
interface
uses windows;
{
Automatically converted by H2Pas 0.99.15 from cdromioctl.h
The following command line parameters were used:
cdromioctl.h
}
{$PACKRECORDS C}
{
distilled information from various header files from Microsoft's
DDK for Windows NT 4.0
}
type
SCSI_PASS_THROUGH = record
Length : USHORT;
ScsiStatus : UCHAR;
PathId : UCHAR;
TargetId : UCHAR;
Lun : UCHAR;
CdbLength : UCHAR;
SenseInfoLength : UCHAR;
DataIn : UCHAR;
DataTransferLength : ULONG;
TimeOutValue : ULONG;
DataBufferOffset : ULONG;
SenseInfoOffset : ULONG;
Cdb : array[0..15] of UCHAR;
end;
PSCSI_PASS_THROUGH = ^SCSI_PASS_THROUGH;
SCSI_PASS_THROUGH_DIRECT = record
Length : USHORT;
ScsiStatus : UCHAR;
PathId : UCHAR;
TargetId : UCHAR;
Lun : UCHAR;
CdbLength : UCHAR;
SenseInfoLength : UCHAR;
DataIn : UCHAR;
DataTransferLength : ULONG;
TimeOutValue : ULONG;
DataBuffer : PVOID;
SenseInfoOffset : ULONG;
Cdb : array[0..15] of UCHAR;
end;
PSCSI_PASS_THROUGH_DIRECT = ^SCSI_PASS_THROUGH_DIRECT;
SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER = record
spt : SCSI_PASS_THROUGH_DIRECT;
Filler : ULONG;
ucSenseBuf : array[0..31] of UCHAR;
end;
PSCSI_PASS_THROUGH_DIRECT_WITH_BUFFER = ^SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER;
{
method codes
}
const
METHOD_BUFFERED = 0;
METHOD_IN_DIRECT = 1;
METHOD_OUT_DIRECT = 2;
METHOD_NEITHER = 3;
{
file access values
}
FILE_ANY_ACCESS = 0;
FILE_READ_ACCESS = $0001;
FILE_WRITE_ACCESS = $0002;
IOCTL_CDROM_BASE = $00000002;
IOCTL_SCSI_BASE = $00000004;
{
constants for DataIn member of SCSI_PASS_THROUGH structures
}
SCSI_IOCTL_DATA_OUT = 0;
SCSI_IOCTL_DATA_IN = 1;
SCSI_IOCTL_DATA_UNSPECIFIED = 2;
{
Standard IOCTL define
}
Function CTL_CODE( ADevType, AFunction, AMethod, AAccess : Longint) : Longint;
function IOCTL_CDROM_READ_TOC : Longint;
function IOCTL_CDROM_GET_LAST_SESSION : longint;
function IOCTL_SCSI_PASS_THROUGH : longint;
function IOCTL_SCSI_MINIPORT : longint;
function IOCTL_SCSI_GET_INQUIRY_DATA : longint;
function IOCTL_SCSI_GET_CAPABILITIES : longint;
function IOCTL_SCSI_PASS_THROUGH_DIRECT : longint;
function IOCTL_SCSI_GET_ADDRESS : longint;
implementation
{ was #define dname def_expr }
function IOCTL_CDROM_GET_LAST_SESSION : longint;
{ return type might be wrong }
begin
IOCTL_CDROM_GET_LAST_SESSION:=CTL_CODE(IOCTL_CDROM_BASE,$000E,METHOD_BUFFERED,FILE_READ_ACCESS);
end;
{ was #define dname def_expr }
function IOCTL_SCSI_PASS_THROUGH : longint;
{ return type might be wrong }
begin
IOCTL_SCSI_PASS_THROUGH:=CTL_CODE(IOCTL_SCSI_BASE,$0401,METHOD_BUFFERED,FILE_READ_ACCESS or FILE_WRITE_ACCESS);
end;
{ was #define dname def_expr }
function IOCTL_SCSI_MINIPORT : longint;
{ return type might be wrong }
begin
IOCTL_SCSI_MINIPORT:=CTL_CODE(IOCTL_SCSI_BASE,$0402,METHOD_BUFFERED,FILE_READ_ACCESS or FILE_WRITE_ACCESS);
end;
{ was #define dname def_expr }
function IOCTL_SCSI_GET_INQUIRY_DATA : longint;
{ return type might be wrong }
begin
IOCTL_SCSI_GET_INQUIRY_DATA:=CTL_CODE(IOCTL_SCSI_BASE,$0403,METHOD_BUFFERED,FILE_ANY_ACCESS);
end;
{ was #define dname def_expr }
function IOCTL_SCSI_GET_CAPABILITIES : longint;
{ return type might be wrong }
begin
IOCTL_SCSI_GET_CAPABILITIES:=CTL_CODE(IOCTL_SCSI_BASE,$0404,METHOD_BUFFERED,FILE_ANY_ACCESS);
end;
{ was #define dname def_expr }
function IOCTL_SCSI_PASS_THROUGH_DIRECT : longint;
{ return type might be wrong }
begin
IOCTL_SCSI_PASS_THROUGH_DIRECT:=CTL_CODE(IOCTL_SCSI_BASE,$0405,METHOD_BUFFERED,FILE_READ_ACCESS or FILE_WRITE_ACCESS);
end;
{ was #define dname def_expr }
function IOCTL_SCSI_GET_ADDRESS : longint;
{ return type might be wrong }
begin
IOCTL_SCSI_GET_ADDRESS:=CTL_CODE(IOCTL_SCSI_BASE,$0406,METHOD_BUFFERED,FILE_ANY_ACCESS);
end;
Function CTL_CODE( ADevType, AFunction, AMethod, AAccess : Longint) : Longint;
begin
Result:= (ADevType shl 16 )
Or (AAccess shl 14)
Or (AFunction SHL 2)
Or AMethod;
end;
function IOCTL_CDROM_READ_TOC : Longint;
begin
Result:=CTL_CODE(IOCTL_CDROM_BASE, 0, METHOD_BUFFERED, FILE_READ_ACCESS )
end;
end.

136
packages/cdrom/src/cdromlin.inc Normal file
View File

@ -0,0 +1,136 @@
uses
baseunix,
unix,
lincd;
Function ReadCDTOC(Device : String; Var CDTOC : Array of TTocEntry) : Integer;
Var
I,Drive : Integer;
tochdr : Tcdrom_tochdr;
tocentry : tcdrom_tocentry;
begin
drive:=fpOpen(Device, Open_RDONLY or Open_NONBLOCK);
if drive<0 then
begin
Result:=-1;
Exit;
end;
if fpioctl(drive, CDROMREADTOCHDR, @tochdr)<>0 then
begin
Result:=-1;
Exit;
end;
If (tochdr.cdth_trk1-tochdr.cdth_trk0)>High(CDToc) then
Result:=-2
else
begin
Result:=0;
for i := tochdr.cdth_trk0 to tochdr.cdth_trk1 do
begin
tocentry.cdte_track := i;
tocentry.cdte_format := CDROM_MSF;
fpIOCtl(drive, CDROMREADTOCENTRY, @tocentry);
// We should do some error checking here actually.
With cdtoc[result] do
begin
min := tocentry.cdte_addr.msf.minute;
sec := tocentry.cdte_addr.msf.second;
frame := tocentry.cdte_addr.msf.frame;
inc(frame,min*60*75);
inc(frame,sec*75);
end;
Inc(result);
end;
tocentry.cdte_track := $AA;
tocentry.cdte_format := CDROM_MSF;
fpIOCtl(drive, CDROMREADTOCENTRY, @tocentry);
With cdtoc[Result] do
begin
Min := tocentry.cdte_addr.msf.minute;
sec := tocentry.cdte_addr.msf.second;
frame := tocentry.cdte_addr.msf.frame;
inc(frame, min*60*75);
inc(frame, sec*75);
end;
end;
fpClose(drive);
end;
{ ---------------------------------------------------------------------
/etc/fstab scanning.
---------------------------------------------------------------------}
Function ExtractDevice(S : String) : String;
Var
P,L : Integer;
begin
Result:='';
P:=Pos('#',S);
If P<>0 then
S:=Copy(S,1,P-1);
If Length(S)>0 then
begin
P:=1;
While (P<=Length(S)) and (S[P] in [#9,' ']) do
Inc(p);
L:=P;
While (L<=Length(S)) and (Not (S[L] in [#9,' '])) do
Inc(L);
If L>P then
Result:=Copy(S,P,L-P);
end;
end;
Function TestFSTab(var Devices : Array of String) : Integer;
Var
fstab : text;
Line : String;
begin
Result:=0;
Assign(FSTab,'/etc/fstab');
{$i-}
Reset(fstab);
{$i+}
If IOResult=0 then
begin
While Not EOF(fstab) do
begin
ReadLn(fsTab,Line);
Line:=ExtractDevice(Line);
If IsCdDevice(Line) and (Result<=High(Devices)) then
begin
Devices[Result]:=Line;
inc(Result);
end;
end;
Close(fstab);
end
else
Result:=-1;
end;
Function GetCDRomDevices(Var Devices : Array of string) : Integer;
Var
S : String;
begin
Result:=TestFSTab(Devices);
If (Result<1) then
begin
S:=DetectCD;
If (S<>'') then
begin
Devices[0]:=S;
Result:=1;
end;
end
end;

50
packages/cdrom/src/cdromw32.inc Normal file
View File

@ -0,0 +1,50 @@
uses wincd;
Function ReadCDTOC(Device : String; Var CDTOC : Array of TTocEntry) : Integer;
Var
Toc : TToc;
I,Res : Integer;
begin
Res:=ReadTOC(Device,TOC);
If Res<0 then
Result:=Res
else
begin
If Res>High(CDTOC)+1 then
Result:=-2
else
begin
Result:=0;
For I:=TOC.FirstTrack to Toc.LastTrack do
begin
With CDTOC[Result],TOC.TocTrack[Result] do
begin
min:=Addr[1];
sec:=Addr[2];
frame:=Addr[3]; // ?? tocentry.cdte_addr.msf.frame;
inc(frame,min*60*75);
inc(frame,sec*75);
end;
Inc(Result);
end;
// Lead out
With CDTOC[Result],TOC.TocTrack[Result] do
begin
min:=Addr[1];
sec:=Addr[2];
frame:=Addr[3]; // ?? tocentry.cdte_addr.msf.frame;
inc(frame,min*60*75);
inc(frame,sec*75);
end;
end;
end;
end;
Function GetCDRomDevices(Var Devices : Array of string) : Integer;
begin
Result:=enumcddrives(Devices);
end;

69
packages/cdrom/src/discid.pp Normal file
View File

@ -0,0 +1,69 @@
{
Copyright (c) 1999-2000 by Michael Van Canneyt
Unit to read a disc TOC and get discid for a cddb query.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit discid;
{$mode objfpc}
interface
uses cdrom,sysutils;
Function CDDBDiscID(Const CDTOC : Array of TTocEntry; Count : Integer) : integer ;
Function GetCDDBQueryString(Const Tracks : Array of TTocEntry; Count : Integer) : String;
Implementation
Function cddb_sum(N : Integer) : Cardinal;
begin
Result:=0;
while (n > 0) do
begin
Inc(result,(n mod 10));
n:=n div 10;
end;
end;
Function cddbdiscid(Const cdtoc : Array of TTocEntry; Count : Integer) : integer ;
Var
i,t,n : cardinal;
begin
t:=0;
n:=0;
i:= 0;
For I:=0 to count-1 do
n := n + cddb_sum((cdtoc[i].min * 60) + cdtoc[i].sec);
t:=((cdtoc[Count].min * 60) + cdtoc[Count].sec) -
((cdtoc[0].min * 60) + cdtoc[0].sec);
Result:=(((n mod $ff) shl 24) or (t shl 8 or count));
end;
Function GetCDDBQueryString(Const Tracks : Array of TTocEntry; Count : Integer) : String;
Var
I,TheDiscID : Integer;
begin
TheDiscID:=cddbdiscid(Tracks,Count);
Result:=Lowercase(HexStr(TheDiscID,8))+' '+intToStr(Count);
for I:=0 to Count-1 do
Result:=Result+' '+IntToStr(tracks[i].frame);
Result:=Result+' '+IntToStr(tracks[Count].frame div 75);
end;
end.

1203
packages/cdrom/src/lincd.pp Normal file
View File

File diff suppressed because it is too large Load Diff

162
packages/cdrom/src/major.pp Normal file
View File

@ -0,0 +1,162 @@
unit major;
interface
{
Automatically converted by H2Pas 0.99.15 from major.h
The following command line parameters were used:
major.h
}
{$PACKRECORDS C}
const
MAX_CHRDEV = 255;
MAX_BLKDEV = 255;
UNNAMED_MAJOR = 0;
MEM_MAJOR = 1;
RAMDISK_MAJOR = 1;
FLOPPY_MAJOR = 2;
PTY_MASTER_MAJOR = 2;
IDE0_MAJOR = 3;
PTY_SLAVE_MAJOR = 3;
HD_MAJOR = IDE0_MAJOR;
TTY_MAJOR = 4;
TTYAUX_MAJOR = 5;
LP_MAJOR = 6;
VCS_MAJOR = 7;
LOOP_MAJOR = 7;
SCSI_DISK0_MAJOR = 8;
SCSI_TAPE_MAJOR = 9;
MD_MAJOR = 9;
MISC_MAJOR = 10;
SCSI_CDROM_MAJOR = 11;
QIC02_TAPE_MAJOR = 12;
XT_DISK_MAJOR = 13;
SOUND_MAJOR = 14;
CDU31A_CDROM_MAJOR = 15;
JOYSTICK_MAJOR = 15;
GOLDSTAR_CDROM_MAJOR = 16;
OPTICS_CDROM_MAJOR = 17;
SANYO_CDROM_MAJOR = 18;
CYCLADES_MAJOR = 19;
CYCLADESAUX_MAJOR = 20;
MITSUMI_X_CDROM_MAJOR = 20;
{ ARM Linux /dev/mfm }
MFM_ACORN_MAJOR = 21;
SCSI_GENERIC_MAJOR = 21;
Z8530_MAJOR = 34;
DIGI_MAJOR = 23;
IDE1_MAJOR = 22;
DIGICU_MAJOR = 22;
MITSUMI_CDROM_MAJOR = 23;
CDU535_CDROM_MAJOR = 24;
STL_SERIALMAJOR = 24;
MATSUSHITA_CDROM_MAJOR = 25;
STL_CALLOUTMAJOR = 25;
MATSUSHITA_CDROM2_MAJOR = 26;
QIC117_TAPE_MAJOR = 27;
MATSUSHITA_CDROM3_MAJOR = 27;
MATSUSHITA_CDROM4_MAJOR = 28;
STL_SIOMEMMAJOR = 28;
ACSI_MAJOR = 28;
AZTECH_CDROM_MAJOR = 29;
{ SparcLinux & Linux/68k /dev/fb }
GRAPHDEV_MAJOR = 29;
{ Linux/mips, SGI /dev/shmiq }
SHMIQ_MAJOR = 85;
CM206_CDROM_MAJOR = 32;
IDE2_MAJOR = 33;
IDE3_MAJOR = 34;
{ expanded storage on S/390 = "slow ram" }
XPRAM_MAJOR = 35;
{ proposed by Peter }
NETLINK_MAJOR = 36;
PS2ESDI_MAJOR = 36;
IDETAPE_MAJOR = 37;
Z2RAM_MAJOR = 37;
{ AP1000 Block device }
APBLOCK_MAJOR = 38;
{ AP1000 DDV block device }
DDV_MAJOR = 39;
{ Network block device }
NBD_MAJOR = 43;
RISCOM8_NORMAL_MAJOR = 48;
{ 48..55 }
DAC960_MAJOR = 48;
RISCOM8_CALLOUT_MAJOR = 49;
MKISS_MAJOR = 55;
{ DSP56001 processor device }
DSP56K_MAJOR = 55;
IDE4_MAJOR = 56;
IDE5_MAJOR = 57;
{ Logical Volume Manager }
LVM_BLK_MAJOR = 58;
SCSI_DISK1_MAJOR = 65;
SCSI_DISK2_MAJOR = 66;
SCSI_DISK3_MAJOR = 67;
SCSI_DISK4_MAJOR = 68;
SCSI_DISK5_MAJOR = 69;
SCSI_DISK6_MAJOR = 70;
SCSI_DISK7_MAJOR = 71;
COMPAQ_SMART2_MAJOR = 72;
COMPAQ_SMART2_MAJOR1 = 73;
COMPAQ_SMART2_MAJOR2 = 74;
COMPAQ_SMART2_MAJOR3 = 75;
COMPAQ_SMART2_MAJOR4 = 76;
COMPAQ_SMART2_MAJOR5 = 77;
COMPAQ_SMART2_MAJOR6 = 78;
COMPAQ_SMART2_MAJOR7 = 79;
SPECIALIX_NORMAL_MAJOR = 75;
SPECIALIX_CALLOUT_MAJOR = 76;
COMPAQ_CISS_MAJOR = 104;
COMPAQ_CISS_MAJOR1 = 105;
COMPAQ_CISS_MAJOR2 = 106;
COMPAQ_CISS_MAJOR3 = 107;
COMPAQ_CISS_MAJOR4 = 108;
COMPAQ_CISS_MAJOR5 = 109;
COMPAQ_CISS_MAJOR6 = 110;
COMPAQ_CISS_MAJOR7 = 111;
ATARAID_MAJOR = 114;
{ Official assignations from Peter }
DASD_MAJOR = 94;
{ Official assignations from Peter }
MDISK_MAJOR = 95;
{ 80->87 }
I2O_MAJOR = 80;
IDE6_MAJOR = 88;
IDE7_MAJOR = 89;
IDE8_MAJOR = 90;
IDE9_MAJOR = 91;
UBD_MAJOR = 98;
AURORA_MAJOR = 79;
JSFD_MAJOR = 99;
PHONE_MAJOR = 100;
{ Logical Volume Manager }
LVM_CHAR_MAJOR = 109;
RTF_MAJOR = 150;
RAW_MAJOR = 162;
USB_ACM_MAJOR = 166;
USB_ACM_AUX_MAJOR = 167;
USB_CHAR_MAJOR = 180;
UNIX98_PTY_MASTER_MAJOR = 128;
UNIX98_PTY_MAJOR_COUNT = 8;
UNIX98_PTY_SLAVE_MAJOR = UNIX98_PTY_MASTER_MAJOR + UNIX98_PTY_MAJOR_COUNT;
{ VERITAS volume i/o driver }
VXVM_MAJOR = 199;
{ VERITAS volume config driver }
VXSPEC_MAJOR = 200;
{ VERITAS volume multipath driver }
VXDMP_MAJOR = 201;
MSR_MAJOR = 202;
CPUID_MAJOR = 203;
{ OnStream-SCx0 SCSI tape }
OSST_MAJOR = 206;
{ Official allocations now }
IBM_TTY3270_MAJOR = 227;
IBM_FS3270_MAJOR = 228;
implementation
end.

293
packages/cdrom/src/scsidefs.pp Normal file
View File

@ -0,0 +1,293 @@
unit scsidefs;
interface
const
{ ---------------------------------------------------------------------
TARGET STATUS VALUES
---------------------------------------------------------------------}
STATUS_GOOD = $00; // Status Good
STATUS_CHKCOND = $02; // Check Condition
STATUS_CONDMET = $04; // Condition Met
STATUS_BUSY = $08; // Busy
STATUS_INTERM = $10; // Intermediate
STATUS_INTCDMET = $14; // Intermediate-condition met
STATUS_RESCONF = $18; // Reservation conflict
STATUS_COMTERM = $22; // Command Terminated
STATUS_QFULL = $28; // Queue full
{ ---------------------------------------------------------------------
SCSI MISCELLANEOUS EQUATES
---------------------------------------------------------------------}
MAXLUN = 7; // Maximum Logical Unit Id
MAXTARG = 7; // Maximum Target Id
MAX_SCSI_LUNS = 64; // Maximum Number of SCSI LUNs
MAX_NUM_HA = 8; // Maximum Number of SCSI HA's
{ ---------------------------------------------------------------------
SCSI COMMAND OPCODES
---------------------------------------------------------------------}
{ ---------------------------------------------------------------------
Commands for all Device Types
---------------------------------------------------------------------}
SCSI_CHANGE_DEF = $40; // Change Definition (Optional)
SCSI_COMPARE = $39; // Compare (O)
SCSI_COPY = $18; // Copy (O)
SCSI_COP_VERIFY = $3A; // Copy and Verify (O)
SCSI_INQUIRY = $12; // Inquiry (MANDATORY)
SCSI_LOG_SELECT = $4C; // Log Select (O)
SCSI_LOG_SENSE = $4D; // Log Sense (O)
SCSI_MODE_SEL6 = $15; // Mode Select 6-byte (Device Specific)
SCSI_MODE_SEL10 = $55; // Mode Select 10-byte (Device Specific)
SCSI_MODE_SEN6 = $1A; // Mode Sense 6-byte (Device Specific)
SCSI_MODE_SEN10 = $5A; // Mode Sense 10-byte (Device Specific)
SCSI_READ_BUFF = $3C; // Read Buffer (O)
SCSI_REQ_SENSE = $03; // Request Sense (MANDATORY)
SCSI_SEND_DIAG = $1D; // Send Diagnostic (O)
SCSI_TST_U_RDY = $00; // Test Unit Ready (MANDATORY)
SCSI_WRITE_BUFF = $3B; // Write Buffer (O)
{ ---------------------------------------------------------------------
Commands Unique to Direct Access Devices
---------------------------------------------------------------------}
SCSI_FORMAT = $04; // Format Unit (MANDATORY)
SCSI_LCK_UN_CAC = $36; // Lock Unlock Cache (O)
SCSI_PREFETCH = $34; // Prefetch (O)
SCSI_MED_REMOVL = $1E; // Prevent/Allow medium Removal (O)
SCSI_READ6 = $08; // Read 6-byte (MANDATORY)
SCSI_READ10 = $28; // Read 10-byte (MANDATORY)
SCSI_RD_CAPAC = $25; // Read Capacity (MANDATORY)
SCSI_RD_DEFECT = $37; // Read Defect Data (O)
SCSI_READ_LONG = $3E; // Read Long (O)
SCSI_REASS_BLK = $07; // Reassign Blocks (O)
SCSI_RCV_DIAG = $1C; // Receive Diagnostic Results (O)
SCSI_RELEASE = $17; // Release Unit (MANDATORY)
SCSI_REZERO = $01; // Rezero Unit (O)
SCSI_SRCH_DAT_E = $31; // Search Data Equal (O)
SCSI_SRCH_DAT_H = $30; // Search Data High (O)
SCSI_SRCH_DAT_L = $32; // Search Data Low (O)
SCSI_SEEK6 = $0B; // Seek 6-Byte (O)
SCSI_SEEK10 = $2B; // Seek 10-Byte (O)
SCSI_SET_LIMIT = $33; // Set Limits (O)
SCSI_START_STP = $1B; // Start/Stop Unit (O)
SCSI_SYNC_CACHE = $35; // Synchronize Cache (O)
SCSI_VERIFY = $2F; // Verify (O)
SCSI_WRITE6 = $0A; // Write 6-Byte (MANDATORY)
SCSI_WRITE10 = $2A; // Write 10-Byte (MANDATORY)
SCSI_WRT_VERIFY = $2E; // Write and Verify (O)
SCSI_WRITE_LONG = $3F; // Write Long (O)
SCSI_WRITE_SAME = $41; // Write Same (O)
{ ---------------------------------------------------------------------
Commands Unique to Sequential Access Devices
---------------------------------------------------------------------}
SCSI_ERASE = $19; // Erase (MANDATORY)
SCSI_LOAD_UN = $1B; // Load/Unload (O)
SCSI_LOCATE = $2B; // Locate (O)
SCSI_RD_BLK_LIM = $05; // Read Block Limits (MANDATORY)
SCSI_READ_POS = $34; // Read Position (O)
SCSI_READ_REV = $0F; // Read Reverse (O)
SCSI_REC_BF_DAT = $14; // Recover Buffer Data (O)
SCSI_RESERVE = $16; // Reserve Unit (MANDATORY)
SCSI_REWIND = $01; // Rewind (MANDATORY)
SCSI_SPACE = $11; // Space (MANDATORY)
SCSI_VERIFY_T = $13; // Verify (Tape) (O)
SCSI_WRT_FILE = $10; // Write Filemarks (MANDATORY)
{ ---------------------------------------------------------------------
Commands Unique to Printer Devices
---------------------------------------------------------------------}
SCSI_PRINT = $0A; // Print (MANDATORY)
SCSI_SLEW_PNT = $0B; // Slew and Print (O)
SCSI_STOP_PNT = $1B; // Stop Print (O)
SCSI_SYNC_BUFF = $10; // Synchronize Buffer (O)
{ ---------------------------------------------------------------------
Commands Unique to Processor Devices
---------------------------------------------------------------------}
SCSI_RECEIVE = $08; // Receive (O)
SCSI_SEND = $0A; // Send (O)
{ ---------------------------------------------------------------------
Commands Unique to Write-Once Devices
---------------------------------------------------------------------}
SCSI_MEDIUM_SCN = $38; // Medium Scan (O)
SCSI_SRCHDATE10 = $31; // Search Data Equal 10-Byte (O)
SCSI_SRCHDATE12 = $B1; // Search Data Equal 12-Byte (O)
SCSI_SRCHDATH10 = $30; // Search Data High 10-Byte (O)
SCSI_SRCHDATH12 = $B0; // Search Data High 12-Byte (O)
SCSI_SRCHDATL10 = $32; // Search Data Low 10-Byte (O)
SCSI_SRCHDATL12 = $B2; // Search Data Low 12-Byte (O)
SCSI_SET_LIM_10 = $33; // Set Limits 10-Byte (O)
SCSI_SET_LIM_12 = $B3; // Set Limits 10-Byte (O)
SCSI_VERIFY10 = $2F; // Verify 10-Byte (O)
SCSI_VERIFY12 = $AF; // Verify 12-Byte (O)
SCSI_WRITE12 = $AA; // Write 12-Byte (O)
SCSI_WRT_VER10 = $2E; // Write and Verify 10-Byte (O)
SCSI_WRT_VER12 = $AE; // Write and Verify 12-Byte (O)
{ ---------------------------------------------------------------------
Commands Unique to CD-ROM Devices
---------------------------------------------------------------------}
SCSI_PLAYAUD_10 = $45; // Play Audio 10-Byte (O)
SCSI_PLAYAUD_12 = $A5; // Play Audio 12-Byte 12-Byte (O)
SCSI_PLAYAUDMSF = $47; // Play Audio MSF (O)
SCSI_PLAYA_TKIN = $48; // Play Audio Track/Index (O)
SCSI_PLYTKREL10 = $49; // Play Track Relative 10-Byte (O)
SCSI_PLYTKREL12 = $A9; // Play Track Relative 12-Byte (O)
SCSI_READCDCAP = $25; // Read CD-ROM Capacity (MANDATORY)
SCSI_READHEADER = $44; // Read Header (O)
SCSI_SUBCHANNEL = $42; // Read Subchannel (O)
SCSI_READ_TOC = $43; // Read TOC (O)
SCSI_STOP = $4E;
SCSI_PAUSERESUME = $4B;
{ ---------------------------------------------------------------------
Commands Unique to Scanner Devices
---------------------------------------------------------------------}
SCSI_GETDBSTAT = $34; // Get Data Buffer Status (O)
SCSI_GETWINDOW = $25; // Get Window (O)
SCSI_OBJECTPOS = $31; // Object Postion (O)
SCSI_SCAN = $1B; // Scan (O)
SCSI_SETWINDOW = $24; // Set Window (MANDATORY)
{ ---------------------------------------------------------------------
Commands Unique to Optical Memory Devices
---------------------------------------------------------------------}
SCSI_UpdateBlk = $3D; // Update Block (O)
{ ---------------------------------------------------------------------
Commands Unique to Optical Medium Changer Devices
---------------------------------------------------------------------}
SCSI_EXCHMEDIUM = $A6; // Exchange Medium (O)
SCSI_INITELSTAT = $07; // Initialize Element Status (O)
SCSI_POSTOELEM = $2B; // Position to Element (O)
SCSI_REQ_VE_ADD = $B5; // Request Volume Element Address (O)
SCSI_SENDVOLTAG = $B6; // Send Volume Tag (O)
{ ---------------------------------------------------------------------
Commands Unique to Optical Communication Devices
---------------------------------------------------------------------}
SCSI_GET_MSG_6 = $08; // Get Message 6-Byte (MANDATORY)
SCSI_GET_MSG_10 = $28; // Get Message 10-Byte (O)
SCSI_GET_MSG_12 = $A8; // Get Message 12-Byte (O)
SCSI_SND_MSG_6 = $0A; // Send Message 6-Byte (MANDATORY)
SCSI_SND_MSG_10 = $2A; // Send Message 10-Byte (O)
SCSI_SND_MSG_12 = $AA; // Send Message 12-Byte (O)
{ ---------------------------------------------------------------------
Request Sense Data Format
---------------------------------------------------------------------}
type
SENSE_DATA_FMT = record
ErrorCode, // Error Code (70H or 71H)
SegmentNum, // Number of current segment descriptor
SenseKey, // Sense Key(See bit definitions too)
InfoByte0, // Information MSB
InfoByte1, // Information MID
InfoByte2, // Information MID
InfoByte3, // Information LSB
AddSenLen, // Additional Sense Length
ComSpecInf0, // Command Specific Information MSB
ComSpecInf1, // Command Specific Information MID
ComSpecInf2, // Command Specific Information MID
ComSpecInf3, // Command Specific Information LSB
AddSenseCode, // Additional Sense Code
AddSenQual, // Additional Sense Code Qualifier
FieldRepUCode, // Field Replaceable Unit Code
SenKeySpec15, // Sense Key Specific 15th byte
SenKeySpec16, // Sense Key Specific 16th byte
SenKeySpec17, // Sense Key Specific 17th byte
AddSenseBytes : BYTE; // Additional Sense Bytes
end;
TSENSE_DATA_FMT = SENSE_DATA_FMT;
PSENSE_DATA_FMT = ^SENSE_DATA_FMT;
{ ---------------------------------------------------------------------
REQUEST SENSE ERROR CODE
---------------------------------------------------------------------}
const
SERROR_CURRENT = $70; // Current Errors
SERROR_DEFERED = $71; // Deferred Errors
{ ---------------------------------------------------------------------
REQUEST SENSE BIT DEFINITIONS
---------------------------------------------------------------------}
SENSE_VALID = $80; // Byte 0 Bit 7
SENSE_FILEMRK = $80; // Byte 2 Bit 7
SENSE_EOM = $40; // Byte 2 Bit 6
SENSE_ILI = $20; // Byte 2 Bit 5
{ ---------------------------------------------------------------------
REQUEST SENSE SENSE KEY DEFINITIONS
---------------------------------------------------------------------}
KEY_NOSENSE = $00; // No Sense
KEY_RECERROR = $01; // Recovered Error
KEY_NOTREADY = $02; // Not Ready
KEY_MEDIUMERR = $03; // Medium Error
KEY_HARDERROR = $04; // Hardware Error
KEY_ILLGLREQ = $05; // Illegal Request
KEY_UNITATT = $06; // Unit Attention
KEY_DATAPROT = $07; // Data Protect
KEY_BLANKCHK = $08; // Blank Check
KEY_VENDSPEC = $09; // Vendor Specific
KEY_COPYABORT = $0A; // Copy Abort
KEY_EQUAL = $0C; // Equal (Search)
KEY_VOLOVRFLW = $0D; // Volume Overflow
KEY_MISCOMP = $0E; // Miscompare (Search)
KEY_RESERVED = $0F; // Reserved
{ ---------------------------------------------------------------------
PERIPHERAL DEVICE TYPE DEFINITIONS
---------------------------------------------------------------------}
DTYPE_DASD = $00; // Disk Device
DTYPE_SEQD = $01; // Tape Device
DTYPE_PRNT = $02; // Printer
DTYPE_PROC = $03; // Processor
DTYPE_WORM = $04; // Write-once read-multiple
DTYPE_CROM = $05; // CD-ROM device
DTYPE_CDROM = DTYPE_CROM;
DTYPE_SCAN = $06; // Scanner device
DTYPE_OPTI = $07; // Optical memory device
DTYPE_JUKE = $08; // Medium Changer device
DTYPE_COMM = $09; // Communications device
DTYPE_RESL = $0A; // Reserved (low)
DTYPE_RESH = $1E; // Reserved (high)
DTYPE_UNKNOWN = $1F; // Unknown or no device type
{ ---------------------------------------------------------------------
ANSI APPROVED VERSION DEFINITIONS
---------------------------------------------------------------------}
ANSI_MAYBE = $0; // Device may or may not be ANSI approved stand
ANSI_SCSI1 = $1; // Device complies to ANSI X3.131-1986 (SCSI-1)
ANSI_SCSI2 = $2; // Device complies to SCSI-2
ANSI_RESLO = $3; // Reserved (low)
ANSI_RESHI = $7; // Reserved (high)
implementation
end.

511
packages/cdrom/src/wincd.pp Normal file
View File

@ -0,0 +1,511 @@
{
}
unit wincd;
{$mode objfpc}
{$h+}
interface
uses Windows,SysUtils;
Type
TCDAccessMethod = (camNone,camASPI,camSPTI,camIOCTL);
{$packrecords c}
TTOCTrack = packed record
rsvd,
ADR,
trackNumber,
rsvd2 : Byte;
addr : Array[0..3] of byte;
end;
TTOC = packed Record
toclen : word;
firsttrack,
lastTrack : byte;
toctrack: Array[0..99] of TTocTrack;
end;
Const
AccessMethodNames : Array[TCDAccessMethod] of string
= ('None','ASPI','SPTI','IOCTL');
Function GetCDAccessMethod : TCDAccessMethod;
Procedure SetCDAccessMethod (Value : TCDAccessMethod);
Function ReadTOC(Device : String; Var TOC : TTOc) : Integer;
Function EnumCDDrives(Var Drives : Array of String) : Integer;
Function GetNumDrives : Integer;
implementation
uses cdromioctl,wnaspi32,scsidefs;
Var
CurrentAccessMethod : TCDAccessMethod;
CDOSVer : Integer;
{ ---------------------------------------------------------------------
SPTI Defines.
---------------------------------------------------------------------}
Type
{$packrecords C}
SCSI_PASS_THROUGH = record
Length : USHORT;
ScsiStatus : UCHAR;
PathId : UCHAR;
TargetId : UCHAR;
Lun : UCHAR;
CdbLength : UCHAR;
SenseInfoLength : UCHAR;
DataIn : UCHAR;
DataTransferLength : ULONG;
TimeOutValue : ULONG;
DataBufferOffset : ULONG;
SenseInfoOffset : ULONG;
Cdb : array[0..15] of UCHAR;
end;
TSCSI_PASS_THROUGH = SCSI_PASS_THROUGH;
PSCSI_PASS_THROUGH = ^TSCSI_PASS_THROUGH;
SCSI_PASS_THROUGH_DIRECT = record
Length : USHORT;
ScsiStatus : UCHAR;
PathId : UCHAR;
TargetId : UCHAR;
Lun : UCHAR;
CdbLength : UCHAR;
SenseInfoLength : UCHAR;
DataIn : UCHAR;
DataTransferLength : ULONG;
TimeOutValue : ULONG;
DataBuffer : PVOID;
SenseInfoOffset : ULONG;
Cdb : array[0..15] of UCHAR;
end;
TSCSI_PASS_THROUGH_DIRECT = SCSI_PASS_THROUGH_DIRECT;
PSCSI_PASS_THROUGH_DIRECT = ^SCSI_PASS_THROUGH_DIRECT;
SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER = record
spt : SCSI_PASS_THROUGH_DIRECT;
Filler : ULONG;
ucSenseBuf : array[0..31] of UCHAR;
end;
TSCSI_PASS_THROUGH_DIRECT_WITH_BUFFER = SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER;
PSCSI_PASS_THROUGH_DIRECT_WITH_BUFFER = ^SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER;
const
METHOD_BUFFERED = 0;
METHOD_IN_DIRECT = 1;
METHOD_OUT_DIRECT = 2;
METHOD_NEITHER = 3;
FILE_ANY_ACCESS = 0;
FILE_READ_ACCESS = $0001;
FILE_WRITE_ACCESS = $0002;
IOCTL_CDROM_BASE = $00000002;
IOCTL_SCSI_BASE = $00000004;
SCSI_IOCTL_DATA_OUT = 0;
SCSI_IOCTL_DATA_IN = 1;
SCSI_IOCTL_DATA_UNSPECIFIED = 2;
{ ---------------------------------------------------------------------
Initialization code.
---------------------------------------------------------------------}
procedure InitWinCD;
Var
TheCDOSVER : TOSVersionInfo;
begin
TheCDOSVer.dwOSVersionInfoSize:=SizeOf(TheCDOSver);
GetVersionEx(TheCDOSVer);
CDOSVer:=TheCDOSVer.dwMajorVersion;
If AspiLoaded then
CurrentAccessMethod := camASPI
else
begin
if (CDOSver<1) then
CurrentAccessMethod := camNone
else
{
It is better to use SPTI on windows, but the problem with that
is that administrative priviledges are needed. A detection
algorithm for these priviledges here would be nice.
}
CurrentAccessMethod := camSPTI;
end;
end;
{ ---------------------------------------------------------------------
Actual reading of table of contents.
---------------------------------------------------------------------}
{ ---------------------------------------------------------------------
1. SPTI
---------------------------------------------------------------------}
Function sptiReadTOC(Device : String; var TOC: TToC) : Integer;
Var
DriveHandle : THandle;
len : Cardinal;
buf : Array[0..31] of char;
ID,retVal : Integer;
Returned,Flags : Cardinal;
swb : TSCSI_PASS_THROUGH_DIRECT_WITH_BUFFER;
begin
Flags := Cardinal(GENERIC_READ);
if (CDOSVer>4) then
Flags:=Flags or Cardinal(GENERIC_WRITE);
Device:=Upcase('\\.\'+Device);
DriveHandle:=CreateFile(pchar(Device),Flags,FILE_SHARE_READ,
nil,OPEN_EXISTING, 0, 0 );
if (DriveHandle=INVALID_HANDLE_VALUE) then
begin
Result:=-1;
Exit;
end;
Try
Returned:= 0;
len:= sizeof(SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER);
FillChar(swb, len ,0);
With swb.spt do
begin
Length := sizeof(swb.spt); // SCSI_PASS_THROUGH);
CdbLength := 10;
DataIn := SCSI_IOCTL_DATA_IN;
DataTransferLength := SizeOf(tOC);
TimeOutValue := 5;
DataBuffer := @TOC;
SenseInfoOffset := @swb.ucSenseBuf[0]-pbyte(@swb.spt);
Cdb[0] := $43; // read TOC
Cdb[1] := $02; // MSF mode
Cdb[7] := $03;
Cdb[8] := $24;
end;
if (Not DeviceIoControl(DriveHandle,
IOCTL_SCSI_PASS_THROUGH_DIRECT,
@swb,
len,
@swb,
len,
@Returned,
Nil)) then
begin
Result:=-1;
Exit;
end;
With TOC do
Result:=LastTrack-FirstTrack+1;
finally
CloseHandle(DriveHandle);
end;
end;
{ ---------------------------------------------------------------------
2. ASPI
---------------------------------------------------------------------}
Function AspiGetNumAdapters : Integer;
Var
D : DWORD;
Count, Status : Byte;
begin
d:= GetASPI32SupportInfo();
Count:=D and $FF;
Status:=(D shr 8) and $ff;
if (Status<>SS_COMP) and (Status<>SS_NO_ADAPTERS) then
Result:=-1
else
Result:=Count;
end;
Function DriveToSCSIParm (Device : String; Var HID,TGT,LUN : Byte) : Boolean;
Var
Code : Integer;
begin
Result:=False;
Code:=Pos('[',Device);
if Code<>0 then
begin
Delete(Device,1,Code);
Code:=Pos(';',Device);
HID:=StrToIntDef(Copy(Device,1,Code-1),-1);
Result:=HID<>-1;
If result then
begin
Delete(DEvice,1,Code);
Code:=Pos(';',Device);
Tgt:=StrToIntDef(Copy(Device,1,Code-1),-1);
Result:=tgt<>-1;
If result then
begin
Delete(DEvice,1,Code);
Code:=Pos(']',Device);
Lun:=StrToIntDef(Copy(Device,1,Code-1),-1);
Result:=Lun<>-1;
end;
end;
end;
end;
Var
Atoc : TTOc;
Function AspiReadTOC(Device : String; Var TOC : TTOC) : Integer;
Var
HAID,TGT,LUN : Byte;
Status : DWord;
S,T : SRB_ExecSCSICmd;
HEvent : THANDLE;
begin
If Not DriveToSCSIParm(Device,HAID,TGT,lun) then
begin
Result:=-1;
Exit;
end;
Writeln('About to read toc from ',haid,' ',tgt,' ',lun);
hEvent:=CreateEvent( nil, TRUE, FALSE, nil );
Writeln('Resetting event');
ResetEvent(hEvent);
Writeln('Reset event');
Try
FillChar(S,sizeof(s),0);
s.SRB_Cmd := SC_EXEC_SCSI_CMD;
s.SRB_HaID := HaID;
s.SRB_Target := Tgt;
s.SRB_Lun := lun;
s.SRB_Flags := SRB_DIR_IN or SRB_EVENT_NOTIFY;
s.SRB_BufLen := SizeOf(Toc);
s.SRB_BufPointer := @TOC;
s.SRB_SenseLen := SENSE_LEN;
s.SRB_CDBLen := $0A;
s.SRB_PostProc := LPVOID(hEvent);
s.CDBByte[0] := SCSI_READ_TOC; // read TOC command
s.CDBByte[1] := $02; // MSF mode
s.CDBByte[7] := HiByte(Word(S.SRB_BufLen)); // high-order byte of buffer len
s.CDBByte[8] := LoByte(Word(S.SRB_BUFLEN)); // low-order byte of buffer len
Writeln('Sending Command');
SendASPI32Command(LPSRB(@s));
Writeln('Sent Command');
Status:=S.SRB_STATUS;
Writeln('Command status,',Status);
if (Status=SS_PENDING ) then
begin
Writeln('Waiting for object');
WaitForSingleObject( hEvent, 10000 ); // wait up to 10 secs
Writeln('Waiting ended');
end;
Finally
CloseHandle( hEvent );
end;
if (S.SRB_Status<>SS_COMP ) then
begin
Result:=-1;
Exit;
end;
Writeln('Command completed');
With TOC do
Result:=LastTrack-FirstTrack+1;
end;
{ ---------------------------------------------------------------------
3. IOCTL
---------------------------------------------------------------------}
Function ioctlReadTOC(Device : String; Var TOC : TTOC) : Integer;
Var
DriveHandle : Thandle;
Retval : Longint;
Returned : DWord;
Flags : Cardinal;
begin
Flags:=Cardinal(GENERIC_READ);
device:=Upcase('\\.\'+device);
DriveHandle:=CreateFile(PChar(Device), Flags,
FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
if (DriveHandle = INVALID_HANDLE_VALUE) then
begin
result:=-1;
exit;
end;
Try
Returned := 0;
FillChar(Toc, sizeof(TOC),0 );
if Not DeviceIoControl(DriveHandle,
IOCTL_CDROM_READ_TOC,
Nil,
0,
@TOC,
sizeof(TTOC),
@Returned,
NiL) then
begin
Result:=-1;
exit;
end;
With TOC do
Result:=LastTrack-FirstTrack+1;
Finally
CloseHandle(DriveHandle);
end;
end;
Function NtDriveInfo(CopyDrives : Boolean;Var CDDrives : Array of string): Integer;
var
I : Integer;
Drives : Array[0..105] of char;
P : PChar;
begin
FillChar(Drives,SizeOf(Drives),0);
GetLogicalDriveStrings(105,Drives);
P:=@Drives[0];
Result:=0;
While P[0]<>#0 do
begin
If GetDriveType(p)=DRIVE_CDROM then
begin
If CopyDrives and (Result<High(CDDrives)) then
CDDrives[Result]:=Upcase(P[0])+':';
Inc(Result);
end;
P:=P+Strlen(P)+1;
end;
end;
Function NTGetNumDrives: Integer;
Var A : Array[1..1] of string;
begin
Result:=NTDriveInfo(False,A);
end;
Function ioctlEnumDrives(Var Drives : Array of string) : Integer;
begin
result:=NTDriveInfo(True,Drives);
end;
{ ---------------------------------------------------------------------
3. Generic
---------------------------------------------------------------------}
Function ReadTOC(Device : String; Var TOC : TTOc) : Integer;
begin
Case CurrentAccessMethod of
camNone : Result:=-1;
camASPI : Result:=AspiReadTOC(Device,TOC);
camSPTI : Result:=SptiReadTOC(Device,TOC);
camIOCTL : Result:=IOCTLReadTOC(Device,TOC);
end;
end;
Function GetCDAccessMethod : TCDAccessMethod;
begin
Result:=CurrentAccessMethod;
end;
Procedure SetCDAccessMethod (Value : TCDAccessMethod);
begin
CurrentAccessMethod:=Value;
end;
Function ASPIDriveInfo(CopyInfo : Boolean; Var Drives : Array of string) : Integer;
var
sh : SRB_HAInquiry;
sd : SRB_GDEVBlock;
numAdapters, maxTgt : Byte;
i, j, k : byte;
idx : Integer;
begin
Result:=0;
numAdapters := AspiGetNumAdapters;
if (numAdapters=0) then
exit;
For I:=0 to NumAdapters-1 do
begin
FillChar(sh,sizeof(sh),0);
sh.SRB_Cmd := SC_HA_INQUIRY;
sh.SRB_HaID := i;
SendASPI32Command(LPSRB(@sh));
if (sh.SRB_Status=SS_COMP) then
begin
maxTgt:=sh.HA_Unique[3];
if (maxTgt=0) then
maxTgt:=MAXTARG;
For J:=0 to Maxtgt-1 do
For k:=0 to MAXLUN-1 do
begin
FillChar(sd,sizeof(sd),0);
sd.SRB_Cmd := SC_GET_DEV_TYPE;
sd.SRB_HaID := i;
sd.SRB_Target := j;
sd.SRB_Lun := k;
SendASPI32Command(LPSRB(@sd));
if (sd.SRB_Status=SS_COMP) and
(sd.SRB_DeviceType=DTYPE_CDROM) then
begin
If CopyInfo and (Result<High(Drives)) then
Drives[Result]:=Format('ASPI[%d;%d;%d]',[I,J,K]);
Inc(Result);
end;
end;
end;
end;
end;
Function ASPIGetNumDrives: Integer;
Var
A : Array[1..1] of string;
begin
Result:=AspiDriveInfo(False,A);
end;
Function GetNumDrives : Integer;
begin
If CurrenTAccessMethod=camASPI then
Result:=AspiGetNumDrives
else
Result:=NTGetNumDrives;
end;
Function EnumCDDrives(Var Drives : Array of String) : Integer;
begin
If CurrenTAccessMethod=camASPI then
Result:=AspiDriveInfo(True,Drives)
else
Result:=ioctlEnumDrives(Drives);
end;
Initialization
InitWinCD;
end.

259
packages/cdrom/src/wnaspi32.pp Normal file
View File

@ -0,0 +1,259 @@
unit wnaspi32;
{$mode objfpc}
interface
uses Windows;
type
LPSRB = Pointer;
const
{ $packrecords c}
SENSE_LEN = 14; // Default sense buffer length
SRB_DIR_SCSI = $00; // Direction determined by SCSI command
SRB_DIR_IN = $08; // Transfer from SCSI target to host
SRB_DIR_OUT = $10; // Transfer from host to SCSI target
SRB_POSTING = $01; // Enable ASPI posting
SRB_EVENT_NOTIFY = $40; // Enable ASPI event notification
SRB_ENABLE_RESIDUAL_COUNT = $04; // Enable residual byte count reporting
SRB_DATA_SG_LIST = $02; // Data buffer points to scatter-gather list
WM_ASPIPOST = $4D42; // ASPI Post message
{ ---------------------------------------------------------------------
ASPI Command Definitions
---------------------------------------------------------------------}
SC_HA_INQUIRY = $00; // Host adapter inquiry
SC_GET_DEV_TYPE = $01; // Get device type
SC_EXEC_SCSI_CMD = $02; // Execute SCSI command
SC_ABORT_SRB = $03; // Abort an SRB
SC_RESET_DEV = $04; // SCSI bus device reset
SC_GET_DISK_INFO = $06; // Get Disk information
{ ---------------------------------------------------------------------
SRB Status
---------------------------------------------------------------------}
SS_PENDING = $00; // SRB being processed
SS_COMP = $01; // SRB completed without error
SS_ABORTED = $02; // SRB aborted
SS_ABORT_FAIL = $03; // Unable to abort SRB
SS_ERR = $04; // SRB completed with error
SS_INVALID_CMD = $80; // Invalid ASPI command
SS_INVALID_HA = $81; // Invalid host adapter number
SS_NO_DEVICE = $82; // SCSI device not installed
SS_INVALID_SRB = $E0; // Invalid parameter set in SRB
SS_FAILED_INIT = $E4; // ASPI for windows failed init
SS_ASPI_IS_BUSY = $E5; // No resources available to execute cmd
SS_BUFFER_TO_BIG = $E6; // Buffer size to big to handle!
SS_NO_ADAPTERS = $E8; // No adapters.
{ ---------------------------------------------------------------------
Host Adapter Status
---------------------------------------------------------------------}
HASTAT_OK = $00; // Host adapter did not detect an // error
HASTAT_SEL_TO = $11; // Selection Timeout
HASTAT_DO_DU = $12; // Data overrun data underrun
HASTAT_BUS_FREE = $13; // Unexpected bus free
HASTAT_PHASE_ERR = $14; // Target bus phase sequence // failure
HASTAT_TIMEOUT = $09; // Timed out while SRB was waiting to beprocessed.
HASTAT_COMMAND_TIMEOUT = $0B; // While processing the SRB, the adapter timed out.
HASTAT_MESSAGE_REJECT = $0D; // While processing SRB, the // adapter received a MESSAGE // REJECT.
HASTAT_BUS_RESET = $0E; // A bus reset was detected.
HASTAT_PARITY_ERROR = $0F; // A parity error was detected.
HASTAT_REQUEST_SENSE_FAILED = $10; // The adapter failed in issuing
{ ---------------------------------------------------------------------
SRB - HOST ADAPTER INQUIRY - SC_HA_INQUIRY
---------------------------------------------------------------------}
type
SRB_HAInquiry = record
SRB_Cmd : Byte; // ASPI command code = SC_HA_INQUIRY
SRB_Status : Byte; // ASPI command status byte
SRB_HaId : Byte; // ASPI host adapter number
SRB_Flags : Byte; // ASPI request flags
SRB_Hdr_Rsvd : DWORD; // Reserved, MUST = 0
HA_Count : Byte; // Number of host adapters present
HA_SCSI_ID : Byte; // SCSI ID of host adapter
HA_ManagerId : array[0..15] of Byte; // String describing the manager
HA_Identifier : array[0..15] of Byte; // String describing the host adapter
HA_Unique : array[0..15] of Byte; // Host Adapter Unique parameters
HA_Rsvd1 : Word;
end;
PSRB_HAInquiry = ^SRB_HAInquiry;
TSRB_HAInquiry = SRB_HAInquiry;
{ ---------------------------------------------------------------------
SRB - GET DEVICE TYPE - SC_GET_DEV_TYPE
---------------------------------------------------------------------}
SRB_GDEVBlock = record
SRB_Cmd, // ASPI command code = SC_GET_DEV_TYPE
SRB_Status, // ASPI command status byte
SRB_HaId, // ASPI host adapter number
SRB_Flags : BYTE; // Reserved
SRB_Hdr_Rsvd : DWORD; // Reserved
SRB_Target, // Target's SCSI ID
SRB_Lun, // Target's LUN number
SRB_DeviceType, // Target's peripheral device type
SRB_Rsvd1 : BYTE;
end;
TSRB_GDEVBlock = SRB_GDEVBlock;
PSRB_GDEVBlock = ^SRB_GDEVBlock;
{ ---------------------------------------------------------------------
SRB - EXECUTE SCSI COMMAND - SC_EXEC_SCSI_CMD
---------------------------------------------------------------------}
SRB_ExecSCSICmd = record
SRB_Cmd, // ASPI command code = SC_EXEC_SCSI_CMD
SRB_Status, // ASPI command status byte
SRB_HaId, // ASPI host adapter number
SRB_Flags : BYTE; // ASPI request flags
SRB_Hdr_Rsvd : DWORD; // Reserved
SRB_Target, // Target's SCSI ID
SRB_Lun : BYTE; // Target's LUN number
SRB_Rsvd1 : WORD; // Reserved for Alignment
SRB_BufLen : DWORD; // Data Allocation Length
SRB_BufPointer : Pointer; // Data Buffer Pointer
SRB_SenseLen, // Sense Allocation Length
SRB_CDBLen, // CDB Length
SRB_HaStat, // Host Adapter Status
SRB_TargStat : BYTE; // Target Status
SRB_PostProc, // Post routine
SRB_Rsvd2 : Pointer; // Reserved
SRB_Rsvd3, // Reserved for alignment
CDBByte : array[0..15] of byte; // SCSI CDB
SenseArea : array[0..SENSE_LEN + 1] of byte; // Request Sense buffer
end;
TSRB_ExecSCSICmd = SRB_ExecSCSICmd;
PSRB_ExecSCSICmd = ^SRB_ExecSCSICmd;
{ ---------------------------------------------------------------------
SRB - ABORT AN SRB - SC_ABORT_SRB
---------------------------------------------------------------------}
SRB_Abort = record
SRB_Cmd, // ASPI command code = SC_EXEC_SCSI_CMD
SRB_Status, // ASPI command status byte
SRB_HaId, // ASPI host adapter number
SRB_Flags : BYTE; // Reserved
SRB_Hdr_Rsvd : DWORD; // Reserved
SRB_ToAbort : Pointer; // Pointer to SRB to abort
end;
TSRB_Abort = SRB_Abort;
PSRB_Abort = ^SRB_Abort;
{ ---------------------------------------------------------------------
SRB - BUS DEVICE RESET - SC_RESET_DEV
---------------------------------------------------------------------}
SRB_BusDeviceReset = record
SRB_Cmd, // ASPI command code = SC_EXEC_SCSI_CMD
SRB_Status, // ASPI command status byte
SRB_HaId, // ASPI host adapter number
SRB_Flags : BYTE; // Reserved
SRB_Hdr_Rsvd : DWORD; // Reserved
SRB_Target, // Target's SCSI ID
SRB_Lun : BYTE; // Target's LUN number
SRB_Rsvd1 : array[0..11] of byte; // Reserved for Alignment
SRB_HaStat, // Host Adapter Status
SRB_TargStat : BYTE; // Target Status
SRB_PostProc, // Post routine
SRB_Rsvd2 : Pointer; // Reserved
SRB_Rsvd3, // Reserved
CDBByte : array[0..15] of byte; // SCSI CDB
end;
TSRB_BusDeviceReset = SRB_BusDeviceReset;
PSRB_BusDeviceReset = ^SRB_BusDeviceReset;
{ ---------------------------------------------------------------------
SRB - GET DISK INFORMATION - SC_GET_DISK_INFO
---------------------------------------------------------------------}
SRB_GetDiskInfo = record
SRB_Cmd, // ASPI command code = SC_EXEC_SCSI_CMD
SRB_Status, // ASPI command status byte
SRB_HaId, // ASPI host adapter number
SRB_Flags : BYTE; // Reserved
SRB_Hdr_Rsvd : DWORD; // Reserved
SRB_Target, // Target's SCSI ID
SRB_Lun, // Target's LUN number
SRB_DriveFlags, // Driver flags
SRB_Int13HDriveInfo, // Host Adapter Status
SRB_Heads, // Preferred number of heads translation
SRB_Sectors : BYTE; // Preferred number of sectors translation
SRB_Rsvd1 : array[0..9] of byte; // Reserved
end;
TSRB_GetDiskInfo = SRB_GetDiskInfo;
PSRB_GetDiskInfo = ^SRB_GetDiskInfo;
type
TSendASPI32Command = function( LPSRB : Pointer ) : DWORD; cdecl;
TGetASPI32SupportInfo = function : DWORD; cdecl;
Const
SendASPI32Command : TSendASPI32Command = nil;
GetASPI32SupportInfo : TGetASPI32SupportInfo = nil;
Function ASPILoaded : Boolean;
Procedure CheckASPI;
procedure UnloadASPI;
implementation
const
HWNASPI : THandle = 0;
WNASPI : pchar = 'wnaspi32.dll';
Function ASPILoaded : Boolean;
begin
Result:=HWNASPI<>0;
end;
Procedure CheckASPI;
begin
HWNASPI:=LoadLibrary(WNASPI);
if (HWNASPI<>0) then
begin
SendASPI32Command:=TSendASPI32Command(GetProcAddress(HWNASPI,'SendASPI32Command'));
GetASPI32SupportInfo:=TGetASPI32SupportInfo(GetProcAddress(HWNASPI,'GetASPI32SupportInfo'));
end
end;
procedure UnloadASPI;
begin
if (HWNASPI<>0) then
begin
FreeLibrary(HWNASPI);
HWNASPI:=0;
SendASPI32Command:=nil;
GetASPI32SupportInfo:=nil;
end;
end;
initialization
CheckAspi;
finalization
UnloadASPI;
end.