# cf. http://www.ruby-forum.com/topic/97105

6.times { k=0; p $*.map!{|i|k+k=i} << 1 }

# ... or ...

ar=[]; 6.times { k=0; p ar.map!{|i|k+k=i} << 1 }


# a more general approach (for polynomials)

class Polynomial

   def triangle(nterms, row, pos=nil)

      return nil if nterms < 2 || row < 1
      nterms = nterms - 2
      num_of_rows = row

      var1 = 0 + nterms   
      var2 = 1 + nterms
      var3 = 3 + nterms 
  
      ar1 = [0, 1, 0]   # first row
      var1.times { ar1.push(0) }
      var1.times { ar1.unshift(0) }

      ar2 = []
      ar3 = []
      ar4 = [[1]]

      for num in 0..(num_of_rows - 1)  

         nextnum = ar1.size - var2

         for nextn in 1..nextnum
            sum = 0
            count = 0
            ar1.each do |n|  
               count += 1 
               if count < var3 then t = sum += n; ar2 << t else break end 
            end

            ar3 << ar2.last
            ar2.clear
            ar1.shift

         end   # second for-loop

         ar1.clear
         ar1 << ar3
         ar1.flatten!

         var2.times { ar1.push(0) }
         var2.times { ar1.unshift(0) }

         ar4 << ar3
         ar3 = []

      end  # first for-loop

      if !pos.nil?
         ret = ar4.at(row).at(pos)
         return "No such position: #{pos} in row: #{row}" if ret.nil?
         ret
      else
         ar4.map! { |r| r.join('-') }
         ar4
      end
   end 
end 


puts Polynomial.new.triangle(2, 5)
puts Polynomial.new.triangle(3, 5)
puts Polynomial.new.triangle(4, 5)
puts Polynomial.new.triangle(5, 5)
puts Polynomial.new.triangle(5, 4, 8)
puts Polynomial.new.triangle(4, 9)
puts Polynomial.new.triangle(4, 9, 10)


#------------------------


class Integer
   def fak
      f=1
      (2..self).each { |i| f *= i   }
      f
   end
end

module Enumerable
   def sum
      inject { |n, m| n + m  }
   end
end

# cf. http://blade.nagaokaut.ac.jp/~sinara/ruby/math/combinatorics/array-rep_perm.rb
class Array
  def rep_perm(n)
    if n < 0
    elsif n == 0
      yield([])
    else
      rep_perm(n - 1) do |x|
	each do |y|
	  yield(x + [y])
	end
      end
    end
  end
end


nterms = 2
exponent = 80
exponent = 8

# create the same number of variable names as there are terms 
# example: ['a', 'b'] for (a+b)**3

var_names = ('a'..'z').to_a.slice(0, nterms)
#var_names = (('a'..'z').to_a << ('A'..'Z').to_a << ('aa'..'zz').to_a).flatten!.slice(0, nterms)

ar1 = []
(0..exponent).to_a.rep_perm(nterms) { |x| p x; ar1 << x if x.sum == exponent }   # example: ... if [2,6].sum == 8
ar1.reverse!

#p ar1
#puts ar1

ar2 = []

ar1.each do |term|

   #puts "term: #{term.inspect}"  # example: term: [5, 0, 0]
   count = 0
   var1 = 1
   term.each { |i| var1 *= i.fak }
   var2 = exponent.fak / var1 
   var3 = "#{var2}   (  #{ term.join('-') << '-' } )"  # prepare term for parsing with gsub below
   ar2 << var3

end

#p ar2

result = ar2.collect do |term|
   p term
   count = -1
   term.gsub!(/(\d+)-/)  { count += 1;  "#{var_names.at(count)}" << '**' << $1 << ' ' }
   term.gsub!(/^(\d+)( +)/, '\1\2*\2')
end

puts result

unit SLLMan;
interface
type
  PSLLItem = ^TSLLItem;
  TSLLItem = record
    Next: pointer;
    Data: pointer;
   end;

function llsGetItem(id: cardinal; var start: pointer): pointer;
function llsTakeOutItem(id: cardinal; var start: pointer): pointer;
procedure llsInsertItem(item: pointer; var start: pointer);
function llsGetItemCount(start: pointer): cardinal;
function llsNewSLLHeader: PSLLItem;
procedure llsKillSLLHeader(hdr: pointer);
       // These ids are numbered from 0
implementation
function malloc(size: cardinal): pointer;
begin
  GetMem(result,size);
end;
function llsGetItemCount(start: pointer): cardinal;
var
  cur: PSLLItem;
  tmp: cardinal;
