mbcdbc.pas

刻录机源码

      Dispose(Dirs[i]);
      Dirs[i] := nil;
    end;
  end;

  for i:=0 to FileCounter-1 do
  begin
    if Files[i] <> nil then
    begin
      f := Files[i];
      f.Path := '';
      f.ShortName := '';
      f.LongName := '';
      Dispose(Files[i]);
      Files[i] := nil;
    end;
  end;
  ISOHeader.Free;
  Inherited;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function LToMW(w: Word): Word;
begin
  result := ((w shl 8) and $FF00) or ((w shr 8) and $00FF);
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
procedure TMCDBurner.SetBufferSize(Value: Integer);
begin
  if Value < 2 * 1024 * 1024 then
    Value := 2 * 1024 * 1024;
  Value := Value div DefaultSectorSize;
  Value := Value * DefaultSectorSize;
  fBufferSize := Value;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.ClearAll(Max_Files, Max_Dirs: Integer): Boolean;
var
  i: Integer;
  d: PDirEntry;
  f: PFileEntry;
begin
  GetTimeZoneInformation(TimeZoneInformation);
  TimeZoneDiff := (-TimeZoneInformation.Bias div 15) {+ (-TimeZoneInformation.DaylightBias div 15)};
  ISOHeader.Clear;
  for i:=0 to DirCounter-1 do
  begin
    if Dirs[i] <> nil then
    begin
      d := Dirs[i];
      d.ShortName := '';
      d.LongName := '';
      d.Path := '';
      Dispose(Dirs[i]);
      Dirs[i] := nil;
    end;
  end;
  for i:=0 to FileCounter-1 do
  begin
    if Files[i] <> nil then
    begin
      f := Files[i];
      f.ShortName := '';
      f.LongName := '';
      f.Path := '';
      Dispose(Files[i]);
      Files[i] := nil;
    end;
  end;
  SetLength(Dirs, 0);
  SetLength(PathTable, 0);
  SetLength(PathTableJ, 0);
  SetLength(Files, 0);
  MaxDirs := Max_Dirs;
  MaxFiles := Max_Files;
  SetLength(Dirs, Max_Dirs);
  SetLength(PathTable, Max_Dirs);
  SetLength(PathTableJ, Max_Dirs);
  SetLength(Files, Max_Files);

  FFilesSize := 0;
  SettingsCanBeChanged := True;
  FileCounter := 0;
  DirCounter := 0;
  fillchar(ZEROS, DefaultSectorSize, 0);
  Depth := 1;
  New_D(fRoot);
  fRoot.Files := nil;
  fRoot.Path := '\';
  fRoot.ShortName := 'CD_ROOT';
  fRoot.LongName := 'CD Root Directory';
  fRoot.Depth := Depth;
  fRoot.Parent := fRoot;
  Result := True;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
procedure TMCDBurner.New_D(var P: PDirEntry);
begin
  if DirCounter >= MaxDirs then
  begin
    DebugMsg(Format('>>> '+ERR_MAXDIRS, [MaxDirs]), mtNONFATALERROR);
    P := nil;
    exit;
  end;
  New(P);
  P.Imported := False;
  P.Order := 0;
  Dirs[DirCounter] := p;
  PathTable[DirCounter] := p;
  PathTableJ[DirCounter] := p;
  Inc(DirCounter);
  SettingsCanBeChanged := False;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
procedure TMCDBurner.New_F(var P: PFileEntry);
begin
  if FileCounter >= MaxFiles then
  begin
    DebugMsg(Format(ERR_MAXFILES, [MaxFILES]), mtNONFATALERROR);
    P := nil;
    exit;
  end;
  New(P);
  Files[FileCounter] := p;
  Inc(FileCounter);
  P.Imported := False;
  P.Prev := False;
  P.SpaceReqOnDisc := 0;
  P.Buffer := nil;
  SettingsCanBeChanged := False;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
procedure TMCDBurner.WriteFiles;
var
  i: Integer;
  p: PFileEntry;
  ChunkSize: Integer;
  BytesLeft, BytesToRead: Integer;
  NumRead, NumWritten: Integer;
  Buf: array[1..128*1024] of char;
  src: File;
begin
  ChunkSize := 128*1024;
  for i := 0 to FileCounter-1 do
  begin
    p := Files[i];
    if ((p.Attr and faDirectory) <> faDirectory) then
    begin
      FileMode := $0; AssignFile(src, p.Path); Reset(src, 1); FileMode := $2;
      if p.FileSize <> 0 then
      begin
        if (p.AddressJ+(fDataLocation)) <> filepos(f) div 2048 then
          DebugMsg('>>> '+ERR_4 + ' '+p.Path+' '+IntToStr(p.AddressJ+(fDataLocation))+'<>'+IntToStr(filepos(f) div 2048), mtFATALERROR);
        BytesLeft := p.FileSize;
        repeat
          if ChunkSize > BytesLeft then
          begin
            BytesToRead := BytesLeft;
            Fillchar(buf[BytesToRead], ChunkSize-BytesLeft, 0);
          end
          else
            BytesToRead := ChunkSize;
          BlockRead(src, Buf, BytesToRead, NumRead);
          BytesLeft := BytesLeft - BytesToRead;
          BlockWrite(F, Buf, Sectors(BytesToRead)*2048, NumWritten);
        until (NumRead = 0) or (Sectors(BytesToRead)*2048 <> NumRead) or (BytesLeft = 0);
        CloseFile(src);
      end;
    end;
  end;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function FileAndDirDescriptorWidth_r(d: PDirEntry): Integer;
var
  l, W, bytes: Integer;
  p: PFileEntry;
  fn: String;
