|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Помогите оптимизировать код
Здраствуйте, у меня проблема.
Пытаюсь убрать повторяющиеся строки из Memo. Причем не учитывая данные в [ ] Код:
Кусок из мемо: [30.4.2009 7:9:25] login=user1 | ip=195.58.235.14 [30.4.2009 8:35:10] login=user2 | ip=81.23.190.39 [30.4.2009 9:1:0] login=user3 | ip=195.58.235.14 <--- Эту строку надо оставить [30.4.2009 8:12:56] login=user3 | ip=195.58.235.14 <--- Эту строку надо удалить Удаляю повторы вот таким кодом: Код:
procedure DeleteEmpty; var zz:Integer; begin zz:=0; repeat zz:=zz+1; if Form1.Memo1.Lines[zz]='' then begin Form1.Memo1.Lines.Delete(zz); zz:=0; end; until zz=Form1.Memo1.Lines.Count-1; end; procedure TForm1.Button9Click(Sender: TObject); var i,ii: Integer; str,sstr : String; begin i:=0; repeat i:=i+1; ii:=0; str:=Copy(Memo1.Lines[i],pos(']',Memo1.Lines[i])+1,Length(Memo1.Lines[i])); repeat sstr:=Copy(Memo1.Lines[ii],pos(']',Memo1.Lines[ii])+1,Length(Memo1.Lines[ii])); if str=sstr then Memo1.Lines[ii]:=''; ii:=ii+1; until ii=Memo1.Lines.Count; Memo1.Lines[i]:=str; until i=Memo1.Lines.Count; DeleteEmpty; end; При обработки Memo в 10000 линий процесс затягивается до одного часа а то и больше , а это плохо Вообщем помогите оптимизировать . А тем кто поможет подарю восьмизначный номерок ============ Зарание благодарю. [ Ты не сможешь никому помочь до тех пор, пока не поможешь себе ] Delphi 7 user
ICQ: 570224849 / JID: x-rem@jabber.ru|no / Skype: ukc-rem / VK: ukc_rem.vk.com (ID: 27703738) |
#2
|
||||
|
||||
Вот переделай под себя.
Код:
Memo1.lines.BeginUpdate;//Запретить перерисовку for i := Memo1.lines.Count - 1 downto 0 do begin //Тут смело удаляй ненужные строки, тк цикл идет с конца - ничего смещать не прийдется. end; Memo1.lines.EndUpdate;//вернуть в нормальное состояние Если есть возможность дай лог-файл поэкспериментировать, а вообще для для строк придется поработать с PChar - не копировать строку а смещать указатель. pos(']', xxx) - храни длину каждой строки в поле Object (заполни один раз перед основным циклом). ...сказал, и загрустил от бесспорной своей правоты Последний раз редактировалось 0nni, 05.05.2009 в 23:53. |
#3
|
||||
|
||||
Т.е. вас интересует какие пользователи подключались в течении суток?
Вот такой вариант, генератор вашего лога, запись в файл и обратный разбор лога с записью в новый файл без повторов. Код:
program Project22; {$APPTYPE CONSOLE} uses SysUtils,Classes,StrUtils; Type TLogRec = class D,T,U: String; end; Const Users: Array[1..3] of String = ('user1 | ip=195.58.235.14','user2 | ip=81.23.190.39','user3 | ip=195.58.235.14'); RowCount = 1000; function LogSort(List: TStringList; Index1, Index2: Integer): Integer; Var D1,D2,T1,T2: String; begin D1 := TLogRec(List.Objects[Index1]).D; D2 := TLogRec(List.Objects[Index2]).D; T1 := TLogRec(List.Objects[Index1]).T; T2 := TLogRec(List.Objects[Index2]).T; Result := 0; if StrToDate(D1) < StrToDate(D2) then Result := -1; if StrToDate(D1) > StrToDate(D2) then Result := 1; if StrToDate(D1) = StrToDate(D2) then begin if StrToTime(T1) < StrToTime(T2) then Result := -1; if StrToTime(T1) > StrToTime(T2) then Result := 1; end; end; Var Rec: TLogRec; Log: TStringList; i: Integer; TextLog: TextFile; S: String; begin Log := TStringList.Create; for i := 1 to RowCount do begin Rec := TLogRec.Create; Rec.D := Format('%d.%d.%d',[Random(30)+1,4,2009]); Rec.T := Format('%d:%d:%d',[Random(23)+1,Random(59)+1,Random(59)+1]); Rec.U := Users[Random(3)+1]; Log.AddObject(Format('[%s %s] %s',[Rec.D,Rec.T,Rec.U]),Rec); end; Log.CustomSort(@LogSort); AssignFile(TextLog,'C:\Connect.log'); Rewrite(TextLog); for i := 0 to Log.Count-1 do WriteLn(TextLog,Log.Strings[i]); CloseFile(TextLog); Log.Free; AssignFile(TextLog,'C:\Connect.log'); Reset(TextLog); Log := TStringList.Create; Log.Sorted := True; Log.Duplicates := dupIgnore; while not Eof(TextLog) do begin ReadLn(TextLog, S); Rec := TLogRec.Create; i := Pos(' ',S); Rec.D := Copy(S, 2, i-1); Rec.T := Copy(S, i+1, Pred(PosEx(']',S,i)-i)); i := PosEx(']',S,i); Rec.U := Copy(S, i+2, Length(S)); Log.AddObject(Format('%s %s',[Rec.D,Rec.U]),Rec); end; CloseFile(TextLog); AssignFile(TextLog,'C:\Connect1.log'); Rewrite(TextLog); for i := 0 to Log.Count-1 do WriteLn(TextLog,Log.Strings[i]); CloseFile(TextLog); Log.Free; end. Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. Последний раз редактировалось Страдалецъ, 06.05.2009 в 04:18. |
#4
|
||||
|
||||
@0nni
спасиб, с восьмизнаком пролетел @Страдалецъ сори но это малёх не то что нужно)) Всё что нужно это удалить из мемо повторяющиеся строки , не учитывая данных в [ ] [ Ты не сможешь никому помочь до тех пор, пока не поможешь себе ] Delphi 7 user
ICQ: 570224849 / JID: x-rem@jabber.ru|no / Skype: ukc-rem / VK: ukc_rem.vk.com (ID: 27703738) Последний раз редактировалось X-rem, 06.05.2009 в 18:26. |
#5
|
||||
|
||||
Я так понял проблему решили?
Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#6
|
||||
|
||||
Нет,
Удаляет всё ещё долго. Onni чуть ускорил) [ Ты не сможешь никому помочь до тех пор, пока не поможешь себе ] Delphi 7 user
ICQ: 570224849 / JID: x-rem@jabber.ru|no / Skype: ukc-rem / VK: ukc_rem.vk.com (ID: 27703738) |
#7
|
||||
|
||||
Так возьмите мой пример за основу. У меня вся прога на создание файла в 1000 строк и получение уникального списка обработав ту-же 1000 работает не более секунды.
Там все еще проще, раз вам не требуется учитывать даты. Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#8
|
||||
|
||||
Тогда если не сложно)
Напиши в асю 570224849 (Ответ : 20) [ Ты не сможешь никому помочь до тех пор, пока не поможешь себе ] Delphi 7 user
ICQ: 570224849 / JID: x-rem@jabber.ru|no / Skype: ukc-rem / VK: ukc_rem.vk.com (ID: 27703738) |
#9
|
||||
|
||||
Так попробуйте:
Код:
AssignFile(TextLog,'C:\Connect.log'); Reset(TextLog); Log := TStringList.Create; Log.Sorted := True; Log.Duplicates := dupIgnore; while not Eof(TextLog) do begin ReadLn(TextLog, S); Log.Add(Copy(S, Pos(']',S)+2, Length(S))); end; CloseFile(TextLog); Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#10
|
||||
|
||||
Проверяй ПМ)
[ Ты не сможешь никому помочь до тех пор, пока не поможешь себе ] Delphi 7 user
ICQ: 570224849 / JID: x-rem@jabber.ru|no / Skype: ukc-rem / VK: ukc_rem.vk.com (ID: 27703738) Последний раз редактировалось X-rem, 06.05.2009 в 18:30. |
#11
|
||||
|
||||
closed.....
[ Ты не сможешь никому помочь до тех пор, пока не поможешь себе ] Delphi 7 user
ICQ: 570224849 / JID: x-rem@jabber.ru|no / Skype: ukc-rem / VK: ukc_rem.vk.com (ID: 27703738) |