begin
  if start = nil then begin llsGetItemCount := 0; Exit; end;
  tmp := 1;  cur := start;
  while (cur^.Next <> nil) do
  begin
    Inc(tmp);
    cur := cur^.Next;
  end;
  llsGetItemCount := tmp;
end;
procedure llsKillSLLHeader(hdr: pointer);
begin
  if hdr = nil then Exit;
  Free(hdr);
end;
function llsNewSLLHeader: PSLLItem;
var
  tmp: PSLLItem;
begin
  tmp := malloc(sizeof(TSLLItem));
  tmp^.Next := nil;
  tmp^.Data := nil;
  llsNewSLLHeader := tmp;
end;
function llsGetItem(id: cardinal; var start: pointer): pointer;
var
  cur: PSLLItem;
begin
  if start = nil then begin llsGetItem := nil; Exit; end;
  cur := start;
  while (id<>0) do
  begin
    if cur^.Next <> nil then
        begin
          Dec(id);
          cur := cur^.Next;
        end else
        begin
          llsGetItem := nil;
          Exit;
        end;
  end;
  llsGetItem := cur;
end;

function llsTakeOutItem(id: cardinal; var start: pointer): pointer;
var
  tmp: PSLLItem;
  last: PSLLItem;
begin
  if start = nil then begin llsTakeOutItem := nil; Exit; end;
  if (id = 0) then
    begin
      tmp := start;
      if tmp^.Next = nil then start := nil else start := tmp^.Next;
      llsTakeOutItem := tmp;
      Exit;
    end;
  tmp := start;
  repeat
    dec(id);
    last := tmp;
    tmp := tmp^.Next;
  until (id = 0);
  last^.Next := tmp^.Next;
  llsTakeOutitem := tmp;
end;
procedure llsInsertItem(item: pointer; var start: pointer);
var
  cur: PSLLItem;
begin
 if start = nil then
  begin
    start := item;
    exit;
  end;
 cur := start;
 while (cur^.Next<>nil) do cur := cur^.Next;
 cur^.Next := item;
end;

end.

unit WavePlotter;

interface

uses
  forms, dialogs, SysUtils, Classes, Controls, Graphics;

const
  PI2 = PI * 2;

type
  TWaveType = ( wtSqr, wtPoly, wtSin );

  TWave = class( TPersistent )
  public
    waveType: TWaveType;
    color: TColor;
    offset: integer;
    frequency, amplitude, volts, interval, gain: extended;

    procedure AssignTo(Dest: TPersistent); override;
  end;

  TWaveShape = class( TGraphicControl )
  protected
    fWaves: TList;
    fBoxSize: integer;
    fLineColor: TColor;

    function getWave(const index: integer): TWave;
    procedure setBoxSize(const Value: integer);

    function getBackgroundColor: TColor;
    procedure setBackgroundColor(const Value: TColor);
    procedure setLineColor(const Value: TColor);

  public
    constructor create( AOwner: TComponent ); override;
    destructor destroy; override;

    procedure clear;
    procedure delete( const index: integer );

    function add: integer;

    property waves[ const index: integer]: TWave read GetWave;

  published
    procedure paint; override;
    property boxSize: integer read fBoxSize write setBoxSize;
    property backgroundColor: TColor read getBackgroundColor write setBackgroundColor;
    property lineColor: TColor read fLineColor write setLineColor;

    //inherited
    //property Canvas;
    property Align;
    property Anchors;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    //property Font;
    property ParentColor;
    //property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

function max( const a, b: integer ): integer;
begin
  if a > b then
    result := a
  else
    result := b;
end;

{ TWaveShape }

function TWaveShape.add: integer;
begin
  result := fWaves.add( TWave.Create );
end;

procedure TWaveShape.clear;
begin
  while fWaves.count > 0 do begin
    TWave( fWaves[0] ).free;
    fWaves.delete( 0 );
  end;
end;

constructor TWaveShape.create(AOwner: TComponent);
begin
  inherited;
  fWaves := TList.create;
  fLineColor := clGray;
  color := clBtnFace;
  fBoxSize := 50;
end;

procedure TWaveShape.delete(const index: integer);
begin
  if ( index > -1 ) and ( index < fWaves.count ) then begin
    TWave( fWaves[index] ).free;
    fWaves.delete( index );
  end;
end;

destructor TWaveShape.destroy;
begin
  fWaves.free;
  inherited;
end;

function TWaveShape.getBackgroundColor: TColor;
begin
  result := color;
end;

