usaveparsed.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{Writes the parsed data to the file.
~param FileName name and path of the file to save to
~param List     the data to save }
procedure WriteDataToFile(const FileName: String; List: TFileList);
var       Stream         :TParsedDataStream;     //stream to write the data to
begin
 Stream := TParsedDataStream.Create(FileName, True); //create stream
 try
   Stream.FileList := List;                          //assign data to write
   Stream.WriteData;                                 //write them
 finally
  Stream.FileList := nil;                            //don't free data
  Stream.Free;                                       //free stream
 end;
end;

{Reads parsed data from the file
~param FileName name and path of the file to load
~param Errors   out: errors encountered while reading the data
~result the data loaded from the file }
function ReadDataFromFile(const FileName: String;
                          var Errors: TParsedDataReadErrors): TFileList;
var      Stream          :TParsedDataStream;     //stream to load the data from
begin
 Result := nil;
 try
   Stream := TParsedDataStream.Create(FileName, False); //create stream
   try
     Stream.FileList := TFileList.Create;               //create list for data
     Stream.ReadData;                                   //read data from stream
     Result := Stream.FileList;                         //return the data
     Stream.FileList := nil;                            //don't free the data
     Errors := Stream.ParsedDataReadErrors;             //return the errors
   finally
    Stream.Free;                                        //free the stream
   end;
 except                                                 //error while freeing
  Result.Free;                                          //stream? => free list
  raise;
 end;
end;














   { * * *  ***  * * *  ***   TParsedDataStream   ***  * * *  ***  * * *  }



{Creates the object and opens the file.
~param FileName the file to open/create
~param Write    if the file should be created/overwritten }
constructor TParsedDataStream.Create(const FileName: String; Write: Boolean);
var         OpenMode         :Word;             //modes to open the file
begin
 inherited Create;                              //create the object

 if Write then
  OpenMode := fmCreate
 else
  OpenMode := fmOpenRead or fmShareDenyWrite;
 FStream := TFileStream.Create(FileName, OpenMode); //open the file

 FNormalFileCount := -1;                        //no data so far
 FFileCount := -1;
// FFileList := nil;

 FIdentifierCount := -1;
 FIdents := TIdentifierList.Create;             //create list of identifiers
// FFree := nil;

 FClassCount := -1;
// FClasses := nil;
// FClassDataVersion := nil;
end;

{Frees the object and closes the file. }
destructor TParsedDataStream.Destroy;
var        i     :Integer;                    //counter through identifiers
           Free  :PBoolean;                   //runner through FFree
begin
 FStream.Free;                                //close the file

 FreeMem(FClassDataVersion);                  //free array of versions
 FreeMem(FClasses);                           //free array of classes

 if assigned(FIdents) then                    //identifiers collected?
  begin
   //list created and identifiers read?
   if assigned(FFree) and (FIdentifierCount <> -1) then
    begin
     Free := FFree;
     i := FIdents.Count;
     inc(Free, i - 1);
     for i := i - 1 downto 0 do                   //run through all identifiers
      begin
       if not Free^ then                            //if it shouldn't be freed
        FIdents.Remove(i, False);                     //remove it so it won't
       dec(Free);
      end;
    end
   else
    FIdents.RemoveAll(False);                     //don't free any identifier
   FIdents.Free;                                //free list of identifiers
  end;
 FreeMem(FFree);                              //free array of booleans

 FFileList.Free;                              //free all files and their data

 inherited Destroy;                           //free the object
end;









{Marks the identifier not to be freed anymore.
~param Ident the identifier to mark not to free }
procedure TParsedDataStream.OwnIdent(Ident: TIdentifier);
var       Free             :PBoolean;      //the entry to say not to free
begin
 Free := FFree;
 inc(Free, FIdents.FindIdentIndex(Ident)); //get entry of identifier
 if not Free^ then
  raise Exception.Create('Identifier is already owned, can''t be owned again!');
 Free^ := False;                           //do not free the identifier
end;






{Reads some bytes from the stream.
~param Buffer buffer to read the data into
~param Count  number of bytes to read
~result the number of bytes that could be read }
function TParsedDataStream.Read(var Buffer; Count: Longint): Longint;
begin
 Result := FStream.Read(Buffer, Count);
end;

