burnerthread.pas

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

{-----------------------------------------------------------------------------
 Unit Name: BurnerThread
 Author:    Paul Fisher / Andrew Semack
 Purpose:   main thread to burn TCustomimages (audio / file / iso9660 / DVD /BinCUE)
 History:
-----------------------------------------------------------------------------}

unit BurnerThread;

interface

uses
  Windows, Classes, SCSIDefs, DeviceTypes, CustomImage, FileImage,
  AudioImage, DVDImage, ISOImage, BinCueImage, HandledThread,Resources,
  SysUtils, SCSIUnit, SCSITypes, CDBufferedStream;

type
  TBurnerThread = class(THandledThread)
  private
    FInfoRecord: PCDBurnerInfo;
    FBurnSettings: TBurnSettings;
    FOnCDStatus: TCDStatusEvent;
    FOnCopyStatus: TCopyStatusEvent;
    FOnBufferProgress: TCDBufferProgressEvent;
    FOnFileBufferProgress: TCDFileBufferProgressEvent;
    FOnBufferStatus: TCDBufferStatusEvent;
    FOnWriteStatusEvent: TCDWriteStatusEvent;
    FFileName: string;
    FImage: TCustomImage;
    FLastError: TScsiError;
    FDefaults: TScsiDefaults;
    ISOFilestream: TCDBufferedStream;
    BufferSize: Integer;
    BufferFreeSpace: Integer;
    FCDSpeedType: Integer;
    function SetWriteMode(BurnSettings: TBurnSettings): boolean;
    function WriteData(GLBA: DWORD; SectorCount: WORD;
      Buf: pointer; BufLen: DWORD): boolean;
    function WriteAudio(GLBA, SectorCount: DWORD;
      Buf: pointer; BufLen: DWORD): boolean;
    function SendCueSheet(ATIPBuffer: pointer; ATIPBufferSize : longint): boolean;
    function GetBufferFreeSpace: Integer;
    function GetBufferCapacity: Integer;
    function CloseTrack(TrackNo: Byte): boolean;
    function CloseSession: boolean;
    function SyncCache: boolean;
    function GetBurnerInfo: TCDBurnerInfo;
    procedure WriteImage;
  protected
    function WriteISOToCD(Filename: string): boolean;
    function WriteAudioCD(TrackCount: Integer): boolean;
    function WriteDAOImage: boolean;
    procedure Execute; override;
    property BurnerInfo: TCDBurnerInfo read GetBurnerInfo;
  public
    procedure Burn;
    constructor Create(InfoRecord: PCDBurnerInfo; ISOImage: TCustomImage);
    destructor Destroy; override;
  published
    property BurnSettings: TBurnSettings read FBurnSettings write FBurnSettings;
    property CDSpeed: Integer read FCDSpeedType write FCDSpeedType default
      SCDS_MAXSPEED;
    property OnCDStatus: TCDStatusEvent read FOnCDStatus write FOnCDStatus;
    property OnCopyStatus: TCopyStatusEvent read FOnCopyStatus write
      FOnCopyStatus;
    property OnBufferProgress: TCDBufferProgressEvent read FOnBufferProgress
      write FOnBufferProgress;
    property OnFileBufferProgress: TCDFileBufferProgressEvent read
      FOnFileBufferProgress write FOnFileBufferProgress;
    property OnBufferStatus: TCDBufferStatusEvent read FOnBufferStatus write
      FOnBufferStatus;
    property OnWriteStatusEvent: TCDWriteStatusEvent read FOnWriteStatusEvent
      write FOnWriteStatusEvent;
  end;

implementation

uses CovertFuncs;

{ TBurnerThread }

procedure TBurnerThread.Burn;
begin
  Resume;
end;

constructor TBurnerThread.Create(InfoRecord: PCDBurnerInfo; ISOImage: TCustomImage);
begin
  inherited Create(True); // Create thread suspended
  Priority := TThreadPriority(tpTimeCritical); // Set Priority Level
  FreeOnTerminate := True; // Thread Free Itself when terminated
  FFileName := '';
  FImage := ISOImage;        // assign tcustomimage
  FInfoRecord := InfoRecord; // CD/DVD Burner
