Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.08.01;
Скачать: CL | DM;

Вниз

Поиск текста   Найти похожие ветки 

 
НовиЧок ©   (2004-07-18 06:49) [0]

Уважаемые мастера!

Подскажите, пожалуйста, как можно профильтровать файл или Memo и выдрать от туда определённый текст? Например это сохранённый html файл в тексте которого есть IP адреса:
61.6.77.2
202.97.150.150
20.13.199.59
вот их и нужно от туда вынуть.


 
GraY ©   (2004-07-18 07:12) [1]

напиши поиск в формате ххх.ххх.ххх.ххх
где х-0...9


 
TUser ©   (2004-07-18 07:26) [2]

pos, posex


 
Anatoly Podgoretsky ©   (2004-07-18 09:08) [3]

TUser ©   (18.07.04 07:26) [2]
По всем 4 миллиардам адресов


 
Рыба ©   (2004-07-18 10:23) [4]

unit Search;

interface

uses WinProcs, SysUtils, StdCtrls, Dialogs;

const
 WordDelimiters: set of Char = [ #0..#255] - ["a".."z","A".."Z","1".."9","0"];

function SearchMemo(Memo: TCustomEdit; const SearchString: String; Options: TFindOptions): Boolean;

implementation

function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer;
                  SearchString: String; Options: TFindOptions): PChar;
var C: Char;
   Direction: Shortint;
   SearchCount, I: Integer;
   CharMap: array [Char] of Char;

 function FindNextWordStart(var BufPtr: PChar) : Boolean;
 begin                   { (True XOR N) is equivalent to (not N) }
   while (SearchCount > 0) and
         ((Direction = 1) xor
         (BufPtr^ in WordDelimiters)) do begin
     Inc(BufPtr, Direction);
     Dec(SearchCount);
   end;
   while (SearchCount > 0) and
         ((Direction = -1) xor
         (BufPtr^ in WordDelimiters)) do begin
     Inc(BufPtr, Direction);
     Dec(SearchCount);
   end;
   Result := SearchCount > 0;
   if Direction = -1 then begin {back up one char, to leave ptr on first non delim}
     Dec(BufPtr, Direction);
     Inc(SearchCount);
   end;
 end;

begin
 Result := nil;
 if BufLen <= 0 then Exit;
 if frDown in Options then begin
   Direction := 1;
   Inc(SelStart, SelLength);  { start search past end of selection }
   SearchCount := BufLen - SelStart - Length(SearchString);
   if SearchCount < 0 then Exit;
   if Longint(SelStart) + SearchCount > BufLen then Exit; end
 else begin
   Direction := -1;
   Dec(SelStart, Length(SearchString));
   SearchCount := SelStart+1;
 end;
 if (SelStart < 0) or (SelStart > BufLen) then Exit;
 Result := @Buf[SelStart];
 for C := Low(CharMap) to High(CharMap) do CharMap[C] := C;
 if not (frMatchCase in Options) then begin
   AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap));
   AnsiUpperBuff(@SearchString[1], Length(SearchString));
 end;
 while SearchCount > 0 do begin
   if frWholeWord in Options then begin
     if not FindNextWordStart(Result) then Break;
   end;
   I := 0;
   while (CharMap[Result[I]] = SearchString[I+1]) do begin
     Inc(I);
     if I >= Length(SearchString) then begin
       if (not (frWholeWord in Options)) or
          (SearchCount = 0) or
          (Result[I] in WordDelimiters) then begin
         Exit;
       end;
       Break;
     end;
   end;
   Inc(Result, Direction);
   Dec(SearchCount);
 end;
 Result := nil;
end;

function SearchMemo(Memo: TCustomEdit;
                   const SearchString: String;
                   Options: TFindOptions): Boolean;
var Buffer, P: PChar;
   Size: Word;
begin
 Result := False;
 if Length(SearchString) = 0 then Exit;
 Size := Memo.GetTextLen;
 if Size = 0 then Exit;
 Buffer := StrAlloc(Size + 1);
 try
   Memo.GetTextBuf(Buffer, Size + 1);
   P := SearchBuf(Buffer, Size + 1, Memo.SelStart, Memo.SelLength,
                  SearchString, Options);
   if P <> nil then begin
     Memo.SelStart := P - Buffer;
     Memo.SelLength := Length(SearchString);
     Result := True;
   end;
 finally
   StrDispose(Buffer);
 end;
end;

end.



Страницы: 1 вся ветка

Текущий архив: 2004.08.01;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.036 c
4-1087812260
DimaT
2004-06-21 14:04
2004.08.01
MAPI in the Service NT


1-1090344661
Виталий
2004-07-20 21:31
2004.08.01
Undeclared Identifier


3-1089033398
RainKM
2004-07-05 17:16
2004.08.01
Бази Даных


6-1086206423
Krey
2004-06-03 00:00
2004.08.01
События NetBios


11-1077753962
KisaNetik
2004-02-26 03:06
2004.08.01
Проблема с dll в KOL ! Помогите плиз!!!





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский