Здравстуйте, уважаемые формучане!
Я, если честно, запарился.
Написал программу, все превосходно работает, но через определенное время (часа 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.
Пожалуйста, помогите!