pretraga fajlova

List.Items.Add(s+SearchRec.Name+IntToStr(PosInFile(ja,s+SearchRec.Name))); { Adding to list }
http://atviewer.sourceforge.net/atstreamsearch.htm
http://www.yunqa.de/delphi/products/tntunicodecontrols/index
https://community.embarcadero.com/images/38980/Delphi_and_Unicode.pdf
https://www.embarcadero.com/images/old/dm/technical-papers/delphi-in-a-unicode-world-updated.pdf
-------------------------

procedure TForm1.AddAllFilesInDir(const Dir: string);
var
  SR: TSearchRec;
begin
  if FindFirst(IncludeTrailingBackslash(Dir) + '*.*', faAnyFile or faDirectory, SR) = 0 then
    try
      repeat
        if (SR.Attr and faDirectory) = 0 then
          ListBox1.Items.Add(SR.Name)
        else if (SR.Name <> '.') and (SR.Name <> '..') then
          AddAllFilesInDir(IncludeTrailingBackslash(Dir) + SR.Name);  // recursive call!
      until FindNext(Sr) <> 0;
    finally
      FindClose(SR);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.BeginUpdate;
  AddAllFilesInDir('C:\Users\Andreas Rejbrand\Documents\Aweb');
  ListBox1.Items.EndUpdate;
end;


------------------------

procedure FindDocs(const Root: string);
var
  SearchRec: TSearchRec;
  Folders: array of string;
  Folder: string;
  I: Integer;
  Last: Integer;
begin
  SetLength(Folders, 1);
  Folders[0] := Root;
  I := 0;
  while (I < Length(Folders)) do
  begin
    Folder := IncludeTrailingBackslash(Folders[I]);
    Inc(I);
    { Collect child folders first. }
    if (FindFirst(Folder + '*.*', faDirectory, SearchRec) = 0) then
    begin
      repeat
        if not ((SearchRec.Name = '.') or (SearchRec.Name = '..')) then
        begin
          Last := Length(Folders);
          SetLength(Folders, Succ(Last));
          Folders[Last] := Folder + SearchRec.Name;
        end;
      until (FindNext(SearchRec) <> 0);
      FindClose(SearchRec);
    end;
    { Collect files next.}
    if (FindFirst(Folder + '*.doc', faAnyFile - faDirectory, SearchRec) = 0) then
    begin
      repeat
        if not ((SearchRec.Attr and faDirectory) = faDirectory) then
        begin
          WriteLn(Folder, SearchRec.Name);
        end;
      until (FindNext(SearchRec) <> 0);
      FindClose(SearchRec);
    end;
  end;
end;


----------------------------



procedure TForm1.Button1Click(Sender: TObject);
begin
GetAllSubFolders(Edit1.Text);
end;

procedure TForm1.GetAllSubFolders(sPath: String);
var
Path : String;
Rec : TSearchRec;
begin
try
Path := IncludeTrailingBackslash(sPath);
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if (Rec.Name<>'.') and (Rec.Name<>'..') then
begin
ListBox1.Items.Add(Path+Rec.Name);
GetAllSubFolders(Path + Rec.Name);
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
except
on e: Exception do
Showmessage('Err : TForm1.GetAllSubFolders - '+e.Message);
end;
end;



-----------------------



procedure GetSubDirs(const sRootDir: string; slt: TStrings);
var
  srSearch: TSearchRec;
  sSearchPath: string;
  sltSub: TStrings;
  i: Integer;
begin
  sltSub := TStringList.Create;
  slt.BeginUpdate;
  try
    sSearchPath := AddDirSeparator(sRootDir);
    if FindFirst(sSearchPath + '*', faDirectory, srSearch) = 0 then
      repeat
        if ((srSearch.Attr and faDirectory) = faDirectory) and
          (srSearch.Name <> '.') and
          (srSearch.Name <> '..') then
        begin
          slt.Add(sSearchPath + srSearch.Name);
          sltSub.Add(sSearchPath + srSearch.Name);
        end;
      until (FindNext(srSearch) <> 0);

    FindClose(srSearch);

    for i := 0 to sltSub.Count - 1 do
      GetSubDirs(sltSub.Strings[i], slt);
  finally
    slt.EndUpdate;
    FreeAndNil(sltSub);
  end;
end;


------------------------------


procedure TForm1.ListDir(Path:String; List:TListBox);
{Path : string that contains start path for listing filenames and directories
 List : List box in which found filenames are going to be stored }
