Главная страница
    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
14-1089786998
Ozone
2004-07-14 10:36
2004.08.01
Настройки Excel я


4-1087995049
Samael6
2004-06-23 16:50
2004.08.01
Хук на закрытие и свертывание окна


4-1087048261
Игорь
2004-06-12 17:51
2004.08.01
Перехват открытия файлов


6-1086080566
NorthMan
2004-06-01 13:02
2004.08.01
про IdTCPServer


14-1089960179
Nikon777777
2004-07-16 10:42
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский