iso9660imagetree.pas

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

End;


Destructor TDirectoryEntry.Destroy;
Begin
  If ( Assigned(FFiles) ) Then FreeAndNil(FFiles);
  If ( Assigned(FDirectories) ) Then FreeAndNil(FDirectories);
  Inherited;
End;


Function TDirectoryEntry.GetDirCount: Integer;
Begin
  If ( Assigned(FDirectories) ) Then
    Result := FDirectories.Count
  Else
    Result := 0;
End;


Function TDirectoryEntry.GetDirEntry(Index: Integer): TDirectoryEntry;
Begin
  Result := FDirectories[Index] As TDirectoryEntry;
End;

Function TDirectoryEntry.GetFileCount: Integer;
Begin
  If ( Assigned(FFiles) ) Then
    Result := FFiles.Count
  Else
    Result := 0;
End;


Function TDirectoryEntry.GetFileEntry(Index: Integer): TFileEntry;
Begin
  Result := FFiles[Index] As TFileEntry;
End;


Procedure TDirectoryEntry.MoveDirTo(ANewDirectory: TDirectoryEntry);
Begin
  If ( Self = ANewDirectory ) Then
    LastError := ('can not move directory to itself');
  If ( fParent = ANewDirectory ) Then
  Begin
    Assert(False, 'senseless move of directory');
    Exit;
  End;
  FParent.DelDirectory(Self);
  FParent := ANewDirectory;
  ANewDirectory.AddDirectory(Self);
End;



{ TFileEntry }

Constructor TFileEntry.Create(ADirectoryEntry: TDirectoryEntry; Const ASource : TDataSourceFlag);
Begin
  Inherited Create;
  FSource     := ASource;
  FSourceFile := '';
  FDirectory  := ADirectoryEntry;
  FDirectory.AddFile(Self);
  FFlags      := efNone;
  FSourceBlockSize := GetCDFSSize(RetrieveFileSize(fSourceFile));
End;



Destructor TFileEntry.Destroy;
Begin
  Inherited;
End;



Function TFileEntry.GetCDFSSize(FileSize : Integer):Integer;
var
     ResLength : Integer;
begin
    ResLength := 1;
    if FileSize > 2048 then
    begin
      ResLength := FileSize div 2048;
      if FileSize mod 2048 > 0 then ResLength := ResLength + 1;
    end;
    result := ResLength;
end;



Procedure TFileEntry.CreateLBAStart( var StartBlock : integer);
begin
    FLBAStart := StartBlock;
    StartBlock := StartBlock + GetCDFSSize(RetrieveFileSize(fSourceFile));
end;


Function TFileEntry.GetWideFileName : PWideChar;
begin
   Result := FWideName;
end;


Procedure TFileEntry.FillISOData(Primary : Boolean);
var
        RecordSize : Integer;
        FileNameSize : Integer;
        Filename : String;
Begin
  If ( FSource <> dsfFromLocal ) Then
     LastError := ('Can not fill ISO structure, Not a local file entry');
  FName := ExtractFileName(FSourceFile);
  Filename := FName + ';1';
  FileNameSize := Length(Filename);
  FWideName := StrToUnicode(Filename);
  fName := GetISOFilename(fname);
if Primary = True then
  With FISOData Do
  Begin
    RecordSize                          := sizeof(FISOData) + Length(fName);
    if (RecordSize mod 2) >0 then inc(RecordSize);
    LengthOfDirectoryRecord             := RecordSize;
    DataLength.LittleEndian             := RetrieveFileSize(fSourceFile);
    DataLength.BigEndian                := SwapDWord(DataLength.LittleEndian);
    RecordingDateAndTime                := BuildDirectoryDateTime(NOW,0);
    VolumeSequenceNumber.LittleEndian   := 1;
    VolumeSequenceNumber.BigEndian      := SwapWord(VolumeSequenceNumber.LittleEndian);
    FileFlags                           := $00; //File
    LengthOfFileIdentifier              := Length(fName);
    FileUnitSize                        := 0;
    InterleaveGapSize                   := 0;
    LocationOfExtent.LittleEndian       := FLBAStart;
    LocationOfExtent.BigEndian          := SwapDWord(LocationOfExtent.LittleEndian);
  End
   else
  With FISOData Do
  Begin
    RecordSize                          := sizeof(FISOData) + (FileNameSize * 2);
    if (RecordSize mod 2) >0 then inc(RecordSize);
    LengthOfDirectoryRecord             := RecordSize;
    DataLength.LittleEndian             := RetrieveFileSize(fSourceFile);
    DataLength.BigEndian                := SwapDWord(DataLength.LittleEndian);
    RecordingDateAndTime                := BuildDirectoryDateTime(NOW,0);
    VolumeSequenceNumber.LittleEndian   := 1;
    VolumeSequenceNumber.BigEndian      := SwapWord(VolumeSequenceNumber.LittleEndian);
    FileFlags                           := $00; //File
    LengthOfFileIdentifier              := (FileNameSize * 2);
    FileUnitSize                        := 0;
    InterleaveGapSize                   := 0;
    LocationOfExtent.LittleEndian       := FLBAStart;
    LocationOfExtent.BigEndian          := SwapDWord(LocationOfExtent.LittleEndian);
  End;