var
SearchRec:TsearchRec;
Result:integer;
S:string; { Used to hold current directory, GetDir(0,s) }
begin
     try {Exception handler }
        ChDir(Path);
     except on EInOutError do
            begin
                 MessageDlg('Error occurred by trying to change directory',mtWarning,[mbOK],0);
                 Exit;
            end;
     end;
     if length(path)<> 3 then path:=path+'\';   { Checking if path is root, if not add }
     FindFirst(path+'*.*',faAnyFile,SearchRec); { '\' at the end of the string         }
                                                { and then add '*.*' for all file     }
     Repeat
           if SearchRec.Attr=faDirectory then   { if directory then }
           begin
                if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then { Ignore '.' and '..' }
                begin
                     GetDir(0,s); { Get current dir of default drive }
                     if length(s)<>3 then s:=s+'\'; { Checking if root }
                     List.Items.Add(s+SearchRec.Name); { Adding to list }
                     ListDir(s+SearchRec.Name,List); { ListDir found directory }
                end;
           end
           else { if not directory }
           begin
                GetDir(0,s); { Get current dir of default drive }
                if length(s)<>3 then List.items.add(s+'\'+SearchRec.Name) { Checking if root }
                   else List.items.add(s+SearchRec.Name); { Adding to list }
           end;
           Result:=FindNext(SearchRec);
           Application.ProcessMessages;
     until result<>0; { Found all files, go out }
     GetDir(0,s);
     if length(s)<>3 then ChDir('..'); { if not root then go back one level }
end;


---------------------------


procedure GetFiles(APath: string; AExt: string; AList: TStrings; ARecurse:
boolean);
var
  theExt:       string;
  searchRec: SysUtils.TSearchRec;
begin
  if APath[Length(APath)] <> '\' then
    APath := APath + '\';
  AList.AddObject(APath, Pointer(-1));
  if FindFirst(APath + '*.*', faAnyFile, searchRec) = 0 then try
    repeat
      with searchRec do begin
        if (Name <> '.') and (Name <> '..') then
          if (Attr and faDirectory <= 0) then begin
            theExt := '*' + UpperCase(ExtractFileExt(searchRec.Name));
            if (AExt = '*.*') or (theExt = UpperCase(AExt)) then
              AList.AddObject(searchRec.Name, Pointer(0))
          end
          else begin
            if ARecurse then begin
              GetFiles(APath + Name + '\', AExt, AList, ARecurse);
            end;
          end;
      end; {with searchRec...}
      Application.ProcessMessages;
    until FindNext(searchRec) <> 0;
  finally
    SysUtils.FindClose(searchRec);
  end;
end;

----------------------------------



function PosInFile(Str,FileName:string):integer;
var
   Buffer : array [0..1023] of char;
   BufPtr,BufEnd:integer;
   F:File;
   Index : integer;
   Increment : integer;
   c : char;

function NextChar : char;
 begin
   if BufPtr>=BufEnd then
   begin
     BlockRead(F,Buffer,1024,BufEnd);
     BufPtr := 0;
     Form1.ProgressBar1.Position := FilePos(F);
     Application.ProcessMessages;
   end;
   Result := Buffer[BufPtr];
   Inc(BufPtr);
 end;

 begin
   Result := -1;
   AssignFile(F,FileName);
   Reset(F,1);
   Form1.ProgressBar1.Max := FileSize(F);
   BufPtr:=0;
   BufEnd:=0;
   Index := 0;
   Increment := 1;
   repeat
     c:=NextChar;
     if c=Str[Increment] then
       Inc(Increment)
     else
     begin
       Inc(Index,Increment);
       Increment := 1;
     end;
     if Increment=(Length(Str)+1) then
     begin
       Result := Index;
       break;
     end;
   until BufEnd = 0;
   CloseFile(F);
   Form1.ProgressBar1.Position := 0;
 end;


-------------------------


function ScanFile( const filename: String; const forString: String;
  caseSensitive: Boolean ): LongInt;
  { returns position of string in file or -1, if not found }
const
  BufferSize= $8001;  { 32K + 1 bytes }
var
  pBuf, pEnd, pScan, pPos: Pchar;
  filesize: LongInt;
  bytesRemaining: LongInt;
  bytesToRead: Word;
  F: File;
  SearchFor: Pchar;
  oldMode: Word;
begin
  Result := - 1;  { assume failure }
  if (Length( forString ) = 0) or (Length( filename ) = 0) then
    Exit;
  SearchFor := Nil;
  pBuf := Nil;
  { open file as binary, 1 byte recordsize }
  AssignFile( F, filename );
  oldMode := FileMode;
  FileMode := 0;  { read-only access }
  Reset( F, 1 );
  FileMode := oldMode;
  try  { allocate memory for buffer and pchar search string }
    SearchFor := StrAlloc( Length( forString ) +1 );
    StrPCopy( SearchFor, forString );
    if not caseSensitive then  { convert to upper case }
      AnsiUpper( SearchFor );
    GetMem( pBuf, BufferSize );
    filesize := System.Filesize( F );
    bytesRemaining := filesize;
    pPos := Nil;
    while bytesRemaining > 0 do
    begin
      { calc how many bytes to read this round }
      if bytesRemaining >= BufferSize then
        bytesToRead := Pred( BufferSize )
      else
        bytesToRead := bytesRemaining;
        { read a buffer full and zero-terminate the buffer }
      BlockRead( F, pBuf^, bytesToRead, bytesToRead );
      pEnd := @pBuf[ bytesToRead ];
      pEnd^ := #0;
      { scan the buffer. Problem: buffer may contain #0 chars! So we
      treat it as a concatenation of zero-terminated strings. }
      pScan := pBuf;
      while pScan < pEnd do
      begin
        if not caseSensitive then  { convert to upper case }
          AnsiUpper( pScan );
        pPos := StrPos( pScan, SearchFor );  { search for substring }
        if pPos <> Nil then
        begin  { Found it! }
          Result := FileSize - bytesRemaining + LongInt( pPos )
            - LongInt( pBuf );
          Break;
        end;
        pScan := StrEnd( pScan );
        Inc( pScan );
      end;
      if pPos <> Nil then
        Break;
      bytesRemaining := bytesRemaining - bytesToRead;
      if bytesRemaining > 0 then
      begin
        { no luck in this buffers load. We need to handle the case of
        the search string spanning two chunks of file now. We simply
        go back a bit in the file and read from there, thus inspecting
        some characters twice }
        Seek( F, FilePos(F) - Length( forString ));
        bytesRemaining := bytesRemaining + Length( forString );
      end;
    end;
  finally
    CloseFile( F );
    if SearchFor <> Nil then
      StrDispose( SearchFor );
    if pBuf <> Nil then
      FreeMem( pBuf, BufferSize );
  end;
end;


-------------------------

procedure TForm1.Button1Click(Sender: TObject);
var
  FromF, ToF: file;
  NumRead, NumWritten: Integer;
  Buf: array[1..2048] of Char;
begin
  if OpenDialog1.Execute then     { Display Open dialog box. }
  begin
    AssignFile(FromF, OpenDialog1.FileName);
    Reset(FromF, 1); { Record size = 1 }
    if SaveDialog1.Execute then      { Display Save dialog box. }
    begin
      AssignFile(ToF, SaveDialog1.FileName); { Open output file. }
      Rewrite(ToF, 1); { Record size = 1 }
      Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF))
        + ' bytes...');
      repeat
        System.BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (NumWritten <> NumRead);
      // Use CloseFile rather than Close; Close is provided for backward compatibility.
      CloseFile(FromF);
      CloseFile(ToF);
      Canvas.TextOut(120, 10, ' done.');
    end;
  end;
