sptiunit.pas

用于CD/DVD烧录的Delphi源码,包括source和demo

{-----------------------------------------------------------------------------
 Unit Name: SptiFunctions
 Author:    Dancemammal
 Purpose:   w2k spti functions version
 History:  First Code Release

-----------------------------------------------------------------------------}

unit SptiUnit;

interface

uses Windows, CovertFuncs, wnaspi32, skSCSI, CDROMIOCTL, dialogs, SCSITypes,
  scsidefs, sysutils, Registry;

{Const //=======  Possible values of Direction parameter ========
   SRB_NODIR = 2; // No data I/O is performed
   SRB_DIR_IN = 1; // Transfer from SCSI target to host
   SRB_DIR_OUT = 0; // Transfer from host to SCSI target
}

type
  SCSI_ADDRESS = record
    Length: LongInt;
    PortNumber: Byte;
    PathId: Byte;
    TargetId: Byte;
    Lun: Byte;
  end;
  PSCSI_ADDRESS = ^SCSI_ADDRESS;

  ENotAdmin = Exception;

  NTSCSIDRIVE = record
    ha: byte;
    tgt: byte;
    lun: byte;
    driveLetter: Char; //Was byte
    bUsed: Bool;
    hDevice: THandle;
    inqData: array[0..36 - 1] of byte;
  end;
  PNTSCSIDRIVE = ^NTSCSIDRIVE;

type

  {CDB types for Spti commands}
  TCDB12 = array[0..11] of BYTE;
  PCDB12 = ^TCDB12;
  TCDB10 = array[0..9] of BYTE;
  PCDB10 = ^TCDB10;
  TCDB6 = array[0..5] of BYTE;
  PCDB6 = ^TCDB6;

type
  TScsiInt13info = packed record
    Support,
      DosSupport: BOOLEAN;
    DriveNumber,
      Heads,
      Sectors: BYTE;
  end;

  // Request for information about host adapter.
type
  TScsiHAinfo = packed record
    ScsiId: BYTE; // SCSI Id of selected host adapter
    MaxTargetCount: BYTE; // Max target count for selected HA
    ResidualSupport: BOOLEAN; // True if HA supports residual I/O
    MaxTransferLength: DWORD; // Max transfer length in bytes
    BufferAlignMask: WORD; // Buffer for data I/O must be aligned by:
    // 0=byte, 1=word, 3=dword, 7=8-byte, etc. 65536 bytes max
    ScsiManagerId, // MustBe = 'ASPI for WIN32'
    HostAdapterId: string[16]; // String describing selected HA
  end;

type
  TScsiDeviceType = (TSDDisk, TSDTape, TSDPrinter, TSDProcessor,
    TSDWORM, TSDCDROM, TSDScanner, TSDOptical,
    TSDChanger, TSDCommunication,
    TSDInvalid, TSDAny, TSDOther);
var
  TScsiDeviceTypeName: array[TScsiDeviceType] of string = ('Disk Drive',
    'Tape Drive', 'Printer', 'Processor', 'WORM Drive', 'CD-ROM Drive',
    'Scanner', 'Optical Drive', 'Changer', 'Communication Device',
    'Invalid', 'Any Type Device', 'Other Type Device');

  {Aspi Functions}

function GetAdaptorName(ID: Integer): string;
function GetSCSIID(ID: Integer): string;
function ISCDROM(ID, Target, LUN: Integer): Boolean;
function GetCDRegName(ID, Target, LUN: Integer): string;
function ResetAspi(ID, Target, LUN: Integer): Boolean;
function AttachLUN(var Arg: BYTE; DeviceID: TBurnerID): BYTE;

function CloseDriveHandle(DeviceID: TCDBurnerInfo): Boolean;
function GetDriveTempHandle(DeviceID: TCDBurnerInfo): Thandle;
procedure GetDriveHandle(var DeviceID: TCDBurnerInfo);