End;




Function TFileEntry.GetFullPath: String;
Var
  ADir : TDirectoryEntry;
Begin
  ADir := fDirectory;
  Result := '';
  While ( Assigned(ADir) ) Do
  Begin
    Result := ADir.Name + '/' + Result;
    ADir   := ADir.Parent;
  End;
End;



Procedure TFileEntry.MoveTo(ANewDirectoryEntry: TDirectoryEntry);
Begin
  fDirectory.DelFile(Self);
  fDirectory := ANewDirectoryEntry;
  ANewDirectoryEntry.AddFile(Self);
End;


{ TImageTree }

Constructor TImageTree.Create;
Begin
  Inherited Create;
  FFileBlocks := 0;
  FLittleEndianPathTable := TList.create;
  FRootDir := TDirectoryEntry.Create(Self, Nil, dsfFromImage);
  FRootDir.FName := char(0);
End;


Destructor TImageTree.Destroy;
Begin
  ClearPathTables;
  If ( Assigned(FLittleEndianPathTable) ) Then FLittleEndianPathTable.Free;
  If ( Assigned(fRootDir) ) Then FreeAndNil(fRootDir);
  Inherited;
End;



Procedure TImageTree.ClearPathTables;
Var
   Index : Integer;
   PathRec : PPathTableRecord;
begin
   FFileBlocks := 0;
   if FLittleEndianPathTable.Count = 0 then exit;
//   for Index := 0 to (FLittleEndianPathTable.Count - 1) do   //changed to fix AV error 
   For Index := (FLittleEndianPathTable.Count - 1) downto 0 do
   begin
       PathRec := FLittleEndianPathTable.Items[Index];
     try
       if PathRec <> nil then
            Dispose(PathRec);
     except
     end;
      FLittleEndianPathTable.Delete(Index);
   end;
  FLittleEndianPathTable.Pack;
end;




Function TImageTree.GetPathTableLength : Integer;
var
     TableSize : Integer;
     Index,SubSize : Integer;
     PathRec : PPathTableRecord;
begin
   TableSize := 0;
   for Index := 0 to FLittleEndianPathTable.Count - 1 do
   begin
     PathRec := FLittleEndianPathTable.Items[Index];
     SubSize := PathRec^.LengthOfPathRecord;
     TableSize := TableSize + SubSize;
   end;
   Result := TableSize;
end;



Function TImageTree.GetJolietPathTableLength : Integer;
var
     TableSize : Integer;
     Index,SubSize : Integer;
     PathRec : PPathTableRecord;
begin
   TableSize := 0;
   for Index := 0 to FLittleEndianPathTable.Count - 1 do
   begin
     PathRec := FLittleEndianPathTable.Items[Index];
     SubSize := PathRec^.LengthOfPathRecordM;
     TableSize := TableSize + SubSize;
   end;
   Result := TableSize;
end;




Procedure TImageTree.RecurseFiles(CurrentDir : TDirectoryEntry);
var
     Index : Integer;
begin
    for Index := 0 to CurrentDir.FileCount -1 do
    begin
       CurrentDir.GetFileEntry(Index).CreateLBAStart(FileLBA);
       FFileBlocks := FFileBlocks + CurrentDir.GetFileEntry(Index).BlockSize;
    end;
end;




procedure TImageTree.SortDirectories;
var
   NoExchanges : boolean;
   Index : Integer;
   PathRec1,PathRec2 : PPathTableRecord;
