Extends elements unable to receive focus, allowing them to handle the following events: keypress, keydown, keyup, blur e focus.

[UPDATED CODE AND HELP CAN BE FOUND HERE]

   1  
   2  //========================================================
   3  // REQUIRES http://www.jsfromhell.com/geral/event-listener
   4  //========================================================
   5  
   6  //+ Jonas Raoni Soares Silva
   7  //@ http://jsfromhell.com/geral/focuser [v1.0]
   8  
   9  focuser = function(o){ //v1.0
  10      var x, $ = document.body.appendChild(document.createElement("input")), s = $.style,
  11      h = function(e){(o["on" + e.type] instanceof Function) && o["on" + e.type].call(o, (e.which + 1 || e.keyCode + 1) - 1 || 0);};
  12      $.type = "text", s.position = "absolute", s.left = s.top = "-100px";
  13      o.blur = function(){$.blur();}, addEvent(o, "click", o.focus = function(){$.focus();});
  14      for(x in {keypress: 0, keydown: 0, keyup: 0, blur: 0, focus: 0}) $["on" + x] = h;
  15  };

Example:

   1  
   2  <style type="text/css">
   3  #type{
   4      background: #eef;
   5      border: 2px inset #999;
   6      overflow: auto;
   7      padding: 30px;
   8      margin: 30px;
   9      width: 200px;
  10  }
  11  </style>
  12  
  13  <div id="type">
  14  <b>Click and type to edit</b> the &lt;div&gt;. Press TAB or click out to test the focus.
  15  </div>
  16  
  17  <script type="text/javascript">
  18  var t = document.getElementById("type");
  19  focuser(t);
  20  t.onfocus = function(){
  21      this.style.background = "#fee";
  22  };
  23  t.onblur = function(){
  24      this.style.background = "#eef";
  25  };
  26  t.onkeypress = function(k){
  27      var s = this.innerHTML;
  28      this.innerHTML = k == 8 ? s.slice(0, -1) : s + String.fromCharCode(k);
  29  };
  30  </script>

Rotate the elements of an array with the minimum possible amount of movements.
It's thousands faster than using sequences of "array.unshift(array.pop())" or "array.push(array.shift())" due to memory moving on the "unshift" and "shift" methods. It also doesn't use a helper array, so it's fast and requires no aditional memory.

[UPDATED CODE CAN BE FOUND HERE]

   1  
   2  //+ Jonas Raoni Soares Silva
   3  //@ http://jsfromhell.com/array/rotate [v1.0]
   4  
   5  rotate = function(a /*array*/, p /* integer, positive integer rotate to the right, negative to the left... */){ //v1.0
   6      for(var l = a.length, p = (Math.abs(p) >= l && (p %= l), p < 0 && (p += l), p), i, x; p; p = (Math.ceil(l / p) - 1) * p - l + (l = p))
   7          for(i = l; i > p; x = a[--i], a[i] = a[i - p], a[i - p] = x);
   8      return a;
   9  };

Usage

   1  
   2  document.write(
   3      "rotate([1,2,3], 2) = ", rotate([1,2,3], 2), "<br />",
   4      "rotate([1,2,3], -2) = ", rotate([1,2,3], -2), "<br />",
   5      "rotate([1,2,3], 1000) = ", rotate([1,2,3], 1000), "<br />"
   6  )

A wave plotter component that is able to draw sin, poly and squared lines, I used this in a osciloscope xD

I didn't liked this code, but the draw part (TWaveShape.paint) is looking cool, I used the same "X" coord to draw the 3 kinds of lines :)

I mean:

