sptiunit.pas

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

  if not status = 0 then
  begin
    //    ErrorInt := GetLastError;
    Result := Err_Unknown;
    Exit;
  end;
end;

function ASPIsendScsiCommand(DeviceID: TCDBurnerInfo;
  Pcdb: pointer; CdbLen: DWORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  Result := Err_None;
  FillChar(Sdf.Sense, sizeof(TscsiSenseInfo), 0);
  if Assigned(Sdf.fOnCommandSending) then
    Sdf.fOnCommandSending(DeviceID, Pcdb, CdbLen, Pbuf, BufLen,
      Direction, @Sdf, Result);

  Result := ASPIsendScsiCommandInternal(DeviceID,
    Pcdb, CdbLen, Pbuf, BufLen, Direction, Sdf);

  if Assigned(Sdf.fOnCommandSent) then
    Sdf.fOnCommandSent(DeviceID, Pcdb, CdbLen, Pbuf, BufLen,
      Direction, @Sdf, Result);
end;

procedure ASPIabortCommand(HaId: BYTE; Psrb: pointer);
type
  SRB_Abort = packed record
    SRB_Cmd: BYTE; // ASPI command code = 3 = SC_ABORT_SRB
    SRB_Status: BYTE; // ASPI command status byte
    SRB_HaId: BYTE; // ASPI host adapter number
    SRB_Flags: BYTE; // Reserved
    SRB_Hdr_Rsvd: DWORD; // Reserved
    SRB_ToAbort: pointer; // Pointer to SRB to abort
  end;
var
  Asrb: SRB_Abort;
begin
  FillChar(Asrb, sizeof(Asrb), 0);
  Asrb.SRB_Cmd := 3;
  Asrb.SRB_HaId := HaId;
  Asrb.SRB_ToAbort := Psrb;
  //   SendASPI32Command(@Asrb);
end;

function ASPIresetDevice(DeviceID: TCDBurnerInfo; Timeout: DWORD): TScsiError;
type
  SRB_ResetDevice = packed record
    SRB_Cmd: BYTE; // ASPI command code = 4 = SC_RESET_DEV
    SRB_Status: BYTE; // ASPI command status byte
    SRB_HaId: BYTE; // ASPI host adapter number
    SRB_Flags: BYTE; // Reserved
    SRB_Hdr_Rsvd: DWORD; // Reserved
    SRB_Target: BYTE; // Target's SCSI ID
    SRB_Lun: BYTE; // Target's LUN number
    SRB_Rsvd1: array[0..11] of BYTE; // Reserved for Alignment
    SRB_HaStat: BYTE; // Host Adapter Status
    SRB_TargStat: BYTE; // Target Status
    SRB_PostProc: THandle; // Post routine
    SRB_Rsvd2: POINTER; // Reserved
    SRB_Rsvd3: array[0..31] of BYTE; // Reserved for alignment
  end;
var
  Rsrb: SRB_ResetDevice;
  hEvent: THandle;
begin
  Result := Err_None;
  hEvent := CreateEvent(nil, true, false, nil); // event to notify completion
  if hEvent = 0 then
  begin
    Result := Err_NoEvent;
    exit;
  end;
  ResetEvent(hEvent);
  FillChar(Rsrb, sizeof(Rsrb), 0);
  with Rsrb do
  begin
    SRB_Cmd := 4; //  SC_RESET_DEV
    ScatterDeviceID(DeviceID.DriveID, SRB_HaId, SRB_Target, SRB_Lun);
    SRB_PostProc := hEvent;
  end;
  {   If SendASPI32Command(@Rsrb) = 0 Then Begin // SS_PENDING
        If WaitForSingleObject(hEvent, Timeout) <> WAIT_OBJECT_0
           Then Begin
           Result := Err_NotifyTimeout;
           ASPIabortCommand(Rsrb.SRB_HaId, @Rsrb);
        End;
     End Else Result := Err_NoDevice;
     }

  CloseHandle(hEvent);
  if Result = Err_None then
    with Rsrb do
      Result := GetAspiError(SRB_Status, SRB_HaStat, SRB_TargStat);
end;

function ASPIgetDriveInt13info(DeviceID: TCDBurnerInfo;
  var Info: TScsiInt13info): TScsiError;
type
  SRB_Int13info = packed record
    SRB_Cmd: BYTE; // ASPI command code=6=SC_GET_DISK_INFO
    SRB_Status: BYTE; // ASPI command status byte
    SRB_HaId: BYTE; // ASPI host adapter number
    SRB_Flags: BYTE; // Reserved
    SRB_Hdr_Rsvd: DWORD; // Reserved
    SRB_Target: BYTE; // Target's SCSI ID
    SRB_Lun: BYTE; // Target's LUN number
    SRB_DriveFlags: BYTE; // Driver flags
    SRB_Int13Drive: BYTE; // Host Adapter Status
    SRB_Heads: BYTE; // Preferred number of heads translation
    SRB_Sectors: BYTE; // Preferred number of sectors translation
    SRB_Rsvd: array[0..9] of BYTE; // Reserved
  end;
var
  Isrb: SRB_Int13info;
begin
  FillChar(Isrb, sizeof(Isrb), 0);
  with Isrb do
  begin
    SRB_Cmd := 6;
    ScatterDeviceID(DeviceID.DriveID, SRB_HaId, SRB_Target, SRB_Lun);
  end;
  //   SendASPI32Command(@Isrb);
  with Info, Isrb do
  begin
    Result := GetAspiError(SRB_Status, $FF, $FF);
    Support := (Result = Err_None) and ((SRB_DriveFlags and 3) <> 0);
    DosSupport := (Result = Err_None) and ((SRB_DriveFlags and 1) <> 0);
    DriveNumber := SRB_Int13Drive;
    Heads := SRB_Heads;
    Sectors := SRB_Sectors;
  end;
end;

function GetSPTICdRomDrives(var CdRoms: TSPTIWriters): Boolean;
var
  Index: integer;
begin
  Result := False;
  if GetDriveNumbers(CdRoms) > 0 then
  begin
    for Index := 0 to CdRoms.CdRomCount - 1 do
    begin
      GetDriveInformation(Index, CdRoms);
    end;
    Result := True;
  end;
end;

procedure GetDriveInformation(i: byte; var CdRoms: TSPTIWriters);
var
  fh: THandle;
  buf: array[0..1023] of Char;
  buf2: array[0..31] of Char;
  status: Bool;
  pswb: PSCSI_PASS_THROUGH_DIRECT_WITH_BUFFER;
  pscsiAddr: PSCSI_ADDRESS;
  length, returned: integer;
  inqData: array[0..99] of Char; // was array[0..99] of Byte;
  dwFlags: DWord;
  DriveString: PChar;
begin
  dwFlags := GENERIC_READ;
  if getOsVersion >= OS_WIN2K then
    dwFlags := dwFlags or GENERIC_WRITE;
  StrPCopy(@buf2, Format('\\.\%s:', [CdRoms.CdRom[i].DriveLetter]));
  fh := CreateFile(buf2, dwFlags, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if fh = INVALID_HANDLE_VALUE then
  begin
    // It seems that with no Administrator privileges
    // the handle value will be invalid
    Exit;
  end;

  (*
   * Get the drive inquiry data
   *)
  ZeroMemory(@buf, 1024);
  ZeroMemory(@inqData, 100);
  pswb := PSCSI_PASS_THROUGH_DIRECT_WITH_BUFFER(@buf);
  pswb^.spt.Length := sizeof(SCSI_PASS_THROUGH);
  pswb^.spt.CdbLength := 6;
  pswb^.spt.SenseInfoLength := 24;
  pswb^.spt.DataIn := SCSI_IOCTL_DATA_IN;
  pswb^.spt.DataTransferLength := 100;
  pswb^.spt.TimeOutValue := 2;
  pswb^.spt.DataBuffer := @inqData;
  pswb^.spt.SenseInfoOffset := SizeOf(pswb^.spt) + SizeOf(pswb^.Filler);
  pswb^.spt.Cdb[0] := $12;
  pswb^.spt.Cdb[4] := $64;

  length := sizeof(SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER);
  status := DeviceIoControl(fh,
    IOCTL_SCSI_PASS_THROUGH_DIRECT,
    pswb,
    length,
    pswb,
    length,
    Cardinal(returned),
    nil);

  if not status then
  begin
    // CloseHandle( fh );
    Exit;
  end;

  DriveString := @inqData;
  Inc(DriveString, 8);

  CdRoms.CdRom[i].Vendor := Copy(DriveString, 1, 8); // Vendor
  CdRoms.CdRom[i].ProductId := Copy(DriveString, 8 + 1, 16);
  // Product ID
  CdRoms.CdRom[i].Revision := Copy(DriveString, 24 + 1, 4);
  // Revision
  CdRoms.CdRom[i].VendorSpec := Copy(DriveString, 28 + 1, 20);
  // Vendor Spec.
  CdRoms.CdRom[i].Description := CdRoms.CdRom[i].Vendor +
    CdRoms.CdRom[i].ProductId + CdRoms.CdRom[i].Revision;
  CdRoms.CdRom[i].DriveHandle := fh;
  (*
   * get the address (path/tgt/lun) of the drive via IOCTL_SCSI_GET_ADDRESS
   *)
  ZeroMemory(@buf, 1024);
  pscsiAddr := PSCSI_ADDRESS(@buf);
  pscsiAddr^.Length := sizeof(SCSI_ADDRESS);
  if (DeviceIoControl(fh, IOCTL_SCSI_GET_ADDRESS, nil, 0,
    pscsiAddr, sizeof(SCSI_ADDRESS), Cardinal(returned),
    nil)) then
  begin
    CDRoms.CdRom[i].HaId := pscsiAddr^.PortNumber;
    CDRoms.CdRom[i].Target := pscsiAddr^.TargetId;
    CDRoms.CdRom[i].Lun := pscsiAddr^.Lun;
  end
  else
  begin
    Exit;
  end;

  // CloseHandle( fh );
end;

function ASPIsend6(DeviceID: TCDBurnerInfo;
  OpCode: BYTE; Lba: DWORD; Byte4: BYTE;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
var
  cdb: array[0..5] of BYTE;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);

  cdb[5] := 0;
  cdb[4] := Byte4;
  FillDWORD(LBA, cdb[0]);
  cdb[1] := AttachLUN(cdb[1], DeviceID.DriveID);
  cdb[0] := OpCode;
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 6,
    Pbuf, BufLen, Direction, Sdf);
end;

function ASPIsend10(DeviceID: TCDBurnerInfo; OpCode: BYTE;
  Byte1: BYTE; Lba: DWORD; Byte6: BYTE; Word7: WORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
var
  cdb: array[0..9] of BYTE;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);

  cdb[9] := 0;
  FillWORD(Word7, cdb[7]);
  cdb[6] := Byte6;
  FillDWORD(LBA, cdb[2]);
  cdb[1] := AttachLUN(Byte1, DeviceID.DriveID);
  cdb[0] := OpCode;
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 10,
    Pbuf, BufLen, Direction, Sdf);
end;

function ASPIsend12(DeviceID: TCDBurnerInfo; OpCode: BYTE;
  Byte1: BYTE; Lba: DWORD; TLength: DWORD; Byte10: BYTE;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
var
  cdb: array[0..11] of BYTE;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  cdb[11] := 0;
  cdb[10] := Byte10;
  FillDWORD(TLength, cdb[6]);
  FillDWORD(LBA, cdb[2]);
  cdb[1] := AttachLUN(Byte1, DeviceID.DriveID);
  cdb[0] := OpCode;
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 12,
    Pbuf, BufLen, Direction, Sdf);
end;

function ASPIsend12CDB(DeviceID: TCDBurnerInfo; CDB: TCDB12; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 12, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsend10CDB(DeviceID: TCDBurnerInfo; CDB: TCDB10; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 10, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsend6CDB(DeviceID: TCDBurnerInfo; CDB: TCDB6; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 6, Pbuf, BufLen, Direction,
    Sdf);
end;

end.