dvdimage.pas

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

{-----------------------------------------------------------------------------
 Unit Name: DVDImage
 Author:    Paul Fisher / Andrew Semack
 Purpose:  Class for the creation of DVD Video Images
 History:  ISO9660 plus UDF Micro Bridge
-----------------------------------------------------------------------------}

unit DVDImage;

interface

uses
  CustomImage, Math, CovertFuncs, SysUtils, windows, ComCtrls, Classes,
    DeviceTypes,
  ISO9660MicroUDFClassTypes, ISO9660MicroUDFBootClass, ISO9660MicroUDFPrimaryVolClass,
    ISO9660MicroUDFSupplementVolClass,
  ISO9660MicroUDFstreamHandler, ISO9660MicroUDFImageTree,MicroUDFClassTypes,
  PopulateMicroUDFRecords,MicroUDFConsts;



const
  DVDAudioDir = 'AUDIO_TS';
  DVDVideoDir = 'VIDEO_TS';

type
  TDVDImage = class(TCustomImage)
  private
    FOnDVDStatus: TCDStatusEvent;
    FFileName: string;
    FVolID: string;
    procedure GetImageData(const ALength: Cardinal);
  protected
    FImage: TImageStreamHandler;
    FISOHeader: TISOHeader;
    FBRClass: TBootRecordVolumeDescriptor;
    FPVDClass: TPrimaryVolumeDescriptor;
    FSVDClass: TSupplementaryVolumeDescriptor;
    FVDSTClass: TVolumeDescriptorSetTerminator;

    // DVD VIDEO UDF Records
    FUDFBEA01 : UDF_BeginningExtendedAreaDesc;
    FUDFNSR02 : UDF_NSRDescriptor;
    FUDFTEA01 : UDF_TerminatingExtendedAreaDesc;
    FUDF_PVD  : UDF_PrimaryVolumeDescriptor;
    FUDF_IUVD : UDF_ImplementationUseVolumeDescriptor;
    FUDF_PD   : UDF_PartitionDescriptor;
    FUDF_LVD  : UDF_logicalVolDesc;
    FUDF_USD  : UDF_UnallocSpaceDesc;
    FUDF_TD   : UDF_TerminatingDesc;
    FUDF_AVDP : UDF_AnchorVolumeDescriptorPointer;
    FUDF_FSD  : UDF_FileSetDescriptor;
    FUDF_LVID : UDF_logicalVolumeIntegrityDesc;


    FTree: TImageTree;
    procedure SetVolID(VolName: string);
    procedure CreateVolumeDescriptors;
    Procedure CreateUDFDescriptors;
    procedure Log(const AFunction, AMessage: string);
    function ParseDirectory(const AUsePrimaryVD: Boolean = True): Boolean;
    function ParseDirectorySub(AParentDir: TDirectoryEntry; const AFileName:
      string; var ADirectoryEntry: PDirectoryRecord): Boolean;
    procedure WriteStructureTree(Primary: Boolean; ISOStream:
      TImageStreamHandler; ADirEntry: TDirectoryEntry);
    procedure WriteRootStructureTree(Primary: Boolean; ISOStream:
      TImageStreamHandler; ADirEntry: TDirectoryEntry);
    procedure WriteFileData(ISOStream: TImageStreamHandler; ADirEntry:
      TDirectoryEntry);
    procedure WritePathTableData(ISOStream: TImageStreamHandler; CurrentPointer:
      Integer);
    procedure WriteJolietPathTableData(ISOStream: TImageStreamHandler;
      CurrentPointer: Integer);

    // UDF File Structure, what a cock!
    procedure WriteUDFRootStructureTree(ISOStream: TImageStreamHandler; ADirEntry: TDirectoryEntry);
  public
    constructor Create;
    destructor Destroy; override;
    function SaveDVDImageToDisk: Boolean;
    function ParsePathTable(ATreeView: TTreeView = nil): Boolean;
    function ExtractFile(const AFileEntry: TFileEntry; const AFileName: string):
      Boolean;
    function CloseImage: Boolean;
  published
    property OnDVDStatus: TCDStatusEvent read FOnDVDStatus write FOnDVDStatus;
    property Filename: string read FFileName write FFileName;
    property Structure: TImageTree read FTree;
    property Volume_ID: string read FVolID write SetVolID;
    property BootRecordVolumeDescriptor: TBootRecordVolumeDescriptor read
      FBRClass write FBRClass;
    property PrimaryVolumeDescriptor: TPrimaryVolumeDescriptor read FPVDClass
      write FPVDClass;
    property SupplementaryVolumeDescriptor: TSupplementaryVolumeDescriptor read
      FSVDClass write FSVDClass;
  end;