end;

-------------------------




//search and replace

Var
  TheFile : String;
  SearchStringPos : Integer;
  YourSearchString : ShortString;
  YourReplaceString : ShortString;
begin
  RichEdit1.PlainText:=true;
  RichEdit1.Lines.LoadFromFile('YourFile.html');
  YourSearchString := '<BR>';
  YourReplaceString := '<HR>';
  TheFile:=RichEdit1.Text;
  SearchStringPos:=Pos(YourSearchString,TheFile);
  While SearchStringPos > 0 do
  begin
    RichEdit1.SelStart:=SearchStringPos-1;
    RichEdit1.SelLength:=length(YourSearchString);
    RichEdit1.SelText:=YourReplaceString;
    TheFile:=RichEdit1.Text;
    SearchStringPos:=Pos(YourSearchString,TheFile)
  end;
  RichEdit1.Lines.SaveToFile('YourFile.html');
end;


-------------------------
//SysUtils unit

TS := TStringList.Create;
try
  TS.LoadFromFile(filename);
  TS.Text := StringReplace(TS.Text, 'foo', 'bar', [rfreplaceAll]);
  TS.SaveToFile(filename);
finally
  TS.Free;
end;



//TS.Text := StringReplace(TS.Text, '<hr>', '<br>', [rfreplaceAll,rfIgnoreCase]);
-----------------------------