Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.08.01;
Скачать: [xml.tar.bz2];

Вниз

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

 
НовиЧок ©   (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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.033 c
1-1089793797
Chas
2004-07-14 12:29
2004.08.01
Печать в дельфи (срочно)


14-1089906817
CHES
2004-07-15 19:53
2004.08.01
Ваше отношение к советской попсе


14-1089225291
VID
2004-07-07 22:34
2004.08.01
Простой вопрос о настройке сети между двумя компами


14-1089992917
Top100
2004-07-16 19:48
2004.08.01
Где ввести ключ регистрации в FstReport?


14-1090037247
banderas
2004-07-17 08:07
2004.08.01
Молю о помощи !!!





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский