Beogradsko programiranje: 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]);
-----------------------------

Beogradsko programiranje

beogradsko programiranje

Monday, February 20, 2017

pretraga fajlova