begin
  p := d.Files;
  if (d.Files = nil) or (p.ShortName <> '.') then
  begin
    w := 68+ELen+ELen;
    bytes := DefaultSectorSize-w;
  end
  else
  begin
    bytes := DefaultSectorSize;
    w := 0;
  end;
  while p <> nil do
  begin
    if (p.Attr and faDirectory <> faDirectory) then
      fn := p.ShortName+fSuf
    else
      fn := p.ShortName;
    l := Length(fn);
    if (fn = '.') or (fn = '..') then
      l := 1
    else if l mod 2 = 0 then
      l := l + 1;
    l := l + 33+ELen;
    if bytes - l < 0 then
    begin
      w := w + bytes + l;
      bytes := DefaultSectorSize - l;
    end
    else
    begin
      bytes := bytes - l;
      w := w + l;
    end;
    p := p.Next;
  end;
  w := w + bytes;
  result := Sectors(w)*DefaultSectorSize;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TMCDBurner.FileAndDirDescriptorWidth: Integer;
var
  i: Integer;
  a, w, ww: Integer;
  d: PDirEntry;
begin
  ww := 0;
  a := 0;
  for i:=0 to DirCounter-1 do
  begin
    d := dirs[i];
    w := FileAndDirDescriptorWidth_r(d);
    ww := ww + w;
    d.Address := a;
    d.Size := w;
    a := a + w div DefaultSectorSize;
  end;
  result := ww;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
function SetExt(Buffer: PChar; Flag: Word; Ext: Boolean; Number: Byte): Boolean;
begin
  if (Flag and 2) = 2 then
    Buffer[5] := Chr(ELen+127)
  else
    if Ext then
      Buffer[5] := Chr(ELen+7)
    else
      Buffer[5] := Chr(ELen-1);
  Buffer[1] := #0;
  Buffer[2] := #0;
  Buffer[3] := #0;
  Buffer[4] := #0;
  Buffer[6] := Chr(ELen+71);
  Buffer[7] := Chr(ELen+74);
  Buffer[8] := Chr(ELen+51);
  Buffer[9] := Chr(Number);
  Buffer[10] := #0;
  Buffer[11] := #0;
  Buffer[12] := #0;
  Buffer[13] := #0;
  Buffer[14] := #0;
  if ((Flag and 2) = 2) or not Ext then
    Buffer[9] := #0;
  Result := True;
end;
{******************************************************************************}
{                                                                              }
{******************************************************************************}
procedure TMCDBurner.WriteFileAndDirDescriptor_r(d: PDirEntry; Start, FileStart: Integer);
var
  l, ll,  bytes: Integer;
  p: PFileEntry;
  fn: String;
  fd: TDirectoryDescriptor;
begin
  ll := 0;
  p := d.Files;
  fillchar(fd, sizeof(fd), 0);
  fd.FileUnitSize := 0;
  fd.InterleaveGap := 0;
  if (d.Files = nil) or (p.ShortName <> '.')  then
  begin
    fd.LenDr := 34+ELen;
    fd.FileName[0] := #0;
    fd.LenOfFileIdentifier := 1;
    fd.FileFlag := 2;
    fd.Address := d.Address+Start;
    fd.AddressBE := L2MDW(d.Address+Start);
    fd.DataLength := d.Size;
    fd.DataLengthBE := L2MDW(d.Size);
    fd.VolSeqnumber := 1;
    fd.VolSeqnumberBE := 256;
    SetDateTime(Now, fd);
    if ELen <> 0 then
      SetExt(@fd.FileName[0], fd.FileFlag, False, 0);
    ISOHeader.write(fd, 34+ELen);

    fd.FileName[0] := #1;
    fd.Address := d.Parent.Address+Start;
    fd.AddressBE := L2MDW(d.Parent.Address+Start);
    fd.DataLength := d.Parent.Size;
    fd.DataLengthBE := L2MDW(d.Parent.Size);
    if ELen <> 0 then
      SetExt(@fd.FileName[0], fd.FileFlag, False, 0);
    ISOHeader.Write(fd, 34+ELen);
    bytes := DefaultSectorSize-(68+ELen+ELen);
  end
  else
  begin
    bytes := DefaultSectorSize;
  end;
  while p <> nil do
  begin
    if p.Imported then
    fillchar(fd, sizeof(fd), 0);
    if (p.Attr and faDirectory <> faDirectory) then
    begin
      fn := p.ShortName+fSuf;
      fd.FileFlag := 0;
      if not p.Imported then
      begin
        fd.Address := p.Address+FileStart;
        fd.AddressBE := L2MDW(p.Address+FileStart);
      end
      else
      begin
        fd.Address := p.Address;
        fd.AddressBE := L2MDW(p.Address);
      end;
      fd.DataLength := p.FileSize;
      fd.DataLengthBE := L2MDW(p.FileSize);
    end
    else
    begin
      fd.FileFlag := 2;
      fn := p.ShortName;
      fd.Address := p.Address+Start;
      fd.AddressBE := L2MDW(p.Address+Start);
      fd.DataLength := p.FileSize;
      fd.DataLengthBE := L2MDW(p.FileSize);
    end;
    l := Length(fn);
    if fn = '.' then
    begin
      l := 1;
      fd.FileName[0] := #0;
      fd.LenOfFileIdentifier := l;
    end
    else if fn = '..' then
    begin
      l := 1;
      fd.FileName[0] := #1;
      fd.LenOfFileIdentifier := l;
    end
    else
    if l mod 2 = 0 then
    begin
      CopyToArray(fn, fd.FileName, L);
      fd.FileName[l] := #0;
      fd.LenOfFileIdentifier := l;
      l := l + 1;
      ll := 0;
    end