loop(x){
case waveType of
wtSin: y := lala;
wtPoly: y := lele;
wtSqr: y := lili;
end;
}

   1  
   2  unit WavePlotter;
   3  
   4  interface
   5  
   6  uses
   7    forms, dialogs, SysUtils, Classes, Controls, Graphics;
   8  
   9  const
  10    PI2 = PI * 2;
  11  
  12  type
  13    TWaveType = ( wtSqr, wtPoly, wtSin );
  14  
  15    TWave = class( TPersistent )
  16    public
  17      waveType: TWaveType;
  18      color: TColor;
  19      offset: integer;
  20      frequency, amplitude, volts, interval, gain: extended;
  21  
  22      procedure AssignTo(Dest: TPersistent); override;
  23    end;
  24  
  25    TWaveShape = class( TGraphicControl )
  26    protected
  27      fWaves: TList;
  28      fBoxSize: integer;
  29      fLineColor: TColor;
  30  
  31      function getWave(const index: integer): TWave;
  32      procedure setBoxSize(const Value: integer);
  33  
  34      function getBackgroundColor: TColor;
  35      procedure setBackgroundColor(const Value: TColor);
  36      procedure setLineColor(const Value: TColor);
  37  
  38    public
  39      constructor create( AOwner: TComponent ); override;
  40      destructor destroy; override;
  41  
  42      procedure clear;
  43      procedure delete( const index: integer );
  44  
  45      function add: integer;
  46  
  47      property waves[ const index: integer]: TWave read GetWave;
  48  
  49    published
  50      procedure paint; override;
  51      property boxSize: integer read fBoxSize write setBoxSize;
  52      property backgroundColor: TColor read getBackgroundColor write setBackgroundColor;
  53      property lineColor: TColor read fLineColor write setLineColor;
  54  
  55      //inherited
  56      //property Canvas;
  57      property Align;
  58      property Anchors;
  59      property Constraints;
  60      property DragCursor;
  61      property DragKind;
  62      property DragMode;
  63      property Enabled;
  64      //property Font;
  65      property ParentColor;
  66      //property ParentFont;
  67      property ParentShowHint;
  68      property PopupMenu;
  69      property ShowHint;
  70      property Visible;
  71      property OnClick;
  72      property OnContextPopup;
  73      property OnDblClick;
  74      property OnDragDrop;
  75      property OnDragOver;
  76      property OnEndDock;
  77      property OnEndDrag;
  78      property OnMouseDown;
  79      property OnMouseMove;
  80      property OnMouseUp;
  81      property OnStartDock;
  82      property OnStartDrag;
  83    end;
  84  
  85  implementation
  86  
  87  function max( const a, b: integer ): integer;
  88  begin
  89    if a > b then
  90      result := a
  91    else
  92      result := b;
  93  end;
  94  
  95  { TWaveShape }
  96  
  97  function TWaveShape.add: integer;
  98  begin
  99    result := fWaves.add( TWave.Create );
 100  end;
 101  
 102  procedure TWaveShape.clear;
 103  begin
 104    while fWaves.count > 0 do begin
 105      TWave( fWaves[0] ).free;
 106      fWaves.delete( 0 );
 107    end;
 108  end;
 109  
 110  constructor TWaveShape.create(AOwner: TComponent);
 111  begin
 112    inherited;
 113    fWaves := TList.create;
 114    fLineColor := clGray;
 115    color := clBtnFace;
 116    fBoxSize := 50;
 117  end;
 118  
 119  procedure TWaveShape.delete(const index: integer);
 120  begin
 121    if ( index > -1 ) and ( index < fWaves.count ) then begin
 122      TWave( fWaves[index] ).free;
 123      fWaves.delete( index );
 124    end;
 125  end;
 126  
 127  destructor TWaveShape.destroy;
 128  begin
 129    fWaves.free;
 130    inherited;
 131  end;
 132  
 133  function TWaveShape.getBackgroundColor: TColor;
 134  begin
 135    result := color;
 136  end;
 137  
 138  function TWaveShape.getWave(const index: integer): TWave;
 139  begin
 140    result := nil;
 141    if ( index > -1 ) and ( index < fWaves.count ) then
 142      result := TWave( fWaves[ index ] );
 143  end;
 144  
 145  procedure TWaveShape.paint;
 146  var
 147    k, x: integer;
 148    lastX, lastY: array of integer;
 149    y: extended;
 150  begin
 151    if not enabled then
 152      exit;
 153    canvas.brush.color := color;
 154    canvas.fillRect( clientRect );
 155  
 156    setLength( lastY, fWaves.count );
 157    setLength( lastX, fWaves.count );
 158    for k := 0 to high( lastY ) do begin
 159      lastY[k] := clientHeight div 2 + waves[k].offset;
 160      lastX[k] := 0;
 161    end;
 162  
 163    for x := 0 to max( clientWidth, clientHeight ) do begin
 164      with canvas do begin
 165        pen.color := fLineColor;
 166        pen.width := 1;
 167        pen.style := psDot;
 168  
 169        if x mod fBoxSize = 0 then begin
 170          moveTo( 0, x + trunc( frac( clientHeight / 2 / fBoxSize ) * fBoxSize ) );
 171          lineTo( clientWidth, x + trunc( frac( clientHeight / 2 / fBoxSize ) * fBoxSize ) );
 172  
 173          moveTo( x, 0 );
 174          lineTo( x, clientHeight );
 175        end;
 176  
 177        for k := 0 to fWaves.count - 1 do begin
 178          with waves[k] do begin
 179            pen.color := color;
 180            pen.width := 1;
 181            pen.style := psSolid;
 182  
 183            y := pi*k + PI2 * x * interval / fBoxSize * frequency;
 184  
 185            case waveType of
 186              wtSin:
 187                y := sin( y );
 188              wtPoly: begin
 189                y := frac( y / PI2 );
 190                if y <= 0.25 then
 191                  y := y / 0.25
 192                else if y <= 0.75 then
 193                  y := ( -y + 0.5 ) / 0.25
 194                else
 195                  y := ( y - 1 ) / 0.25;
 196              end;
 197              wtSqr: begin
 198                if frac( y / PI2 ) <= 0.5 then
 199                  y := 1
 200                else
 201                  y := -1;
 202              end;
 203            end;
 204            y := ( y * ( fBoxSize / volts ) * amplitude * gain ) + clientHeight / 2 + offset;
 205            moveTo( lastX[k], lastY[k] );
 206            lastX[k] := x;
 207            lastY[k] := trunc( y );
 208            lineTo( x, lastY[k] );
 209          end;
 210        end;
 211      end;
 212    end;
 213  end;
 214  
 215  procedure TWaveShape.setBackgroundColor(const Value: TColor);
 216  begin
 217    color := Value;
 218    Invalidate;
 219  end;
 220  
 221  procedure TWaveShape.setBoxSize(const Value: integer);
 222  begin
 223    fBoxSize := Value;
 224    invalidate;
 225  end;
 226  
 227  
 228  procedure TWaveShape.setLineColor(const Value: TColor);
 229  begin
 230    fLineColor := Value;
 231    Invalidate;
 232  end;
 233  
 234  { TWave }
 235  
 236  procedure TWave.AssignTo(Dest: TPersistent);
 237  begin
 238    if Dest.ClassType <> TWave then
 239      inherited;
 240    with TWave( Dest ) do begin
 241      waveType := self.waveType;
 242      color := self.color;
 243      offset := self.offset;
 244      frequency := self.frequency;
 245      amplitude := self.amplitude;
 246      volts := self.volts;
 247      interval := self.interval;
 248      gain := self.gain;
 249    end;
 250  end;
 251  
 252  end.

A simple pointer stack...

   1  
   2  unit Stack;
   3  
   4  interface
   5  
   6  uses
   7    SysUtils, Classes;
   8  
   9  type
  10    TStack = class
  11    private
  12      FList: PPointerList;
  13      FCapacity, FCount: Cardinal;
  14      procedure Grow;
  15    public
  16      destructor Destroy; override;
  17      procedure Push( const Data: Pointer );
  18      function Pop: Pointer;
  19    end;
  20  
  21  implementation
  22  
  23  { TStack }
  24  
  25  destructor TStack.Destroy;
  26  begin
  27    FreeMem( FList );
  28    inherited;
  29  end;
  30  
  31  procedure TStack.Grow;
  32  begin
  33    if FCapacity > 64 then
  34      Inc( FCapacity, FCapacity div 4 )
  35    else
  36      if FCapacity > 8 then
  37        Inc( FCapacity, 16 )
  38      else
  39        Inc( FCapacity, 4 );
  40    ReallocMem( FList, FCapacity * SizeOf( Pointer ) );
  41  end;
  42  
  43  function TStack.Pop: Pointer;
  44  begin
  45    if FCount > 0 then
  46    begin
  47      Dec( FCount );
  48      Result := FList^[FCount];
  49    end
  50    else
  51      Result := nil;
  52  end;
  53  
  54  procedure TStack.Push(const Data: Pointer);
  55  begin
  56    if FCapacity = FCount then
  57      Grow;
  58    FList^[FCount] := Data;
  59    Inc( FCount );
  60  end;
  61  
  62  end.
  63  

