Главная страница
    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.044 c
1-1089821765
sectus
2004-07-14 20:16
2004.08.01
входные данныйе одной функции разных типов....


1-1090410674
001
2004-07-21 15:51
2004.08.01
Как поставить "хук" или что-то наподобии на обращение к дисководу


8-1084513790
alienserg
2004-05-14 09:49
2004.08.01
сжатие аудиопотока налету.


14-1089426184
Aldor_
2004-07-10 06:23
2004.08.01
В заголовках Windows.pas нет некоторых функций


1-1090424383
Василий
2004-07-21 19:39
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский