sptiunit.pas

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

begin
  Result := EmptyStr;
end;

function GetSCSIID(ID: Integer): string;
begin
  Result := EmptyStr;
end;

function ISCDROM(ID, Target, LUN: Integer): Boolean;
begin
  Result := false;
end;

function GetCDRegName(ID, Target, LUN: Integer): string;
var
  DEVName: string;
  Registry: TRegistry;
  Root2000: string;
  Root98: string;
  FormatKey: string;
begin
  DEVName := 'Cannot Find Name';
  Root2000 := 'HKEY_LOCAL_MACHINE';
  Root98 := 'HKEY_LOCAL_MACHINE\Enum\Scsi';
  FormatKey := 'HARDWARE\DEVICEMAP\Scsi\Scsi Port ' + inttostr(ID) +
    '\Scsi Bus 0\Target Id ' + inttostr(Target) + '\Logical Unit Id ' +
    inttostr(LUN);
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_LOCAL_MACHINE;

  Registry.OpenKey(FormatKey, False);
  DEVName := Registry.ReadString('Identifier');
  Registry.Free;
  Result := DEVName;
end;

function ResetAspi(ID, Target, LUN: Integer): Boolean;
begin
  Result := False;
end;

function BigEndianW(Arg: WORD): WORD;
begin
  result := ((Arg shl 8) and $FF00) or
    ((Arg shr 8) and $00FF);
end;

function BigEndianD(Arg: DWORD): DWORD;
begin
  result := ((Arg shl 24) and $FF000000) or
    ((Arg shl 8) and $00FF0000) or
    ((Arg shr 8) and $0000FF00) or
    ((Arg shr 24) and $000000FF);
end;

procedure BigEndian(const Source; var Dest; Count: integer);
var
  pSrc, pDst: PChar;
  i: integer;
begin
  pSrc := @Source;
  pDst := PChar(@Dest) + Count;
  for i := 0 to Count - 1 do
  begin
    Dec(pDst);
    pDst^ := pSrc^;
    Inc(pSrc);
  end;
end;

function GatherWORD(b1, b0: byte): WORD;
begin
  result := ((WORD(b1) shl 8) and $FF00) or
    ((WORD(b0)) and $00FF);
end;

{$WARNINGS OFF}

function GatherDWORD(b3, b2, b1, b0: byte): DWORD;
begin
  result := ((LongInt(b3) shl 24) and $FF000000) or
    ((LongInt(b2) shl 16) and $00FF0000) or
    ((LongInt(b1) shl 8) and $0000FF00) or
    ((LongInt(b0)) and $000000FF);
end;
{$WARNINGS ON}

procedure ScatterDWORD(Arg: DWORD; var b3, b2, b1, b0: byte);
begin
  b3 := (Arg shr 24) and $FF;
  b2 := (Arg shr 16) and $FF;
  b1 := (Arg shr 8) and $FF;
  b0 := Arg and $FF;
end;

procedure ASPIstrCopy(Src: PChar; var Dst: ShortString; Leng: Integer);
var
  i: integer;
begin
  i := 0;
  while (i < Leng) and (Src[i] >= ' ') do
  begin
    Dst[i + 1] := Src[i];
    inc(i);
  end;
  while (i > 0) and (Dst[i] = ' ') do
    Dec(i); // Trim it Right
  Dst[0] := CHR(i);
end;

