Ĺadny brzuch
Mam formę. Na niej ciapnąłem sobie OpenDialog i Button (ten Button tylko na razie dla ułatwienia, później podepnę wszystko pod OpenDialog, ale nie w tym rzecz ;) ).
Mam też przygotowany algorytm KMP (wyszukiwanie).
Kod pod Button1Click wygląda następująco:
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ć mało finezyjne - ot KMP zerżnięty jak leci :P Efektem działania będzie dodanie informacji do pola Memo o miejscu wystąpienia ciągu (i jednocześnie o ilości - policze sobie ile jest linii w memo :) )
Mam niestety jeden spory problem.
Ten spory problem to: wyszukiwanie ciągu musi nastąpić w pliku binarnym, o sporawym rozmiarze. Gdzie nie dokopałbym się do przykładów - zawsze jest na stringach. Nie mam pojęcia jak spiąć otwieranie pliku binarnego z algorytmem. On tu wszędzie operuje na stringach :( Jak dam TFileStream to się nie będzie trzymać (wiadomo czego)...
Użytkownik Dj. Kadet edytował ten post 21 luty 2006, 02:05
Znalazłem kolejny kawałek kodu - funkcję jak poniżej. Niestety też nie działa - zwraca -1 (czyli nic nie znaleziono :( ). Help :( Może jest tu jakiś błąd. 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 }
Próbuję wyszukać #$00 + #$9C + #$B7 + #$38 w pliku binarnym, ale choćbym nie wiem jak kombinował mimo, że wartość ta jest w pliku, nie znajduje nic. Ani kombinując z tymi fragmentami z pierwszego postu, ani z tą funkcją powyżej. Musi się przecież jakoś dać to zrobić :unsure:
Użytkownik Dj. Kadet edytował ten post 22 luty 2006, 01:44
A próbowałeś na strumieniach? Spróbuję napisać to z głowy:
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 ciągu i := Pos(#00#156#183#56, SS.DataString); finally SS.Free; end; finally FS.Free; end; end;
TO JEST TO :excl:
Dzięki - pozwoliłem sobie nieco zmodyfikować łącząc z algo KMP w efekcie szukanie jest ultra szybkie - ułamki sekundy, nawet na bardzo dużych plikach. Może 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 poukładanie to już szczególik - minuta, pięc i będzie czysto ;)
Ta procedurka zwróci do pola Memo nazwanego GdzieToJest w kolejnych liniach pozycje wystąpienia ciągu binarnego #$00 + #$9C + #$B7 + #$38.
Naprawdę nie wiem jak dziękować :) Wielkie pozdrowienia :)
Mam nadzieję, że nie tylko mi się przyda :)
Drobna uwaga: lepiej jednak stosuj bloki try...finally przy tworzeniu i usuwaniu strumieni. Podobnie, jeśli chodzi o OpenDialog.Execute, lepiej stosować
if OpenDialog1.Execute then begin //tutaj kod tego, co ma się dziać po wskazaniu pliku end;
bo inaczej będziesz miał błąd, gdy użytkownik kliknie Anuluj, zamiast Otwórz (pole OpenDialog1.FileName nie będzie zawierało ścieżki istniejącego pliku).
A no faktycznie ;) Przy anuluj w OpenDialog wywali błąd. Jeszcze raz dzięki :) Teraz działa już perfekcyjnie :D
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
Mam też przygotowany algorytm KMP (wyszukiwanie).
Kod pod Button1Click wygląda następująco:
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ć mało finezyjne - ot KMP zerżnięty jak leci :P Efektem działania będzie dodanie informacji do pola Memo o miejscu wystąpienia ciągu (i jednocześnie o ilości - policze sobie ile jest linii w memo :) )
Mam niestety jeden spory problem.
Ten spory problem to: wyszukiwanie ciągu musi nastąpić w pliku binarnym, o sporawym rozmiarze. Gdzie nie dokopałbym się do przykładów - zawsze jest na stringach. Nie mam pojęcia jak spiąć otwieranie pliku binarnego z algorytmem. On tu wszędzie operuje na stringach :( Jak dam TFileStream to się nie będzie trzymać (wiadomo czego)...
Użytkownik Dj. Kadet edytował ten post 21 luty 2006, 02:05
Znalazłem kolejny kawałek kodu - funkcję jak poniżej. Niestety też nie działa - zwraca -1 (czyli nic nie znaleziono :( ). Help :( Może jest tu jakiś błąd. 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 }
Próbuję wyszukać #$00 + #$9C + #$B7 + #$38 w pliku binarnym, ale choćbym nie wiem jak kombinował mimo, że wartość ta jest w pliku, nie znajduje nic. Ani kombinując z tymi fragmentami z pierwszego postu, ani z tą funkcją powyżej. Musi się przecież jakoś dać to zrobić :unsure:
Użytkownik Dj. Kadet edytował ten post 22 luty 2006, 01:44
A próbowałeś na strumieniach? Spróbuję napisać to z głowy:
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 ciągu i := Pos(#00#156#183#56, SS.DataString); finally SS.Free; end; finally FS.Free; end; end;
TO JEST TO :excl:
Dzięki - pozwoliłem sobie nieco zmodyfikować łącząc z algo KMP w efekcie szukanie jest ultra szybkie - ułamki sekundy, nawet na bardzo dużych plikach. Może 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 poukładanie to już szczególik - minuta, pięc i będzie czysto ;)
Ta procedurka zwróci do pola Memo nazwanego GdzieToJest w kolejnych liniach pozycje wystąpienia ciągu binarnego #$00 + #$9C + #$B7 + #$38.
Naprawdę nie wiem jak dziękować :) Wielkie pozdrowienia :)
Mam nadzieję, że nie tylko mi się przyda :)
Drobna uwaga: lepiej jednak stosuj bloki try...finally przy tworzeniu i usuwaniu strumieni. Podobnie, jeśli chodzi o OpenDialog.Execute, lepiej stosować
if OpenDialog1.Execute then begin //tutaj kod tego, co ma się dziać po wskazaniu pliku end;
bo inaczej będziesz miał błąd, gdy użytkownik kliknie Anuluj, zamiast Otwórz (pole OpenDialog1.FileName nie będzie zawierało ścieżki istniejącego pliku).
A no faktycznie ;) Przy anuluj w OpenDialog wywali błąd. Jeszcze raz dzięki :) Teraz działa już perfekcyjnie :D