general.pas

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

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2004-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}

unit General;

{Contains some simple, general functions and two classes. }

interface

uses Classes,
{$IFNDEF LINUX}
     Windows, Graphics
{$ENDIF}
{$IFDEF LINUX}
     Types, QForms, QGraphics
{$ENDIF}
     ;


{$UNDEF CHECK_SearchString}      //check the assembler function SearchString?

{$IFOPT C-}
 {$UNDEF CHECK_SearchString}     //only with assertions!
{$ENDIF}


      //the characters to end a line/to start a new line/to delimit/separate
      //lines; should be handled as a string
const LineDelimiter{: String} =
{$IFDEF VER120}
                                #13#10;
//                                ''^M''#10'';
{$ELSE}
 {$IFDEF VER130}
                                #13#10;
 {$ELSE}
                                System.sLineBreak;
 {$ENDIF}
{$ENDIF}





//Searches a string in another like pos but with a start index.
function SearchString(const SubStr, Text: String;
                      StartIndex: Integer = 1): Integer;


//Searches a string in another and returns it last occurrence.
function LastPos(const SubStr, Text: String): Integer;

//Checks whether the text starts with the string, case is ignored.
function StartsTextWith(const Start, Text: String): Boolean;

//Searches a byte in a memory block and returns its offset or -1.
function MemoryScan(Value: Byte; Memory: Pointer; Size: Integer): Integer;

//Swaps the bytes in an integer value from "network order".
function BigEndianToLittleEndian(const Value: Integer): Integer;



//Deletes all whitespaces out of the string.
function DeleteAllWhiteSpaces(const Text: String): String;
//Uniques all whitespaces to a single space ' '.
function UniqueWhiteSpacesToSpace(const Text: String): String;






{$IFDEF VER120}

//Returns the value of an environment variable.
function GetEnvironmentVariable(const Name: String): String;

{$ENDIF}


//Copies the content of a file to another one.
procedure CopyFile(const Source, Dest: String);






//Loads a graphic and returns it as a bitmap.
function TransformFileToBitmap(const FileName: String): TBitmap;

//Extracts the dimensions of a PNG image from its data stream.
function ExtractPNGImageSize(Stream: TStream): TPoint;
//Extracts the dimensions of a JPEG image from its data stream.
function ExtractJPEGImageSize(Stream: TStream): TPoint;


{$IFNDEF NOPNGSUPPORT}

//Converts a bitmap file to a PNG image file.
procedure ConvertBMPToPNG(BMP: TBitmap; const BMPName, PNGName: String);

{$ENDIF}

{$IFNDEF NOJPEGSUPPORT}

//Converts a bitmap file to a JPEG image file.
procedure ConvertBMPToJPEG(BMP: TBitmap; const BMPName, JPEGName: String);

{$ENDIF}



{$IFDEF VER120}

//Frees the object and clears its reference.
procedure FreeAndNil(var AnObject: TObject);

{$ENDIF}



//Returns the number in its roman representation.
function IntToRoman(Value :Integer): String;

//Returns a list of files with the specified extension in that directory,
//including subdirectories if demanded.
function FindFilesByExtension(const Extension: String; Path: String;
                              List: TStrings; Recurse: Boolean): Cardinal;



//Fills the list with all command line parameters of the program.
procedure GetCommandLineParameters(AddTo: TStrings);








type


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



  {Implements a write-only stream, that writes its data buffered to another
   stream. }
  TBufferStream = class(TStream)
  private
    //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;

    //Changes the size of the used buffer, may flush the stream.
    procedure SetBufferSize(Value: LongInt);
  public
    //Creates the buffered stream and saves the stream to write buffered to.
    constructor Create(Stream: TStream);
    //Creates a new file and links it to the newly created buffered stream.
    constructor CreateFile(const FileName: String);
    //Flushes the buffer before freeing the stream.
    destructor Destroy; override;

    //Reads data from the stream.
    function Read(var Buffer; Count: Longint): Longint; override;
    //Writes data into the stream.
    function Write(const Buffer; Count: Longint): Longint; override;
    //Changes the current position in the stream.
    function Seek(Offset: Longint; Origin: Word): Longint; override;

    //Flushes the buffer of the stream.
    procedure Flush;


    //Writes the string into the stream.
    procedure WriteString(const Data: String);
    //Writes the strings into the stream.
    procedure WriteStrings(const Data: array of String);
    //Writes the character into the stream.
    procedure WriteCharacter(Data: Char);
    //Writes the arguments formatted into the stream.
    procedure WriteFormatted(const Fmt: String; const Args: array of const);


    property OutputStream: TStream read FStream;
    property OwnedStream: Boolean read FOwnedStream write FOwnedStream;
    property BufferSize: LongInt read FBufferSize write SetBufferSize;
  end;




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


  {A simple map of strings to strings. }
  TStringMap = class
  private
    //the strings as keys mapping to other strings
    FKeys: TStringList;
    //the value strings
    FValues: TStringList;

    //Returns the string of the key or ''.
    function Get(const Key: String): String;
    //Puts the value string of the key.
    procedure Put(const Key: String; const Value: String);
  public
    //Creates the string map.
    constructor Create;
    //Frees the string map.
    destructor Destroy; override;

    //Checkes whether a value for the key is available.
    function Available(const Key: String): Boolean;
    //Removes the value for the key.
    function Remove(const Key: String): Boolean;

    //Removes all values.
    procedure Clear;

    //Used to access the map.
    property Strings[const Key: String]: String read Get write Put; default;
  end;