// =================== Helper routines ======================
// Intel/Windows/Delphi <-> Motorola/ASPI format conversion routines
function BigEndianW(Arg: WORD): WORD;
function BigEndianD(Arg: DWORD): DWORD;
procedure BigEndian(const Source; var Dest; Count: integer);
function GatherWORD(b1, b0: byte): WORD;
function GatherDWORD(b3, b2, b1, b0: byte): DWORD;
procedure ScatterDWORD(Arg: DWORD; var b3, b2, b1, b0: byte);
procedure ASPIstrCopy(Src: PChar; var Dst: ShortString; Leng: Integer);

// ASPI Error decoding routines
function GetAspiError(Status, HaStat, TargStat: BYTE): TScsiError;
function GetAspiErrorSense(Status, HaStat, TargStat: BYTE;
  Sense: PscsiSenseInfo): TScsiError;
function AspiCheck(Err: TScsiError): boolean;

// TBurnerID helper definitions and functions

procedure FillWORD(Src: WORD; var Dst: BYTE);
procedure FillDWORD(Src: DWORD; var Dst: BYTE);

function GatherDeviceID(Adapter, Target, Lun: byte; Letter: char): TBurnerID;

function ScatterDeviceID(DeviceID: TBurnerID;
  var Adapter, Target, Lun: byte): char;

function DeviceIDtoLetter(DeviceID: TBurnerID): char;

function ASPIgetDeviceIDflag(DeviceID: TBurnerID;
  Flag: TAspiDeviceIDflag): boolean;

procedure ASPIsetDeviceIDflag(var DeviceID: TBurnerID;
  Flag: TAspiDeviceIDflag; Value: boolean);

// ============= Base-level ASPI request routines ==============

function ASPIhaInquiry(HaId: BYTE; var sh: TScsiHAinfo): TScsiError;
// Request for device type.
function ASPIgetDeviceType(DeviceID: TBurnerID;
  var DeviceType: TScsiDeviceType): TScsiError;
