scsiunit.pas

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

  FillChar(cdb, 10, 0);
  cdb[0] := SCSI_SYNC_CACHE; {command}
  cdb[1] := $01;
  Result := ASPIsend10CDB(DeviceID, CDB, nil, 0, SRB_DIR_IN, Sdf);
end;


function SCSIFormatCD(DeviceID: TCDBurnerInfo; BlankType: byte; LBA: longint;
  var Sdf: TScsiDefaults): TScsiError;
var
  cdb: TCDB6;
  m_lba: longint;
begin
  m_lba := LBA;
  FillChar(cdb, 6, 0);
  cdb[0] := SCSI_FORMAT; {command}
  cdb[1] := BlankType; {blanktype}
  cdb[2] := (m_lba shr 24) and $FF;
  cdb[3] := (m_lba shr 16) and $FF;
  cdb[4] := (m_lba shr 8) and $FF;
  cdb[5] := m_lba and $FF;
  Result := ASPIsend6CDB(DeviceID, CDB, nil, 0, SRB_DIR_IN, Sdf);
end;


function SCSISendCUESheet(DeviceID: TCDBurnerInfo;
  Buf: pointer; BufSize : Longint; var Sdf: TScsiDefaults): TScsiError;
var
  CDB: TCDB10;
begin
  FillChar(cdb, 10, 0);
  cdb[0] := SCSI_SEND_CUE_SHEET;
  cdb[6] := (BufSize shr 16) and $FF;
  cdb[7] := (BufSize shr 8) and $FF;
  cdb[8] :=  BufSize and $FF;
  Result := ASPIsend10CDB(DeviceID, CDB, Buf, BufSize, SRB_DIR_IN, Sdf);
end;



function SCSISetSpeed(DevID: TCDBurnerInfo; ReadSpeed, WriteSpeed: Integer;
  var Sdf: TScsiDefaults): TScsiError;
var
  cdb: TCDB12;
  Lun: Byte;
begin
  //cdr CDB:  BB 00 FF FF 08 4C 00 00 00 00 00 00
  Lun := 0;
  FillChar(cdb, 12, 0);
  cdb[0] := AC_SETCDSPEED; {command }
  cdb[1] := AttachLUN(Lun, DevID.DriveID);
  cdb[2] := (ReadSpeed shr 8);
  cdb[3] := ReadSpeed;
  cdb[4] := (WriteSpeed shr 8);
  cdb[5] := WriteSpeed;
  Result := ASPIsend12CDB(Devid, CDB, nil, 0, SRB_DIR_OUT, Sdf);
end;

function ScsiGetWriteParams(DevID: TCDBurnerInfo; Size: Integer; var Param:
  string;
  var Sdf: TScsiDefaults): TScsiError;
var
  ModePage: TScsiWriteModePage;
  BufSize: DWord;
begin
  BufSize := sizeof(ModePage);
  fillchar(ModePage, Bufsize, 0);
  {get current params}
  Sdf.ModePageType := MPTcurrent;
  Result := SCSImodeSensePage(DevID, $05, @ModePage, BufSize, 0, Sdf);

  Param := 'Get CD/DVD Writer Parameters : Failed';
  if Result <> Err_None then
    exit;

  Param := 'Test Write :  ';
  if IsBitSet(ModePage.TestFlagWriteType, 4) = true then
    Param := Param + 'Test Write is ON' + #10#13
  else
    Param := Param + 'Test Write is OFF' + #10#13;

  Param := Param + 'Buffer Underrun :  ';
  if IsBitSet(ModePage.TestFlagWriteType, 6) = true then
    Param := Param + 'BurnProof is ON' + #10#13
  else
    Param := Param + 'BurnProof is OFF' + #10#13;

  Param := Param + 'Write Type :  ';
  case (ModePage.TestFlagWriteType and $0F) of
    0: Param := Param + 'Packet/Incremental' + #10#13;
    1: Param := Param + 'Track At Once (TAO)' + #10#13;
    2: Param := Param + 'Session At Once (SAO)' + #10#13;
    3: Param := Param + 'Raw Data Burn' + #10#13;
  else
    Param := Param + 'Unknown Write Mode' + #10#13;
  end; //Case

  Param := Param + 'Multisession :  ';

  case (ModePage.MSFPCopyTrackMode shr 6) of
    3: Param := Param + 'Next Session Allowed / ON' + #10#13;
  else
    Param := Param + 'Next Session Not Allowed / OFF' + #10#13;

  end; //Case

  Param := Param + 'Packet Type :  ';
  case (ModePage.MSFPCopyTrackMode and $20) of
    1: Param := Param + 'Fixed Size Packets' + #10#13;
  else
    Param := Param + 'Variable Size Packets' + #10#13;

  end; //Case
  Param := Param + 'Packet Size :  ' + inttostr(ModePage.PacketSize) + #10#13;

  Param := Param + 'Session Type :  ';
  case (ModePage.SessionFormat) of
    $00: Param := Param + 'CD-DA or CDROM Disk' + #10#13;
    $01: Param := Param + 'CDI Video Disk' + #10#13;
    $32: Param := Param + 'CDROM XA Disk' + #10#13;
  else
    Param := Param + 'Unknown Session Mode' + #10#13;
  end; //Case
  Param := Param + 'Audio Pause Length :  ' +
    inttostr(SwapWord(ModePage.AudioPauseLength)) + #10#13;
  Param := Param + 'Data Block :  ' + inttostr(ModePage.DataBlockType) + #10#13;
