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

Вниз

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

 
user'S ©   (2007-01-08 14:41) [0]

каким образом в строке символов выписать слово стоящее на втором месте.
просьба, если можно, подскажите как организовать поиск перебором символов. Проблема возникла с присвоением переменной значения строки в N-символов,


 
kaZaNoVa ©   (2007-01-08 14:46) [1]

pos


 
kaZaNoVa ©   (2007-01-08 14:47) [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.



 
Virgo_Style ©   (2007-01-08 15:17) [3]

[1],[2]
Я понимаю твою гордость, но не стоит демонстрировать ее хотя бы там, где она не к месту.

user"S ©   (08.01.07 14:41)
каким образом в строке символов выписать слово стоящее на втором месте.

В простейшем случае - найти первый пробел, все, что между ним и вторым пробелом - второе слово. Усложняя - надо игнорировать пробелы в начале строки, несколько пробелов подряд воспринимать как один, наконец, ряд символов тоже считать "пробелами".

user"S ©   (08.01.07 14:41)
Проблема возникла с присвоением переменной значения строки в N-символов

э-э-э... S:=copy(...,...,N) ?


 
Zorro2001 ©   (2007-01-09 03:51) [4]

В простейшем случае - найти первый пробел, все, что между ним и вторым пробелом - второе слово
вместо пробела ищем символ  :

begin
   GetMem(ch, 1000000);
   AssignFile(fs,"sys.txt");
   Reset (fs);
   While not Eof(fs) do
    begin
     Readln(fs,str);
     OemToChar(PChar(str),ch);
     str2:=StrPas(ch);
     int:=Pos(":", str2);
     str1:=copy(str2,1,int);
     str3:=copy(str2,int+1,100);
     VLE.InsertRow(str1,Trim(str3),True);
    end;
  end;
 CloseFile(fs);
 FreeMem(ch, 1000000);


 
Джо ©   (2007-01-09 03:53) [5]

> просьба, если можно, подскажите как организовать поиск перебором
> символов. Проблема возникла с присвоением переменной значения
> строки в N-символов,

Ну, какая же это проблема? Вот у меня проблема — график сна пошел коту под хвост :(

Перебо символов строки:
var
 Ch: Char;
for I := 1 to Length(S) do
begin
 Ch := S[I]
end;


 
Palladin ©   (2007-01-09 03:54) [6]


> [4] Zorro2001 ©

что такое fs?
что такое ch?
что такое str?
что такое VLE?
причем здесь поиск : ?
и вообще что это за бред?


 
Джо ©   (2007-01-09 03:55) [7]

> [6] Palladin ©   (09.01.07 03:54)
> и вообще что это за бред?

Особенно интересна строка GetMem(ch, 1000000), она мне до того понравилась, что теперь точно не усну :)


 
Palladin ©   (2007-01-09 03:56) [8]


> [5] Джо ©

такая же фигня :(, как ты мог заметить, нарыл вот про что и чего...

http://www.medeor.ru/Melatonin_Plus.htm

завтра, точнее сегодня возьму и проведу эксперимент


 
Джо ©   (2007-01-09 03:58) [9]

> [8] Palladin ©   (09.01.07 03:56)
> http://www.medeor.ru/Melatonin_Plus.htm

Гм.
«Ей-богу, решусь!» (c) проф. Преображенский
:)


 
Zorro2001 ©   (2007-01-09 04:20) [10]


> Palladin ©  [6]

fs:TextFile
ch:PChar
str, str2, str1, str3:string
VLE: TValueListEditor
Особенно интересна строка GetMem(ch, 1000000), она мне до того понравилась, что теперь точно не усну :)
резервирование памяти для работы со строками.
BD7 иногда тупит без этого..


 
Anatoly Podgoretsky ©   (2007-01-09 15:16) [11]

> Zorro2001  (09.01.2007 04:20:10)  [10]

Выбрось весь этот код и пиши с начала.


 
Zorro2001 ©   (2007-01-10 02:07) [12]


> Anatoly Podgoretsky ©   (09.01.07 15:16) [11]


А зачем если он работает и никаких проблем с ним нету...


 
ors_archangel ©   (2007-01-10 02:24) [13]


>  FreeMem(ch, 1000000);


FreeMem(ch);

- надо же оправдывать 8 байт заголовка блоков MM


 
user'S ©   (2007-01-10 11:45) [14]

Удалено модератором


 
user'S ©   (2007-01-10 11:46) [15]

Удалено модератором


 
user'S ©   (2007-01-10 11:48) [16]

Удалено модератором



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.01.28;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.046 c
15-1167826006
melkyi
2007-01-03 15:06
2007.01.28
Интересная задача по ДМ


15-1168381360
Bogdan1024
2007-01-10 01:22
2007.01.28
Генерирование документов


15-1167986950
Chuk & Gek
2007-01-05 11:49
2007.01.28
ГМТ,


15-1167866497
lookin
2007-01-04 02:21
2007.01.28
В Скайп?


9-1143032218
Yegorchic
2006-03-22 15:56
2007.01.28
FreeForm и GLScene.SaveToFile





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