// SCSI command execution.
//   DeviceID     identifies the device to be accessed.
//   Pcdb/CdbLen  SCSI Command Descriptor Block pointer/size
//   Pbuf/BufLen  Data buffer pointer/size.
//                Must be nil/0 if command does not requires data I/O.
//   Direction    Data transfer direction. Must be one of SRB_DIR constants.
function ASPIsendScsiCommand(DeviceID: TCDBurnerInfo;
  Pcdb: pointer; CdbLen: DWORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
// Abort issued by ASPIsendScsiCommand() request for a given host adapter.
procedure ASPIabortCommand(HaId: BYTE; Psrb: pointer);
// Soft reset for the given device.
function ASPIresetDevice(DeviceID: TCDBurnerInfo; Timeout: DWORD): TScsiError;
// Retrieves some DOS-related info about device.

function ASPIgetDriveInt13info(DeviceID: TCDBurnerInfo;
  var Info: TScsiInt13info): TScsiError;

//=================== Device enumerator routine ====================
//  Callback function definition.
//    lpUserData  specifies the user-defined value given in AspiEnumDevices
//    Device      identifies the device found
//    Return Value  To continue enumeration, the callback function must
//                  return TRUE; to stop enumeration, it must return FALSE.
//  Enumerator routine definition.
//    DeviceType  Type of devices to enumerate. Set it to TSDAny to
//                obtain all devices available.
//    CallBack    Points to an user-defined callback function (see above).
//    lpUserData  Specifies a user-defined value to be passed to the callback.
//    Return Value  Number of devices found. Zero if no devices of specified
//                  type exists, -1 if search fails.
type
  TAspiDeviceEnumCallBack
    = function(lpUserData: pointer; Device: TCDBurnerInfo; FoundName: string):
    boolean;

  // ================== Mid-level SCSI request routines ================
  // Three most frequent cases of ASPISendScsiCommand(),
  // for CDB of 6, 10 and 12 bytes length.
function ASPIsend6(DeviceID: TCDBurnerInfo;
  OpCode: BYTE; Lba: DWORD; Byte4: BYTE;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;

function ASPIsend10(DeviceID: TCDBurnerInfo; OpCode: BYTE;
  Byte1: BYTE; Lba: DWORD; Byte6: BYTE; Word7: WORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;

function ASPIsend12(DeviceID: TCDBurnerInfo; OpCode: BYTE;
  Byte1: BYTE; Lba: DWORD; TLength: DWORD; Byte10: BYTE;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;

{With new TCDB command struct}
function ASPIsend6CDB(DeviceID: TCDBurnerInfo; CDB: TCDB6; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;

function ASPIsend10CDB(DeviceID: TCDBurnerInfo; CDB: TCDB10; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;

function ASPIsend12CDB(DeviceID: TCDBurnerInfo; CDB: TCDB12; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;

// ++++++++++++++base SPTI commands all new+++++++++++++++++++

type
  TSPTIWriter = record
    HaId: Byte;
    Target: Byte;
    Lun: Byte;
    Vendor: ShortString;
    ProductId: ShortString;
    Revision: ShortString;
    VendorSpec: ShortString;
    Description: ShortString;
    DriveLetter: Char;
    DriveHandle: Thandle;
  end;

  TSPTIWriters = record
    ActiveCdRom: Byte;
    CdRomCount: Byte;
    CdRom: array[0..25] of TSPTIWriter;
  end;

function ScsiErrToString(Err: TScsiError): string;
function ScsiErrToStr(Err: TScsiError): string;
function ScsiDeviceIDtoStr(Device: TBurnerID): string;

function GetDriveNumbers(var CDRoms: TSPTIWriters): integer;
function GetSPTICdRomDrives(var CdRoms: TSPTIWriters): Boolean;
procedure GetDriveInformation(i: byte; var CdRoms: TSPTIWriters);

implementation

uses Scsiunit;

function AttachLUN(var Arg: BYTE; DeviceID: TBurnerID): BYTE;
var
  i, j, Lun: BYTE;
begin
  ScatterDeviceID(DeviceID, i, j, Lun);
  Result := ((Lun and 7) shl 5) or (Arg and $1F);
end;

procedure FillWORD(Src: WORD; var Dst: BYTE);
begin
  BigEndian(Src, Dst, 2);
end;

procedure FillDWORD(Src: DWORD; var Dst: BYTE);
begin
  BigEndian(Src, Dst, 4);
end;

function ScsiErrToString(Err: TScsiError): string;
begin
  Result := EnumToStr(TypeInfo(TScsiError), Err);
end;

function ScsiErrToStr(Err: TScsiError): string;
begin
  Result := '() result is ' + ScsiErrToString(Err);
end;

function ScsiDeviceIDtoStr(Device: TBurnerID): string;
var
  Adapter, Target, Lun: byte;
  Letter: Char;
begin
  Letter := ScatterDeviceID(Device, Adapter, Target, Lun);
  if Letter < 'A' then
    Letter := '?';
  Result := IntToStr(Adapter) + ','
    + IntToStr(Target) + ','
    + IntToStr(Lun) + ','
    + Letter + ': ';
end;

{*******************************************************************************
                                                                    AspiIntalled
*******************************************************************************}

function AspiInstalled: Integer;
var
  AspiStatus: Cardinal;
begin
  if WNASPI_LOADED then
  begin
    AspiStatus := GetASPI32SupportInfo;
    if HIBYTE(LOWORD(AspiStatus)) = SS_COMP then
    begin
      // get number of host installed on the system
      Result := LOBYTE(LOWORD(AspiStatus));
    end
    else
      Result := -1
  end
  else
    Result := -1
end;

function CheckAspiLayer: Boolean;
begin
  Result := True;
  if AspiInstalled = -1 then
    Result := False;
end;

function GetDriveNumbers(var CDRoms: TSPTIWriters): integer;
var
  i: integer;
  szDrives: array[0..105] of Char;
  p: PChar;
begin
  GetLogicalDriveStrings(105, szDrives);
  p := szDrives;
  i := 0;
  while p^ <> '' do
  begin
    if GetDriveType(p) = DRIVE_CDROM then
    begin
      CdRoms.CdRom[i].DriveLetter := p^; // + ':\';
      i := CdRoms.CdRomCount + 1;
      CdRoms.CdRomCount := CdRoms.CdRomCount + 1;
    end;
    p := p + lstrlen(p) + 1;
  end;
  Result := CdRoms.CdRomCount;
end;

function GetAdaptorName(ID: Integer): string;