mbcdbc.pas

刻录机源码

  FinalizeDisc := True;
  SetWriteParams(TestWrite, UnderrunProtection, FinalizeDisc, MediumIs);
  FinalizeDisc := OrgFin;
  WaitForReady(10000, 500);
  if (dt = mtDVD_RAM) or (dt = mtDVD_PLUSRW) then
  begin
    fStartAddress := GetLastRecordedAddress;
    result := True;
    exit;
  end;
  ReadDiscInformation;
  if (dt = mtDVD_RW_RO) or (dt = mtDVD_RW_SR) then
  begin
    result := ReadTrackInformation(1);
    if result then
    begin
      if TrackInformation.NextWritableAddress <> 0 then
         fStartAddress := TrackInformation.NextWritableAddress;
      exit;
    end;
  end
  else
  begin
    ti := SessionsOnDisc+1;
    result := ReadTrackInformation(ti);
    if result then
      fStartAddress := TrackInformation.NextWritableAddress
    else
      fStartAddress := 0;
  end;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.PrepareISO: Boolean;
begin
  Prepare(True, nil);
  result := True;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.PrepareCD: Boolean;
begin
  Prepare(False, nil);
  result := True;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.PrepareHeader(ISOFile: Boolean = False; TargetDir: PDirEntry = nil): Boolean;
var
  iCursor: Int64;
  i: Integer;
  p: PDirEntry;
  lp, ln: Integer;
  fs: TFileStreamEx;

Label
  SortAgain, SortAgainJ;
begin
  Valid := True;
  if not FileExists(fBootImage) then
  begin
    fBootable := False;
  end
  else if (fBootImage = '') then
     fBootable := False;
  DoDebug := False; 
  fStartAddress := 0;
  if not ISOFile then
  begin
    MediumIs := DiscType;
    if (GetAddress) then
    begin
       if not GetNextWritableAddress then
         DebugMsg('>>> '+ERR_NEXTADRESS, mtUNKNOWN);
       if fStartAddress > $FF000000 then
         fStartAddress := 0;
    end;
    if (fSessionToImport <> 0) then
    begin
      ImportSession(fSessionToImport, TargetDir);
      WithOldSession := True;
    end
    else
      WithOldSession := False;
  end;
  if DoDebug then DebugMsg(IntToStr(FileCounter)+' Files Added to CD, now sorting', mtMESSAGE);
  if DoDebug then DebugMsg('Sorting .... ISO9660 LN-PN', mtMESSAGE);  /// Sort Path Table Record - 6.9.1
  SortLN(PathTable, DirCounter-1, False); SortPN(PathTable, DirCounter-1, False);
  if DoDebug then DebugMsg('Sorting .... Joliet  LN-PN', mtMESSAGE);
  SortLN(PathTableJ, DirCounter-1, True); SortPN(PathTableJ, DirCounter-1, True);
SortAgain:
  if DoDebug then DebugMsg('Sorting .... ISO9660', mtMESSAGE);
  SortNumber(PathTable, DirCounter-1); SortParent(PathTable, DirCounter-1);
  SortNumber(PathTable, DirCounter-1); SortPN(PathTable, DirCounter-1, False);
  lp := 0; ln := 0;
  for i:=1 to DirCounter-1 do
  begin
    p := PathTable[i];
    if lp > p.Parent.Number then
      goto SortAgain;
    if ln > p.Number then
      goto SortAgain;
    lp := p.Parent.Number;
    ln := p.Number;
  end;