implementation

uses SysUtils,

{$IFDEF LINUX}
     QControls,

 {$IFNDEF NOPNGSUPPORT}
     Qt,
 {$ELSE}
  {$IFNDEF NOJPEGUPPORT}
     Qt,
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

{$IFNDEF NOPNGSUPPORT}
 {$IFNDEF LINUX}
     pngimage,
 {$ENDIF}
{$ENDIF}

{$IFNDEF NOJPEGSUPPORT}
 {$IFNDEF LINUX}
     jpeg,
 {$ENDIF}
{$ENDIF}

     UFilePaths;



type     StrRec = record                   //copied from unit System
                    allocSiz  :LongInt;    //copied from unit System
                    refCnt    :LongInt;    //copied from unit System
                    length    :LongInt;    //copied from unit System
                  end;
const    skew = sizeof(StrRec);            //copied from unit System



{Searches a string in another like pos but with a start index.~[br]
 This function is an altered copy of the function pos in the unit System, so it
 is mostly copyrighted by Borland. It has the same functionality as PosEx as
 defined in Delphi 7+ in unit StrUtils, but is optimized as it is written in
 assembler.
~param SubStr     the string to search in Str
~param Text       the text to scan for SubStr
~param StartIndex the index to start the search, if <= 1: like System.pos()
~result the index of SubStr in Text >= StartIndex, or 0 if not found }
function SearchString(const SubStr, Text: String;
                      StartIndex: Integer = 1): Integer;
asm
{     ->EAX     Pointer to SubStr               }
{       EDX     Pointer to Text                 }
{       ECX     StartIndex                      }
{     <-EAX     Position of SubStr in Text or 0 }

        TEST    EAX,EAX
        JE      @@noWork

        TEST    EDX,EDX
        JE      @@stringEmpty

        DEC     ECX                             { change to relative offset     }
        JGE     @@positive                      { was 0 or negative             }
        XOR     ECX,ECX                         { than assume it was 1          }

@@positive:
        CMP     ECX,[EDX-skew].StrRec.length
        JG      @@stringEmpty


        PUSH    EBX
        PUSH    ESI
        PUSH    EDI


        MOV     EDI,EDX                         { point EDI to Text             }
        PUSH    EDI                             { remember Text position to calculate index     }

        MOV     ESI,EDI                         { move Text temporarily to ESI  }
        ADD     EDI,ECX                         { go to StartIndex in Text      }

        NEG     ECX
        ADD     ECX,[ESI-skew].StrRec.length    { ECX = Length(Text) - StartIndex       }



        MOV     ESI,EAX                         { point ESI to SubStr           }

        MOV     EDX,[ESI-skew].StrRec.length    { EDX = Length(SubStr)          }

        DEC     EDX                             { EDX = Length(SubStr) - 1              }
        JS      @@fail                          { < 0 ? return 0                        }
        MOV     AL,[ESI]                        { AL = first char of SubStr             }
        INC     ESI                             { point ESI to 2'nd char of SubStr      }

        SUB     ECX,EDX                         { # of positions in Text to look at     }
                                                { = Length(Text) - Length(SubStr) + 1   }
        JLE     @@fail
@@loop:            
        REPNE   SCASB
        JNE     @@fail
        MOV     EBX,ECX                         { save outer loop counter               }
        PUSH    ESI                             { save outer loop SubStr pointer        }
        PUSH    EDI                             { save outer loop Text pointer          }

        MOV     ECX,EDX
        REPE    CMPSB
        POP     EDI                             { restore outer loop Text pointer       }
        POP     ESI                             { restore outer loop SubStr pointer     }