This is just a snippet since I didn't added some units that can be replaced without major efforts:
- PathParser.pas: parses paths shortcuts (it's on my bigbold snippets, search on my tags)
- Stack.pas: implements a simple stack (it's on my bigbold snippets, search on my tags)
- ZlibEx.pas: used to compress/decompress the file contents (My ZlibEx is a modified version of this file: http://www.dellapasqua.com/delphizlib)
- MD5.pas: used to calculate the file hash and check consistency when unjoining files
- SysUtils2: Some idiot functions =b

I used this in a personalized installer that I've made in my first job =b

unit FileJoiner;

interface

uses
  SysUtils, SysUtils2, Classes, MD5, ZlibEx, PathParser, Stack;

type
  TOverwriteMode = ( omNo, omAskUser, omIfNewer, omIfOlder, omIfDiff );
  TOverwriteAction = ( oaOverwriteAll, oaNoOverwriteAll, oaYes, oaNo );

  TFileHeader = record
    MD5Hash: TDigestStr;
    ModificationDate: TDateTime;
    Attributes: LongWord;
    Overwrite: TOverwriteMode;
    Size: Int64;
    MustKeep: Boolean;
  end;

  TFileJoinerItem = class
  public
    Source, Destiny: string;
    MustKeep, Recurse: Boolean;
    Overwrite: TOverwriteMode;

    constructor Create( const FromPath, ToPath: string; const OverwriteMode: TOverwriteMode = omIfNewer; const Recursive: Boolean = True; const MustKeepFile: Boolean = False ); overload;
    function Assign( Item: TFileJoinerItem ): TFileJoinerItem;

    procedure Save( const Stream: TStream );
    procedure Load( const Stream: TStream );
  end;

  TCustomFileJoiner = class;

  TFileJoinerFilesCallback = procedure( Sender: TCustomFileJoiner; Item: TFileJoinerItem ) of object;
  TFileJoinerNotifyEvent = procedure( Sender: TCustomFileJoiner ) of object;
  TFileJoinerFileExists = procedure( Sender: TCustomFileJoiner; var CanOverwrite: TOverwriteAction ) of object;

  TJoinerStatus = ( jsIdle, jsJoining, jsUnjoining );

  TCustomFileJoiner = class
  private
    FStream: TStream;
    FCurFile, FTotalFiles: LongWord;
    FCurSize, FTotalSize, FCurPosition, FCurWrittenBytes: Int64;
    FCurFilename: string;
    FCurFileInfo: TFileHeader;
    FOnFileExists: TFileJoinerFileExists;
    FOnWorkEnd, FOnWorkBegin, FOnWork, FOnProcessFile: TFileJoinerNotifyEvent;

    procedure ProgressNotifier( Sender: TObject );

  public
    //properties
    property CurFilename: string read FCurFilename;
    property CurFileInfo: TFileHeader read FCurFileInfo;
    property CurFilePosition: Int64 read FCurPosition;
    property CurWrittenBytes: Int64 read FCurWrittenBytes;
    property CurSize: Int64 read FCurSize;
    property CurFile: LongWord read FCurFile;

    property TotalSize: Int64 read FTotalSize;
    property TotalFiles: LongWord read FTotalFiles;

    //events
    property OnWorkBegin: TFileJoinerNotifyEvent read FOnWorkBegin write FOnWorkBegin;
    property OnWork: TFileJoinerNotifyEvent read FOnWork write FOnWork;
    property OnWorkEnd: TFileJoinerNotifyEvent read FOnWorkEnd write FOnWorkEnd;
    property OnProcessFile: TFileJoinerNotifyEvent read FOnProcessFile write FOnProcessFile;
    property OnFileExists: TFileJoinerFileExists read FOnFileExists write FOnFileExists;
  end;

  TFileJoiner = class( TCustomFileJoiner )
  private
    FPaths: TList;

    function GetItem(const Index: Integer): TFileJoinerItem;
    function GetCount: Integer;
    procedure StreamFile( Sender: TCustomFileJoiner; Item: TFileJoinerItem );
    procedure Compress( Input: TStream );

  public
    constructor Create;
    destructor Destroy; override;

    procedure Join( const Filename: string ); overload;
    procedure Join( const Stream: TStream ); overload;

    procedure SaveList( const Filename: string ); overload;
    procedure SaveList( Stream: TStream ); overload;
    procedure LoadList( const Filename: string ); overload;
    procedure LoadList( Stream: TStream ); overload;

    procedure CountFiles;

    function Add( const FromPath, ToPath: string; const OverwriteMode: TOverwriteMode = omIfNewer; const Recursive: Boolean = False; const MustKeep: Boolean = False ): Integer;
    procedure Clear;
    procedure Remove( const Index: Integer );
    procedure ListFiles( const Callback: TFileJoinerFilesCallback );

    property Count: Integer read GetCount;
    property Items[ const Index: Integer ]: TFileJoinerItem read GetItem; default;
  end;

  TFileUnjoiner = class( TCustomFileJoiner )
  private
    FDataBegin: Int64;
    procedure Decompress( Output: TStream );

  public
    procedure Assign( const Filename: string ); overload;
    procedure Assign( Stream: TStream ); overload;
    procedure UnJoin;
  end;

implementation

{ TCustomFileJoiner }

procedure TCustomFileJoiner.ProgressNotifier(Sender: TObject);
begin
  if Assigned( FOnWork ) then
    with TStream( Sender ) do
    begin
      FCurWrittenBytes := Position - FCurPosition;
      FCurPosition := Position;
      FOnWork( Self );
    end;
end;

{ TFileJoiner }

procedure TFileJoiner.Join( const Filename: string );
begin
  FStream := TFileStream.Create( Filename, fmCreate );
  try
    Join( FStream );
  finally
    FStream.Free;
  end;
end;

procedure TFileJoiner.Join( const Stream: TStream );
var
  Pos: array[0..1] of Int64;
begin
  FStream := Stream;
  if Assigned( FOnWorkBegin ) then
    FOnWorkBegin( Self );

  FCurFile := 0;
  FCurSize := 0;

  //record position to get back later and reserve space on the file to record the "totals"
  Pos[0] := FStream.Position;
  FStream.Seek( SizeOf( FCurFile ) + SizeOf( FCurSize ), soCurrent );

  //write files
  ListFiles( StreamFile );

  //write the totals and get back
  Pos[1] := Stream.Position;
  FStream.Position := Pos[0];
  FStream.Write( FCurFile, SizeOf( FCurFile ) );
  FStream.Write( FCurSize, SizeOf( FCurSize ) );
  FStream.Position := Pos[1];

  //job done
  if Assigned( FOnWorkEnd ) then
    FOnWorkEnd( Self );
end;

procedure TFileJoiner.StreamFile( Sender: TCustomFileJoiner; Item: TFileJoinerItem );
var
  InputFile: TFileStream;
  Pos: array[0..1] of Int64;
begin
  try
    Inc( FCurFile );
    FCurPosition := 0;
    FCurFilename := Item.Source;

    FCurFileInfo.MD5Hash := FileMD5Digest( Item.Source );
    FCurFileInfo.ModificationDate := FileDateToDateTime( FileAge( Item.Source ) );
    FCurFileInfo.Attributes := FileGetAttr( Item.Source );
    FCurFileInfo.Overwrite := Item.Overwrite;

    InputFile := TFileStream.Create( Item.Source, fmOpenRead or fmShareDenyWrite );
    try
      FCurFileInfo.Size := InputFile.Size;
      if Assigned( FOnProcessFile ) then
        FOnProcessFile( Self );

      Pos[0] := FStream.Position;
      //reserve space for the file header and EOF position
      FStream.Seek( SizeOf( FCurFileInfo ) + SizeOf( Pos[0] ), soCurrent );
      StringWrite( FStream, Item.Destiny );

      Compress( InputFile );

      //update the header and get back
      Pos[1] := FStream.Position;
      FStream.Position := Pos[0];
      FStream.Write( FCurFileInfo, SizeOf( FCurFileInfo ) );
      FStream.Write( Pos[1], SizeOf( Pos[1] ) );
      FStream.Position := Pos[1];

      //update summary
      Inc( FCurSize, FCurFileInfo.Size );
    finally
      InputFile.Free;
    end;
  except
    on E: Exception do
      raise EWriteError.CreateFmt( '%s.StreamFile: Error on joining: "%s" - %s',  [ ClassName, FCurFilename, E.Message ] );
  end;
end;

function TFileJoiner.Add(const FromPath, ToPath: string;
  const OverwriteMode: TOverwriteMode; const Recursive: Boolean; const MustKeep: Boolean ): Integer;
begin
  Result := FPaths.Add( TFileJoinerItem.Create( FromPath, ToPath, OverwriteMode, Recursive, MustKeep ) );
end;

procedure TFileJoiner.Clear;
var
  I: Integer;
begin
  for I := FPaths.Count - 1 downto 0 do
  begin
    TFileJoinerItem( FPaths[I] ).Free;
    FPaths.Delete( I );
  end;
end;

constructor TFileJoiner.Create;
begin
  FPaths := TList.Create;
end;

destructor TFileJoiner.Destroy;
begin
  Clear;
  FPaths.Free;
  inherited;
end;

procedure TFileJoiner.CountFiles;
type
  PStackItem = ^TStackItem;
  TStackItem = record
    Data: PChar;
    Searcher: TSearchRec;
  end;

var
  I: Integer;
  Path, Filter: string;
  Stack: TStack;
  CurStack, X: PStackItem;
begin
  FTotalFiles := 0;
  FTotalSize := 0;

  Stack := TStack.Create;
  try
    for I := 0 to FPaths.Count - 1 do
    begin
      Path := Self[I].Source;
      if LastDelimiter( '*?', ExtractFileName( Path ) ) <> 0 then
      begin
        Filter := ExtractFileName( Path );
        Path := ExtractFilePath( Path );
      end
      else if FileExists( Path ) then
      else if DirectoryExists( Path ) then
      begin
        Filter := '*';
        Path := AddSlash( Path );
      end
      else
        raise Exception.CreateFmt( '%s.GetFilesSumary: "%s" não encontrado', [ ClassName, Path ] );

      New( CurStack );
      CurStack^.Data := CopyString( Path );
      repeat
        with CurStack^ do
        begin
          if FindFirst( Data + Filter, faDirectory, Searcher ) = 0 then
          begin
            repeat
              Inc( FTotalFiles );
              Inc( FTotalSize, Searcher.Size );
            until FindNext( Searcher ) <> 0;
            FindClose( Searcher );
          end;

          if Self[I].Recurse and ( FindFirst( Data + Filter, faArchive, Searcher ) = 0 ) then
          begin
            repeat
              if Searcher.Name[1] <> '.' then
              begin
                New( X );
                X^.Data := CopyString( AddSlash( Data + Searcher.Name ) );
                Stack.Push( X );
              end;
            until FindNext( Searcher ) <> 0;
            FindClose( Searcher );
          end;
          FreeMem( Data );
          Dispose( CurStack );
          CurStack := Stack.Pop;
        end;
      until CurStack = nil;
    end;
  finally
    Stack.Free;
  end;
end;

function TFileJoiner.GetItem(const Index: Integer): TFileJoinerItem;
begin
  Result := FPaths.Items[ Index ];
end;

function TFileJoiner.GetCount: Integer;
begin
  Result := FPaths.Count;
end;

procedure TFileJoiner.ListFiles( const Callback: TFileJoinerFilesCallback);
type
  PStackItem = ^TStackItem;
  TStackItem = record
    Source, Destiny: PChar;
    Searcher: TSearchRec;
  end;

var
  Stack: TStack;
  Filter: string;
  Current, X: PStackItem;
  Data: TFileJoinerItem;
  I: Integer;
begin
  Stack := TStack.Create;
  try
    Data := TFileJoinerItem.Create;
    try
      for I := 0 to FPaths.Count - 1 do
      begin
        Data.Assign( Self[I] );
        with Data do
        begin
          Destiny := AddSlash( Destiny );
          if LastDelimiter( '*?', ExtractFileName( Source ) ) <> 0 then
          begin
            Filter := ExtractFileName( Source );
            Source := ExtractFilePath( Source );
          end
          else if FileExists( Source ) then
          begin
            Destiny := Destiny + ExtractFileName( Data.Source );
            Callback( Self, Data );
            Continue;
          end
          else if DirectoryExists( Source ) then
          begin
            Filter := '*';
            Destiny := AddSlash( Destiny + ExtractFileName( RemoveSlash( Source ) ) );
            Source := AddSlash( Source );
          end
          else
            raise Exception.CreateFmt( '%s.ListFiles: "%s" não encontrado', [ ClassName, Source ] );
        end;

        New( Current );
        with Current^ do
        begin
          Source := CopyString( Data.Source );
          Destiny := CopyString( Data.Destiny );
        end;

        repeat
          with Current^ do
          begin
            if FindFirst( Source + Filter, faDirectory, Searcher ) = 0 then
            begin
              repeat
                Data.Source := Source + Searcher.Name;
                Data.Destiny := Destiny + Searcher.Name;
                Callback( Self, Data )
              until FindNext( Searcher ) <> 0;
              FindClose( Searcher );
            end;

            if Data.Recurse and ( FindFirst( Source + '*', faArchive, Searcher ) = 0 ) then
            begin
              repeat
                if Searcher.Name[1] <> '.' then
                begin
                  New( X );
                  X^.Source := CopyString( AddSlash( Source + Searcher.Name ) );
                  X^.Destiny := CopyString( AddSlash( Destiny + Searcher.Name ) );
                  Stack.Push( X );
                end;
              un

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 :)

   1  
   2  //
   3  //    TNotesSeeker - classe de buscas do Notes.
   4  //
   5  //    Notes, http://notes.codigolivre.org.br
   6  //    Copyright (C) 2003-2004, Equipe do Notes.
   7  //
   8  //    This program is free software; you can redistribute it and/or modify
   9  //    it under the terms of the GNU General Public License as published by
  10  //    the Free Software Foundation; either version 2 of the License, or
  11  //    (at your option) any later version.
  12  //
  13  //    This program is distributed in the hope that it will be useful,
  14  //    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  //    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16  //    GNU General Public License for more details.
  17  //
  18  //    You should have received a copy of the GNU General Public License
  19  //    along with this program; if not, write to the Free Software
  20  //    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21  //
  22  //    **************************************************************
  23  //    Revision #0
  24  //      Version  : 1.0.0
  25  //      Date     : 2003-11-30 22:00:00 GMT -3:00
  26  //      Reviewer : Jonas Raoni Soares Silva
  27  //      Changes  : Criada a classe.
  28  //    **************************************************************
  29  //    Revision #1
  30  //      Version  : 1.0.1
  31  //      Date     : 2004-09-09 03:30:00 GMT -3:00
  32  //      Reviewer : Jonas Raoni Soares Silva
  33  //      Changes  : Acho q acabaram-se os bugs... Será??? :]
  34  //    **************************************************************
  35  
  36  (*
  37  @abstract(NotesSeeker - classe de buscas do Notes.)
  38  @author(Jonas Raoni Soares Silva <jonblackjack@bol.com.br>)
  39  @created(30 Nov 2003)
  40  *)
  41  
  42  unit NotesSeeker;
  43  
  44  interface
  45  
  46  uses
  47    SysUtils, Classes;
  48  
  49  type
  50  
  51  {
  52    @code(ENotesSeekerException) -
  53      Notificar erros na classe TNotesSeeker de forma
  54      profissional, facilitando a interceptação e/ou log de
  55      erros
  56  }
  57    ENotesSeekerException = class ( Exception )
  58    public
  59      constructor Create(const Msg: string);
  60      constructor CreateFmt(const Msg: string; const Args: array of const);
  61    end;
  62  
  63    {Opões de pesquisa: <BR>
  64     @code(nsHandleEOL) - se você precisar buscar por quebras de linhas, você precisa setar esta opção.<BR>
  65     @code(nsCaseSensitive) - diferenciar maiúsculas de minúsculas.<BR>
  66     @code(nsWholeWords) - retorna apenas palavras inteiras.<BR>
  67     @code(nsBackward) - busca de traz para frente. <BR>
  68     @code(nsHandleWildCard) - usa coringas * e ? na pesquisa.}
  69    TNotesSeekerOption = ( nsHandleEOL, nsCaseSensitive, nsWholeWords, nsBackward, nsHandleWildCard );
  70    { Set de @link(TNotesSeekerOption).}
  71    TNotesSeekerOptions = set of TNotesSeekerOption;
  72  
  73    TSearchFunction = function: Boolean of object;
  74  
  75  {
  76    @code(TNotesSeeker) -
  77      Permite fazer buscas em strings com várias opções
  78  }
  79    TNotesSeeker = class(TObject)
  80    private
  81      Jump, LineJump: Cardinal;
  82      FList: TList;
  83    protected
  84      FMatches, FStartAt, FEOLLen, FSearchLen, FCurCol,
  85      FCurLine, FMatchLen, FMatchLine, FMatchCol: Cardinal;
  86  
  87      FBufferEnd, FBuffer, FBufferBegin, FBufferBackup,
  88      FEOL, FSearchBegin, FSearch, FSearchEnd: PChar;
  89  
  90      FOptions: TNotesSeekerOptions;
  91  
  92      FContextRightLenght, FContextLeftLenght: Cardinal;
  93  
  94      FKeepText: Boolean;
  95  
  96      function GetText: string;
  97      function GetReplacedText: string;
  98      function GetContext: string;
  99      function GetSearchStr: string;
 100      function GetRemainingText: string;
 101      function GetCurByte: Cardinal;
 102      function GetEOL: string;
 103  
 104      procedure SetOptions(const Value: TNotesSeekerOptions);
 105      procedure SetText( const Value: string);
 106      procedure SetSearchStr(const Value: string);
 107      procedure SetEOL(const Value: string);
 108  
 109      procedure FreeBuffer;
 110      procedure FreeEOL;
 111      procedure FreeSearchStr;
 112  
 113      {Search Engines}
 114      function SearchForward: Boolean;
 115      function SearchForwardWithWildCard: