Eğer yavaşlık kaynağının Dosya_kontrol() fonksiyonu olduğuna emin iseniz;
1- Pos() fonksiyonu ile aşağıdaki fonksiyonları kıyaslayıp daha performanslı olanı kullanabilirsiniz.
Kod: Tümünü seç
function PosEx_Sha_Pas_2(const SubStr, S: string; Offset: Integer = 1): Integer;
Type
PInteger =^Integer;
var
len, lenSub: Integer;
ch: char;
p, pSub, pStart, pStop: pchar;
label
Loop0, Loop4,
TestT, Test0, Test1, Test2, Test3, Test4,
AfterTestT, AfterTest0,
Ret, Exit;
begin;
pSub := pointer(SubStr);
p := pointer(S);
if (p = nil) or (pSub = nil) or (Offset < 1) then
begin;
Result := 0;
goto Exit;
end;
lenSub := PLongInt(PByte(pSub) - 4)^ - 1; // <- Modified
len := PLongInt(PByte(p) - 4)^; // <- Modified
if (len < lenSub + Offset) or (lenSub < 0) then
begin;
Result := 0;
goto Exit;
end;
pStop := p + len;
p := p + lenSub;
pSub := pSub + lenSub;
pStart := p;
p := p + Offset + 3;
ch := pSub[0];
lenSub := -lenSub;
if p < pStop then
goto Loop4;
p := p - 4;
goto Loop0;
Loop4:
if ch = p[-4] then
goto Test4;
if ch = p[-3] then
goto Test3;
if ch = p[-2] then
goto Test2;
if ch = p[-1] then
goto Test1;
Loop0:
if ch = p[0] then
goto Test0;
AfterTest0:
if ch = p[1] then
goto TestT;
AfterTestT:
p := p + 6;
if p < pStop then
goto Loop4;
p := p - 4;
if p < pStop then
goto Loop0;
Result := 0;
goto Exit;
Test3:
p := p - 2;
Test1:
p := p - 2;
TestT:
len := lenSub;
if lenSub <> 0 then
repeat
;
if (pSub[len] <> p[len + 1]) or (pSub[len + 1] <> p[len + 2]) then
goto AfterTestT;
len := len + 2;
until len >= 0;
p := p + 2;
if p <= pStop then
goto Ret;
Result := 0;
goto Exit;
Test4:
p := p - 2;
Test2:
p := p - 2;
Test0:
len := lenSub;
if lenSub <> 0 then
repeat
;
if (pSub[len] <> p[len]) or (pSub[len + 1] <> p[len + 1]) then
goto AfterTest0;
len := len + 2;
until len >= 0;
Inc(p);
Ret:
Result := p - pStart;
Exit:
end;
Kaynak:
http://fastcode.sourceforge.net/
Kod: Tümünü seç
function RPos(const aSubStr, aString : String; const aStartPos: Integer): Integer; overload;
var
i: Integer;
pStr: PChar;
pSub: PChar;
begin
pSub := Pointer(aSubStr);
for i := aStartPos downto 1 do
begin
pStr := @(aString[i]);
if (pStr^ = pSub^) then
begin
if CompareMem(pSub, pStr, Length(aSubStr)) then
begin
result := i;
EXIT;
end;
end;
end;
result := 0;
end;
function RPos(const aSubStr, aString : String): Integer; overload;
begin
result := RPos(aSubStr, aString, Length(aString) - Length(aSubStr) + 1);
end;
Kaynak:
http://stackoverflow.com/questions/1548 ... ng-from-th
2- Dosya okuma kısmını da optimize ederek aşağıdaki fonksiyonları kullanarak dosya içinde arama yapabilirsiniz. Bu fonksiyonlar dosya ortasında aranan değeri bulur ise devamını okumadan dosyayı kapatıp sonucu geri çevirecektir.
Kod: Tümünü seç
function StringInFile(strFind, strFileName: string): boolean;
const
BUFSIZE = 8192;
var
fstm: TFileStream;
numread: Longint;
buffer: array [0..BUFSIZE-1] of char;
szFind: array [0..255] of char;
found: boolean;
begin
StrPCopy(szFind, strFind);
found := False;
fstm := TFileStream.Create(strFileName, fmOpenRead);
repeat
numread := fstrm.Read(Buffer, BUFSIZE);
if BMFind(szFind, Buffer, numread) >= 0 then
found := True
else if numread = BUFSIZE then // more to scan
fstm.Position := fstmPosition - (Length(strFind)-1);
until found or (numread < BUFSIZE);
fstm.Free;
Result := found;
end;
function BMFind(szSubStr, buf: PChar; iBufSize: integer): integer;
{ Returns -1 if substring not found,
or zero-based index into buffer if substring found }
var
iSubStrLen: integer;
skip: array [char] of integer;
found: boolean;
iMaxSubStrIdx: integer;
iSubStrIdx: integer;
iBufIdx: integer;
iScanSubStr: integer;
mismatch: boolean;
iBufScanStart: integer;
ch: char;
begin
{ Initialisations }
found := False;
Result := -1;
{ Check if trivial scan for empty string }
iSubStrLen := StrLen(szSubStr);
if iSubStrLen = 0 then
begin
Result := 0;
Exit
end;
iMaxSubStrIdx := iSubStrLen - 1;
{ Initialise the skip table }
for ch := Low(skip) to High(skip) do skip[ch] := iSubStrLen;
for iSubStrIdx := 0 to (iMaxSubStrIdx - 1) do
skip[szSubStr[iSubStrIdx]] := iMaxSubStrIdx - iSubStrIdx;
{ Scan the buffer, starting comparisons at the end of the substring }
iBufScanStart := iMaxSubStrIdx;
while (not found) and (iBufScanStart < iBufSize) do
begin
iBufIdx := iBufScanStart;
iScanSubStr := iMaxSubStrIdx;
repeat
mismatch := (szSubStr[iScanSubStr] <> buf[iBufIdx]);
if not mismatch then
if iScanSubStr > 0 then
begin // more characters to scan
Dec(iBufIdx); Dec(iScanSubStr)
end
else
found := True;
until mismatch or found;
if found then
Result := iBufIdx
else
iBufScanStart := iBufScanStart + skip[buf[iBufScanStart]];
end;
end;
Kaynak:
http://delphidabbler.com/tips/42