Fast selection

scvalex (Alexandru Scvortov) — Mon, 08 Oct 2007 10:48:19 GMT

Selectv returns the position of the nth smallest number in the list.

Selectv modifies the list.



#include 



typedef struct {

	int len;

	int e[102];

} List;



void printv(char *msg, List l) {

	printf("%s", msg);

	int i;

	for (i = 0; i < l.len; ++i)

		printf("%d ", l.e[i]);

	printf("\n");

}



int pivot(List *l, int p, int r) {

	int x = l->e[r];

	int i = p - 1;

	int j = r + 1;

	

	while (1) {

		do {

			++i;

		} while (l->e[i] < x);

		do {

			--j;

		} while (l->e[j] > x);

	

		//printf("%d %d\n", i, j);

		

		if (i < j) {

			int aux = l->e[i];

			l->e[i] = l->e[j];

			l->e[j] = aux;

		} else

			return i - 1;

	}

}





int selectv(List *l, int nrp, int p, int r) {

	//printf("p, r: %d, %d\n", p, r);

	//printf("nrp: %d\n", nrp);

	//printv("l: ", *l);

	

	if (p == r)

		return l->e[p];

	

	if (p < r) {

		int q = pivot(l, p, r);

		

		//getchar();

		

		if (q - p + 1< nrp)

			return selectv(l, nrp - (q - p) - 1, q + 1, r);

		return selectv(l, nrp, p, q);

	}

	return -1;

}



int main(int argc, char *argv[]) {

	List l;

	l.len = 100;

	int i;

	for (i = 0; i < l.len; ++i)

		l.e[i] = l.len - i;

	

	int nth = 56;

	printf("%d: %d\n", nth, selectv(&l, nth, 0, l.len - 1));

	

	//printv("L: ", l);

	

	return 0;

}

Another Pyrex Permutation Generator

llimllib (Bill Mill) — Wed, 02 Aug 2006 23:59:41 GMT

// description of your code here



cdef class PermuteJ:



   cdef int n, first

   cdef int lst3[32]

   cdef object lst, lst2



   def __init__(self, lst):

       cdef int i

       self.lst = lst

       self.lst2 = lst[:]

       self.first = 0

       self.n = len(lst) - 1

       if self.n >= 31:

           raise Exception, "Are you kidding?"

       for i from 0 <= i < len(lst):

           self.lst3[i] = i



   def __iter__(self):

       return self



   def __next__(self):

       cdef int j, l, k, x, y, z, sn, length, neg1, neg2, neg3

       cdef int* sl

       cdef object output



       if self.first == 0:

           self.first = 1

           return self.lst2

       if self.n == 1:

           return [self.lst[1], self.lst[0]]



       sn = self.n

       length = sn + 1

       sl = self.lst3

       neg1 = sn

       neg2 = length - 2

       neg3 = length - 3

       while 1:

           if sl[neg2] < sl[neg1]:

               sl[neg2], sl[neg1] = sl[neg1], sl[neg2]

           elif sl[neg3] < sl[neg2]:

               if sl[neg3] < sl[neg1]:

                   sl[neg3], sl[neg2], sl[neg1] = sl[neg1], sl[neg3], sl[neg2]

               else:

                   sl[neg3], sl[neg2], sl[neg1] = sl[neg2], sl[neg1], sl[neg3]

           else:

               j = sn - 3

               if j < 0: raise StopIteration

               y = sl[j]

               x = sl[neg3]

               z = sl[neg1]

               while y >= x:

                   j = j - 1

                   if j < 0: raise StopIteration

                   x = y

                   y = sl[j]

               if y < z:

                   sl[j] = z

                   sl[j+1] = y

                   sl[sn] = x

               else:

                   l = neg2

                   while y >= sl[l]:

                       l = l - 1

                   sl[j], sl[l] = sl[l], y

                   sl[sn], sl[j+1] = sl[j+1], sl[sn]

               k = j + 2

               l = neg2

               while k < l:

                   sl[k], sl[l] = sl[l], sl[k]

                   k = k + 1

                   l = l - 1



           lst = self.lst

           lst2 = self.lst2

           for j from 0 <= j < length:

               lst2[j] = sl[j]



           return lst2

Fast Sequential Search/Replace Engine supporting wildcards, backward search, whole words, etc... //Pascal Class

jonasraoni (Jonas Raoni Soares Silva) — Thu, 15 Jun 2006 18:55:44 GMT

A quite fast unit to search/replace strings sequentially (while Seeker.Search() do...) in files/strings done mostly with pointers to improve speed. It's able to search backward, count end of lines, check case-sensitiveness, match whole words and handle wildcards (* and ?),

The search method was divided into 4 specialized methods, again to improve speed. The right method is choosed according to the options that were setted (wildcard, search backward, etc...)

This is an old code that doesn't match my current skills, anyway it has some cool techniques that I really enjoyed :)



//

//    TNotesSeeker - classe de buscas do Notes.

//

//    Notes, http://notes.codigolivre.org.br

//    Copyright (C) 2003-2004, Equipe do Notes.

//

//    This program is free software; you can redistribute it and/or modify

