Главная страница
    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.031 c
3-1089033344
Terminus
2004-07-05 17:15
2004.08.01
ZeosDBO. Несколько запросов


14-1090117107
Думкин
2004-07-18 06:18
2004.08.01
С днем рождения! 18 июля


3-1089196035
AlexanderSK
2004-07-07 14:27
2004.08.01
Удаление первичного ключа


3-1088287779
solenko
2004-06-27 02:09
2004.08.01
Пароли при динамическом создании таблиц


14-1089680200
olhovik
2004-07-13 04:56
2004.08.01
InstallShield Express





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