general.pas

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

  Result := p^ <> #0;             //not skipped til end of the command line?
  if Result then                  //parameter available?
   begin
    SetLength(S, MaxLen);           //set maximum possible buffer
    i := 1;                         //fill from the beginning

    InQuotedStr := False;           //not in quotes currently
    //handle all characters until a white space outside quotes or end reached
    while (InQuotedStr or (p^ > ' ')) and (p^ <> #0) do
     case p^ of                       //special character?
       '\':     begin                   //a back slash may be special before "
                 BackSlashes := 1;      //one found
                 Inc(p);
                 while p^ = '\' do      //count the back slashes
                  begin
                   Inc(BackSlashes);
                   Inc(p);
                  end;
                 iSlash := BackSlashes;
                 if p^ = '"' then       //was before a "?
                  iSlash := iSlash div 2; //they were quoted, two \\ are one \
                 for iSlash := 1 to iSlash do //insert all the (quoted) \
                  begin
                   S[i] := '\';
                   Inc(i);
                  end;
                 if Odd(BackSlashes) and (p^ = '"') then //and a quoted \" ?
                  begin
                   S[i] := '"';                            //just write the "
                   Inc(i);
                   Inc(p);                                 //and skip it
                  end;
                end;
       '"':     begin                   //quote character found?
                 InQuotedStr := not InQuotedStr;   //toggle quoting state
                 Inc(p);                           //just skip it
                end;
     else
      S[i] := p^;                       //simply copy the character
      Inc(i);
      Inc(p);                           //and continue to the next
     end;
    Parameter := Copy(S, 1, i - 1);   //return the parameter
   end //if Result
  else
   Parameter := '';                   //no parameter available
  CmdLine := p;                       //return position after the parameter
 end;

var      CmdLine       :PChar;    //the command line of the program
         EndOfLine     :PChar;    //the position of the end of the line
         Parameter     :String;   //each parameter
begin
 CmdLine := GetCommandLine;       //get the whole command line
 if assigned(CmdLine) then        //this should always work
  begin
   EndOfLine := StrEnd(CmdLine);    //get its end, for maximal parameter length
   //skip the name of the executable
   if NextParameter(CmdLine, EndOfLine - CmdLine, Parameter) then
    //get each parameter
    while NextParameter(CmdLine, EndOfLine - CmdLine, Parameter) do
     AddTo.Append(Parameter);         //and add it
  end;
end;


{$ELSE}

{Fills the list with all command line parameters of the program.
~param AddTo the list to fill with the command line parameters }
procedure GetCommandLineParameters(AddTo: TStrings);
var       i            :Integer;            //counter through all parameters
begin
 for i := 1 to ParamCount do                //add each parameter
  AddTo.Append(ParamStr(i));
end;

{$ENDIF}









   { * * *  ***  * * *  ***   TBufferStream   ***  * * *  ***  * * *  }

{
    //the stream to write buffered to
    FStream: TStream;
    //whether the destination stream should also be freed, when this stream is
    //freed
    FOwnedStream: Boolean;

    //the buffer, nil if none has been allocated, i.e. no buffering
    FBuffer: Pointer;
    //the size of the used buffer, changing it may flush the stream
    FBufferSize: LongInt;
    //current position in the buffer, the next byte to be filled
    FBufferPosition: LongInt;
}

{Creates the buffered stream and saves the stream to write buffered to.
~param Stream the stream to write the written data to }
constructor TBufferStream.Create(Stream: TStream);
begin
 inherited Create;                   //create the stream

 BufferSize := 4096;                 //create a big buffer

 FStream := Stream;                  //save the parameters
end;

{Creates a new file and links it to the newly created buffered stream.
~param FileName the name of the file to create }
constructor TBufferStream.CreateFile(const FileName: String);
var         FileStream   :TFileStream;                 //the stream of the file
begin
 FileStream := TFileStream.Create(FileName, fmCreate); //open the file
 try
   Create(FileStream);                                 //create the stream
   FOwnedStream := True;                              //automatically free file
 except
   FileStream.Free;
   raise;
 end;
end;



{Flushes the buffer before freeing the stream. }
destructor TBufferStream.Destroy;
begin
 try
   Flush;                             //flush the buffer
 finally
  if FOwnedStream then                //the stream is owned by this stream?
   FStream.Free;                        //free it, too

  FreeMem(FBuffer);                   //free the buffer

  inherited Destroy;                  //free the stream
 end;
end;

{Changes the size of the used buffer, may flush the stream.
~param Value the new size of the buffer }
procedure TBufferStream.SetBufferSize(Value: LongInt);
begin
 if Value < 0 then
  raise EStreamError.CreateFmt('Size of buffer for stream "%d" is invalid!',
                               [Value]);

 if Value <> FBufferSize then        //new size for the buffer?
  begin
   Flush;                              //empty the buffer
   ReallocMem(FBuffer, Value);         //create the buffer
   FBufferSize := Value;               //set its size
  end;
end;


{Reads data from the stream.
~param Buffer the buffer to save read data to
~param Count  the number of byte to be read
~result the number of read bytes, may be less than Count
~exception EReadError reading from a buffered stream is currently not
                      supported }
function TBufferStream.Read(var Buffer; Count: Longint): Longint;
begin
 raise EReadError.Create('Reading buffered stream not supported!');
end;

{Writes data into the stream.
~param Buffer the buffer whose content should be written
~param Count  the number of byte to be written
~result the number of written bytes, may be less than Count }
function TBufferStream.Write(const Buffer; Count: Longint): Longint;
var      BufPos       :PByte;                  //position inside the buffer
begin
 if Count > FBufferSize then                   //bigger than total buffer?
  begin
   Flush;                                        //write buffer
   Result := FStream.Write(Buffer, Count);       //and content directly
  end
 else
  begin
   if Count > FBufferSize - FBufferPosition then //does not fit in the buffer?
    Flush;                                         //write buffer
   if Count > FBufferSize div 2 then             //is relatively big?
    begin
     Flush;
     Result := FStream.Write(Buffer, Count)        //write content directly
    end
   else
    begin
     BufPos := FBuffer;
     Inc(BufPos, FBufferPosition);                 //search free part of buffer
     Move(Buffer, BufPos^, Count);                 //copy content
     Inc(FBufferPosition, Count);                  //set new position
     Result := Count;                              //all has been buffered
    end;
  end;
end;

{Changes the current position in the stream.
~param Offset the number of bytes to seek
~param Origin the origin to seek from
~result the new absolute position inside the stream
~exception EStreamError seeking in a buffered stream is currently not
                        supported }
function TBufferStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
 if (Origin = soFromCurrent) and (Offset = 0) then
  Result := FStream.Position + FBufferPosition
 else
  raise EStreamError.Create('Seeking a buffered stream is not supported!');
end;


{Flushes the buffer of the stream. }
procedure TBufferStream.Flush;
begin
 if FBufferPosition > 0 then                     //some data in the buffer?
  begin
   FStream.WriteBuffer(FBuffer^, FBufferPosition); //write it
   FBufferPosition := 0;                           //no data left
  end;
end;





{Writes the string into the stream.
~param Data the string to write }
procedure TBufferStream.WriteString(const Data: String);
begin
 if Data <> '' then                              //the string is not empty?
  WriteBuffer(Pointer(Data)^, Length(Data));       //write its content
end;

{Writes the strings into the stream.
~param Data the strings to write }
procedure TBufferStream.WriteStrings(const Data: array of String);
var       i            :Integer;                 //counter through all strings
begin
// Assert(Length(Data) > 1);
 for i := Low(Data) to High(Data) do             //for each string
  if Data[i] <> '' then                            //string is not empty?
   WriteBuffer(Pointer(Data[i])^, Length(Data[i]));  //write its content
end;

{Writes the character  into the stream.
~param Data the character to write }
procedure TBufferStream.WriteCharacter(Data: Char);
begin
 WriteBuffer(Data, 1);                       //write the character
end;

{Writes the arguments formatted into the stream.
~param Fmt  the format to format the argument with
~param Args the argument to be written  }
procedure TBufferStream.WriteFormatted(const Fmt: String;
                                       const Args: array of const);
begin
 WriteString(Format(Fmt, Args));            //write the formatted string
end;










   { * * *  ***  * * *  ***   TStringMap   ***  * * *  ***  * * *  }


{Creates the string map. }
constructor TStringMap.Create;
begin
 inherited Create;                //create the map

 FKeys := TStringList.Create;     //create the lists
 FKeys.Sorted := True;            //sort for faster access
 FValues := TStringList.Create;
end;

{Frees the string map. }
destructor TStringMap.Destroy;
begin
 FValues.Free;                    //free the lists
 FKeys.Free;

 inherited Destroy;               //free the map
end;


{Returns the string of the key or ''.
~param Key the kes whose value should be returned
~result the value of the key or '' if it is not in the map }
function TStringMap.Get(const Key: String): String;
var      Index     :Integer;
begin
 Index := FKeys.IndexOf(Key);     //get the index of the key
 if Index <> -1 then              //value for key set?
  Result := FValues[Index]          //return it
 else
  Result := '';                     //or else an empty string
end;

{Puts the value string of the key.
~param Key   the key whose value should be set
~param Value the new value for the key }
procedure TStringMap.Put(const Key: String; const Value: String);
var       Index     :Integer;
begin
 Index := FKeys.IndexOf(Key);     //get the index of the key
 if Index <> -1 then              //value for key set?
  FValues[Index] := Value           //set the new value
 else
  FValues.Insert(FKeys.Add(Key), Value);  //or add it new
end;


{Checkes whether a value for the key is available.
~param Key the key to check, if a value is set for it
~result whether a value for the key is available }
function TStringMap.Available(const Key: String): Boolean;
begin
 Result := FKeys.IndexOf(Key) <> -1;
end;

{Removes the value for the key.
~param Key the key whose value should be removed
~result if a value was previously available for the key }
function TStringMap.Remove(const Key: String): Boolean;
var      Index     :Integer;
begin
 Index := FKeys.IndexOf(Key);     //get the index of the key
 Result := Index <> -1;           //value for key set?
 if Result then
  begin
   FKeys.Delete(Index);             //delete the value and the key
   FValues.Delete(Index);
  end;
end;


{Removes all values. }
procedure TStringMap.Clear;
begin
 FKeys.Clear;
 FValues.Clear;
end;


end.