function GetAspiError(Status, HaStat, TargStat: BYTE): TScsiError;
begin
  result := Err_Unknown;
  case Status of
    0, 1: result := Err_None; // No error, all OK
    2, 3: result := Err_Aborted;
    $80: result := Err_InvalidRequest; // This command is
    // not supported by ASPI manager
    $81: result := Err_InvalidHostAdapter;
    $82: result := Err_NoDevice;
    $E0: result := Err_InvalidSrb;
    $E1: result := Err_BufferAlign;
    $E5: result := Err_AspiIsBusy;
    $E6: result := Err_BufferTooBig;
    4: case HaStat of
        $09: result := Err_CommandTimeout;
        $0B: result := Err_SrbTimeout;
        $0D: result := Err_MessageReject;
        $0E: result := Err_BusReset;
        $0F: result := Err_ParityError;
        $10: result := Err_RequestSenseFailed;
        $11: result := Err_SelectionTimeout;
        $12: result := Err_DataOverrun;
        $13: result := Err_UnexpectedBusFree;
        $14: result := Err_BusPhaseSequence;
        $00: case TargStat of
            0, 2: result := Err_CheckCondition;
            $08: result := Err_TargetBusy;
            $18: result := Err_TargetReservationConflict;
            $28: result := Err_TargetQueueFull;
          end;
      end;
  end;
end;

function GetAspiErrorSense(Status, HaStat, TargStat: BYTE;
  Sense: PscsiSenseInfo): TScsiError;