//    it under the terms of the GNU General Public License as published by

//    the Free Software Foundation; either version 2 of the License, or

//    (at your option) any later version.

//

//    This program 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, write to the Free Software

//    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

//

//    **************************************************************

//    Revision #0

//      Version  : 1.0.0

//      Date     : 2003-11-30 22:00:00 GMT -3:00

//      Reviewer : Jonas Raoni Soares Silva

//      Changes  : Criada a classe.

//    **************************************************************

//    Revision #1

//      Version  : 1.0.1

//      Date     : 2004-09-09 03:30:00 GMT -3:00

//      Reviewer : Jonas Raoni Soares Silva

//      Changes  : Acho q acabaram-se os bugs... Será??? :]

//    **************************************************************



(*

@abstract(NotesSeeker - classe de buscas do Notes.)

@author(Jonas Raoni Soares Silva )

@created(30 Nov 2003)

*)



unit NotesSeeker;



interface



uses

  SysUtils, Classes;



type



{

  @code(ENotesSeekerException) -

    Notificar erros na classe TNotesSeeker de forma

    profissional, facilitando a interceptação e/ou log de

    erros

}

  ENotesSeekerException = class ( Exception )

  public

    constructor Create(const Msg: string);

    constructor CreateFmt(const Msg: string; const Args: array of const);

  end;



  {Opões de pesquisa: 


   @code(nsHandleEOL) - se você precisar buscar por quebras de linhas, você precisa setar esta opção.


   @code(nsCaseSensitive) - diferenciar maiúsculas de minúsculas.


   @code(nsWholeWords) - retorna apenas palavras inteiras.


   @code(nsBackward) - busca de traz para frente. 


   @code(nsHandleWildCard) - usa coringas * e ? na pesquisa.}

  TNotesSeekerOption = ( nsHandleEOL, nsCaseSensitive, nsWholeWords, nsBackward, nsHandleWildCard );

  { Set de @link(TNotesSeekerOption).}

  TNotesSeekerOptions = set of TNotesSeekerOption;



  TSearchFunction = function: Boolean of object;



{

  @code(TNotesSeeker) -

    Permite fazer buscas em strings com várias opções

}

  TNotesSeeker = class(TObject)

  private

    Jump, LineJump: Cardinal;

    FList: TList;

  protected

    FMatches, FStartAt, FEOLLen, FSearchLen, FCurCol,

    FCurLine, FMatchLen, FMatchLine, FMatchCol: Cardinal;



    FBufferEnd, FBuffer, FBufferBegin, FBufferBackup,

    FEOL, FSearchBegin, FSearch, FSearchEnd: PChar;



    FOptions: TNotesSeekerOptions;



    FContextRightLenght, FContextLeftLenght: Cardinal;



    FKeepText: Boolean;



    function GetText: string;

    function GetReplacedText: string;

    function GetContext: string;

    function GetSearchStr: string;

    function GetRemainingText: string;

    function GetCurByte: Cardinal;

    function GetEOL: string;



    procedure SetOptions(const Value: TNotesSeekerOptions);

    procedure SetText( const Value: string);

    procedure SetSearchStr(const Value: string);

    procedure SetEOL(const Value: string);



    procedure FreeBuffer;

    procedure FreeEOL;

    procedure FreeSearchStr;



    {Search Engines}

    function SearchForward: Boolean;

    function SearchForwardWithWildCard: Boolean;

    function SearchBackward: Boolean;

    function SearchBackwardWithWildCard: Boolean;



  public

    { Efetua a busca: se o termo procurado for encontrado, retorna true, caso contrário retorna false }

    Search: TSearchFunction;



    { Método construtor }

    constructor Create; virtual;

    { Método destruidor }

    destructor Destroy; override;



    { Armazena o tamanho do "match", quando a opção wildcard estiver desligada esta será igual ao tamanho da própria string procurada }

    property MatchLength: Cardinal read FMatchLen;

    { Quando HandleEOL fizer parte das opções, armazenará a linha onde a string procurada foi encontrada }

    property CurLine: Cardinal read FMatchLine;

    { Armazenará a coluna onde a string procurada foi encontrada, se HandleEOL não estiver nas opções, armazenará a mesma coisa que a propriedade CurByte }

    property CurCol: Cardinal read FMatchCol;

    { Armazena a posição ou byte "absoluto" onde a string foi encontrada }

    property CurByte: Cardinal read GetCurByte;

    { Especifica a posição/byte inicial onde a busca deverá começar }

    property StartAt: Cardinal read FStartAt write FStartAt;

    { Retorna o contexto onde a string procurada foi encontrada }

    property Context: string read GetContext;

    { Especifica a quantidade de caracteres que deverão fazer parte do contexto encontrado ao lado esquerdo da string procurada }

    property ContextLeftLenght: Cardinal read FContextLeftLenght write FContextLeftLenght;

    { Especifica a quantidade de caracteres que deverão fazer parte do contexto encontrado ao lado direito da string procurada }

    property ContextRightLenght: Cardinal read FContextRightLenght write FContextRightLenght;

    { Armazena o número de strings que coincidiram com a busca até o presente momento }

    property Matches: Cardinal read FMatches;

    { Permite alterar a sequência de caracteres que demarcam o fim de uma linha }

    property EOL: string read GetEOL write SetEOL;

    { Armazena as opções atualmente habilitadas para a busca, podendo ser alterada a qualquer momento }

    property Options: TNotesSeekerOptions read FOptions write SetOptions;

    { Termo a ser procurado no texto }

    property SearchStr: string read GetSearchStr write SetSearchStr;

    { Texto onde a busca será efetuada }

    property Text: string read GetText write SetText;

    { Texto restante ao término da busca }

    property RemainingText: string read GetRemainingText;

    { Especifica se a classe deverá manter uma cópia do texto setado inicialmente }

    property KeepText: Boolean read FKeepText write FKeepText;

    { Retorna o texto com os replaces, caso KeepText seja falso, essa propriedade se torna sinônimo da propriedade Text }

    property ReplacedText: string read GetReplacedText;



    { Prepara tudo para uma nova busca }

    procedure StartSearch;

    { Carrega o texto da busca a partir de um arquivo }

    procedure LoadFromFile( const AFilename: string );

    { Carrega o texto da busca a partir de um stream }

    procedure LoadFromStream( const AStream: TStream );

    { Carrega o texto da busca a partir de um buffer }

    procedure LoadFromBuffer( const ABuffer: PChar );

    { Efetua a substituição da string encontrada pela string contida em "S" }

    procedure Replace( const S: String );

    { Modo prático para setar as opções }

    procedure EnableOptions( const CaseSensitive: Boolean = true; const WholeWords: Boolean = false; const HandleEOL: Boolean = true; const HandleWildCard: Boolean = false; const Backward: Boolean = false );



  end;



  { Compara Str1 e Str2 de trás pra frente, se as duas forem iguais retorna true, caso contrário false }

  function StrLRComp( S1, S2: PChar; const S2Begin: PChar ): Boolean;

  { Converte para maiúsculo (ANSI) -> VALEUUUUU TIO RUSSÃO hahaha, o que tem no delphi "aplica a alteração"

    Idéia de manter tabela com tudo maiúsculo arrancada de "QStrings 6.07.424 Copyright (C) 2000, 2003 Andrew Dryazgov [ andrewdr@newmail.ru ]" }

  function AnsiUpCase(Ch: Char): Char;