begin
	Repeat
		NoExchanges := true;
		For Index := 0 to FLittleEndianPathTable.Count -2 do
		begin
                     PathRec1 := FLittleEndianPathTable.Items[index];
                     PathRec2 := FLittleEndianPathTable.Items[index+1];
			if (PathRec1^.ParentDirectoryNumber > PathRec2^.ParentDirectoryNumber) then
			begin //we have to switch.
                            NoExchanges := False; //We have to tell the sort we aren't done.
                            FLittleEndianPathTable.Exchange(Index,Index+1);
			end;
		end;
	Until NoExchanges;
end;






Procedure TImageTree.AddDirectory(CurrentDir : TDirectoryEntry ; Parent : Integer);
var
     PathRecL,PathRecM : PPathTableRecord;
     Temp : String;
     wTemp : WideString;
     WideChr : PWideChar;
     Size : Integer;
begin
   CurrentDir.CreateLBAStart(False,CurrentLBA);
   RecurseFiles(CurrentDir);
   // do little endian list first
   New(PathRecL);
   FillChar(PathRecL^,sizeof(PathRecL^),$00);
   PathRecL^.ParentDirectoryNumber := Parent;
   PathRecL^.LengthOfDirectoryIdentifier := Length(CurrentDir.Name);
   if (PathRecL^.LengthOfDirectoryIdentifier mod 2) > 0 then inc(PathRecL^.LengthOfDirectoryIdentifier);
   StrPCopy(PathRecL^.DirectoryIdentifier,Copy(CurrentDir.Name, 1, Length(CurrentDir.Name)));
   PathRecL^.LocationOfExtent := CurrentDir.StartLBA;
   PathRecL^.LengthOfPathRecord := (8 + PathRecL^.LengthOfDirectoryIdentifier);


   //do big endian list
   Temp := CurrentDir.Name;
   Size := (length(temp)+1)*2;
   WideChr:= PWideChar(StrAlloc(Size));//important
   StringToWideChar(temp,WideChr,Size + 1);
   FillChar(PathRecL^.DirectoryIdentifierM,128,0);
   CopyMemory(@PathRecL^.DirectoryIdentifierM[1],@WideChr[0],(length(Temp)*2)-1);//makes it big endian wide char

   if Length(CurrentDir.Name) = 1 then
        PathRecL^.LengthOfDirectoryIdentifierM := 1
         else
             PathRecL^.LengthOfDirectoryIdentifierM := Length(CurrentDir.Name)*2;

   if (PathRecL^.LengthOfDirectoryIdentifierM mod 2) > 0 then inc(PathRecL^.LengthOfDirectoryIdentifierM);
   PathRecL^.LocationOfExtentM := SwapDWord(CurrentDir.StartLBA);
   PathRecL^.LengthOfPathRecordM := (8 + PathRecL^.LengthOfDirectoryIdentifierM);
 // add to list
   FLittleEndianPathTable.Add(PathRecL);
end;








Procedure TImageTree.ScanAllDirectories(CurrentDir : TDirectoryEntry ; Parent : Integer);
var
     Index : Integer;
begin
   For Index := 0 to CurrentDir.GetDirCount -1 do
   begin
       AddDirectory(CurrentDir.GetDirEntry(Index),Parent);   // add to list under parent
       if CurrentDir.GetDirEntry(Index).GetDirCount > 0 then
          ScanAllDirectories(CurrentDir.GetDirEntry(Index),Parent +1);
   end; 
end;





Procedure TImageTree.RefreshPathTables(StartLBA, FileBlock : Integer);
var
     PathRec : PPathTableRecord;
begin
   if not Assigned(fRootDir) then Exit;
   ClearPathTables;           // Clear all remaining path tables
   CurrentLBA := StartLBA;          // setup start Logical Block Address
   FDirectoryStartLBA := StartLBA;
   FileLBA := FileBlock;
   FFileStartBlock := FileLBA;
   AddDirectory(FRootDir,1);   // Start With Root Directory
   ScanAllDirectories(FRootDir,1);
   FPathTableStopSector := CurrentLBA;
   FJolietOffsett := CurrentLBA;
end;




Function TImageTree.GetTableCount : Integer;
begin
    Result := FLittleEndianPathTable.Count;
end;


Function TImageTree.GetLastError : String;
begin
    Result := LastError;
end;



end.