Ładny brzuch
Mam form. Na niej ciapnem sobie OpenDialog i Button (ten Button tylko na razie dla uatwienia, pniej podepn wszystko pod OpenDialog, ale nie w tym rzecz ;) ).
Mam te przygotowany algorytm KMP (wyszukiwanie).
Kod pod Button1Click wyglda nastpujco:
procedure TForm1.Button1Click(Sender: TObject); var m,n,i,j,t : Integer; wzorzec, tekst : String; P : array of Integer; begin OpenDialog1.Execute; // tu jest problem n := length(tekst); wzorzec := #$00 + #$9C + #$B7 + #$38; m:=length(wzorzec); SetLength(P,m+1); P[0]:=0; P[1]:=0; t:=0; for j:=2 to m do begin while (t>0) and (wzorzec[t+1]<>wzorzec[j]) do t:=P[t]; if wzorzec[t+1]=wzorzec[j] then t:=t+1; P[j]:=t; end; i:=1; j:=0; while i<=n-m+1 do begin j:=P[j]; while ((j<m)and(wzorzec[j+1]=tekst[i+j])) do j:=j+1; if j=m then GdzieToJest.Lines.Add(IntToStr(i)); i:=i+max(1,j-P[j]); end; end;
Jak wida mao finezyjne - ot KMP zernity jak leci :P Efektem dziaania bdzie dodanie informacji do pola Memo o miejscu wystpienia cigu (i jednoczenie o iloci - policze sobie ile jest linii w memo :) )
Mam niestety jeden spory problem.
Ten spory problem to: wyszukiwanie cigu musi nastpi w pliku binarnym, o sporawym rozmiarze. Gdzie nie dokopabym si do przykadw - zawsze jest na stringach. Nie mam pojcia jak spi otwieranie pliku binarnego z algorytmem. On tu wszdzie operuje na stringach :( Jak dam TFileStream to si nie bdzie trzyma (wiadomo czego)...
Uytkownik Dj. Kadet edytowa ten post 21 luty 2006, 02:05
Znalazem kolejny kawaek kodu - funkcj jak poniej. Niestety te nie dziaa - zwraca -1 (czyli nic nie znaleziono :( ). Help :( Moe jest tu jaki bd. Po 24h w Google literek ju nie widz :mellow:
(* This can be used for Streams OR files. Set AStream parameter to nil if passing a FileName. Usage: Scan a Stream: ScanIt('texttofind', False, MyMemoryStream); Scan a File: ScanIt('texttofind', False, nil, 'c:\mytextfile.txt'); *) function TForm1.ScanIt(const forString: String; caseSensitive: Boolean; AStream: TStream; AFilename: TFileName = ''): LongInt; { returns position of string in stream or file, returns -1 if not found } const BufferSize= $8001; { 32K+1 bytes } var pBuf, pend, pScan, pPos : Pchar; bytesRemaining: Integer; bytesToRead: Integer; SearchFor: Pchar; filesize: LongInt; fsTemp: TFileStream; begin Result := -1; { assume failure } if (Length(forString) = 0) or ((AStream <> nil) and (AStream.Size = 0)) and ((AStream = nil) and (Length(AFilename) = 0)) then Exit; SearchFor := nil; pBuf := nil; { open file as binary, 1 byte recordsize } if not Assigned(AStream) then begin fsTemp := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite); try Result := ScanIt(forString, caseSensitive, fsTemp); finally fsTemp.free; end; end else begin 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 := AStream.Size; 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; AStream.ReadBuffer(pBuf^, bytesToRead); { read a buffer full and zero-terminate the buffer } 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 { Found it! } begin 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 } AStream.Seek(-Length(forString), soFromCurrent); bytesRemaining := bytesRemaining + Length(forString); end; end; { while } finally if SearchFor <> nil then StrDispose(SearchFor); if pBuf <> nil then FreeMem(pBuf, BufferSize); end; end; end; { ScanIt }
Prbuj wyszuka #$00 + #$9C + #$B7 + #$38 w pliku binarnym, ale chobym nie wiem jak kombinowa mimo, e warto ta jest w pliku, nie znajduje nic. Ani kombinujc z tymi fragmentami z pierwszego postu, ani z t funkcj powyej. Musi si przecie jako da to zrobi :unsure:
Uytkownik Dj. Kadet edytowa ten post 22 luty 2006, 01:44
A prbowae na strumieniach? Sprbuj napisa to z gowy:
var FS: TFileStream; SS: TStringStream; i: Integer; begin FS := TFileStream.Create('nazwa_pliku', fmOpenRead); try SS := TStringStream.Create(''); try SS.Copy(FS, FS.Size); //szukamy cigu i := Pos(#00#156#183#56, SS.DataString); finally SS.Free; end; finally FS.Free; end; end;
TO JEST TO :excl:
Dziki - pozwoliem sobie nieco zmodyfikowa czc z algo KMP w efekcie szukanie jest ultra szybkie - uamki sekundy, nawet na bardzo duych plikach. Moe to by wietna podstawa engine'u wyszukiwawczego :excl:
procedure TForm1.Button1Click(Sender: TObject); var m,n,i,j,t : Integer; wzorzec, tekst : String; P : array of Integer; FS: TFileStream; SS: TStringStream; begin OpenDialog1.Execute; FS := TFileStream.Create(OpenDialog1.FileName, fmOpenRead); SS := TStringStream.Create(''); SS.CopyFrom(FS, FS.Size); tekst := SS.DataString; n := length(tekst); wzorzec := #$00 + #$9C + #$B7 + #$38; m:=length(wzorzec); SetLength(P,m+1); P[0]:=0; P[1]:=0; t:=0; for j:=2 to m do begin while (t>0) and (wzorzec[t+1]<>wzorzec[j]) do t:=P[t]; if wzorzec[t+1]=wzorzec[j] then t:=t+1; P[j]:=t; end; i:=1; j:=0; while i<=n-m+1 do begin j:=P[j]; while ((j<m)and(wzorzec[j+1]=tekst[i+j])) do j:=j+1; if j=m then GdzieToJest.Lines.Add(IntToStr(i)); i:=i+max(1,j-P[j]); end; SS.Free; FS.Free; end;
Troch mietnik, ale poukadanie to ju szczeglik - minuta, pic i bdzie czysto ;)
Ta procedurka zwrci do pola Memo nazwanego GdzieToJest w kolejnych liniach pozycje wystpienia cigu binarnego #$00 + #$9C + #$B7 + #$38.
Naprawd nie wiem jak dzikowa :) Wielkie pozdrowienia :)
Mam nadziej, e nie tylko mi si przyda :)
Drobna uwaga: lepiej jednak stosuj bloki try...finally przy tworzeniu i usuwaniu strumieni. Podobnie, jeli chodzi o OpenDialog.Execute, lepiej stosowa
if OpenDialog1.Execute then begin //tutaj kod tego, co ma si dzia po wskazaniu pliku end;
bo inaczej bdziesz mia bd, gdy uytkownik kliknie Anuluj, zamiast Otwrz (pole OpenDialog1.FileName nie bdzie zawierao cieki istniejcego pliku).
A no faktycznie ;) Przy anuluj w OpenDialog wywali bd. Jeszcze raz dziki :) Teraz dziaa ju perfekcyjnie :D
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
Mam te przygotowany algorytm KMP (wyszukiwanie).
Kod pod Button1Click wyglda nastpujco:
procedure TForm1.Button1Click(Sender: TObject); var m,n,i,j,t : Integer; wzorzec, tekst : String; P : array of Integer; begin OpenDialog1.Execute; // tu jest problem n := length(tekst); wzorzec := #$00 + #$9C + #$B7 + #$38; m:=length(wzorzec); SetLength(P,m+1); P[0]:=0; P[1]:=0; t:=0; for j:=2 to m do begin while (t>0) and (wzorzec[t+1]<>wzorzec[j]) do t:=P[t]; if wzorzec[t+1]=wzorzec[j] then t:=t+1; P[j]:=t; end; i:=1; j:=0; while i<=n-m+1 do begin j:=P[j]; while ((j<m)and(wzorzec[j+1]=tekst[i+j])) do j:=j+1; if j=m then GdzieToJest.Lines.Add(IntToStr(i)); i:=i+max(1,j-P[j]); end; end;
Jak wida mao finezyjne - ot KMP zernity jak leci :P Efektem dziaania bdzie dodanie informacji do pola Memo o miejscu wystpienia cigu (i jednoczenie o iloci - policze sobie ile jest linii w memo :) )
Mam niestety jeden spory problem.
Ten spory problem to: wyszukiwanie cigu musi nastpi w pliku binarnym, o sporawym rozmiarze. Gdzie nie dokopabym si do przykadw - zawsze jest na stringach. Nie mam pojcia jak spi otwieranie pliku binarnego z algorytmem. On tu wszdzie operuje na stringach :( Jak dam TFileStream to si nie bdzie trzyma (wiadomo czego)...
Uytkownik Dj. Kadet edytowa ten post 21 luty 2006, 02:05
Znalazem kolejny kawaek kodu - funkcj jak poniej. Niestety te nie dziaa - zwraca -1 (czyli nic nie znaleziono :( ). Help :( Moe jest tu jaki bd. Po 24h w Google literek ju nie widz :mellow:
(* This can be used for Streams OR files. Set AStream parameter to nil if passing a FileName. Usage: Scan a Stream: ScanIt('texttofind', False, MyMemoryStream); Scan a File: ScanIt('texttofind', False, nil, 'c:\mytextfile.txt'); *) function TForm1.ScanIt(const forString: String; caseSensitive: Boolean; AStream: TStream; AFilename: TFileName = ''): LongInt; { returns position of string in stream or file, returns -1 if not found } const BufferSize= $8001; { 32K+1 bytes } var pBuf, pend, pScan, pPos : Pchar; bytesRemaining: Integer; bytesToRead: Integer; SearchFor: Pchar; filesize: LongInt; fsTemp: TFileStream; begin Result := -1; { assume failure } if (Length(forString) = 0) or ((AStream <> nil) and (AStream.Size = 0)) and ((AStream = nil) and (Length(AFilename) = 0)) then Exit; SearchFor := nil; pBuf := nil; { open file as binary, 1 byte recordsize } if not Assigned(AStream) then begin fsTemp := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite); try Result := ScanIt(forString, caseSensitive, fsTemp); finally fsTemp.free; end; end else begin 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 := AStream.Size; 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; AStream.ReadBuffer(pBuf^, bytesToRead); { read a buffer full and zero-terminate the buffer } 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 { Found it! } begin 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 } AStream.Seek(-Length(forString), soFromCurrent); bytesRemaining := bytesRemaining + Length(forString); end; end; { while } finally if SearchFor <> nil then StrDispose(SearchFor); if pBuf <> nil then FreeMem(pBuf, BufferSize); end; end; end; { ScanIt }
Prbuj wyszuka #$00 + #$9C + #$B7 + #$38 w pliku binarnym, ale chobym nie wiem jak kombinowa mimo, e warto ta jest w pliku, nie znajduje nic. Ani kombinujc z tymi fragmentami z pierwszego postu, ani z t funkcj powyej. Musi si przecie jako da to zrobi :unsure:
Uytkownik Dj. Kadet edytowa ten post 22 luty 2006, 01:44
A prbowae na strumieniach? Sprbuj napisa to z gowy:
var FS: TFileStream; SS: TStringStream; i: Integer; begin FS := TFileStream.Create('nazwa_pliku', fmOpenRead); try SS := TStringStream.Create(''); try SS.Copy(FS, FS.Size); //szukamy cigu i := Pos(#00#156#183#56, SS.DataString); finally SS.Free; end; finally FS.Free; end; end;
TO JEST TO :excl:
Dziki - pozwoliem sobie nieco zmodyfikowa czc z algo KMP w efekcie szukanie jest ultra szybkie - uamki sekundy, nawet na bardzo duych plikach. Moe to by wietna podstawa engine'u wyszukiwawczego :excl:
procedure TForm1.Button1Click(Sender: TObject); var m,n,i,j,t : Integer; wzorzec, tekst : String; P : array of Integer; FS: TFileStream; SS: TStringStream; begin OpenDialog1.Execute; FS := TFileStream.Create(OpenDialog1.FileName, fmOpenRead); SS := TStringStream.Create(''); SS.CopyFrom(FS, FS.Size); tekst := SS.DataString; n := length(tekst); wzorzec := #$00 + #$9C + #$B7 + #$38; m:=length(wzorzec); SetLength(P,m+1); P[0]:=0; P[1]:=0; t:=0; for j:=2 to m do begin while (t>0) and (wzorzec[t+1]<>wzorzec[j]) do t:=P[t]; if wzorzec[t+1]=wzorzec[j] then t:=t+1; P[j]:=t; end; i:=1; j:=0; while i<=n-m+1 do begin j:=P[j]; while ((j<m)and(wzorzec[j+1]=tekst[i+j])) do j:=j+1; if j=m then GdzieToJest.Lines.Add(IntToStr(i)); i:=i+max(1,j-P[j]); end; SS.Free; FS.Free; end;
Troch mietnik, ale poukadanie to ju szczeglik - minuta, pic i bdzie czysto ;)
Ta procedurka zwrci do pola Memo nazwanego GdzieToJest w kolejnych liniach pozycje wystpienia cigu binarnego #$00 + #$9C + #$B7 + #$38.
Naprawd nie wiem jak dzikowa :) Wielkie pozdrowienia :)
Mam nadziej, e nie tylko mi si przyda :)
Drobna uwaga: lepiej jednak stosuj bloki try...finally przy tworzeniu i usuwaniu strumieni. Podobnie, jeli chodzi o OpenDialog.Execute, lepiej stosowa
if OpenDialog1.Execute then begin //tutaj kod tego, co ma si dzia po wskazaniu pliku end;
bo inaczej bdziesz mia bd, gdy uytkownik kliknie Anuluj, zamiast Otwrz (pole OpenDialog1.FileName nie bdzie zawierao cieki istniejcego pliku).
A no faktycznie ;) Przy anuluj w OpenDialog wywali bd. Jeszcze raz dziki :) Teraz dziaa ju perfekcyjnie :D