end;

function TBurnerThread.GetBurnerInfo: TCDBurnerInfo;
begin
  Result := FInfoRecord^;
end;

destructor TBurnerThread.Destroy;
begin
  if ISOFilestream <> nil then ISOFilestream.Free;
  inherited;
end;

function TBurnerThread.SetWriteMode(BurnSettings: TBurnSettings): boolean;
begin
  FLastError := SCSISetWriteParameters(BurnerInfo, 0,
    BurnSettings.WriteType, BurnSettings.DataBlockType, BurnSettings.TrackMode,
      BurnSettings.SessionType,
    BurnSettings.PacketSize, BurnSettings.AudioPause, BurnSettings.TestWrite,
      BurnSettings.BurnProof, fDefaults);
  Result := fLastError = Err_None;
end;


function TBurnerThread.SendCueSheet(ATIPBuffer: pointer; ATIPBufferSize : longint): boolean;
begin
  FLastError := SCSISendCUESheet(BurnerInfo, ATIPBuffer, ATIPBufferSize, fDefaults);
  Result := fLastError = Err_None;
end;



function TBurnerThread.WriteData(GLBA: DWORD; SectorCount: WORD;
  Buf: pointer; BufLen: DWORD): boolean;
begin
  FLastError := SCSIWrite10(BurnerInfo, GLBA, SectorCount, Buf, BufLen,
    fDefaults);
  Result := fLastError = Err_None;
end;

function TBurnerThread.WriteAudio(GLBA, SectorCount: DWORD;
  Buf: pointer; BufLen: DWORD): boolean;
begin
  fLastError := SCSIWriteCDDA(BurnerInfo, GLBA, SectorCount, csfAudio,
    [cffUserData], Buf, BufLen, fDefaults);
  Result := fLastError = Err_None;
end;

function TBurnerThread.GetBufferFreeSpace: Integer;
var
  BufferInfo: TScsiCDBufferInfo;
  FreeSpace: DWord;
begin
  FillChar(BufferInfo, sizeof(TScsiCDBufferInfo), 0);
  SCSIgetBufferCapacity(BurnerInfo, BufferInfo, fDefaults);
  FreeSpace := BufferInfo.BlankLength;
  FreeSpace := Swap32(FreeSpace);
  Result := FreeSpace;
end;

function TBurnerThread.GetBufferCapacity: Integer;
var
  BufferInfo: TScsiCDBufferInfo;
  BufSpace: DWord;
  FreeSpace: DWord;
  Percent, Divisor: Integer;

begin
  FillChar(BufferInfo, sizeof(TScsiCDBufferInfo), 0);
  SCSIgetBufferCapacity(BurnerInfo, BufferInfo, fDefaults);
  BufSpace := BufferInfo.SizeOfBuffer;
  FreeSpace := BufferInfo.BlankLength;
  BufferSize := Swap32(BufSpace);
  BufferFreeSpace := Swap32(FreeSpace);
  Divisor := (BufferSize div 100);
  Percent := ((BufferSize - BufferFreeSpace) div Divisor);
  if (Percent < 0) then
    Percent := 0;
  if (Percent > 100) then
    Percent := 100;
  Result := Percent;
end;

function TBurnerThread.CloseSession: boolean;
begin
  FLastError := SCSICloseSession(BurnerInfo, fDefaults);
  Result := FLastError = Err_None;
end;

function TBurnerThread.CloseTrack(TrackNo: Byte): boolean;
begin
  FLastError := SCSICloseTrack(BurnerInfo, TrackNo, fDefaults);
  Result := FLastError = Err_None;
end;

function TBurnerThread.SyncCache: boolean;
begin
  FLastError := SCSISYNCCACHE(BurnerInfo, fDefaults);
  Result := FLastError = Err_None;
end;