const

  { Caracteres que definem delimitadores de palavra, usada quando a opção WholeWords está ativa }

  WhiteSpaces: set of Char = [' ',#9,#13,#10,'!','"','#','$','%','&','''','(',')','*','+','-','/',':',';','<','=','>','?','@','[','\',']','^','`','{','|','}','~'];



const

  //fiz algumas alterações hehe, o tiozaum russo devia tá começano a ficar cego enqto fazia isso :)

  ToUpperChars: array[0..255] of Char =

    (#$00,#$01,#$02,#$03,#$04,#$05,#$06,#$07,#$08,#$09,#$0A,#$0B,#$0C,#$0D,#$0E,#$0F,

     #$10,#$11,#$12,#$13,#$14,#$15,#$16,#$17,#$18,#$19,#$1A,#$1B,#$1C,#$1D,#$1E,#$1F,

     #$20,#$21,#$22,#$23,#$24,#$25,#$26,#$27,#$28,#$29,#$2A,#$2B,#$2C,#$2D,#$2E,#$2F,

     #$30,#$31,#$32,#$33,#$34,#$35,#$36,#$37,#$38,#$39,#$3A,#$3B,#$3C,#$3D,#$3E,#$3F,

     #$40,#$41,#$42,#$43,#$44,#$45,#$46,#$47,#$48,#$49,#$4A,#$4B,#$4C,#$4D,#$4E,#$4F,

     #$50,#$51,#$52,#$53,#$54,#$55,#$56,#$57,#$58,#$59,#$5A,#$5B,#$5C,#$5D,#$5E,#$5F,

     #$60,#$41,#$42,#$43,#$44,#$45,#$46,#$47,#$48,#$49,#$4A,#$4B,#$4C,#$4D,#$4E,#$4F,

     #$50,#$51,#$52,#$53,#$54,#$55,#$56,#$57,#$58,#$59,#$5A,#$7B,#$7C,#$7D,#$7E,#$7F,

     #$80,#$81,#$82,#$81,#$84,#$85,#$86,#$87,#$88,#$89,#$8A,#$8B,#$8C,#$8D,#$8E,#$8F,

     #$90,#$91,#$92,#$93,#$94,#$95,#$96,#$97,#$98,#$99,#$8A,#$9B,#$8C,#$9D,#$9E,#$9F,

     #$A0,#$A1,#$A1,#$A3,#$A4,#$A5,#$A6,#$A7,#$A8,#$A9,#$AA,#$AB,#$AC,#$AD,#$AE,#$AF,

     #$B0,#$B1,#$B2,#$B2,#$A5,#$B5,#$B6,#$B7,#$A8,#$B9,#$BA,#$BB,#$BC,#$BD,#$BE,#$BF,

     #$C0,#$C1,#$C2,#$C3,#$C4,#$C5,#$C6,#$C7,#$C8,#$C9,#$CA,#$CB,#$CC,#$CD,#$CE,#$CF,

     #$D0,#$D1,#$D2,#$D3,#$D4,#$D5,#$D6,#$D7,#$D8,#$D9,#$DA,#$DB,#$DC,#$DD,#$DE,#$DF,

     #$C0,#$C1,#$C2,#$C3,#$C4,#$C5,#$C6,#$C7,#$C8,#$C9,#$CA,#$CB,#$CC,#$CD,#$CE,#$CF,

     #$D0,#$D1,#$D2,#$D3,#$D4,#$D5,#$D6,#$F7,#$D8,#$D9,#$DA,#$DB,#$DC,#$DD,#$DE,#$9F);



implementation



function StrLRComp( S1, S2: PChar; const S2Begin: PChar ): Boolean;

begin

  while ( S2 <> S2Begin ) and ( S1^ = S2^ ) do begin

    dec( S1 );

    dec( S2 );

  end;

  Result := ( S1^ = S2^ ) and ( S2 = S2Begin );

end;



function AnsiUpCase(Ch: Char): Char;

begin

  Result := ToUpperChars[ ord( ch ) ];

end;





{ class : TNotesSeeker }



{ TNotesSeeker : protected }



function TNotesSeeker.GetText: string;

begin

  if Assigned( FBufferBackup ) then

    Result := StrPas( FBufferBackup )

  else

    Result := ReplacedText;

end;



function TNotesSeeker.GetReplacedText: string;

begin

  Result := StrPas( FBufferBegin );

end;



function TNotesSeeker.GetContext: string;

var

  BeginAt, EndAt: PChar;

begin

  if not ( nsBackward in FOptions ) then begin

    BeginAt := FBuffer - FMatchLen - FContextLeftLenght;

    EndAt := FBuffer+FContextRightLenght;

  end

  else begin

    BeginAt := FBuffer+1-FContextLeftLenght;

    EndAt := FBuffer+1+FMatchLen+FContextRightLenght;

  end;

  if BeginAt > EndAt then

    raise ENotesSeekerException.CreateFmt('GetContext::Range Error "BeginAt(%d) > EndAt(%d)"', [Integer(BeginAt), Integer(EndAt)]);

  if BeginAt < FBufferBegin then

    BeginAt := FBufferBegin;

  if EndAt > FBufferEnd then

    EndAt := FBufferEnd;



  SetString( Result, BeginAt, EndAt-BeginAt );

end;



function TNotesSeeker.GetSearchStr: string;

begin

  Result := StrPas( FSearchBegin );

end;



function TNotesSeeker.GetRemainingText: string;

begin

  Result := '';

  if not ( nsBackward in FOptions ) then

    Result := StrPas( FBuffer )

  else if FBuffer-FBufferBegin > -1 then

    SetString( Result, FBufferBegin, FBuffer-FBufferBegin+1 );

end;



function TNotesSeeker.GetCurByte: Cardinal;

begin

  if nsBackward in FOptions then

    Result := FBufferEnd-1 - FBuffer - FMatchLen

  else

    Result := FBuffer - FMatchLen - FBufferBegin;

end;



function TNotesSeeker.GetEOL: string;

begin

  Result := StrPas( FEOL );

end;



procedure TNotesSeeker.SetOptions(const Value: TNotesSeekerOptions);

begin

  FOptions := Value;

  if nsBackward in Value then

    if nsHandleWildCard in Value then

      Search := SearchBackwardWithWildCard

    else

      Search := SearchBackward

  else if nsHandleWildCard in Value then

    Search := SearchForwardWithWildCard

  else

    Search := SearchForward;

end;



procedure TNotesSeeker.SetText( const Value: string );

begin

  LoadFromBuffer( PChar( Value ) );

end;



procedure TNotesSeeker.SetSearchStr(const Value: string);

begin

  FreeSearchStr;

  FSearchLen := Length( Value );

  GetMem( FSearchBegin, FSearchLen+1 );

  StrCopy( FSearchBegin, PChar( Value ) );

  FSearch := FSearchBegin;

  FSearchEnd := StrEnd( FSearchBegin );

end;



procedure TNotesSeeker.SetEOL(const Value: string);

begin

  FreeEOL;

  FEOLLen := Length( Value );

  GetMem( FEOL, FEOLLen+1 );

  StrCopy( FEOL, PChar( Value ) );

end;





procedure TNotesSeeker.FreeBuffer;

begin

  if Assigned( FBufferBegin ) then begin

    FBufferEnd := nil;

    FBuffer := nil;

    FreeMem( FBufferBegin );

  end;

  if Assigned( FBufferBackup ) then begin

    FreeMem( FBufferBackup );

    FBufferBackup := nil;

  end;

end;



procedure TNotesSeeker.FreeEOL;

begin

  if Assigned( FEOL ) then begin

    FreeMem( FEOL );

    FEOL := nil;

  end;

end;



procedure TNotesSeeker.FreeSearchStr;

begin

  if Assigned( FSearchBegin ) then begin

    FreeMem( FSearchBegin );

    FSearchBegin := nil;

    FSearch := nil;

    FSearchEnd := nil;

  end;

end;







{ TNotesSeeker : public }



constructor TNotesSeeker.Create;

begin

  EOL := #13#10;

  FContextLeftLenght := 10;

  FContextRightLenght := 20;

  Search := SearchForward;

end;



destructor TNotesSeeker.Destroy;

begin

  FreeBuffer;

  FreeSearchStr;

  FreeEOL;

  inherited Destroy;

end;



procedure TNotesSeeker.LoadFromBuffer( const ABuffer: PChar );

begin

  FreeBuffer;

  GetMem( FBufferBegin, StrLen( ABuffer )+1 );

  FBuffer := StrCopy( FBufferBegin, ABuffer );

  FBufferEnd :=  StrEnd( FBufferBegin );

  if FKeepText then begin

    GetMem( FBufferBackup, StrLen( FBufferBegin )+1 );

    StrCopy( FBufferBackup, FBufferBegin );

  end;  

end;



procedure TNotesSeeker.LoadFromFile(const AFilename: string);

var

  FS: TFileStream;

begin

  if not FileExists( AFilename ) then

    raise ENotesSeekerException.CreateFmt( 'LoadFromFile::Arquivo "%s" não encontrado', [AFilename] );

  FS := TFileStream.Create( AFilename, fmOpenRead );

  try

    LoadFromStream( FS );

  finally

    FS.Free;

  end;

end;



procedure TNotesSeeker.LoadFromStream(const AStream: TStream);

var

  Size: Int64;

begin

  FreeBuffer;

  Size := AStream.Size;

  GetMem( FBuffer, Size+1 );

  Size := AStream.Read( FBuffer^, Size );

  ( FBuffer+Size )^ := #0;

  FBufferEnd := (FBuffer+Size);

  FBufferBegin := FBuffer;

  if FKeepText then begin

    GetMem( FBufferBackup, StrLen( FBufferBegin )+1 );

    StrCopy( FBufferBackup, FBufferBegin );

  end;  

end;



procedure TNotesSeeker.StartSearch;

begin

  FMatches := 0;

  FCurLine := 0;

  FCurCol := 0;



  if FSearchLen = 0 then

    raise ENotesSeekerException.Create( 'StartSearch::Propriedade SearchStr está vazia.' );



  if ( FBufferBackup <> FBufferBegin ) and Assigned( FBufferBackup ) then begin

    FreeMem( FBufferBegin );

    GetMem( FBufferBegin, StrLen( FBufferBackup )+1 );

    FBuffer := StrCopy( FBufferBegin, FBufferBackup );

    FBufferEnd := FBuffer + StrLen( FBufferBackup );

  end;



  if nsBackward in FOptions then

    FBuffer := FBufferEnd-1

  else

    FBuffer := FBufferBegin;

end;



procedure TNotesSeeker.Replace(const S: String);

var

  TempBuff: PChar;

  BufferOffset: Integer;

begin

  TempBuff := nil;

  if not ( nsBackward in FOptions ) then begin

    BufferOffset := FBuffer-FMatchLen - FBufferBegin + Length( S );

    GetMem( TempBuff, ( FBuffer-FMatchLen - FBufferBegin) + Length(S) + ( FBufferEnd - FBuffer ) + 1 );

    FBufferEnd := StrLCopy( StrLCopy( StrLCopy( TempBuff, FBufferBegin, FBuffer-FMatchLen - FBufferBegin )+(FBuffer-FMatchLen - FBufferBegin), PChar( S ), Length( S ) )+Length( S ), FBuffer, FBufferEnd - FBuffer )+(FBufferEnd - FBuffer);

    FreeMem( FBufferBegin );

    FBufferBegin := TempBuff;

    FBuffer := FBufferBegin + BufferOffset;

  end

  else begin

    BufferOffset := FBufferEnd - (FBuffer + FMatchLen) + Length( S );

    if FBuffer < FBufferBegin then

      GetMem( TempBuff, FBufferEnd - (FBuffer+FMatchLen) + Length( S ) + ( FBuffer - FBufferBegin ) + 1 )

    else

      GetMem( TempBuff, FBufferEnd - (FBuffer+FMatchLen) + Length( S ) + ( FBuffer - FBufferBegin ) + 1 );

    FBufferEnd := StrLCopy( StrLCopy( StrLCopy( TempBuff, FBufferBegin, FBuffer-FBufferBegin+1 )+(FBuffer-FBufferBegin+1), PChar( S ), Length( S ) )+Length( S ), FBuffer+FMatchLen+1, FBufferEnd-1 - (FBuffer+FMatchLen) )+ ( FBufferEnd-1 - (FBuffer+FMatchLen) );

    FreeMem( FBufferBegin );

    FBufferBegin := TempBuff;

    FBuffer := FBufferEnd - BufferOffset;

  end;

end;





{ ENotesSeekerException }

{ ENotesSeekerException : public }



constructor ENotesSeekerException.Create(const Msg: string);

begin

  inherited Create( 'TNotesSeeker.'+Msg );

end;



constructor ENotesSeekerException.CreateFmt(const Msg: string; const Args: array of const);

begin

  inherited CreateFmt( 'TNotesSeeker.'+Msg, Args );

end;



procedure TNotesSeeker.EnableOptions(const CaseSensitive, WholeWords, HandleEOL, HandleWildCard, Backward: Boolean);

  var Opcoes: TNotesSeekerOptions;

begin

  if CaseSensitive then Include( Opcoes, nsCaseSensitive ) else Exclude( Opcoes, nsCaseSensitive );

  if HandleEOL then Include( Opcoes, nsHandleEOL ) else Exclude( Opcoes, nsHandleEOL );

  if Backward then Include( Opcoes, nsBackward ) else Exclude( Opcoes, nsBackward );

  if HandleWildCard then Include( Opcoes, nsHandleWildCard ) else Exclude( Opcoes, nsHandleWildCard );

  if WholeWords then Include( Opcoes, nsWholeWords ) else Exclude( Opcoes, nsWholeWords );

  SetOptions( Opcoes );

end;



function TNotesSeeker.SearchForward: Boolean;

begin

  Result := True;

  LineJump := 0;

  FMatchLine := 0;

  FMatchCol := 0;

  FMatchLen := 0;

  FSearch := FSearchBegin;



  if FBufferBegin + FStartAt > FBufferEnd then

    FStartAt := FBufferEnd - FBufferBegin;

  while FStartAt > FBuffer-FBufferBegin do begin

    if ( nsHandleEOL in FOptions ) and ( FBuffer^ = FEOL^ ) and ( StrLComp( FBuffer, FEOL, FEOLLen ) = 0 ) then begin

      Inc( FBuffer, FEOLLen );

      Inc( FCurLine );

      FCurCol := 0;

      Continue;

    end

    else

      Inc( FCurCol );

    Inc( FBuffer );

  end;



  while FBuffer <> FBufferEnd do begin

    if ( (nsCaseSensitive in FOptions ) and ( FBuffer^ = FSearch^ ) ) or ( not(nsCaseSensitive in FOptions ) and ( AnsiUpCase( FBuffer^ ) = AnsiUpCase( FSearch^ ) ) ) then begin

      Inc( FMatchLen );

      Inc( FSearch );

      if Result then begin

        Result := False;

        FMatchCol := FCurCol;

        FMatchLine := FCurLine;

        if ( nsWholeWords in FOptions ) and ( FBuffer > FBufferBegin ) and not ( (FBuffer-1)^ in WhiteSpaces ) then begin

          FSearch := FSearchBegin;

          FMatchLen := 0;

          FMatchLine := 0;

          FMatchCol := 0;

        end;

      end;

      if ( nsWholeWords in FOptions ) and ( FMatchLen = FSearchLen ) and ( FBuffer < FBufferEnd-1 ) and not ( (FBuffer+1)^ in WhiteSpaces ) then begin

        FSearch := FSearchBegin;

        FMatchLen := 0;

        FMatchLine := 0;

        FMatchCol := 0;

      end;



      if ( nsHandleEOL in FOptions ) and ( FBuffer^ = FEOL^ ) and ( StrLComp( FBuffer, FEOL, FEOLLen ) = 0 ) then begin

        Inc( FCurLine );

        FCurCol := 0;

        LineJump := FEOLLen-1;

      end

      else if LineJump = 0 then

        Inc( FCurCol )

      else

        Dec( LineJump );



      Inc( FBuffer );

      if FSearch^ = #0 then begin

        Result := True;

        Inc( FMatches );

        Exit;

      end;

    end

    else begin

      Result := True;

      FMatchLen := 0;

      FMatchLine := 0;

      FMatchCol := 0;

      

      if FSearch <> FSearchBegin then begin

        FSearch := FSearchBegin;

        Continue;

      end;



      if ( nsHandleEOL in FOptions ) and ( FBuffer^ = FEOL^ ) and ( StrLComp( FBuffer, FEOL, FEOLLen ) = 0 ) then begin

        Inc( FCurLine );

        FCurCol := 0;

        LineJump := FEOLLen-1;

      end

      else if LineJump = 0 then

        Inc( FCurCol )

      else

        Dec( LineJump );



      Inc( FBuffer )        

    end;

  end;

  Result := False;

end;



function TNotesSeeker.SearchForwardWithWildCard: Boolean;

begin

  Result := True;

  Jump := 1;

  LineJump := 0;

  FMatchLine := 0;

  FMatchCol := 0;

  FMatchLen := 0;

  FSearch := FSearchBegin;



  if FBufferBegin + FStartAt > FBufferEnd then

    FStartAt := FBufferEnd - FBufferBegin;

  while FStartAt > FBuffer-FBufferBegin do begin

    if ( nsHandleEOL in FOptions ) and ( FBuffer^ = FEOL^ ) and ( StrLComp( FBuffer, FEOL, FEOLLen ) = 0 ) then begin

      Inc( FBuffer, FEOLLen );

      Inc( FCurLine );

      FCurCol := 0;

      Continue;

    end

    else

      Inc( FCurCol );

    Inc( FBuffer );

  end;



  while FBuffer <> FBufferEnd do begin

    if FSearch^ = '?' then begin

      Inc( FMatchLen );

      Inc( FSearch );

    end

    else if FSearch^ = '*' then begin

      if (FSearch+Jump)^ = '?' then begin

        Inc( FMatchLen );

        Inc( Jump );

      end

      else if (FSearch+Jump)^ = '*' then begin

        Inc( FSearch, Jump );

        Jump := 1;

        continue;

      end

      else if ( ( nsCaseSensitive in FOptions ) and ( FBuffer^ = (FSearch+Jump)^ ) ) or ( not( nsCaseSensitive in FOptions ) and ( AnsiUpCase( FBuffer^ ) = AnsiUpCase( (FSearch+Jump)^ ) )  ) then begin

        Inc( FMatchLen );

        Inc( Jump );

      end

      else

        Inc( FMatchLen );

      if (FSearch+Jump)^ = #0 then begin

        if (FSearch+Jump-1)^ = '*' then begin

          Inc( FMatchLen, FBufferEnd-FBuffer - 1 );

          FBuffer := FBufferEnd - 1;

        end;

        FSearch := FSearchEnd;

      end;

    end

    else if ( ( nsCaseSensitive in FOptions ) and ( FBuffer^ = FSearch^ ) ) or ( not ( nsCaseSensitive in FOptions ) and ( AnsiUpCase( FBuffer^ ) = AnsiUpCase( FSearch^ ) ) ) then begin

      Inc( FMatchLen );

      Inc( FSearch );

    end

    else begin

      Result := True;

      FMatchLen := 0;

      FMatchLine := 0;

      FMatchCol := 0;

      Jump := 1;

      if FSearch <> FSearchBegin then begin

        FSearch := FSearchBegin;

        Continue;

      end;



      if ( nsHandleEOL in FOptions ) and ( FBuffer^ = FEOL^ ) and ( StrLComp( FBuffer, FEOL, FEOLLen ) = 0 ) then begin

        Inc( FCurLine );

        FCurCol := 0;

        LineJump := FEOLLen-1;

      end

      else if LineJump = 0 then

        Inc( FCurCol )

      else

        Dec( LineJump );



      Inc( FBuffer );

      continue;

    end;



    if Result then begin

      Result := False;

      FMatchCol := FCurCol;

      FMatchLine := FCurLine;

    end;



    if ( nsHandleEOL in FOptions ) and ( FBuffer^ = FEOL^ ) and ( StrLComp( FBuffer, FEOL, FEOLLen ) = 0 ) then begin

      Inc( FCurLine );

      FCurCol := 0;

      LineJump := FEOLLen-1;

    end

    else if LineJump = 0 then

      Inc( FCurCol )

    else

      Dec( LineJump );



    Inc( FBuffer );



    if FSearch^ = #0 then begin

      Result := True;

      Inc( FMatches );

      Exit;

    end;

  end;

  Result := False;

end;



function TNotesSeeker.SearchBackward: Boolean;

begin

  Result := True;

  LineJump := 0;

  FMatchLine := 0;

  FMatchCol := 0;

  FMatchLen := 0;

  FSearch := FSearchEnd-1;



  if FBufferEnd - FStartAt < FBufferBegin then

    FStartAt := FBufferEnd - FBufferBegin;

  while FStartAt > FBufferEnd-1 - FBuffer do begin

    if ( nsHandleEOL in FOptions ) and ( FBuffer-FBufferBegin >= FEOLLen ) and StrLRComp( FBuffer, FEOL+FEOLLen-1, FEOL ) then begin

      Dec( FBuffer, FEOLLen );

      Inc( FCurLine );

      FCurCol := 0;

      Continue;

    end

    else

      Inc( FCurCol );

    Dec( FBuffer );

  end;



  while FBuffer <> FBufferBegin-1 do begin

    if ( (nsCaseSensitive in FOptions ) and ( FBuffer^ = FSearch^ ) ) or ( not(nsCaseSensitive in FOptions ) and ( AnsiUpCase( FBuffer^ ) = AnsiUpCase( FSearch^ ) ) ) then begin

      Inc( FMatchLen );

      Dec( FSearch );

      if Result then begin

        Result := False;

        FMatchCol := FCurCol;

        FMatchLine := FCurLine;



        if ( nsWholeWords in FOptions ) and ( FBuffer < FBufferEnd-1 ) and not ( (FBuffer+1)^ in WhiteSpaces ) then begin

          FSearch := FSearchEnd-1;

          FMatchLen := 0;

          FMatchLine := 0;

          FMatchCol := 0;

        end;

      end;

      if ( nsWholeWords in FOptions ) and ( FMatchLen = FSearchLen ) and ( FBuffer > FBufferBegin ) and not ( (FBuffer-1)^ in WhiteSpaces ) then begin

        FSearch := FSearchEnd-1;

        FMatchLen := 0;

        FMatchLine := 0;

        FMatchCol := 0;

      end;



      if ( nsHandleEOL in FOptions ) and ( FBuffer-FBufferBegin >= FEOLLen ) and StrLRComp( FBuffer, FEOL+FEOLLen-1, FEOL ) then begin

        Inc( FCurLine );

        FCurCol := 0;

        LineJump := FEOLLen-1;

      end

      else if LineJump = 0 then

        Inc( FCurCol )

      else

        Dec( LineJump );



      Dec( FBuffer );

      if FSearch = FSearchBegin-1 then begin

        Result := True;

        Inc( FMatches );

        Exit;

      end;

    end

    else begin

      Result := True;

      FMatchLen := 0;

      FMatchLine := 0;

      FMatchCol := 0;



      if FSearch <> FSearchEnd-1 then begin

        FSearch := FSearchEnd-1;

        Continue;

      end;



      if ( nsHandleEOL in FOptions ) and ( FBuffer-FBufferBegin >= FEOLLen ) and StrLRComp( FBuffer, FEOL+FEOLLen-1, FEOL ) then begin

        Inc( FCurLine );

        FCurCol := 0;

        LineJump := FEOLLen-1;

      end

      else if LineJump = 0 then

        Inc( FCurCol )

      else

        Dec( LineJump );



      Dec( FBuffer );

    end;

  end;

  Result := False;

end;



function TNotesSeeker.SearchBackwardWithWildCard: Boolean;

begin

  Result := True;

  Jump := 1;

  LineJump := 0;

  FMatchLine := 0;

  FMatchCol := 0;

  FMatchLen := 0;

  FSearch := FSearchEnd-1;



  if FBufferEnd - FStartAt < FBufferBegin then

    FStartAt := FBufferEnd - FBufferBegin;

  while FStartAt > FBufferEnd-1 - FBuffer do begin

    if ( nsHandleEOL in FOptions ) and ( FBuffer^ = FEOL^ ) and ( StrLComp( FBuffer, FEOL, FEOLLen ) = 0 ) then begin

      Dec( FBuffer, FEOLLen );

      Inc( FCurLine );

      FCurCol := 0;

      Continue;

    end

    else

      Inc( FCurCol );

    Dec( FBuffer );

  end;



  while FBuffer <> FBufferBegin-1 do begin

    if FSearch^ = '?' then begin

      Inc( FMatchLen );

      Dec( FSearch );

    end

    else if FSearch^ = '*' then begin

      if (FSearch-Jump)^ = '?' then begin

        Inc( FMatchLen );

        Inc( Jump );

      end

      else if (FSearch-Jump)^ = '*' then begin

        Dec( FSearch, Jump );

        Jump := 1;

        continue;

      end

      else if ( ( nsCaseSensitive in FOptions ) and ( FBuffer^ = (FSearch-Jump)^ ) ) or ( not( nsCaseSensitive in FOptions ) and ( AnsiUpCase( FBuffer^ ) = AnsiUpCase( (FSearch-Jump)^ ) )  ) then begin

        Inc( FMatchLen );

        Inc( Jump );

      end

      else

        Inc( FMatchLen );

      if (FSearch-Jump) = FSearchBegin-1 then begin

        if (FSearch-Jump+1)^ = '*' then begin

          Inc( FMatchLen, FBuffer-FBufferBegin );

          FBuffer := FBufferBegin;

        end;

        FSearch := FSearchBegin-1;

      end;

    end

    else if ( ( nsCaseSensitive in FOptions ) and ( FBuffer^ = FSearch^ ) ) or ( not ( nsCaseSensitive in FOptions ) and ( AnsiUpCase( FBuffer^ ) = AnsiUpCase( FSearch^ ) ) ) then begin

      Inc( FMatchLen );

      Dec( FSearch );

    end

    else begin

      Result := True;

      FMatchLen := 0;

      FMatchLine := 0;

      FMatchCol := 0;

      Jump := 1;



      if FSearch <> FSearchEnd-1 then begin

        FSearch := FSearchEnd-1;

        Continue;

      end;



      if ( nsHandleEOL in FOptions ) and ( FBuffer-FBufferBegin >= FEOLLen ) and StrLRComp( FBuffer, FEOL+FEOLLen-1, FEOL ) then begin

        Inc( FCurLine );

        FCurCol := 0;

        LineJump := FEOLLen-1;

      end

      else if LineJump = 0 then

        Inc( FCurCol )

      else

        Dec( LineJump );



      Dec( FBuffer );

      Continue;

    end;



    if Result then begin

      Result := False;

      FMatchCol := FCurCol;

      FMatchLine := FCurLine;

    end;



    if ( nsHandleEOL in FOptions ) and ( FBuffer-FBufferBegin >= FEOLLen ) and StrLRComp( FBuffer, FEOL+FEOLLen-1, FEOL ) then begin

      Inc( FCurLine );

      FCurCol := 0;

      LineJump := FEOLLen-1;

    end

    else if LineJump = 0 then

      Inc( FCurCol )

    else

      Dec( LineJump );



    Dec( FBuffer );

    if FSearch = FSearchBegin-1 then begin

      Result := True;

      Inc( FMatches );

      Exit;

    end;

  end;

  Result := False;

end;



end.

DZone Snippets: fast code

Fast selection

Another Pyrex Permutation Generator

Fast Sequential Search/Replace Engine supporting wildcards, backward search, whole words, etc... //Pascal Class