读书人
栏目▼

delphi内存储器泄露请帮忙提示为o

发布时间： 2013-03-19 17:22:05 作者： rapoo

delphi内存泄露，请帮忙，提示为out of memory
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, StdCtrls, ExtCtrls, ComCtrls, RzTray, Spin,
IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient;

type
TForm1 = class(TForm)
ADOQ1: TADOQuery;
Timer1: TTimer;
ADOQ2: TADOQuery;
ADOConnection1: TADOConnection;
RzTrayIcon1: TRzTrayIcon;
Timer2: TTimer;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Panel1: TPanel;
GroupBox1: TGroupBox;
Label3: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button2: TButton;
Button1: TButton;
Button3: TButton;
Edit4: TEdit;
GroupBox2: TGroupBox;
ListView1: TListView;
GroupBox3: TGroupBox;
Label8: TLabel;
Button4: TButton;
Button5: TButton;
GroupBox4: TGroupBox;
Button6: TButton;
Memo2: TMemo;
GroupBox5: TGroupBox;
Label9: TLabel;
Edit5: TEdit;
Button7: TButton;
Button8: TButton;
Timer3: TTimer;
ADOQ3: TADOQuery;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
Panel2: TPanel;
Label2: TLabel;
edtHost: TEdit;
spnPing: TSpinEdit;
lstReplies: TListBox;
btnPing: TButton;
Button9: TButton;
ICMP: TIdIcmpClient;
Timer4: TTimer;
Label1: TLabel;
CPUBut: TButton;
CUPButRetPhone: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Timer3Timer(Sender: TObject);


procedure btnPingClick(Sender: TObject);
procedure ICMPReply(ASender: TComponent;
const AReplyStatus: TReplyStatus);
procedure Timer4Timer(Sender: TObject);
procedure CPUButClick(Sender: TObject);
procedure CUPButRetPhoneClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function GetBuMen(PhoneNumber:String):string;
end;
function Sms_Connection(CopyRight:pchar;Com_Port,Com_BaudRate:integer;var Mobile_Type,CopyRightToCOM:PChar):integer;stdcall;external 'sms.dll';
function Sms_Send(Sms_TelNum:string;Sms_Text:string):integer;stdcall;external 'sms.dll';
Function Sms_Receive(Sms_Type:string;var Sms_Text:PChar):integer;stdcall;external 'sms.dll';
function Sms_Delete(Sms_Index:string):integer;stdcall;external 'sms.dll';
function Sms_AutoFlag :integer;stdcall;external 'sms.dll';
function Sms_NewFlag :integer;stdcall;external 'sms.dll';
function Sms_Disconnection :integer;stdcall;external 'sms.dll';
var
Form1: TForm1;
myList : TListItem;
strs1 :TStrings;
strs2 :TStrings;
PingStrTrue,PingStrFalse,FShouJiHao : string;
implementation
//修改为2012-09-27，主要为ADOQ1提示出错：不能打开一个关闭的数据集。
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
Mobile_Type:pchar;
CopyRight:pchar;
CopyRightToCOM:pchar;
begin
CopyRight:=PChar('//上海迅赛信息技术有限公司,网址www.xunsai.com//');
if Sms_Connection(CopyRight,StrToInt(Edit1.text),9600,Mobile_Type,CopyRightToCOM)<>0 then
begin
Label3.Caption:='连接成功,芯片为:'+Mobile_Type+'!';
end
else
Label3.Caption:='连接失败!'
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i : integer;
begin
ADOQ1.Close; //修改为2012-09-27
ADOQ1.SQL.Clear;
ADOQ1.SQL.Add('select * from TB_SendMessage where isSent = 0 ');
ADOQ1.Open;
for i := 0 to ADOQ1.RecordCount - 1 do
begin
Edit2.Clear;
edit3.Clear;
Edit4.Clear;
edit2.Text := trim(ADOQ1.fieldbyname('receivers').AsString);
Edit3.Text := trim(ADOQ1.fieldbyname('title').AsString);
edit4.Text := trim(ADOQ1.fieldbyname('ID').AsString);
if Edit2.Text = '' then
begin
;
end else
begin
if Sms_Send(Edit2.Text,Edit3.Text)=1 then
begin
showmessage('发送成功!');
myList := listView1.Items.Add;
MyList.Caption := '';
MyList.SubItems.Add(Edit2.Text);