{Writes some bytes to the stream.
~param Buffer buffer to write the data from
~param Count  number of bytes to write
~result the number of bytes that could be written }
function TParsedDataStream.Write(const Buffer; Count: Longint): Longint;
begin
 Result := FStream.Write(Buffer, Count);
end;

{Does not seek, but raises an exception; there is just no reason to seek.
~param Offset number of bytes not to seek
~param Origin position not to seek from
~result current position in the stream after seeking }
function TParsedDataStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
 raise Exception.Create('Stream of parsed data is not seekable!');
end;









{Gets the version of data of identifiers of that class.
~param IdentClass the class to return the version of its data
~param Version    the variable to return the version
~result if the class is known and the version has been returned }
function TParsedDataStream.GetClassDataVersion(IdentClass: TIdentifierClass;
                                     var Version: TIdentClassVersion): Boolean;
var      ClassPointer     :PIdentifierClass;     //runner through the list
         VersionPointer   :PIdentClassVersion;   //runner through the versions
begin
 ClassPointer := FClasses;
 Result := assigned(ClassPointer);
 if Result then                                  //versions available?
  begin
   VersionPointer := FClassDataVersion;
   //search class in list
   while assigned(ClassPointer^) and (ClassPointer^ <> IdentClass) do
    begin
     inc(VersionPointer);
     inc(ClassPointer);
    end;
   Result := assigned(ClassPointer^);              //class found?
   if Result then
    Version := VersionPointer^;                    //return version of class
  end;
end;




{Writes an integer value into the stream, it should be compressed.
~param Value the integer value to write }
procedure TParsedDataStream.WriteComprInt(Value: Integer);
var       Buffer           :packed array[0..4] of Byte;  //buffer to write
          len              :Integer;       //number of valid byte in the buffer
          Neg              :Boolean;       //if the value is negative
          Val              :Cardinal;      //the unsigned value to write
begin
 Neg := Value < 0;                 //value is negative?
 if Neg then                       //get absolute value to write
  Val := -Value
 else
  Val := Value;

 len := 1;                         //one byte valid so far
 Buffer[0] := Val and $3F;         //set lower 6 bits in the buffer
 if Neg then
  Buffer[0] := Buffer[0] or $80;     //set negative flag
 Val := Val shr 6;                 //6 bits
 if Val <> 0 then
  begin
   inc(len);
   Buffer[0] := Buffer[0] or $40;
   Buffer[1] := Val and $7F;
   Val := Val shr 7;                 //13 bits
   if Val <> 0 then
    begin
     inc(len);
     Buffer[1] := Buffer[1] or $80;
     Buffer[2] := Val and $7F;
     Val := Val shr 7;                 //20 bits
     if Val <> 0 then
      begin
       inc(len);
       Buffer[2] := Buffer[2] or $80;
       Buffer[3] := Val and $7F;
       Val := Val shr 7;                 //27 bits
       if Val <> 0 then
        begin
         inc(len);
         Buffer[3] := Buffer[3] or $80;
         Buffer[4] := Val and $1F;         //32 bits
        end;
      end;
    end;
  end;

 WriteBuffer(Buffer, len);         //write number
end;

{Writes a string value into the stream.
~param Value the string value to write }
procedure TParsedDataStream.WriteString(const Value: String);
begin
 WriteComprInt(length(Value));                 //write length of string
 if Value <> '' then
  WriteBuffer(Pointer(Value)^, length(Value)); //write content of string
end;

{Writes a string value into the stream, it should be compressed.
~param Value the string value to write }
procedure TParsedDataStream.WriteComprString(const Value: String);
var       Compressed       :TMemoryStream;      //the compressed string
          ComprStream      :TCompressionStream; //compressor of content
begin
 if Value <> '' then                            //string not empty?
  begin
   //create stream for the compressed string
   Compressed := TMemoryStream.Create;
   try
     //create compressor
     ComprStream := TCompressionStream.Create(clMax, Compressed);
     try
       //compress the string
       ComprStream.WriteBuffer(Pointer(Value)^, Length(Value));
     finally
      ComprStream.Free;                           //free compressor
     end;

     WriteComprInt(Compressed.Position);          //write length of compressed
     Compressed.Position := 0;                    //reset to beginning
     CopyFrom(Compressed, 0);                     //write the compressed string
   finally
    Compressed.Free;                              //free compressed string
   end;
  end
 else
  WriteComprInt(0);                               //string is empty
