И таки опять поиск необходимых слов в строке.

← →
Sholah_Weras © (2007-01-06 19:52) [0]

Здравствуйте!
Собственно вопрос задан еще в теме сообщения.
Заранее благодарен.

← →
Джо © (2007-01-06 19:54) [1]

Pos, PosEx.

← →
kaZaNoVa © (2007-01-06 20:17) [2]

program Project1; //Прога поиска подстроки в строках и с исключениями. uses SysUtils, windows; const fVvod = "log.txt"; fSearch = "Search.txt"; fResult_y = "Result_yes.txt"; fResult_n = "Result_not.txt"; var f_inData, f_Search, f_Result_y, f_Result_n: textfile; a: array[1..70000] of string; info: string; l, k, n, h, p: int64; {$R *.res} function CompareSearch: Boolean; var f: integer; begin Result := True; for f := 1 to l do if pos(ansilowercase(a[f]), ansilowercase(info)) > 0 then exit; Result := False; end; begin if not (FileExists(fVvod) and FileExists(fSearch)) then begin MessageBox(0, "Нет файлов ввода данных"#13#10#13#10 + fVvod + #13#10 + fSearch, "Ошибка работа программы невозможна", 0); Halt(1); end; p := gettickcount; QueryPerformanceFrequency(h); // HiTicks / second QueryPerformanceCounter(k); AssignFile(f_inData, fVvod); AssignFile(f_Search, fSearch); AssignFile(f_Result_y, fResult_y); AssignFile(f_Result_n, fResult_n); Reset(f_Search); l := 0; while (not eof(f_Search)) do begin inc(l); Readln(f_Search, a[l]); end; CloseFile(f_Search); Reset(f_inData); ReWrite(f_Result_y); ReWrite(f_Result_n); while (not eof(f_inData)) do begin Readln(f_inData, info); if CompareSearch then Writeln(f_Result_y, info) else Writeln(f_Result_n, info); end; //info CloseFile(f_inData); CloseFile(f_Result_y); CloseFile(f_Result_n); QueryPerformanceCounter(n); MessageBox(0, "Готово", Pchar(Inttostr(gettickcount - p) + " ms (" + (Inttostr(round(1000000 * (n - k) / h))) + ") microsec"), 0); end.

← →
Sholah_Weras © (2007-01-06 20:22) [3]

Спасибо

← →
MsGuns © (2007-01-06 20:26) [4]

>kaZaNoVa © (06.01.07 20:17) [2]

Сколько можно публиковать это страховище ?

← →
kaZaNoVa © (2007-01-06 20:37) [5]

MsGuns © (06.01.07 20:26) [4]
покажите хоть одну ошибку в примере:)
либодайте Свой вариант!

← →
MsGuns © (2007-01-06 20:55) [6]

Начиная с первых же строк

const fVvod = "log.txt"; fSearch = "Search.txt"; fResult_y = "Result_yes.txt"; fResult_n = "Result_not.txt";

и далее..

Теперь объясните практическую ценность этого кода

← →
kaZaNoVa © (2007-01-06 21:23) [7]

MsGuns © (06.01.07 20:55) [6]
Теперь объясните практическую ценность этого кода
очень удобная прога, если не нравится, напишите аналог)
все, игнор)

← →
MsGuns © (2007-01-06 21:28) [8]

Очень поучительно.
Образчик "капустной" обертки пуговицы до размеров пальта ;))

Куча кода, суть всех действий которого - одна разъединственная Pos ;))

Прям код Да Винчи ;)

ЗЫ. Я бы вообще не влазил, если бы не Ваше стремление к публикации собственных "изобретений". Решение Ваше коряво, узкоспециально и неинформативно для другого программиста.

ЗАЧЕМ БЫЛО ЕГО ПУБЛИКОВАТЬ ?

Да еще и не единожды

> Сколько можно публиковать это страховище ?