implementation

constructor TDVDImage.Create;
begin
  inherited Create;
  FFileName := '';
  FImage := nil;
  FPVDClass := nil;
  FSVDClass := nil;
  FBRClass := nil;
  ImageType := IT9660Image;
  FTree := TImageTree.Create;
  CreateVolumeDescriptors; // does this need to be moved ??
end;

destructor TDVDImage.Destroy;
begin
  if (Assigned(FTree)) then
    FreeAndNil(FTree);
  if (Assigned(FImage)) then
    FreeAndNil(FImage);
  if (Assigned(FPVDClass)) then
    FreeAndNil(FPVDClass);
  if (Assigned(FSVDClass)) then
    FreeAndNil(FSVDClass);
  if (Assigned(FBRClass)) then
    FreeAndNil(FBRClass);
  inherited;
end;

function TDVDImage.CloseImage: Boolean;
begin
  FFileName := '';
  if Assigned(FImage) then
    FreeAndNil(FImage);
  if Assigned(FPVDClass) then
    FreeAndNil(FPVDClass);
  if Assigned(FSVDClass) then
    FreeAndNil(FSVDClass);
  if Assigned(FBRClass) then
    FreeAndNil(FBRClass);
  if Assigned(FTree) then
    FreeAndNil(FTree);
  Result := True;
end;

procedure TDVDImage.SetVolID(VolName: string);

begin
  FVolID := VolName;
  if (Assigned(fPVDClass)) then
      fPVDClass.VolumeIdentifier := VolName;
  if (Assigned(fSVDClass)) then
      fSVDClass.VolumeIdentifier := VolName;
end;

procedure TDVDImage.GetImageData(const ALength: Cardinal);
var
  OrgPtr,
    Buffer: PByte;
  Row: Cardinal;
  Col: Word;
  CharStr,
    DumpStr: string;
begin
  GetMem(Buffer, ALength);
  OrgPtr := Buffer;
  try
    FImage.Stream.ReadBuffer(Buffer^, ALength);

    for Row := 0 to ((ALength - 1) div 16) do
    begin
      DumpStr := IntToHex(Cardinal(fImage.Stream.Position) - ALength + Row * 16,
        8) + 'h | ';
      CharStr := '';
      for Col := 0 to Min(16, ALength - (Row + 1) * 16) do
      begin
        DumpStr := DumpStr + IntToHex(Buffer^, 2) + ' ';
        if (Buffer^ > 32) then
          CharStr := CharStr + Chr(Buffer^)
        else
          CharStr := CharStr + ' ';
        Inc(Buffer);
      end;
      DumpStr := DumpStr + StringOfChar(' ', 61 - Length(DumpStr)) + '| ' +
        CharStr;
      Log('Dump', DumpStr);
    end;
  finally
    FreeMem(OrgPtr, ALength);
  end;
end;

function TDVDImage.ExtractFile(const AFileEntry: TFileEntry; const AFileName:
  string): Boolean;
var
  lFStream: TFileStream;
  lFSize: Int64;
  lBuffer: Pointer;