function TBurnerThread.WriteISOToCD(Filename: string): boolean;
var
  ISOFilestream: TCDBufferedStream;
  Buf: Pointer;
  BufLen, SectorSize, SectorsToWrite: integer;
  BytesWritten: integer;
  IndexBlock: integer;
  LastBlock: integer;
begin
  if (FBurnSettings.DataBlockType = btRAW_DATA_P_Q_SUB) then
    FBurnSettings.TrackMode := tmCDR_MODE_DAO_96
  else
    FBurnSettings.TrackMode := tmCDR_MODE_DATA;
  if not
    SetWriteMode(FBurnSettings) then
  begin
    if Assigned(FOnCDStatus) then
      FOnCDStatus(resSetDataHardwareFail);
    Result := False;
    exit;
  end
  else if Assigned(FOnCDStatus) then
    FOnCDStatus(resSetDataHardwareOK);

  ISOFilestream := TCDBufferedStream.Create(Filename, fmOpenRead);

  SectorSize := ConvertDataBlock(FBurnSettings.DataBlockType);
  ISOFilestream.SectorSize := SectorSize;

  if not ISOFilestream.ISOSectorSizeOK then
  begin
    if Assigned(FOnCDStatus) then
      FOnCDStatus(resImageSizeError);
    ISOFilestream.free;
    Result := False;
    exit;
  end;

  LastBlock := ISOFilestream.SectorCount;
  IndexBlock := 0;
  BytesWritten := 0;
  SectorsToWrite := 20; // increase to make faster writing ????
  Buf := nil;
  BufLen := (SectorSize * SectorsToWrite); //10 * 4096 40kb at a time
  ReallocMem(Buf, BufLen); // alloc max buf size

  while (BytesWritten < ISOFilestream.Size - 1) do
    //  for IndexBlock := 0 to LastBlock - 1 do
  begin
    try
      if (SectorsToWrite > ISOFilestream.SectorsLeft) then
        SectorsToWrite := (ISOFilestream.SectorsLeft);
      buflen := (SectorSize * SectorsToWrite);

      BytesWritten := BytesWritten + ISOFilestream.Read(pchar(Buf)^, BufLen);
        // read data from iso

      if not WriteData(IndexBlock, SectorsToWrite, buf, BufLen) then
        // write data to cd
      begin
        if Assigned(FOnCDStatus) then
          FOnCDStatus(resDiskWriteError);
        ISOFilestream.free;
        Result := False;
        exit;
      end;

      inc(IndexBlock, SectorsToWrite);
    finally
      if Assigned(FOnCopyStatus) then
        FOnCopyStatus(IndexBlock, (IndexBlock div ((LastBlock - 1) div 100)));
      if Assigned(FOnWriteStatusEvent) then
        FOnWriteStatusEvent(BytesWritten);
      if Assigned(FOnBufferProgress) then
        FOnBufferProgress(GetBufferCapacity);
      if Assigned(FOnBufferStatus) then
        FOnBufferStatus(BufferSize, BufferFreeSpace);
      if Assigned(FOnFileBufferProgress) then
        FOnFileBufferProgress(ISOFilestream.BufferPercentFull);
    end;
    while (GetBufferFreeSpace < 2448) do
    begin
      if Assigned(FOnBufferProgress) then
        FOnBufferProgress(GetBufferCapacity);
        sleep(500);
    end;
  end; {writing for loop}

  ReallocMem(Buf, 0);
  if Assigned(FOnBufferProgress) then
    FOnBufferProgress(GetBufferCapacity);
  if Assigned(FOnCDStatus) then
    FOnCDStatus(resSyncCache);
  if not SyncCache then // Sync the cache buffer
  begin
    if Assigned(FOnCDStatus) then
      FOnCDStatus(resSyncCacheError);
    ISOFilestream.free;
    Result := False;
    exit;
  end;

  if Assigned(FOnCDStatus) then
    FOnCDStatus(resCloseTrack);
  self.CloseTrack(1);
  self.SyncCache;

  if CloseSession = true then
  begin
    if Assigned(FOnCDStatus) then
      FOnCDStatus(resCloseSession);
    self.CloseSession;