Mylist.SubItems.Add(Edit3.Text);
Mylist.SubItems.Add(datetimetostr(now()));
Mylist.SubItems.Add('发送成功');
ADOQ2.SQL.Clear;
ADOQ2.SQL.Add('update TB_SendMessage set isSent = 1 where ID= '+quotedstr(Edit4.Text)+'');
ADOQ2.ExecSQL;
ADOQ2.Close;
sleep(15000);
end
else
begin
showmessage('发送失败!');
myList := listView1.Items.Add;
MyList.Caption := '';
MyList.SubItems.Add(Edit2.Text);
Mylist.SubItems.Add(Edit3.Text);
Mylist.SubItems.Add(datetimetostr(now()));
Mylist.SubItems.Add('发送失败');
sleep(15000);
end;
end;
ADOQ1.Next;
end;
//ADOQ1.Close; //修改为2012-09-27
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Sms_Disconnection;
Label3.Caption:='已断开!';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i : integer;
begin
ADOQ1.Close; ///修改为2012-09-27
ADOQ1.SQL.Clear;
ADOQ1.SQL.Add('select * from TB_SendMessage where isSent = 0 ');
ADOQ1.Open;
for i := 0 to ADOQ1.RecordCount - 1 do
begin
Edit2.Clear;
edit3.Clear;
Edit4.Clear;
edit2.Text := trim(ADOQ1.fieldbyname('receivers').AsString);
Edit3.Text := trim(ADOQ1.fieldbyname('title').AsString);
edit4.Text := trim(ADOQ1.fieldbyname('ID').AsString);
if Sms_Send(Edit2.Text,Edit3.Text)=1 then
begin
//showmessage('发送成功!');
myList := listView1.Items.Add;
MyList.Caption := '';
MyList.SubItems.Add(Edit2.Text);
Mylist.SubItems.Add(Edit3.Text);
Mylist.SubItems.Add(datetimetostr(now()));
Mylist.SubItems.Add('发送成功');
ADOQ2.SQL.Clear;
ADOQ2.SQL.Add('update TB_SendMessage set isSent = 1 where ID= '+quotedstr(Edit4.Text)+'');
ADOQ2.ExecSQL;
ADOQ2.Close;


sleep(5000);
end
else
begin
//showmessage('发送失败!');
myList := listView1.Items.Add;
MyList.Caption := '';
MyList.SubItems.Add(Edit2.Text);
Mylist.SubItems.Add(Edit3.Text);
Mylist.SubItems.Add(datetimetostr(now()));
Mylist.SubItems.Add('发送失败');
sleep(5000);
end;
ADOQ1.Next;
end;
//ADOQ1.Close; /修改为2012-09-27
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
sleep(2000);
strs1 := TstringList.Create;
strs1.Delimiter := '|';
strs2 := TstringList.Create;
strs2.Delimiter := '#';
Button1.OnClick(button1);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
if Sms_NewFlag()=1 then
begin
Label8.Caption:='有新短信,请查收!';
end
else
Label8.Caption:='无短信!';
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Timer2.enabled:=True;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Timer2.enabled:=False;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
StrSmsReceive:pchar;
RecReult:integer;
i,j :Integer;
XuHao1,XuHao2,FJieShouNeiRong,FJieShouShiJian,FBuMen:string;
begin
//RecReult:=Sms_Receive('4',StrSmsReceive);
//Memo2.lines.text:=StrSmsReceive;

//if Sms_NewFlag()=1 then
//begin
RecReult:=Sms_Receive('4',StrSmsReceive);
//sleep(5000);

//showmessage(StrSmsReceive);
if (length(trim(StrSmsReceive))>0) then
begin
Memo2.lines.text:=StrSmsReceive;
StrSmsReceive:=pchar(StringReplace(StrSmsReceive, ' ', '', [rfReplaceAll]));
StrSmsReceive:=pchar(StringReplace(StrSmsReceive, #13, '', [rfReplaceAll]));
//showmessage(StrSmsReceive);

strs1.DelimitedText := StrSmsReceive;
for i := 0 to strs1.Count-1 do
begin
if length(trim(strs1[i]))>0 then
begin
//showmessage(strs1[i]);

strs2.DelimitedText := strs1[i];
//showmessage(inttostr(strs2.Count));
if strs2.Count=5 then
begin


XuHao1 := strs2[0];
XuHao2 := strs2[1];
FShouJiHao := strs2[2];
FJieShouNeiRong := strs2[3];
if FJieShouNeiRong='112' then
begin
btnPing.OnClick(self);
CUPButRetPhone.OnClick(self);
end;
FJieShouShiJian := copy(strs2[4],0,8)+ ' '+copy(strs2[4],9,(length(strs2[4])-8));
FBuMen := GetBuMen(strs2[2]);
ADOQ3.SQL.Clear;
ADOQ3.SQL.Add('INSERT INTO TB_DXM_ReceiveMessage'
+'(FDuXinID1, FDuXinID2,FShouJiHao,FJieShouNeiRong,FJieShouShiJian,FBuMen) VALUES '
+' ('+XuHao1+','+XuHao2+','''+FShouJiHao+''','''+FJieShouNeiRong+''','''+FJieShouShiJian+''','''+FBuMen+''')');
ADOQ3.ExecSQL;
ADOQ3.Close;
Sms_Delete(trim(strs2[0]));
end;
end
end;
end;
//end;




end;

procedure TForm1.Button7Click(Sender: TObject);
var
DelReult:integer;
begin
DelReult:=Sms_Delete(Edit5.text);
end;


[解决办法]
strs := TStringList.Create;
你这个对象在过程里面，之后Create 但是没有Free

用完后应该： strs.free
[解决办法]
用FastMM检测下内存泄漏
[解决办法]
太长啦。。你把有泄漏的部分指出来。。
还有程序即使内存泄漏DELPHI好像也不会报out of memory的吧。。。
[解决办法]
我也遇到了，可能是Timer同步的问题，你检查下Timer执行时是否有交叉的两个Timer
[解决办法]
执行的时候把Timer置为False，执行完后，再置为True
[解决办法]
呵呵 CSDN大牛真多
[解决办法]
用NuMega BoundsChecker检测一下
[解决办法]
把握一个原则，谁创建谁释放

读书人网 >.NET

热点推荐

触屏版 | 电脑版

读书人网 m.reader8.net