end;


{Writes a reference on an identifier into the stream.
~param Ident the identifier to write a reference of into the stream }
procedure TParsedDataStream.WriteIdent(Ident: TIdentifier);
var       Index            :Integer;          //the value to write
begin
 if assigned(Ident) then
  Index := FindObject(FIdentifierTree, Ident)   //get index of the identifier
 else
  Index := -1;                                  //use index of nil
 assert((Index <> -1) or not assigned(Ident));
 WriteComprInt(Index);                        //write index
end;


{Writes a reference on a file into the stream.
~param TheFile the file to write a reference of into the stream }
procedure TParsedDataStream.WriteFile(TheFile: TPascalFile);
var       Index            :Integer;          //the value to write
begin
 if assigned(TheFile) then                    //not nil?
  Index := FindObject(FFileTree, TheFile)       //search index of file
 else
  Index := -1;                                  //use index of nil
 assert((Index <> -1) or not assigned(TheFile));
 WriteComprInt(Index);                        //write index
end;





{Reads an integer value from the stream, it should be compressed.
~result the read integer value }
function TParsedDataStream.ReadComprInt: Integer;
var      Buffer           :Byte;         //buffer for one byte
         Neg              :Boolean;      //if number is negative
         Val              :Cardinal;     //read absolute value
begin
 ReadBuffer(Buffer, 1);
 Neg := Buffer and $80 <> 0;             //is negative?
 Val := Buffer and $3F;                  //6 bits
 if Buffer and $40 <> 0 then
  begin
   ReadBuffer(Buffer, 1);
   Val := Val or (Buffer and $7F) shl 6;   //13 bits
   if Buffer and $80 <> 0 then
    begin
     ReadBuffer(Buffer, 1);
     Val := Val or (Buffer and $7F) shl 13;   //20 bits
     if Buffer and $80 <> 0 then
      begin
       ReadBuffer(Buffer, 1);
       Val := Val or (Buffer and $7F) shl 20;   //27 bits
       if Buffer and $80 <> 0 then
        begin
         ReadBuffer(Buffer, 1);

         if (Buffer > $10) or ((Buffer = $10) and ((Val <> 0) or not Neg)) then
          raise Exception.Create('Invalid value for compressed integer!');

         Val := Val or Buffer shl 27;             //32 bits
        end;
      end;
    end;
  end;

 Result := Val;                          //return read value
 if Neg then                             //is negative?
  Result := -Result;                       //adjust sign
end;


{Reads a string value from the stream.
~result the read string value }
function TParsedDataStream.ReadString: String;
var      len              :Integer;         //length of the string
begin
 Result := '';
 len := ReadComprInt;                       //read length of string
 if len <> 0 then
  begin
   if len < 0 then
    raise Exception.CreateFmt('Invalid, negative length of string: %d', [len]);

   SetLength(Result, len);                    //set length of string
   ReadBuffer(Pointer(Result)^, len);         //read content of string


   //marker set to check for errors when reading the indices of arrays?
   if FCheckArrayIndices then
    //information of the array indices will be ignored, so it will be lost
    Include(FParsedDataReadErrors, pdreArrayIndicesLost);
  end;
end;


{Reads a string value from the stream, it should have been compressed.
~result the read string value }
function TParsedDataStream.ReadComprString: String;

 {Copies the Data from the Stream Source to Dest.
 ~param Source the stream with the data to copy
 ~param Dest   the stream to copy the data to }
 procedure CopyFrom(Source, Dest: TStream);
 const     MaxBufSize = $F000;
 var       Buffer              :^Byte;    //buffer to copy
           Count               :Integer;  //number of read and written bytes
 begin
  GetMem(Buffer, MaxBufSize);             //get the buffer
  try
    repeat
      Count := Source.Read(Buffer^, MaxBufSize); //read from stream
      Count := Dest.Write(Buffer^, Count);       //write read bytes
    until Count <> MaxBufSize;            //until everything read
  finally
   FreeMem(Buffer);                       //free the buffer
  end;
 end;

var      len              :Integer;              //length of the string