end;

//+++++++++++++++++++++++++ End writing functions +++++++++++++++++++++++++

//New Added DVD Functions

function SCSIGetDevConfigProfileMedia(DeviceID: TCDBurnerInfo; var
  ProfileDevDiscType: TScsiProfileDeviceDiscTypes; var Sdf: TScsiDefaults):
  TScsiError;
var
  cdb: array[0..9] of BYTE;
  Buf: Pointer;
  BufLen, CdbLen, SdfTemp: DWORD;
  DeviceConfigHeader: TScsiDeviceConfigHeader;
begin
  ZeroMemory(@DeviceConfigHeader, SizeOf(DeviceConfigHeader));
  Buf := @DeviceConfigHeader;
  BufLen := SizeOf(DeviceConfigHeader);
  cdbLen := DWORD(10);
  cdb[0] := $46;
  cdb[1] := $02;
  cdb[3] := $00;
  cdb[7] := ((SizeOf(DeviceConfigHeader) shr 8) and $FF);
  cdb[8] := (SizeOf(DeviceConfigHeader) and $FF);

  SdfTemp := Sdf.Timeout;
  Sdf.Timeout := Sdf.ReadTimeout;

  Result := ASPIsendScsiCommand(DeviceID, @cdb, CdbLen,
    Buf, BufLen, SRB_DIR_IN, Sdf);
  Sdf.Timeout := SdfTemp;

  if Result = Err_SenseIllegalRequest then
    Exit;

  //  from Profile features in MS-DDK header ntddmmc.h
  case ((DeviceConfigHeader.CurrentProfile shl 8) and $FF00) or
    ((DeviceConfigHeader.CurrentProfile shr 8) and $00FF) of
    $0000:
      begin
        ProfileDevDiscType.SubType := 'pdtNoCurrentProfile';
        ProfileDevDiscType.DType := 'NONE';
        ProfileDevDiscType.TypeNum := 0;
      end;
    $0001:
      begin
        ProfileDevDiscType.SubType := 'pdtNonRemovableDisk';
        ProfileDevDiscType.DType := 'NonRemovable';
        ProfileDevDiscType.TypeNum := 1;
      end;
    $0002:
      begin
        ProfileDevDiscType.SubType := 'pdtRemovableDisk';
        ProfileDevDiscType.DType := 'Removable';
        ProfileDevDiscType.TypeNum := 2;
      end;
    $0003:
      begin
        ProfileDevDiscType.SubType := 'pdtMagnetoOptical_Erasable';
        ProfileDevDiscType.DType := 'Erasable';
        ProfileDevDiscType.TypeNum := 3;
      end;
    $0004:
      begin
        ProfileDevDiscType.SubType := 'pdtOptical_WriteOnce';
        ProfileDevDiscType.DType := 'WriteOnce';
        ProfileDevDiscType.TypeNum := 4;
      end;
    $0005:
      begin
        ProfileDevDiscType.SubType := 'pdfAS-MO';
        ProfileDevDiscType.DType := 'AS-MO';
        ProfileDevDiscType.TypeNum := 5;
      end;
    $0008:
      begin
        ProfileDevDiscType.SubType := 'pdfCD-ROM';
        ProfileDevDiscType.DType := 'CD-ROM';
        ProfileDevDiscType.TypeNum := 6;
      end;
    $0009:
      begin
        ProfileDevDiscType.SubType := 'pdfCD-R';
        ProfileDevDiscType.DType := 'CD-R';
        ProfileDevDiscType.TypeNum := 7;
      end;
    $000A:
      begin
        ProfileDevDiscType.SubType := 'pdfCD-RW';
        ProfileDevDiscType.DType := 'CD-RW';
        ProfileDevDiscType.TypeNum := 8;
      end;
    $0010:
      begin
        ProfileDevDiscType.SubType := 'pdfDVD-ROM';
        ProfileDevDiscType.DType := 'DVD-ROM';
        ProfileDevDiscType.TypeNum := 9;
      end;
    $0011:
      begin
        ProfileDevDiscType.SubType := 'pdfDVD-R';
        ProfileDevDiscType.DType := 'DVD-R';
        ProfileDevDiscType.TypeNum := 10;
      end;
    $0012:
      begin
        ProfileDevDiscType.SubType := 'pdfDVD-RAM';
        ProfileDevDiscType.DType := 'DVD-RAM';
        ProfileDevDiscType.TypeNum := 11;
      end;
    $0013:
      begin
        ProfileDevDiscType.SubType := 'pdfDVD-RW Restricted';
        ProfileDevDiscType.DType := 'DVD-RW Restricted Overwrite';
        ProfileDevDiscType.TypeNum := 13;
      end;
    $0014:
      begin
        ProfileDevDiscType.SubType := 'pdfDVD-RW Sequential';
        ProfileDevDiscType.DType := 'DVD-RW Sequential Recording';
        ProfileDevDiscType.TypeNum := 14;
      end;
    $001A:
      begin
        ProfileDevDiscType.SubType := 'pdfDVD+RW';
        ProfileDevDiscType.DType := 'DVD+RW';
        ProfileDevDiscType.TypeNum := 15;
      end;
    $001B:
      begin
        ProfileDevDiscType.SubType := 'pdfDVD+R';
        ProfileDevDiscType.DType := 'DVD+R';
        ProfileDevDiscType.TypeNum := 16;
      end;
    $0020:
      begin
        ProfileDevDiscType.SubType := 'pdfDDCD-ROM';
        ProfileDevDiscType.DType := 'DDCD-ROM';
        ProfileDevDiscType.TypeNum := 17;
      end;
    $0021:
      begin
        ProfileDevDiscType.SubType := 'pdfDDCD-R';
        ProfileDevDiscType.DType := 'DDCD-R';
        ProfileDevDiscType.TypeNum := 18;
      end;
    $0022:
      begin
        ProfileDevDiscType.SubType := 'pdfDDCD-RW';
        ProfileDevDiscType.DType := 'DDCD-RW';
        ProfileDevDiscType.TypeNum := 19;
      end;
    $FFFF:
      begin
        ProfileDevDiscType.SubType := 'pdfUNKNOWN';
        ProfileDevDiscType.DType := 'UNKNOWN';
        ProfileDevDiscType.TypeNum := 20;
      end;
  end;
