![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
![]() Здравстуйте, уважаемые формучане!
Я, если честно, запарился. Написал программу, все превосходно работает, но через определенное время (часа 2) выскакивает "External error". Смотрю в диспетчере - процесс съел около гигабайта оперативной памяти. Суть программы - грузит из файлов данные, заходит через Webbrowser на страницы, отправляет нужную информацию, и так все в цикле. Данные грузятся из файлов через Tstringlist, после отправки в нужное место очищается с помощью Free. Вроде бы все окей, но память утекает как вода. Вот часть кода, часть убрал из соображений бесполезности. Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,URLMon, ComCtrls, math, OleCtrls, SHDocVw, ExtCtrls; type TForm1 = class(TForm) start: TButton; GroupBox1: TGroupBox; ScrollBox1: TScrollBox; ComboBox1: TComboBox; Label1: TLabel; back: TButton; forward: TButton; update: TButton; stop: TButton; Label2: TLabel; Button6: TButton; Button7: TButton; Label3: TLabel; Edit1: TEdit; Button8: TButton; Label4: TLabel; Button10: TButton; Label5: TLabel; Label6: TLabel; ComboBox2: TComboBox; Button1: TButton; Edit2: TEdit; webbrowser1:TWEbbrowser; procedure ComboBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure stopClick(Sender: TObject); procedure updateClick(Sender: TObject); procedure forwardClick(Sender: TObject); procedure backClick(Sender: TObject); procedure startClick(Sender: TObject); procedure main(); procedure load(); procedure Button7Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button6Click(Sender: TObject); procedure Button8Click(Sender: TObject); procedure ComboBox2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure auth(); procedure ComboBox2Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button10Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; l,l1,l2,l5,m,jou,get,get1:tstringlist; a,y,c,key,st,gg1,doc,tt1:string; n,i,id,num,id1,ppp,t,gg,form,k,kat,kall,on:integer; implementation <Левый код> </ Левый код> procedure Tform1.auth(); begin WebBrowser1.Navigate('сайт.ком'); while WebBrowser1.ReadyState <> 4 do begin Application.ProcessMessages(); end; try WebBrowser1.OleObject.Document.All.Tags('input').Item(2).click ; except startClick(self); end; Delay(3000); while WebBrowser1.ReadyState <> 4 do begin Application.ProcessMessages(); end; WebBrowser1.OleObject.Document.All.Tags('input').Item(1).Value:=tt1; WebBrowser1.OleObject.Document.All.Tags('input').Item(2).Value:='1627911'; WebBrowser1.OleObject.Document.All.Tags('input').Item(4).Click(); WebBrowser1.OleObject.Document.All.Tags('input').Item(3).Click(); end; procedure TForm1.startClick(Sender: TObject); begin main(); end; procedure Tform1.main(); var ovElements: OleVariant; i: Integer; begin kall:=1; webbrowser1.Silent:=true; l:=tstringlist.create; l.LoadFromFile('links.txt'); l2:=tstringlist.create; l2.loadfromfile('last.txt'); gg1:=l2[0]; l1:=tstringlist.create; l1.loadfromfile('rev/base'+gg1+'.txt'); t:=strtoint(l2[1]); if t mod 100 = 0 then begin Application.ProcessMessages(); while WebBrowser1.ReadyState <> 4 do begin Application.ProcessMessages(); end; try m:=tstringlist.create; m.loadfromfile('ttt.txt'); l5:=tstringlist.Create; l5.loadfromfile('get.txt'); tt1:=m[strtoint(l5[0])]; auth(); if strtoint(l5[0])=m.Count-1 then begin l5[0]:=inttostr(0); end else l5[0]:=inttostr(strtoint(l5[0])+1); finally l5.savetofile('get.txt'); l5.Clear; l5.Free; m.clear; m.free; end; delay(4000); while WebBrowser1.ReadyState <> 4 do begin Application.ProcessMessages(); end; load(); end else load(); end; procedure TForm1.load(); var ovElements: OleVariant; i: Integer; begin try while WebBrowser1.ReadyState <> 4 do begin Application.ProcessMessages(); end; WebBrowser1.Navigate(l1[t]+'сайт'); //label1.caption:='Òåêóùèé æóðíàë: ' +l1[strtoint(l2[1])]; //label2.caption:='Òåêóùàÿ áàçà:'+l2[0]; // label2.caption:='Íîìåð æóðíàëà â äàííîé áàçå:'+l2[1]; label5.caption:='Òåêóùèé æóðíàë # '+inttostr(t); edit2.text:=l1[t]; if t=l1.count-1 then begin gg1:=inttostr(strtoint(gg1)+1); t:=0; end; t:=t+1; l2[1]:=inttostr(t); l2.savetofile('last.txt'); delay(500); while WebBrowser1.ReadyState <> 4 do begin Application.ProcessMessages(); end; <Левый код> </Левый код> while WebBrowser1.ReadyState <> 4 do begin Application.ProcessMessages(); end; finally l1.Clear; l1.Free; l2.Clear; l2.Free; l.Clear; l.Free; end; if on<>1 then main(); end; end; end. |
#2
|
||||
|
||||
![]() Похожая ситуация. Создаю новые потоки, ставлю у них FreeOnTerminate = true. Потоки отрабатывают быстро и вырубаются. НО в диспетчере память процесса только растет: изначально 2.5мб, и потом потихоньку увеличивается. Пробовал даже в конце потоков написать Self.Destroy или Self.Free - ноль эмоций.
jmp $ ; Happy End! The Cake Is A Lie. |