begin
  Result := False;

  if Assigned(AFileEntry) then
  begin
    fImage.SeekSector(AFileEntry.ISOData.LocationOfExtent.LittleEndian);
    lFStream := TFileStream.Create(AFileName, fmCreate);
    lFSize := AFileEntry.ISOData.DataLength.LittleEndian;
    GetMem(lBuffer, fImage.SectorDataSize);
    try
      while (lFSize > 0) do
      begin
        fImage.ReadSector_Data(lBuffer^, fImage.SectorDataSize);
        lFStream.WriteBuffer(lBuffer^, Min(lFSize, fImage.SectorDataSize));
        Dec(lFSize, fImage.SectorDataSize);
      end;
      Result := True;
    finally
      lFStream.Free;
      FreeMem(lBuffer, fImage.SectorDataSize);
    end;
  end;
end;


procedure TDVDImage.Log(const AFunction, AMessage: string);
begin
  if Assigned(OnDVDStatus) then
    OnDVDStatus(AFunction + ' : ' + AMessage);
end;



Procedure TDVDImage.CreateUDFDescriptors;
begin
  //DVD Video records
  FillChar(FUDFBEA01, SizeOf(FUDFBEA01), Char(0));
  FUDFBEA01.StandardIdentifier := VSD_STD_ID_BEA01; //BEA01
  FUDFBEA01.StructureVersion := $01;

  FillChar(FUDFNSR02, SizeOf(FUDFNSR02), Char(0));
  FUDFNSR02.StandardIdentifier := VSD_STD_ID_NSR02; //NSR02
  FUDFNSR02.StructureVersion := $01;

  FillChar(FUDFTEA01, SizeOf(FUDFTEA01), Char(0));
  FUDFTEA01.StandardIdentifier := VSD_STD_ID_TEA01; //TEA01
  FUDFTEA01.StructureVersion := $01;

end;



procedure TDVDImage.CreateVolumeDescriptors;
begin
  Log('CreateImage', 'ISO Header Created'); // ISO Header 32k of 0
  FillChar(FISOHeader, SizeOf(FISOHeader), Char(0));

  Log('CreateImage', 'Boot Record Volume Descriptor Created'); // Boot Record VD
  if (Assigned(fBRClass)) then
    fBRClass.Free;
  FBRClass := TBootRecordVolumeDescriptor.Create;

  Log('CreateImage', 'Primary Volume Descriptor Created');
    // Primary Volume Descriptor
  if (Assigned(fPVDClass)) then
    fPVDClass.Free;
  FPVDClass := TPrimaryVolumeDescriptor.Create;

  Log('CreateImage', 'Supplementary Volume Descriptor Created');
    // Supplementary Volume Descriptor
  if (Assigned(FSVDClass)) then
    FSVDClass.Free;
  FSVDClass := TSupplementaryVolumeDescriptor.Create;

  Log('CreateImage', 'Volume Descriptor Set Terminator Created');
    // Volume Descriptor Set Terminator
  FillChar(FVDSTClass, SizeOf(FVDSTClass), Char(0));

  FVDSTClass.VolumeDescriptorType := vdtVDST;
  FVDSTClass.StandardIdentifier := ISO_STANDARD_ID;
  FVDSTClass.VolumeDescriptorVersion := 1;
  CreateUDFDescriptors;
end;


procedure TDVDImage.WriteRootStructureTree(Primary: Boolean; ISOStream:
  TImageStreamHandler; ADirEntry: TDirectoryEntry);
var
  DirIndex, FileIndex, Padd: Integer;
  Dir: TDirectoryEntry;
  RootDir: TRootDirectoryrecord;
  Fil: TFileEntry;
  TempPchar: PChar;
  TempPWideChr: PWideChar;
  PadByte, FileID: Byte;
  FillBlock: array[0..2047] of Byte;
  WideArray: array[0..127] of byte;
  CurrentLBA, StreamPos, PadIndex: Integer;
  DIRRecSize: Integer;
  Sector: Integer;

