mbcdbc.pas

刻录机源码

{*******************************************************************************
  Unit        : mbCDBC.PAS
  Author      : Ehsan Khan
  Date        : Aug 2001 - Jan 2003
  Description :
  Copyright   : 2001-03 Binary Magic, All rights reserved.
{******************************************************************************}
unit mbCDBC;
{$I DEFINES.INC}
interface

uses
  Windows, Messages, SysUtils, Classes, mbISOLib, mbStreamEx, Math, mbDrvLib, mbCache, mbConst, SyncObjs, Dialogs, {mbISOBurner,} mbSPTI;

type
  {$IFNDEF ACTIVEX}
  TAddFileEvent = procedure (Sender: TObject; const FullPath: String; var LongFileName, ShortFileName: String; var DateTime: TDateTime; Attr: Integer; FileSize: Int64; var Skip: Boolean) of object;
  {$else}
  TAddFileEvent = procedure (Sender: TObject; const FullPath: String; var LongFileName, ShortFileName: String; var DateTime: TDateTime; Attr: Integer; FileSize: Integer; var Skip: Boolean) of object;
  {$ENDIF}
  TAddDirEvent = procedure (Sender: TObject; var LongName, ShortName: String; var Skip: Boolean) of object;
  TFileTestFailedEvent = procedure (Sender: TObject; const FullPath: String; var Stop: Boolean) of object;
  TWriteDoneEvent = procedure (Sender: TObject; Error: String) of object;

  TThWrite = class(TThread)
  private
    fImageSize: Int64;
    fCacheSize: Integer;
    fSaveISO: Boolean;
  protected
    procedure Execute; override;
    property ImageSize: Int64 read fImageSize write fImageSize;
  end;
  TMCDBurner = class(TSCSIDevice)
  private
    { Private declarations }
    fOnAddFile: TAddFileEvent;
    fOnAddDir: TAddDirEvent;
    fOnTestFileFails: TFileTestFailedEvent;
    fIdVolume,
    fIdSystem,
    fIdVolumeSet,
    fIdPublisher,
    fIdPreparer,
    fIdApplication,
    fApplicationData2,
    fFileCopyright,
    fFileAbstract,
    fFileBibliographic: String;
    fDateCreation,
    fDateModification,
    fDateEffective,
    fDateExpiration: TDateTime;
    SettingsCanBeChanged,
    fParentDirectoryOnly,
    fJoliet: Boolean;
    fPrepared: Boolean;
    Depth: Integer;
    fBufferSize: Integer;
    fFilesSizeOnDisc: Int64;
    fStartAddress: Cardinal;
    BootCatalogLocation,
    BootImageLocation,
    BootImageSize,
    PathTableRecsLocationL,
    PathTableRecsLocationM,
    PathTableRecsLocationJL,
    PathTableRecsLocationJM,
    iPathTableSize,
    iPathTableSizeJ,
    FileDirDescriptorLocation,
    FileDirDescriptorLocationJ,
    iFileAndDirDescriptorWidth,
    iFileAndDirDescriptorWidthJ,
    fDataLocation: Integer;
    TotalNoOfSectors: Int64;
    fISOFileName: String;
    fRoot: PDirEntry;
    fOnWriteDone: TWriteDoneEvent;
    fOnFinalizingTrack: TNotifyEvent;
    fFinalizeTrack,
    fBootable,
    fReplaceFile,
    fWritePostGap,
    fPerformOPC: Boolean;
    fSessionToImport: SmallInt;
    FFilesSize: Int64;
    fBootImage: String;
    impVD: TVolumeDescriptor;
    fImageSize,
    fBytesWritten: Int64;
    GetAddress, WithOldSession: Boolean;
    fMCDBVersion: String;
    WriteDoneError:String;
    fFileInProcess: String;
    BuildHeaderISOFile: Boolean;
    BuildHeaderTargetDir: PDirEntry;
    procedure WriteDoneEvent;


  protected
    { Protected declarations }
    FileDirDescriptorExtentStart, FileDirDescriptorExtentEnd: Cardinal;
    ISOHeader: TMemoryStream;
    CurrentFile: PFileEntry;
    fAborted: Boolean;
    Pads: Int64;
  private
    { Private declarations }

    procedure New_D(var P: PDirEntry);
    procedure New_F(var P: PFileEntry);
    procedure SetFileAddress;
    function  ImportSessionDirectoryJ(DirLocation, Size: Integer; DestinationDir: PDirEntry): Boolean;
    function  ImportSessionDirectory(DirLocation, Size: Integer; DestinationDir: PDirEntry): Boolean;
    function  GetNextWritableAddress: Boolean;
    function  GetLastRecordedAddress: DWORD;
    function  PathTableWidth: Integer;
    function  PathTableWidthJ: Integer;
    function  FileAndDirDescriptorWidth: Integer;
    function  FileAndDirDescriptorWidthJ: Integer;
    function  DoBurn(ISO: Boolean): Boolean;
    function  GetDirsCount: Integer;
    function  GetFilesCount: Integer;
    function  GetImageSize: Int64;
    procedure WritePVD;
    procedure WriteJVD;
    procedure WriteTVD;
    procedure WriteBVD;
    procedure WriteBootCatalog;
    procedure WritePathTable(Start: Integer; Most: Boolean);
    procedure WritePathTableJ(Start: Integer; Most: Boolean);
    procedure WriteFileAndDirDescriptor_r(d: PDirEntry; Start, FileStart: Integer);
    procedure WriteFileAndDirDescriptor(Start, FileStart: Integer);
    procedure WriteFileAndDirDescriptorJ_r(d: PDirEntry; Start, FileStart: Integer);
    procedure WriteFileAndDirDescriptorJ(Start, FileStart: Integer);
    procedure WriteFiles;
    procedure SetBufferSize(Value: Integer);
    procedure Print_Files(Files: PFileEntry);
    procedure SetMCDBVersion(Value: String);
    function  MakeDir(DirName: String): PDirEntry;
  public
    { Pufblic declarations }
    procedure Print_D1;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Abort;

    function  Initialize: Boolean;
    function  GetDirSize(Path: String): Int64;

    function  CreateDir(DestinationPath: PDirEntry; DirName: String; Attr: Integer = faDirectory): PDirEntry; overload;
    function  CreateDir(DestinationPath: String; DirName: String): PDirEntry; overload;
    function  CreateDir(DirName: String): PDirEntry; overload;
    function  CreateDir(DestinationPath: PDirEntry; sr: TSearchRec): PDirEntry; overload;

    function  MoveFile(DestinationPath, SourcePath: PDirEntry; SourceFile: PFileEntry): Boolean; overload;
    function  MoveFile(DestinationPath, SourcePath, SourceFile: String): Boolean; overload;

    function  RemoveFile(SourceDir: String; SourceFile: String): Boolean; overload;
    function  RemoveFile(var SourceDir: PDirEntry; var SourceFile: PFileEntry): Boolean; overload;
    function  RemoveDir(var SourceDir: PDirEntry): Boolean; overload;
    function  RemoveDir(SourceDir: String): Boolean; overload;
    function  RemoveEmptyDirs: Boolean;
    function  ResetFilesArchiveBit: Boolean;
    function  TestFiles: Boolean;
    function  ResetAllFilesArchiveBit: Boolean;
    function  RemoveDir_r(var SourceFile: PFileEntry): Boolean;

    function  RenameFile(SourceDir, SourceFile: String; NewLongName, NewShortName: String): Boolean; overload;
    function  RenameFile(SourceFile: PFileEntry; NewLongName, NewShortName: String): Boolean; overload;

    function  InsertFile(DestinationPath: String; FilePath: String; SavePath: Boolean = False): Integer; overload;
    function  InsertFile(DestinationPath: PDirEntry; sr: TSearchRec; FilePath: String; OrignalAddress: Integer = 0; ResetArchiveBit: Boolean = False): Integer; overload;
    function  InsertFileWithName(DestinationPath: String; FilePath: String; ShortNameOnDisc, LongNameOnDisc: String): Integer;
    function  InsertMemoryFile(DestinationPath, LongFileName, ShortFileName: String; Attr: Byte; Memory: Pointer; Size: Cardinal): Integer;
    
    function  InsertDir(DestinationPath, SourcePath: String; FileSpecs: String='*.*'; Attr: Integer = faAnyFile; Recursive: Boolean=True; SavePath: Boolean = False; ArchiveOnly: Boolean = False): Integer; overload;
    function  InsertDir(DestinationPath: PDirEntry; SourcePath: String; FileSpecs: String='*.*'; Attr: Integer = faAnyFile; Recursive: Boolean=True; SavePath: Boolean = False; ArchiveOnly: Boolean = False): Integer; overload;


    function  FindFile(Dir: PDirEntry; FileName: String): PFileEntry;
    function  FindDir(DirName: String): PDirEntry;

    function  ExtractFile(FileToExtract: PFileEntry; TargetFile: String): Boolean;
    function  BurnISOImage(ISOFileName: String): Boolean;
    function  Prepare(ISOFile: Boolean = False; TargetDir: PDirEntry = nil): Boolean;
    function  PrepareHeader(ISOFile: Boolean = False; TargetDir: PDirEntry = nil): Boolean;
    function  BuildHeader(ISOFile: Boolean = False; TargetDir: PDirEntry = nil): Boolean;
    function  PrepareCD: Boolean;
    function  PrepareISO: Boolean;
    function  BurnCD: Boolean;
    function  SaveToISOFile(ISOFileName: String; QuickSave: Boolean = False): Integer;

    function  ClearAll(Max_Files: Integer = 65535; Max_Dirs: Integer = 8191): Boolean;
    function  BufferProgress: Integer;
    function  ImportSession(SessionNo: ShortInt; DestinationDir: PDirEntry): Boolean;
    function  GetDevice(Num: Byte): String;
    function  DevicesFound: Byte; overload;
    property  ApplicationData2: String read fApplicationData2 write fApplicationData2;  
    property  SessionToImport: SmallInt read fSessionToImport write fSessionToImport;
    property  RootDir: PDirEntry read fRoot;
    property  BytesWritten: Int64 read fBytesWritten;
    property  ImageSize: Int64 read GetImageSize;
    property  DirsCount: Integer read GetDirsCount;
    property  FilesCount: Integer read GetFilesCount;
    property  FilesSize: Int64 read FFilesSize;
    property  FileInProcess: String read fFileInProcess;
    property  Bootable: Boolean read fBootable write fBootable default False;
    property  ParentDirectoryOnly: Boolean read fParentDirectoryOnly write fParentDirectoryOnly default False;
    property  BootImage: String read fBootImage write fBootImage;
    property  Disc;
    property  Devices;
    property  DeviceName;
    property  HostAdapters;
    property  ErrorString;
    property  DeviceCapabilities;
    property  InquriyData;

  published
    { Published declarations }
    property ASPIInitialized;
    property DeviceMaxWriteSpeed;
    property DeviceMaxReadSpeed;
    property DeviceBufferSize;
    property DeviceFreeBufferSize;
    property UnderrunProtection;
    property DoDebug;
    property OnDeviceChange;
    property OnEraseDone;
    property ReadSpeed;
    property WriteSpeed;
    property Erasing;
    property FinalizeDisc;
    property TestWrite;
    property ReplaceFile: Boolean read fReplaceFile write fReplaceFile;
    property FinalizeTrack: Boolean read fFinalizeTrack write fFinalizeTrack default True;
    property PerformOPC: Boolean read fPerformOPC write fPerformOPC;
    property IdVolume: String read fIdVolume write fIdVolume;
    property IdSystem: String read fIdSystem write fIdSystem;
    property IdVolumeSet: String read fIdVolumeSet write fIdVolumeSet;
    property IdPublisher: String read fIdPublisher write fIdPublisher;
    property IdPreparer: String read fIdPreparer write fIdPreparer;
    property IdApplication: String read fIdApplication write fIdApplication;
    property FileCopyright: String read fFileCopyright write fFileCopyright;
    property FileAbstract: String read fFileAbstract write fFileAbstract;
    property FileBibliographic: String read fFileBibliographic write fFileBibliographic;
    property DateCreation: TDateTime read fDateCreation write fDateCreation;
    property DateModification: TDateTime read fDateModification write fDateModification;
    property DateEffective: TDateTime read fDateEffective write fDateEffective;
    property DateExpiration: TDateTime read fDateExpiration write fDateExpiration;
    property CacheSize: Integer read fBufferSize write SetBufferSize;
    property ISOFileName: String read fISOFileName write fISOFileName;
    property JolietFileSystem: Boolean read fJoliet write fJoliet default True;
    property OnAddFile: TAddFileEvent read fOnAddFile write fOnAddFile;
    property OnAddDir: TAddDirEvent read fOnAddDir write fOnAddDir;
    property OnWriteDone: TWriteDoneEvent read fOnWriteDone write fOnWriteDone;
    property OnFinalizingTrack: TNotifyEvent read fOnFinalizingTrack write fOnFinalizingTrack;
    property Version: String read fMCDBVersion write SetMCDBVersion;
    property WritePostGap: Boolean read fWritePostGap write fWritePostGap;

  end;

procedure Register;

const
  fSuf = ';1';
var
  buffer: array [0..253] of Byte;
  WriteBuffer: array[0..MaxWord * 100] of char;
  vds: array[0..32 * 2048] of char;
  vdsSize: Integer;
  IsPrev: Boolean = False;
  Valid: Boolean = True;
  ELen: Integer = 0;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
{}                                implementation                              {}
{******************************************************************************}
{                                                                              }
{******************************************************************************}
uses mbASPI;

var
  MCDBurner: TMCDBurner;
  ZEROS: array[0..DefaultSectorSize] of char;
  f: File;
  wt: TThWrite;
  Burning: Boolean = False;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
procedure Register;
begin
  RegisterComponents('Magic CD Burner', [TMCDBurner]);
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
procedure TMCDBurner.SetMCDBVersion(Value: String);
begin
  Value := Value;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function  TMCDBurner.GetDevice(Num: Byte): String;
begin
  result := Devices[Num];
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function  TMCDBurner.DevicesFound: Byte;
begin
  result := Devices.Count;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
constructor TMCDBurner.Create;
begin
  ISOHeader := TMemoryStream.Create;
  ISOHeader.SetSize(16777216 * 4);
  fWritePostGap := True;
  Initialize;
  SetBufferSize(4 * 1024 * 1024); // 4 MB
  fJoliet := True;
  fFinalizeTrack := True;
  fMCDBVersion := '1.23';
  UnderrunProtection := True;
  Inherited;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function  TMCDBurner.GetDirsCount: Integer;
begin
  result := DirCounter-1;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function  TMCDBurner.GetFilesCount: Integer;
begin
  result := FileCounter;
end;

function TMCDBurner.GetImageSize: Int64;
begin
  if fWritePostGap and (fImageSize < 300) then
    result := 300
  else
    result := fImageSize;
end;

{******************************************************************************}
{                                                                              }
{******************************************************************************}
destructor TMCDBurner.Destroy;
var
  i: Integer;
  d: PDirEntry;
  f: PFileEntry;
begin
  ISOHeader.Clear;
  ISOHeader.SetSize(16777216 * 4);
  for i:=0 to DirCounter-1 do
  begin
    if Dirs[i] <> nil then
    begin
      d := Dirs[i];
      d.ShortName := '';
      d.LongName := '';
      d.Path := '';