function TWaveShape.getWave(const index: integer): TWave;
begin
  result := nil;
  if ( index > -1 ) and ( index < fWaves.count ) then
    result := TWave( fWaves[ index ] );
end;

procedure TWaveShape.paint;
var
  k, x: integer;
  lastX, lastY: array of integer;
  y: extended;
begin
  if not enabled then
    exit;
  canvas.brush.color := color;
  canvas.fillRect( clientRect );

  setLength( lastY, fWaves.count );
  setLength( lastX, fWaves.count );
  for k := 0 to high( lastY ) do begin
    lastY[k] := clientHeight div 2 + waves[k].offset;
    lastX[k] := 0;
  end;

  for x := 0 to max( clientWidth, clientHeight ) do begin
    with canvas do begin
      pen.color := fLineColor;
      pen.width := 1;
      pen.style := psDot;

      if x mod fBoxSize = 0 then begin
        moveTo( 0, x + trunc( frac( clientHeight / 2 / fBoxSize ) * fBoxSize ) );
        lineTo( clientWidth, x + trunc( frac( clientHeight / 2 / fBoxSize ) * fBoxSize ) );

        moveTo( x, 0 );
        lineTo( x, clientHeight );
      end;

      for k := 0 to fWaves.count - 1 do begin
        with waves[k] do begin
          pen.color := color;
          pen.width := 1;
          pen.style := psSolid;

          y := pi*k + PI2 * x * interval / fBoxSize * frequency;

          case waveType of
            wtSin:
              y := sin( y );
            wtPoly: begin
              y := frac( y / PI2 );
              if y <= 0.25 then
                y := y / 0.25
              else if y <= 0.75 then
                y := ( -y + 0.5 ) / 0.25
              else
                y := ( y - 1 ) / 0.25;
            end;
            wtSqr: begin
              if frac( y / PI2 ) <= 0.5 then
                y := 1
              else
                y := -1;
            end;
          end;
          y := ( y * ( fBoxSize / volts ) * amplitude * gain ) + clientHeight / 2 + offset;
          moveTo( lastX[k], lastY[k] );
          lastX[k] := x;
          lastY[k] := trunc( y );
          lineTo( x, lastY[k] );
        end;
      end;
    end;
  end;
end;

procedure TWaveShape.setBackgroundColor(const Value: TColor);
begin
  color := Value;
  Invalidate;
end;

procedure TWaveShape.setBoxSize(const Value: integer);
begin
  fBoxSize := Value;
  invalidate;
end;


procedure TWaveShape.setLineColor(const Value: TColor);
begin
  fLineColor := Value;
  Invalidate;
end;

{ TWave }

procedure TWave.AssignTo(Dest: TPersistent);
begin
  if Dest.ClassType <> TWave then
    inherited;
  with TWave( Dest ) do begin
    waveType := self.waveType;
    color := self.color;
    offset := self.offset;
    frequency := self.frequency;
    amplitude := self.amplitude;
    volts := self.volts;
    interval := self.interval;
    gain := self.gain;
  end;
end;

end.

unit Stack;

interface

uses
  SysUtils, Classes;

type
  TStack = class
  private
    FList: PPointerList;
    FCapacity, FCount: Cardinal;
    procedure Grow;
  public
    destructor Destroy; override;
    procedure Push( const Data: Pointer );
    function Pop: Pointer;
  end;

implementation

{ TStack }

destructor TStack.Destroy;
begin
  FreeMem( FList );
  inherited;
end;

procedure TStack.Grow;
begin
  if FCapacity > 64 then
    Inc( FCapacity, FCapacity div 4 )
  else
    if FCapacity > 8 then
      Inc( FCapacity, 16 )
    else
      Inc( FCapacity, 4 );
  ReallocMem( FList, FCapacity * SizeOf( Pointer ) );
end;

function TStack.Pop: Pointer;
begin
  if FCount > 0 then
  begin
    Dec( FCount );
    Result := FList^[FCount];
  end
  else
    Result := nil;
end;

procedure TStack.Push(const Data: Pointer);
begin
  if FCapacity = FCount then
    Grow;
  FList^[FCount] := Data;
  Inc( FCount );
end;

end.

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

//
//    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 <jonblackjack@bol.com.br>)
@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: <BR>
   @code(nsHandleEOL) - se você precisar buscar por quebras de linhas, você precisa setar esta opção.<BR>
   @code(nsCaseSensitive) - diferenciar maiúsculas de minúsculas.<BR>
   @code(nsWholeWords) - retorna apenas palavras inteiras.<BR>
   @code(nsBackward) - busca de traz para frente. <BR>
   @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;