skscsi.pas

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

begin
  numAdapters := 0;
  for i := 1 to 26 do
  begin
    if numAdapters < SCSIDrives.Drive[i].Ha then
      numAdapters := SCSIDrives.Drive[i].Ha;
  end;
  Inc(numAdapters);
  Result := numAdapters;
  Exit;
end;

function InitSPTI: Byte;
var
  s: string;
  i, uDriveType, Return: Byte;
begin
  Return := 0;
  TGN := 0;
  FillChar(SCSIDrives, SizeOf(SCSIDrives), 0);
  for i := 2 to 26 do
    SCSIDrives.Drive[i].DeviceHandle := INVALID_HANDLE_VALUE;
  for i := 2 to 26 do
  begin
    s := Char(65 + i) + ':\';
    uDriveType := GetDriveType(@s[1]);
    if uDriveType = DRIVE_CDROM then
    begin
      SPTI_GetDriveInfo(i, SCSIDrives.Drive[i]);
      if SCSIDrives.Drive[i].Used then
        Inc(Return);
    end;
  end;
  SCSIDrives.numAdapters := SPTI_GetNumAdapters;
  if TGN <> 0 then
  begin
    for i := 2 to 26 do
    begin
      if SCSIDrives.Drive[i].Used then
        if ScsiDrives.drive[i].Lun = 250 then
        begin
          SCSIDrives.Drive[i].Lun := 0;
          SCSIDrives.Drive[i].Ha := SCSIDrives.numAdapters;
        end;
    end;
    SCSIDrives.numAdapters := SPTI_GetNumAdapters;
  end;
  Result := Return;
end;

function DeInitSPTI: Integer;
var
  i: integer;
begin
  for i := 2 to 26 do
    if (SCSIDrives.Drive[i].Used) then
      if SCSIDrives.Drive[i].DeviceHandle <> INVALID_HANDLE_VALUE then
        CloseHandle(SCSIDrives.Drive[i].DeviceHandle);
  SCSIDrives.numAdapters := SPTI_GetNumAdapters();
  FillChar(SCSIDrives, SizeOf(SCSIDrives), 0);
  Result := -1;
end;

{******************************************************************************}
{  GetVersionInfo to Determine the Currently Using ASPI/ASAPI Layer's Version  }
{******************************************************************************}

constructor TVersionInfo.GetVersionInfo(FileName: string);
type
  TTranslation = record
    LangID, Charset: Word;
  end;
var
  VerInfo: Pointer;
  VerInfoSize, Dummy: DWord;
  VerValue: Pointer;
  VerValueSize: DWord;
  VerTrans: TTranslation;
  Lang, From: string;
  function GetValue(Value: string): string;
  begin
    if VerQueryValue(VerInfo, PChar(From + Value), VerValue, VerValueSize) then
      Result := PChar(VerValue)
    else
      Result := '';
  end;
begin
  inherited Create;
  VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
  GetMem(VerInfo, VerInfoSize);
  if GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, VerInfo) then
  begin
    VerQueryValue(VerInfo, '\VarFileInfo\Translation', VerValue, VerValueSize);
    Move(VerValue^, VerTrans, VerValueSize);
    Lang := IntToHex(VerTrans.LangID, 4) + IntToHex(VerTrans.Charset, 4);
    From := '\StringFileInfo\' + Lang + '\';
    FCompanyName := GetValue('CompanyName');
    FFileDescription := GetValue('FileDescription');
    FFileVersion := GetValue('FileVersion');
    FInternalName := GetValue('InternalName');
    FLegalCopyright := GetValue('LegalCopyright');
    FLegalTradeMarks := GetValue('LegalTrademarks');
    FOriginalFilename := GetValue('OriginalFilename');
    FProductName := GetValue('ProductName');
    FProductVersion := GetValue('ProductVersion');
    FComments := GetValue('Comments');
    MessageBox(0, PChar(FFileVersion), '', MB_ICONINFORMATION);
  end;
  FreeMem(VerInfo);
end;

{******************************************************************************}
{  GET THE PLATFORM AND EXACT, NAME, VERSION AND BUID OF THE CURRENT OS        }
{******************************************************************************}

function GetOS(var osName: string): DWord;
var
  OS: TOSVersionInfo;
  dwMM: array[0..1] of DWord;
  szMM: array[0..511] of Char;
  Build, Ver, SP: string;
begin
  ZeroMemory(@OS, SizeOf(OS));
  OS.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(OS);
  Result := OS.dwPlatformId;
  dwMM[0] := OS.dwMajorVersion;
  dwMM[1] := OS.dwMinorVersion;
  wvsprintf(szMM, '%d.%d', PChar(@dwMM));
  if OS.dwPlatformId = VER_PLATFORM_WIN32_NT then
    Build := IntToHex(OS.dwBuildNumber, 4)
  else
    Build := IntToHex(Word(OS.dwBuildNumber), 4);
  Ver := ' (' + szMM + '.' + Build + ')';
  if OS.szCSDVersion <> '' then
    SP := ' ' + OS.szCSDVersion;
  // Default for Unknown or Newest Windows Versions
  osName := 'Windows' + SP + Ver;
  // Try to Determine Known OS Names and Versions
  case OS.dwPlatformId of
    VER_PLATFORM_WIN32s: osName := 'Windows 3.1' + Ver;
    VER_PLATFORM_WIN32_WINDOWS:
      case OS.dwMinorVersion of
        0:
          if OS.szCSDVersion = ' C' then
            osName := 'Windows 95 OSR2' + Ver
          else
            osName := 'Windows 95' + Ver;
        10:
          if OS.szCSDVersion = ' A' then
            osName := 'Windows 98 SE' + Ver
          else
            osName := 'Windows 98' + Ver;
        90: osName := 'Windows Me' + Ver;
      end;
    VER_PLATFORM_WIN32_NT:
      case OS.dwMajorVersion of
        3 or 4: osName := 'Windows NT ' + IntToHex(OS.dwMajorVersion, 8) + SP +
          Ver;
        5: case OS.dwMinorVersion of
            0: osName := 'Windows 2000' + SP + Ver;
            1: osName := 'Windows XP' + SP + Ver;
            2: osName := 'Windows Server 2003' + SP + Ver;
          end;
      end;
  end;
end;

{******************************************************************************}
{  EXECUTES A SCSI COMMAND                                                     }
{******************************************************************************}

function TskSCSI.ExecCmd(HaId, Target, Lun: Byte; CDB: TCDB; CDBLen: Cardinal;
  Flags: Cardinal; Buffer: Pointer; BufferLen: Cardinal): Byte;
var
  SRB_ExecSCSICmd: TSRB_ExecSCSICmd;
  SRBPointer: PSRB_ExecSCSICmd;
  FEvent: THandle;
  EventNotify: Boolean;
begin
  FillChar(SRB_ExecSCSICmd, SizeOf(SRB_ExecSCSICmd), 0);
  EventNotify := Flags and $40 = $40;
  FEvent := CreateEvent(nil, True, False, nil);
  if EventNotify then
  begin
    ResetEvent(FEvent);
    SRB_ExecSCSICmd.PostProc := FEvent
  end
  else
    SRB_ExecSCSICmd.PostProc := 0;

  SRB_ExecSCSICmd.Cmd := SC_EXEC_SCSI_CMD;
  SRB_ExecSCSICmd.Flags := Flags;
  SRB_ExecSCSICmd.HaId := HaId;
  SRB_ExecSCSICmd.Target := Target;
  SRB_ExecSCSICmd.Lun := Lun;
  SRB_ExecSCSICmd.BufLen := BufferLen;
  SRB_ExecSCSICmd.BufPointer := Buffer;
  SRB_ExecSCSICmd.SenseLen := SENSE_LEN;
  SRB_ExecSCSICmd.CDBLen := CDBLen;
  SRB_ExecSCSICmd.CDBByte := CDB;
  { for i := 0 to CDBLen - 1 do
      CDBByte[i] := CDB[i];}
  SRB_ExecSCSICmd.CDBByte[1] := ((Lun and 7) shl 5) or
    (SRB_ExecSCSICmd.CDBByte[1] and $1F);

  SRBPointer := @SRB_ExecSCSICmd;
  if SRB_ExecSCSICmd.CDBByte[0] <> $FF then
    SendASPI32Command(SRBPointer)
  else
    SRB_ExecSCSICmd.Status := SS_COMP;
  if EventNotify then
  begin
    if SRB_ExecSCSICmd.Status = SS_PENDING then
      WaitForSingleObject(FEvent, INFINITE);
  end;
  if SRB_ExecSCSICmd.Status = SS_PENDING then
  begin
    if EventNotify then
    begin
      CloseHandle(FEvent);
      ResetEvent(FEvent);
    end;
    AbortCmd(SRB_ExecSCSICmd);
    SRB_ExecSCSICmd.Status := SS_ERR;
    SRB_ExecSCSICmd.HaStat := HASTAT_TIMEOUT;
  end
  else
  begin
    CloseHandle(FEvent);
  end;
  Result := SRB_ExecSCSICmd.Status;