begin
  PadByte := $00;
  FillChar(FillBlock, 2048, 0);
  Log('Write Root Structure', 'Name : ' + ADirEntry.Name);
  // fill in "." and ".." directory sections (i previosly missed)

  RootDir := ADirEntry.RootISOData;
  RootDir.LengthOfDirectoryRecord := $22;
  RootDir.LengthOfFileIdentifier := 1;
  RootDir.FileFlags := $02;
  RootDir.VolumeSequenceNumber := BuildBothEndianWord(1);
  RootDir.LocationOfExtent := ADirEntry.RootISOData.LocationOfExtent;
  FileID := 0;
  ISOStream.Stream.Write(RootDir, sizeof(TDirectoryrecord));
  ISOStream.Stream.Write(FileID, sizeof(FileID)); // write file identifier

  RootDir := ADirEntry.RootISOData;
  RootDir.LengthOfDirectoryRecord := $22;
  RootDir.LengthOfFileIdentifier := 1;
  RootDir.FileFlags := $02;
  RootDir.VolumeSequenceNumber := BuildBothEndianWord(1);
  RootDir.LocationOfExtent := ADirEntry.RootISOData.LocationOfExtent;
  FileID := 1;
  ISOStream.Stream.Write(RootDir, sizeof(TDirectoryrecord));
  ISOStream.Stream.Write(FileID, sizeof(FileID)); // write file identifier
  // done with "." ".."

  for DirIndex := 0 to ADirEntry.DirectoryCount - 1 do // write directories
  begin
    Dir := ADirEntry.Directories[DirIndex];
    Dir.FillISOData(Primary);
    ISOStream.Stream.Write(Dir.ISOData, sizeof(TDirectoryrecord));
    if Primary = True then
    begin
      TempPchar := pchar(Dir.Name);
      ISOStream.Stream.Write(TempPchar^, Dir.ISOData.LengthOfFileIdentifier);
    end
    else
    begin
      TempPWideChr := Dir.GetWideDirName;
      FillChar(WideArray, 128, 0);
      CopyMemory(@WideArray[1], @TempPWideChr[0],
        (Dir.ISOData.LengthOfFileIdentifier) - 1); //makes it big endian wide char
      ISOStream.Stream.Write(WideArray, Dir.ISOData.LengthOfFileIdentifier);
    end;

    DIRRecSize := sizeof(TDirectoryrecord) + Dir.ISOData.LengthOfFileIdentifier;
      // get padding size
    if (DIRRecSize mod 2) > 0 then
      FImage.Stream.Write(PadByte, 1);
  end;

  for FileIndex := 0 to ADirEntry.FileCount - 1 do // write files
  begin
    Fil := ADirEntry.Files[FileIndex];
    Fil.FillISOData(Primary);
    ISOStream.Stream.Write(Fil.ISOData, sizeof(TDirectoryrecord));
    if Primary = True then
    begin
      TempPchar := pchar(Fil.Name);
      ISOStream.Stream.Write(TempPchar^, Fil.ISOData.LengthOfFileIdentifier);
    end
    else
    begin
      TempPWideChr := Fil.GetWideFileName;
      FillChar(WideArray, 128, 0);
      CopyMemory(@WideArray[1], @TempPWideChr[0],
        (Fil.ISOData.LengthOfFileIdentifier) - 1); //makes it big endian wide char
      ISOStream.Stream.Write(WideArray, Fil.ISOData.LengthOfFileIdentifier);
    end;

    DIRRecSize := sizeof(TDirectoryrecord) + Fil.ISOData.LengthOfFileIdentifier;
      // get padding size
    if (DIRRecSize mod 2) > 0 then
      FImage.Stream.Write(PadByte, 1);
  end;

  //pad the remainder of the block
  Padd := 2048 - (ISOstream.Stream.Position mod 2048);
  if Padd < 2048 then
    ISOStream.Stream.Write(FillBlock, Padd);