begin
  Result := GetAspiError(Status, HaStat, TargStat);
  if (Result = Err_CheckCondition) and Assigned(Sense) then
    if Sense^[0] = 0 then
      Result := Err_None
    else if (Sense^[0] and $7E) <> $70 {// recognized values} then
      Result := Err_SenseUnknown
    else
      case (Sense^[2] and $0F) of
        0:
          begin // Skey_NoSense
            if (Sense^[2] and $80) <> 0 {// FileMark flag} then
              Result := Err_SenseFileMark
            else if (Sense^[2] and $40) <> 0 {// EndOfMedia flag} then
              Result := Err_SenseEndOfMedia
            else if (Sense^[2] and $20) <> 0 {// IllegalLength flag} then
              Result := Err_SenseIllegalLength
            else if (Sense^[3] and $80) <> 0 {// ResidualCount < 0} then
              Result := Err_SenseIncorrectLength
            else
              Result := Err_SenseNoSense;
          end;
        1: Result := Err_SenseRecoveredError; //Skey_RecoveredError
        2: Result := Err_SenseNotReady; //Skey_NotReady
        3: Result := Err_SenseMediumError; //Skey_MediumError
        4: Result := Err_SenseHardwareError; //Skey_HardwareError
        5: Result := Err_SenseIllegalRequest; //Skey_IllegalRequest
        6: Result := Err_SenseUnitAttention; //Skey_UnitAttention
        7: Result := Err_SenseDataProtect; //Skey_DataProtect
        8: Result := Err_SenseBlankCheck; //Skey_BlankCheck
        9: Result := Err_SenseVendorSpecific; // Skey_VendorSpecific
        10: Result := Err_SenseCopyAborted; // Skey_CopyAborted
        11: Result := Err_SenseAbortedCommand; // Skey_AbortedCommand
        12: Result := Err_SenseEqual; // Skey_Equal
        13: Result := Err_SenseVolumeOverflow; // Skey_VolumeOverflow
        14: Result := Err_SenseMiscompare; // Skey_Miscompare
        15: Result := Err_SenseReserved; // Skey_Reserved
      end;
end;

function AspiCheck(Err: TScsiError): boolean;
begin
  Result := Err in [Err_None, Err_DataOverrun, Err_SenseRecoveredError];
end;

function GatherDeviceID(Adapter, Target, Lun: byte; Letter: char): TBurnerID;
begin
  Result := GatherDWORD(Adapter, Target,
    ((Lun and 7) shl 5) or (ORD(Letter) and $1F), 0);
end;

function ScatterDeviceID(DeviceID: TBurnerID;
  var Adapter, Target, Lun: byte): char;
var
  Res: BYTE;
begin
  ScatterDWORD(DeviceID, Adapter, Target, Lun, Res);
  Result := CHR((Lun and $1F) or $40);
  Lun := (Lun shr 5) and 7;
end;

function DeviceIDtoLetter(DeviceID: TBurnerID): char;
var
  Adapter, Target, Lun: byte;
begin
  Result := ScatterDeviceID(DeviceID, Adapter, Target, Lun);
end;

function ASPIgetDeviceIDflag(DeviceID: TBurnerID;
  Flag: TAspiDeviceIDflag): boolean;
begin
  Result := (DeviceID and (1 shl ORD(Flag))) <> 0;
end;

procedure ASPIsetDeviceIDflag(var DeviceID: TBurnerID;
  Flag: TAspiDeviceIDflag; Value: boolean);
begin
  if Value then
    DeviceID := DeviceID or (1 shl ORD(Flag))
  else
    DeviceID := DeviceID and not (1 shl ORD(Flag));
end;

function ASPIhaInquiry(HaId: BYTE; var sh: TScsiHAinfo): TScsiError;
begin
  Result := Err_None;
end;

{$WARNINGS OFF}

function ASPIgetDeviceType(DeviceID: TBurnerID;
  var DeviceType: TScsiDeviceType): TScsiError;
type
  SRB_GetDeviceType = packed record
    SRB_Cmd: BYTE; // ASPI command code = 1 = SC_GET_DEV_TYPE
    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 number for specified HA
    SRB_Lun: BYTE; // Logical unit number of selected target
    SRB_DeviceType: BYTE; // Selected HA/Target/Lun device type
    SRB_Rsvd: BYTE; // Reserved for alignment
  end;
var
  Gsrb: SRB_GetDeviceType;
begin
  FillChar(Gsrb, sizeof(Gsrb), 0);
  Gsrb.SRB_Cmd := 1;
  ScatterDeviceID(DeviceID, Gsrb.SRB_HaId, Gsrb.SRB_Target, Gsrb.SRB_Lun);
  //   SendASPI32Command(@Gsrb);
  Result := GetAspiError(Gsrb.SRB_Status, $FF, $FF);
  if (Result = Err_None) and (Gsrb.SRB_DeviceType < ORD(TSDInvalid)) then
    DeviceType := TScsiDeviceType(Gsrb.SRB_DeviceType)
  else
    DeviceType := TSDInvalid;
end;
{$WARNINGS ON}

procedure GetDriveHandle(var DeviceID: TCDBurnerInfo);
var
  fh: THandle;
  buf2: array[0..31] of Char;
  DriveLetter: Char;
  dwFlags: DWord;
begin
  dwFlags := GENERIC_READ;
  if getOsVersion >= OS_WIN2K then
    dwFlags := dwFlags or GENERIC_WRITE;
  DriveLetter := DeviceIDtoLetter(DeviceID.DriveID);
  StrPCopy(@buf2, Format('\\.\%s:', [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
    showmessage('cannot use need admin');
    CloseHandle(fh);
    Exit;
  end;
end;

function GetDriveTempHandle(DeviceID: TCDBurnerInfo): Thandle;
var
  DriveLetter: Char;
begin
  DriveLetter := DeviceIDtoLetter(DeviceID.DriveID);
  Result := CreateFile(PChar('\\.\' + DriveLetter + ':'),
    GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil,
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0);
end;

function CloseDriveHandle(DeviceID: TCDBurnerInfo): Boolean;
begin
  Result := CloseHandle(DeviceID.SptiHandle);
end;

{seperate test function}

function ASPIsendScsiCommandInternal(DeviceID: TCDBurnerInfo;
  Pcdb: pointer; CdbLen: DWORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
var
  status: Byte;
  dwFlags: Cardinal;
  //  ErrorInt: Integer;
  skSCSI: TskSCSI;
  CDB: TCDB;
  CDBSize: Cardinal;
begin
  status := 1;
  Result := Err_None;
  skSCSI := TskSCSI.Create;
  if skSCSI.InitOK then
  begin
    CDBSize := CDBLen;
    Move(TCDB(pcdb^), CDB, CDBSize);
    dwFlags := Direction;
    status := skSCSI.ExecCmd(Deviceid.HaId, DeviceID.Target, DeviceID.Lun, CDB,
      CDBSize, dwFlags, pbuf, BufLen);
    skSCSI.Destroy;
  end;

  // Move(TCDB12(Pcdb^), pswb^.spt.Cdb, pswb^.spt.CdbLength);