end;

{******************************************************************************}
{  ABORTS AN EXECUTED SCSI COMMAND                                             }
{******************************************************************************}

function TskSCSI.AbortCmd(FSRB_ExecSCSICmd: TSRB_ExecSCSICmd): Boolean;
var
  SRB_Abort: TSRB_Abort;
begin
  FillChar(SRB_Abort, SizeOf(TSRB_Abort), 0);
  with SRB_Abort do
  begin
    Cmd := SC_ABORT_SRB;
    HaId := FSRB_ExecSCSICmd.HaId;
    ToAbort := @FSRB_ExecSCSICmd;
  end;
  Result := SRB_Abort.Status = 1;
end;

{******************************************************************************}
{  INTERFACE INFORMATION ROUTINES                                              }
{******************************************************************************}

function TskSCSI.InterfaceNameShort: string;
begin
  case FifType of
    ifASPI: Result := 'ASPI';
    ifASAPI: Result := 'ASAPI';
    ifSPTI: Result := 'SPTI';
  end;
end;

function TskSCSI.InterfaceNameLong: string;
begin
  case FifType of
    ifASPI: Result := 'Advanced SCSI Programming Interface';
    ifASAPI: Result := 'Advanced ASPI Programming Interface';
    ifSPTI: Result := 'SCSI Passthrough Interface';
  end;
end;

function TskSCSI.InterfaceDeveloper: string;
begin
  case FifType of
    ifASPI: Result := 'Adaptec';
    ifASAPI: Result := 'VOB/Pinnacle';
    ifSPTI: Result := 'Microsoft';
  end;
end;

{******************************************************************************}
{  CONSTRUCTOR (LOAD ASPI OR ASAPI DLL OR USE SPTI UNDER NT/2K/XP)             }
{******************************************************************************}

constructor TskSCSI.Create;
var
  dwPlatformID: DWord;
  osName: string;
begin
  inherited Create;
  SCSIHandle := 0;
  FviASPI := nil;
  dwPlatformID := GetOS(osName);
  FosName := osName;
  (* if NT/2k/XP/2003 then use SPTI *)
  if dwPlatformID = VER_PLATFORM_WIN32_NT then
  begin
    InitSPTI;
    SCSIHandle := 1;
    FifType := ifSPTI;
    @GetASPI32SupportInfo := @SPTI_GetASPI32SupportInfo;
    @SendASPI32Command := @SPTI_SendASPI32Command;
  end;
  (* if 9x/Me then use ASPI or ASAPI if any *)
  if dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
  begin
    (* 1st try to initalize ASPI ... *)
    SCSIHandle := LoadLibrary(ASPI);
    if SCSIHandle <> 0 then
    begin
      @GetASPI32SupportInfo := GetProcAddress(SCSIHandle,
        'GetASPI32SupportInfo');
      @SendASPI32Command := GetProcAddress(SCSIHandle, 'SendASPI32Command');
      FviASPI := TVersionInfo.GetVersionInfo(ASPI);
      FifType := ifASPI;
    end
    else
    begin
      (* ... 2nd try to initalize ASAPI *)
      SCSIHandle := LoadLibrary(ASAPI);
      if SCSIHandle <> 0 then
      begin
        @GetASPI32SupportInfo := GetProcAddress(SCSIHandle,
          'GetASAPI32SupportInfo');
        @SendASPI32Command := GetProcAddress(SCSIHandle, 'SendASAPI32Command');
        FviASPI := TVersionInfo.GetVersionInfo(ASAPI);
        FifType := ifASAPI;
      end;
    end;
  end;
  if SCSIHandle <> 0 then
    FInitOK := True;
end;

{******************************************************************************}
{  DESTRUCTOR                                                                  }
{******************************************************************************}

destructor TskSCSI.Destroy;
begin
  if FifType = ifSPTI then
    DeInitSPTI;
  inherited Destroy;
end;

end.