Могу предложить своё страховище. Моя задача была дать программистам, привыкшим к бейсиковским функциям InStr и InStrRev, использовать их на делфи. Если выкинуть пространные коментарии, а также не делать проверку параметров, то получится очень небольшой код, который сводится к использованию стандартной функции SearchBuf.
Но я привожу полный текст юнита, из которого я выкинул реализацию кучи других вещей, не онтносящихся к сабжу.
unit Unit1; interface const vbBinaryCompare = 0; vbTextCompare = 1; { The InStr function returns the position of the first occurrence of one string within another string. } function InStr(const Str, Pat: String; Scmp: Integer = vbBinaryCompare): Integer; overload; function InStr(Strt: Integer; const Str, Pat: String; Scmp: Integer = vbBinaryCompare): Integer; overload; { Parameter Description: Strt - Optional. Specifies the starting position for each search. The search begins at the first character position by default. Str - The string to be searched Pat - The string expression to search for Scmp Optional. - Specifies the string comparison to use. Default is 0 Can have one of the following values: 0 = vbBinaryCompare - Perform a binary comparison 1 = vbTextCompare - Perform a textual comparison The InStr function can return the following values: If Str is "" - InStr returns 0 If Pat is "" - InStr returns start If Pat is not found - InStr returns 0 If Pat is found within Str - InStr returns the position at which match is found. If start > Length(Str) - InStr returns 0 The InStrRev function returns the position of the first occurrence of one string within another string. The search begins from the end of string, but the position returned counts from the beginning of the string. The InStrRev function can return the following values: } function InStrRev(const Str, Pat: String; Strt: Integer = -1; Scmp: Integer = vbBinaryCompare): Integer; { Parameter Description Str - The string to be searched Pat - The string expression to search for Strt Optional. - Specifies the starting position for each search. The search begins at the last character position by default (-1) Scmp Optional. - Specifies the string comparison to use. Default is 0 Can have one of the following values: 0 = vbBinaryCompare - Perform a binary comparison 1 = vbTextCompare - Perform a textual comparison If Str is "" - InStrRev returns 0 If Pat is "" - InStrRev returns start If Pat is not found - InStrRev returns 0 If Pat is found within Str - InStrRev returns the position at which match is found If Strt > Length(Str) - InStrRev returns 0 } implementation uses SysUtils, StrUtils; function InStr(const Str, Pat: String; Scmp: Integer = 0): Integer; overload; begin Result := InStr(1, Str, Pat, Scmp); end; function InStr(Strt: Integer; const Str, Pat: String; Scmp: Integer = vbBinaryCompare): Integer; overload; var Len, LenP: Integer; P: PChar; so: TStringSearchOptions; begin if Strt <= 0 then raise Exception.Create("Wrong InStr parameter"); Len := Length(Str); LenP := Length(Pat); if (Strt > Len) or (Len = 0) or (LenP > Len) then Result := 0 else if LenP = 0 then Result := Strt else begin so := [soDown]; if Scmp = vbBinaryCompare then so := [soDown, soMatchCase]; P := SearchBuf(PChar(Str), Len, Strt - 1, 0, Pat, so); if P = Nil then Result := 0 else Result := P - @Str[1] + 1; end; end; function InStrRev(const Str, Pat: String; Strt: Integer = -1; Scmp: Integer = vbBinaryCompare): Integer; var Len, LenP: Integer; P: PChar; so: TStringSearchOptions; begin Len := Length(Str); LenP := Length(Pat); if Strt = -1 then Strt := Len; if (Len = 0) Or (Strt > Len) Or (LenP > Len) then Result := 0 else if LenP = 0 then Result := Strt else begin if Strt <=0 then raise Exception.Create("Wrong InStrRev parameter"); so := []; if Scmp = vbBinaryCompare then so := [soMatchCase]; P := SearchBuf(PChar(Str), Len, Strt, 0, Pat, so); if P = Nil then Result := 0 else Result := P - @Str[1] + 1; end; end; end.
Пример использования:
{$APPTYPE CONSOLE} uses Unit1; var s: String; i1, i2: Integer; begin s := "--- <* === -123- === *> ---"; i1 := InStr(s, "<*"); i1 := InStr(i1, s, "-"); i2 := InStrRev(s, "*>"); i2 := InStrRev(s, "-", i2); WriteLn(Copy(s, i1 + 1, i2 - i1 - 1)); // 123 ReadLn end.

>palva © (06.01.07 23:02) [9]

И к чему это ?
У тебя, по крайней мере, универсально сделано. Хотя, если честно, я так и не понял, нафиг нужны эти функции, но тебе из погреба виднее ;)))

> И таки опять поиск необходимых слов в строке.
> Sholah_Weras © (06.01.07 19:52)

Что в строке искать надо: слова или слово?
Это разные задачи.

> Хотя, если честно, я так и не понял, нафиг нужны эти функции
А я разве не написал, зачем они были нужны?
Кроме того в делфи нет функций, которые ищут в строке подстроку в обратном направлении, да еще без учета регистра. Или, возможно, я не нашел таких функций.

И таки опять поиск необходимых слов в строке. Найти похожие ветки