SortAgainJ:
  if DoDebug then DebugMsg('Sorting .... Joliet', mtMESSAGE);
  SortNumber(PathTableJ, DirCounter-1);
  SortParent(PathTableJ, DirCounter-1);
  lp := 0; ln := 0;
  for i:=0 to DirCounter-1 do
  begin
    p := PathTableJ[i];
    if lp > p.Parent.Number then
      goto SortAgain;
    if ln > p.Number then
      goto SortAgain;
    lp := p.Parent.Number;
    ln := p.Number;
  end;
  //// ..........................................................................
  if DoDebug then DebugMsg('Sorting .... Done', mtMESSAGE);
  iCursor := fStartAddress + 16;
  iCursor := iCursor;
  if DoDebug then DebugMsg(' Primary Volume Descriptor Location   :'+IntToDec(iCursor, 8), mtMESSAGE);
  if fBootable then
  begin
    iCursor := iCursor + 1;
    if DoDebug then DebugMsg(' Boot Record    Descriptor Location   :'+IntToDec(iCursor, 8), mtMESSAGE);
  end;
  { iCursor := iCursor + DefaultSectorSize;  Prim2VDLocation := iCursor;
  if DoDebug then DebugMsg(' Secondry Volume Descriptor Location  :'+IntToHex(iCursor, 8), mtMESSAGE); }
  if fJoliet then
  begin
    iCursor := iCursor + 1;
    if DoDebug then DebugMsg(' Joliet Volume Descriptor Location    :'+IntToDec(iCursor, 8), mtMESSAGE);
  end;
  iCursor := iCursor + 1;
  if DoDebug then DebugMsg(' Terminator Vol Descriptor Location   :'+IntToDec(iCursor, 8), mtMESSAGE);
  // XYZ-FS iCursor := iCursor + $0000;
  // if DoDebug then DebugMsg(' XYZ-FS                            :'+IntToDex(iCursor, 8));
  // .......................................................................................
  iCursor := iCursor + 1;
  PathTableRecsLocationL := iCursor;
  if DoDebug then DebugMsg(' Path Table Records Location (Least)  :'+IntToDec(iCursor, 8), mtMESSAGE);
  PathTableWidth; iCursor := iCursor + Sectors(iPathTableSize);
  PathTableRecsLocationM := iCursor;
  if DoDebug then DebugMsg(' Path Table Records Location (Most)   :'+IntToDec(iCursor, 8), mtMESSAGE);
  iCursor := iCursor + Sectors(iPathTableSize);
  PathTableRecsLocationJL := iCursor;
  if fJoliet then
  begin
    if DoDebug then DebugMsg(' Path Table Records Location (Least) J:'+IntToDec(iCursor, 8), mtMESSAGE);
    PathTableWidthJ; iCursor := iCursor + Sectors(iPathTableSizeJ);
    PathTableRecsLocationJM := iCursor;
    if DoDebug then DebugMsg(' Path Table Records Location (Most)  J:'+IntToDec(iCursor, 8), mtMESSAGE);
    iCursor := iCursor + Sectors(iPathTableSizeJ);
  end;
  FileDirDescriptorExtentStart := iCursor;
  FileDirDescriptorLocation := iCursor;
  if DoDebug then DebugMsg(' File and Directory Record Location   :'+IntToDec(iCursor, 8), mtMESSAGE);
  iFileAndDirDescriptorWidth := FileAndDirDescriptorWidth;
  iCursor := iCursor + Sectors(iFileAndDirDescriptorWidth);
  if fJoliet then
  begin
    FileDirDescriptorLocationJ := iCursor;
    if DoDebug then DebugMsg(' File and Directory Record Location  J:'+IntToDec(iCursor, 8), mtMESSAGE);
    iFileAndDirDescriptorWidthJ := FileAndDirDescriptorWidthJ;
    iCursor := iCursor + Sectors(iFileAndDirDescriptorWidthJ);
  end;
  FileDirDescriptorExtentEnd := iCursor;
  //----------------------------------------------------------------------- Bootable CD/DVD
  if fBootable then
  begin
    fs := TFileStreamEx.Create(fBootImage, fmOpenRead+fmShareDenyNone);
    BootCatalogLocation := iCursor;
    iCursor := iCursor + 1;
    BootImageLocation := iCursor;
    BootImageSize := Sectors(fs.Size);
    iCursor := iCursor + BootImageSize;
    fs.Destroy;
  end;
  //---------------------------------------------------------------------------------------
  if iCursor < 150 then
  begin
    Pads := 150 - iCursor;
    fDataLocation := 150;
    iCursor := fDataLocation;
    Valid := True;
  end
  else
  begin
    Pads := 150 - iCursor;
    fDataLocation := iCursor;
    Valid := False;
  end;

  if DoDebug then DebugMsg(' First File Location                  :'+IntToDec(iCursor, 8), mtMESSAGE);
  SetFileAddress;
  TotalNoOfSectors := iCursor + fFilesSizeOnDisc;
  //---------------------------------------------------------------------------------------
  if not ISOFile and wms then
    TotalNoOfSectors := TotalNoOfSectors + 150;
  fImageSize := TotalNoOfSectors - (fStartAddress);
  result := True;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.BuildHeader(ISOFile: Boolean = False; TargetDir: PDirEntry = nil): Boolean;
var
  i: Integer;
begin
  BuildHeaderISOFile := ISOFile;
  BuildHeaderTargetDir := TargetDir;
  ISOHeader.Clear;
  if wms then for i := 1 to 150 do
    ISOHeader.Write(ZEROS, DefaultSectorSize);
  for i := 1 to 16 do
    ISOHeader.Write(ZEROS, DefaultSectorSize);
  WritePVD;
  if fBootable then
    WriteBVD;
  if fJoliet then
    WriteJVD;
  WriteTVD;
  fillchar(vds, sizeof(vds), 255);
  ISOHeader.Seek(0, 0);
  ISOHeader.Read(vds[0], ISOHeader.Size);
  vdsSize := ISOHeader.Size;
  WritePathTable(FileDirDescriptorLocation, False);
  WritePathTable(FileDirDescriptorLocation, True);
  if fJoliet then
  begin
    WritePathTableJ(FileDirDescriptorLocationJ, False);
    WritePathTableJ(FileDirDescriptorLocationJ, True);
  end;
  WriteFileAndDirDescriptor(FileDirDescriptorLocation, fDataLocation);
  if fJoliet then
    WriteFileAndDirDescriptorJ(FileDirDescriptorLocationJ, fDataLocation);

  if fBootable then
    WriteBootCatalog;
  if Pads > 0 then
  begin
    for i := 1 to Pads do
      ISOHeader.Write(ZEROS, DefaultSectorSize);
  end;
  fImageSize := TotalNoOfSectors - (fStartAddress);
  result := True;
  fPrepared := True;
  DoDebug := True;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}

function TMCDBurner.Prepare(ISOFile: Boolean = False; TargetDir: PDirEntry = nil): Boolean;
begin
  result := PrepareHeader(ISOFile, TargetDir);
  //result := BuildHeader(ISOFile, TargetDir);
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function GetLastFile(Files: PFileEntry): PFileEntry;
begin
  result := nil;
  while Files <> nil do
  begin
    result := Files;
    Files := Files.Next;
  end;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function CompletePath(d: PDirEntry): String;
var
  s: String;
begin
  s := '\';
  while d.Parent <> d do
  begin
    s := '\'+d.LongName+s;
    d := d.parent;
  end;
  s := Copy(s, 1, Length(s)-1);
  result := UpperCase(s);
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.FindDir(DirName: String): PDirEntry;
var
  i: Integer;
begin
  if (DirName = '') or (DirName = '\') then
  begin
    result := fRoot;
    exit;
  end;
  if Copy(DirName, Length(DirName), 1) = '\' then
    DirName := Copy(DirName, 1, Length(DirName)-1);
  DirName := UpperCase(DirName);
  for i:=1 to DirCounter -1 do
  begin
    if (Dirs[i] <> nil) and (DirName = PDirEntry(Dirs[i]).Path) then
    begin
      result := Dirs[i];
      exit;
    end;
  end;
  result := nil;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function MakeShortFileName(FileName: String; var sr: TSearchRec): Boolean;
var
  i: Integer;
begin
  for i:=1 to Min(length(FileName), 13) do
  begin
    sr.FindData.cAlternateFileName[i-1] := UpCase(FileName[i]); //short name
    if (sr.FindData.cAlternateFileName[i-1] < #33) or (sr.FindData.cAlternateFileName[i-1] > 'z') then sr.FindData.cAlternateFileName[i-1] := '_';
  end;
  i := Min(length(FileName), 13);
  while (i < 13) do
  begin
    sr.FindData.cAlternateFileName[i] := #0;
    inc(i);
  end;
  sr.FindData.cAlternateFileName[13] := #0;
  result := true;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.CreateDir(DirName: String): PDirEntry;
begin
  result := MakeDir(DirName);
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.CreateDir(DestinationPath: String; DirName: String): PDirEntry;
var
  d: PDirEntry;
begin
  d := FindDir(DestinationPath);
  if d = nil then
  begin
    DebugMsg(ERR_INVALIDDESTDIR, mtFATALERROR);
    result := nil;
    exit;
  end;
  result := CreateDir(d, DirName);
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.CreateDir(DestinationPath: PDirEntry; DirName: String; Attr: Integer = faDirectory): PDirEntry;
var
  sr: TSearchRec;
begin
  if Copy(DirName, 1, 1) = '\' then DirName := Copy(DirName, 2, Length(DirName));
  if Copy(DirName, Length(DirName), 1) = '\' then DirName := Copy(DirName, 1, Length(DirName)-1);
  sr.Name := DirName;
  MakeShortFileName(DirName, sr);
  sr.Time := DateTimeToFileDate(Now);
  sr.Attr := Attr;
  result := CreateDir(Destina