end;


function SwapDWord(const AValue: LongWord): LongWord;
begin
  Result := ((AValue shl 24) and $FF000000) or
    ((AValue shl 8) and $00FF0000) or
    ((AValue shr 8) and $0000FF00) or
    ((AValue shr 24) and $000000FF);
end;


function EndianToIntelBytes(const AValue: array of Byte; Count: Byte): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
  begin
    Result := (AValue[I] shl ((Count - (I + 1)) * 8) or Result);
  end;
end;

function SCSIReadDVDStructure(DeviceID: TCDBurnerInfo; var DescriptorStr:
  TScsiDVDLayerDescriptorInfo; var Sdf: TScsiDefaults): TScsiError;
var
  cdb: array[0..9] of BYTE;
  Buf: Pointer;
  BufLen, CdbLen, SdfTemp: DWORD;
  DVDLayerDescriptor: TScsiDVDLayerDescriptor;
  Value: Byte;

begin
  // 1st time we query length of returned data
  ZeroMemory(@DVDLayerDescriptor, SizeOf(DVDLayerDescriptor));
  Buf := @DVDLayerDescriptor;
  BufLen := SizeOf(DVDLayerDescriptor);
  cdbLen := DWORD(10);
  cdb[0] := $AD;
  cdb[6] := 0; //* First layer
  cdb[7] := 0;
  cdb[8] := ((SizeOf(DVDLayerDescriptor) shr 8) and $FF);
  cdb[9] := (SizeOf(DVDLayerDescriptor) and $FF);

  SdfTemp := Sdf.Timeout;
  Sdf.Timeout := Sdf.ReadTimeout;

  Result := ASPIsendScsiCommand(DeviceID, @cdb, CdbLen,
    Buf, BufLen, SRB_DIR_IN, Sdf);
  Sdf.Timeout := SdfTemp;

  if Result = Err_SenseIllegalRequest then
    Exit;

  // now we do the real query
  ZeroMemory(@DVDLayerDescriptor, SizeOf(DVDLayerDescriptor));
  Buf := @DVDLayerDescriptor;
  BufLen := SizeOf(DVDLayerDescriptor);
  CdbLen := DWORD(10);
  cdb[0] := $AD;
  cdb[6] := 0; //* First layer
  cdb[7] := 0;
  cdb[8] := ((SizeOf(DVDLayerDescriptor) shr 8) and $FF);
  cdb[9] := (SizeOf(DVDLayerDescriptor) and $FF);

  Result := ASPIsendScsiCommand(DeviceID, @cdb, CdbLen,
    Buf, BufLen, SRB_DIR_IN, Sdf);
  Sdf.Timeout := SdfTemp;

  Value := (DVDLayerDescriptor.BookType_PartVersion shr 4) and $0F;
  case Value of
    $00: DescriptorStr.BookType := 'DVD-ROM';
    $01: DescriptorStr.BookType := 'DVD-RAM';
    $02: DescriptorStr.BookType := 'DVD-R';
    $03: DescriptorStr.BookType := 'DVD-RW';
    $09: DescriptorStr.BookType := 'DVD+RW';
    $0A: DescriptorStr.BookType := 'DVD+R';
  else
    DescriptorStr.BookType := 'Unknown';
  end;

  Value := (DVDLayerDescriptor.DiscSize_MaximumRate shr 4) and $0F;
  case Value of
    $00: DescriptorStr.DiscSize := '120mm';
    $01: DescriptorStr.DiscSize := '80mm';
  else
    DescriptorStr.DiscSize := 'Unknown';
  end;

  Value := (DVDLayerDescriptor.DiscSize_MaximumRate and $0F);
  case Value of
    $00: DescriptorStr.MaximumRate := '2.52 Mbps';
    $01: DescriptorStr.MaximumRate := '5.04 Mbps';
    $02: DescriptorStr.MaximumRate := '10.08 Mbps';
    $0F: DescriptorStr.MaximumRate := 'Not Specified';
  else
    DescriptorStr.MaximumRate := 'Unknown';
  end;

  Value := (DVDLayerDescriptor.LinearDensity_TrackDensity shr 4) and $0F;
  case Value of
    $00: DescriptorStr.LinearDensity := '0.267 um/bit';
    $01: DescriptorStr.LinearDensity := '0.293 um/bit';
    $02: DescriptorStr.LinearDensity := '0.409 to 0.435 um/bit';
    $04: DescriptorStr.LinearDensity := '0.280 to 0.291 um/bit';
    $08: DescriptorStr.LinearDensity := '0.353 um/bit';
  else
    DescriptorStr.LinearDensity := 'Reserved';
  end;

  Value := (DVDLayerDescriptor.LinearDensity_TrackDensity and $0F);
  case Value of
    $00: DescriptorStr.TrackDensity := '0.74 um/track';
    $01: DescriptorStr.TrackDensity := '0.80 um/track';
    $02: DescriptorStr.TrackDensity := '0.615 um/track';
  else
    DescriptorStr.TrackDensity := 'Reserved';
  end;

  DescriptorStr.NoLayer :=
    IntToStr((DVDLayerDescriptor.NumberOfLayers_TrackPath_LayerType shr 5) and
    $03);
  //    0 = Layer contains embossed data    = $01
  //    1 = Laye