general.pas

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

        JE      @@found
        MOV     ECX,EBX                         { restore outer loop counter    }
        JMP     @@loop

@@fail:
        POP     EDX                             { get rid of saved Text pointer }
        XOR     EAX,EAX
        JMP     @@exit

@@stringEmpty:
        XOR     EAX,EAX
        JMP     @@noWork

@@found:
        POP     EDX                             { restore pointer to first char of Text }
        MOV     EAX,EDI                         { EDI points of char after match        }
        SUB     EAX,EDX                         { the difference is the correct index   }
@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
@@noWork:
end;





{Searches a string in another and returns it last occurrence.
~param SubStr the string to be searched
~param Text   the string to be scanned for the sub-string
~result index of the start of the last occurrence or 0 }
function LastPos(const SubStr, Text: String): Integer;
asm
{     ->EAX     Pointer to substr               }
{       EDX     Pointer to string               }
{     <-EAX     Position of substr in s or 0    }

        TEST    EAX,EAX
        JE      @@noWork

        TEST    EDX,EDX
        JE      @@stringEmpty

        PUSH    EBX
        PUSH    ESI
        PUSH    EDI

        MOV     ESI,EAX                         { Point ESI to substr           }
        MOV     EDI,EDX                         { Point EDI to s                }

        MOV     ECX,[EDI-skew].StrRec.length    { ECX = Length(s)               }

        DEC     EDI                             { Point EDI to last char in s   }
        PUSH    EDI                             { remember s position to calculate index        }
        ADD     EDI,ECX


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


        ADD     ESI,EDX
        DEC     ESI                             { Point ESI to the last char of substr  }
        DEC     EDX                             { EDX = Length(substr) - 1              }
        JS      @@fail                          { < 0 ? return 0                        }
        MOV     AL,[ESI]                        { AL = last char of substr              }
        DEC     ESI                             { Point ESI to last but one char of substr      }

        SUB     ECX,EDX                         { #positions in s to look at    }
                                                { = Length(s) - Length(substr) + 1      }
        JLE     @@fail

        STD                                     { run backwards through the string! }
@@loop:
        REPNE   SCASB
        JNE     @@fail
        MOV     EBX,ECX                         { save outer loop counter               }
        PUSH    ESI                             { save outer loop substr pointer        }
        PUSH    EDI                             { save outer loop s pointer             }

        MOV     ECX,EDX
        REPE    CMPSB
        POP     EDI                             { restore outer loop s pointer  }
        POP     ESI                             { restore outer loop substr pointer     }
        JE      @@found
        MOV     ECX,EBX                         { restore outer loop counter    }
        JMP     @@loop

@@fail:
        CLD                                     { restore forward order }
        POP     EDX                             { get rid of saved s pointer    }
        XOR     EAX,EAX
        JMP     @@exit

@@stringEmpty:
        XOR     EAX,EAX
        JMP     @@noWork

@@found:
        CLD                                     { restore forward order }
        POP     EBX                             { restore pointer to first char of s    }
        MOV     EAX,EDI                         { EDI points of char after match        }
        SUB     EAX,EBX                         { the difference is the correct index   }
        SUB     EAX,EDX                         { get index of start of string  }
        INC     EAX
@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
@@noWork:
end;


{Checks whether the text starts with the string, case is ignored.
~param Start the string the Text has to start with
~param Text  the text so check whether it starts with the string
~result whether the text starts with the string }
function StartsTextWith(const Start, Text: String): Boolean;
asm
{     ->EAX     Pointer to Start                }
{       EDX     Pointer to Text                 }
{     <-EAX/AL  whether Texts starts with Start }
        PUSH    ESI
        PUSH    EDI
        PUSH    EBX
        MOV     ESI,EAX
        MOV     EDI,EDX
        OR      EAX,EAX             { Start = '' ? }

        JE      @@TRUE              { Start is '', Text starts with it }

        MOV     EAX,[EAX-4]         { EAX = Length(Start) }

        OR      EDX,EDX             { Text = '' ? }

        JE      @@FALS              { Text is '', Start not -> return False }

        MOV     EDX,[EDX-4]         { EDX = Length(Text) }
        MOV     ECX,EAX             { ECX = Length(Start) }
        CMP     ECX,EDX             { Length(Start) > Length(Text) ? }
        JA      @@FALS              { Start longer than Text, can't start with it}

        CMP     ECX,ECX             { what's this for? to set the zero flag? }

@@loop: REPE    CMPSB               { make case-sensitive comparison }
        JE      @@TRUE              { all equal? }
        MOV     BL,BYTE PTR [ESI-1] { get not-matching character from Start }
        CMP     BL,'a'
        JB      @@nl1
        CMP     BL,'z'
        JA      @@nl1
        SUB     BL,20H              { as capital letter }
@@nl1:  MOV     BH,BYTE PTR [EDI-1] { get not-matching character from Text }
        CMP     BH,'a'
        JB      @@nl2
        CMP     BH,'z'
        JA      @@nl2
        SUB     BH,20H              { as capital letter }
@@nl2:  CMP     BL,BH               { compare capital letters }
        JE      @@loop              { same character? resume comparison }

@@FALS: MOV     AL,0                { Result := False; }
        JMP     @@end

@@TRUE: MOV     AL,1                { Result := True; }

@@end:  POP     EBX
        POP     EDI
        POP     ESI
end;




{Searches a byte in a memory block and returns its offset or -1.
~param Value  the byte value to be searched
~param Memory the (start of the) memory block to be searched for the byte
~param Size   the size of the memory block to be searched
~returns the offset of the byte in Memory of -1 if not found }
function MemoryScan(Value: Byte; Memory: Pointer; Size: Integer): Integer;
asm                 //EAX/AL = Value; Memory = EDX; Size = ECX
        PUSH    EDI                       //save EDI
        MOV     EDI,EDX                   //set memory to be searched
        REPNE   SCASB                     //search the memory for the byte
        MOV     EAX,0                     //assume not found, will become -1
                       //don't use XOR for that, as that will set the zero flag
        JNE     @@1                       //byte was found?
        MOV     EAX,EDI                   //calculate offset + 1
        SUB     EAX,EDX
@@1:    POP     EDI                       //restore EDI
        DEC     EAX                       //correct offset
end;




{Swaps the bytes in an integer value from "network order".
~param Value the integer value in "network order"
~result the value in the platforms native format }
function BigEndianToLittleEndian(const Value: Integer): Integer;
asm
        //WARNING, this is not portable to other platforms!
        //but as assembler code never is, ... who cares?
        //and anyway, all you should have to do is delete the line
        BSWAP   EAX                           //swap the bytes
end;




{Deletes all whitespaces out of the string. A whitespace is any character
 <= ' '.
~param Text the text to return without any white spaces
~result the Text without white spaces }
function DeleteAllWhiteSpaces(const Text: String): String;
var      pread, pwrite       :PChar; //runner through the string
begin
 Result := Text;
 if Result <> '' then                //string not empty?
  begin
   UniqueString(Result);               //make string writable
   pread := Pointer(Result);
   while not (pread^ in [#0..' ']) do  //skip all leading non-whitespaces
    Inc(pread);
   pwrite := pread;
   while pread^ <> #0 do               //as long a not end of string reached
    begin
     if pread^ > ' ' then                //not a whitespace?
      begin
       pwrite^ := pread^;                  //copy character
       Inc(pwrite);
      end;
     Inc(pread);
    end;
   //set length without whitespaces
   SetLength(Result, pwrite - Pointer(Result));
  end;
end;


{Uniques all whitespaces to a single space ' '. A whitespace is any character
 < ' '. No (white) spaces will be adjacent in the resulting string.
~param Text the text to unique all white spaces in
~result the Text with single white spaces }
function UniqueWhiteSpacesToSpace(const Text: String): String;
var      len                     :Integer;   //numer of characters to scan
         Read                    :PChar;     //to read each character
         Write                   :PChar;     //position to write character
         InSpace                 :Boolean;   //white space already written?
begin
 Result := Text;                  //use the text
 len := Length(Result);           //get number of characters
 if len > 0 then                  //text not empty?
  begin
   //the string is compressed/optimized "in-place"

   UniqueString(Result);            //so we can change the string low-level
   Read := @Result[1];              //initialize read and write position
   Write := Read;
   InSpace := False;                //no space written

   while len > 0 do                 //for each character
    begin
     if Read^ <= ' ' then             //read a white space?
      begin
       if not InSpace then              //space not already written?
        begin
         InSpace := True;                 //space will be written now
         Write^ := ' ';                   //write the space
         Inc(Write);                      //move write pointer
        end;
      end
     else
      begin
       InSpace := False;                //no space written
       Write^ := Read^;                 //copy non-white space
       Inc(Write);                      //move write pointer
      end;

     Inc(Read);                       //move read pointer
     Dec(len);                        //one less to read
    end;

   //snap to written string
   SetLength(Result, Cardinal(Write) - Cardinal(@Result[1]));
  end;
// assert(pos('  ', Result) = 0);
end;





{$IFDEF VER120}

{Returns the value of an environment variable.
~param Name the name of the environment variable
~result the value of the environment variable or '' if it is not set }
function GetEnvironmentVariable(const Name: String): String;
var      Len          :Integer;     //length of the value
begin
 Result := '';                      //no environment variable found so far
 //get length of value
 Len := Windows.GetEnvironmentVariable(PChar(Name), nil, 0);
 if Len > 0 then                    //variable set?
  begin
   SetLength(Result, Len);            //set buffer and get the value
   Windows.GetEnvironmentVariable(PChar(Name), Pointer(Result), Len + 1);
  end;
end;

{$ENDIF}






{Copies the content of a file to another one. If it exists it is overwritten.
~param Source the file to copy
~param Dest   the file to copy the file to }
procedure CopyFile(const Source, Dest: String);
{$IFDEF LINUX}
var       FileStream    :TFileStream;         //the stream to copy the file
{$ENDIF}
begin
 try

{$IFNDEF LINUX}

   //just let windows copy the file
   if not Windows.CopyFile(PChar(Source), PChar(Dest), False) then
 {$IFDEF VER120}
    RaiseLastWin32Error;
 {$ELSE}
    RaiseLastOSError;
 {$ENDIF}

{$ELSE}

   //create destination file
   with TFileStream.Create(Dest, fmCreate or fmShareDenyWrite) do
    try                                          //open source file
      FileStream := TFileStream.Create(Source, fmOpenRead or fmShareDenyWrite);
      try
        CopyFrom(FileStream, 0);                 //copy all data
      finally
       FileStream.Free;                          //and close both files
      end;
    finally
     Free;
    end;

{$ENDIF}
 except
   if ExceptObject is Exception then
    Exception(ExceptObject).Message := Exception(ExceptObject).Message +
                                       #10 + 'While copying "' + Source +
                                       '" to "' + Dest + '"';
   raise;
 end;
end;