关闭线程后资源释放不干净...求助
//----------------------------------------------
type
TDataPool=Record
DataConn:TOraSession;
Query:TOraQuery;
Store:TOraStoredProc;
Flag:integer;
end;
var
FClientCS:TRTLCriticalSection;
FDataPool:TRTLCriticalSection;
DataInfo:tDataInfo;
DataPool:Array of TDataPool;
MaxDataPool:integer;
---在主线程中 创建数据库连接,并成功的连接到数据库
implementation
uses Math;
constructor TBankQuery.Create(const Abh, Atqfs, ATitle: String;{ AQuery: ToraQuery;}ADataInfo:tDataInfo);
begin
inherited Create(True);
sRes:=＇＇＇＇;
sSQL:=＇＇Select ...................................＇＇;
sTitle:=ATitle;
FreeOnTerminate:=True;
Resume;
end;
destructor TBankQuery.Destroy;
begin
inherited Destroy;
end;
procedure TBankQuery.Execute;
var
i:Integer;
j,n,k:integer;
begin
Synchronize(GetDataPoolID);
DataPool[FDataID].Query.SQL.Text:=sSQL;
//---------------------------------
try
DataPool[FDataID].Query.Close;
DataPool[FDataID].Query.SQL.Text:=FSQL3;
DataPool[FDataID].Query.Open;
n:=DataPool[FDataID].Query.FieldbyName(＇＇jls＇＇).AsInteger;
sXym:=cg;
except
sXym:=sjdqsb;
end;
if (j=0)and(k=0)and(n=0) then
begin
try
DataPool[FDataID].Query.Close;
DataPool[FDataID].Query.SQL.Text:=sSQL;
DataPool[FDataID].Query.Open;
except
sXym:=sjdqsb;
end;
if DataPool[FDataID].Query.Active=True then
if DataPool[FDataID].Query.RecordCount>0 then
sXym:=cg
else
sXym:=wcwzsj;
sRes:=＇＇＇＇;
if DataPool[FDataID].Query.Active=True then
if DataPool[FDataID].Query.RecordCount>0 then
begin
.....................
end;
DataPool[FDataID].Query.Close;
DataPool[FDataID].Query.SQL.Text:=＇＇＇＇;
Synchronize(SendQueryData);
end
else
sXym:=wcwzsj;
sRes:=sXym+sRes;
sRes:=sTitle+formatCurr(＇＇00000000＇＇,length(sRes))+sRes;
EnterCriticalSection(FClientCS);
try
frm_DataService.SenDataToCom(sRes,＇＇返回银行查询＇＇);
finally
Sleep(200);
LeaveCriticalSection(FClientCS);
end;
end;
procedure TBankQuery.SendQueryData;
begin
frm_DataService.UpdatePointer(FDataID,0); 设置数据库连接池位空闲转台
end;
procedure TBankQuery.GetDataPoolID;
begin
FDataID:=frm_DataService.GetPoint; //提取空闲的数据库连接池的ID
end;
//--------------------------------
procedure Tfrm_DataService.UpdatePointer(const APoint,Ai:integer);
begin
DataPool[APoint].Flag:=Ai;
end;
问题说明:当用任务管理器查看时发现每调用一次线程就后内存占用就增加一些.我觉是资源没有释放完毕了.
//----------------------------------------------
2楼: 请各位高手帮帮忙,给点建设性的意见. 如免费服装店管理软件
3楼: 在Execute方法中，加上一句： FreeOnTerminate := True;
4楼: 你主程序是如何调用这个线程的？ 释放后有没有把该线程设为nil？
5楼: 谢谢,我试一下,并通报结果.
6楼: DataPool是一个包含连接池,它的结果如下
type
TDataPool=Record
DataConn:TOraSession;
Query:TOraQuery;
Store:TOraStoredProc;
Flag:integer;
end;
DataPool:Array of TDataPool;
是在程序启动的时候设置启动连接数量,并连接数据库.在线程里动态调用空闲的连接进行数据查询(使用Query),当线程结束时关闭Query(DataPool[i].Query.Close),并结束线程.基本结构就是这样.我没找出哪里存在内存泄露.请各位网友帮忙.谢谢了!!!
进销存管理软件版7楼: 其实我在线程创建时执行了FreeOnTerminate := True;
把它放到 Execute中还存在内存泄露.
8楼: 是不是连接池的问题，打印一下连接池的连接个数，是不是没有释放
9楼: 连接池不可以释放吧,如果释放了就不能再使用了.当一个线程执行完操作时就把连接设位空闲状态,已被使用.连接池实在程序关闭的时候释放的.
10楼: 现在在主程序中创建数据库连接控件(TOraSession),并设置连接参数.在线程的Execute过程中动态创建Query,并在该过程结束时执行Close和Free.
现在仍然随着线程不断的创建--执行--结束而占用的内存越来越大.
真愁人~~~~~~~~~~~~~~~
11楼: 真的没有办法了吗？各位高手呀，赶紧帮帮忙呀。
12楼: 我在此贴出主体代码,由于水平有限有很多不理想的地方,最主要的就是连续的运行是存在内存泄露,我一直没找到原因,请高人指点,希望通过这个程序能使自己的水平有个提高.也让大家引以为戒.
开发环境
系统:Windows xp+sp2
工具:Delphi7
串口采用spcomm控件,
数据库是Oracle8i/9i,连接操作控件是 ODAC 5
特别感谢 SS2000 的指点
程序太乱,这里是简单的说明:
线程 Watch 监视任务列表 RecList:TStringList, 有新任务时发送消息和任务字符串指针到Tcommand 线程.
线程 ComSend 监视串口发送数据列表 ComSendList:TStringList,有新任务时把任务命令通过串行通讯发送出去.
线程 WorkThreadPool 由执行任务线程类Tcommand的创建的线程池,接收watch线程的消息和任务字符串指针,这行任务并把结果添加到串口发送数据列表(ConSendList)中,并发送消息给ComSend线程.
各个线程是在点击＂启动＂按钮后创建并等待,接收到相应的消息后执行.
//========================================================================
//===========主程序部分
// 1.启动
procedure Tfrm_DataService.Button2Click(Sender: TObject);
var
i:integer;
begin
if button2.Caption=＇＇开始运行＇＇ then
try
//=======================================================================
RecList:=TStringList.Create;
ComSendList:=TStringList.Create;
FreeThreadList:=TStringList.Create;
//=======================================================================
mem_yh.Lines.Append(＇＇Srieal Start＇＇);
SetLength(WorkThreadPool,MaxDataPool);
for i:=0 to MaxDataPool-1 do
begin
WorkThreadPool[i].WorkThread:=TCommand.Create(False);
WorkThreadPool[i].Flag:=0;
FreeThreadList.add(IntToStr(WorkThreadPool[i].WorkThread.threadID));
end;
//任务监视线程
Wath:=TWatch.Create;
//串口数据发送线程
ComSend:=TComSendData.create(＇＇＇＇,＇＇＇＇);
//打开串口
Comm1.StopComm;
Comm1.CommName:=ComboBox1.Text;
comm1.BaudRate:=StrToInt(ComboBox2.Text);
Comm1.StartComm;
mem_yh.Lines.Append(＇＇启动数据库连接池启动完成.＇＇);
//启动socket
ServerSocket1.Open;
img_h.Visible:=False;
img_l.Visible:=Not img_h.Visible;
button2.Caption:=＇＇停止＇＇;
Button1.Enabled:=False;
ComboBox1.Enabled:=False;
ComboBox2.Enabled:=False;
mem_yh.Lines.Append(＇＇System Start.＇＇);
except
img_h.Visible:=True;
img_l.Visible:=Not img_h.Visible;
Comm1.StopComm;
ServerSocket1.Active:=False;
Button1.Enabled:=True;
ComboBox1.Enabled:=True;
ComboBox2.Enabled:=True;
mem_yh.Lines.Append(＇＇System Start Failed.＇＇);
end
else
try
ServerSocket1.Close;
img_h.Visible:=True;
img_l.Visible:=Not img_h.Visible;
//=======================================================================
while ComSendList.Count>0 do //保证现有的数据发送完成
Application.ProcessMessages;
//释放列表
RecList.Clear;
FreeAndNil(RecList);
ComSendList.Clear;
FreeAndNil(ComSendList);
FreeThreadList.Clear;
FreeAndNil(FreeThreadList);
for i:=0 to MaxDataPool-1 do
begin
PostThreadMessage(workThreadPool[i].WorkThread.ThreadID,
UM_Close,0,0);
FreeAndNil(WorkThreadPool[i].WorkThread);
FreeAndNil(WorkThreadPool[i]);
end;
PostThreadMessage(Wath.ThreadID,UM_Close,0,0);
PostThreadMessage(ComSend.ThreadID,UM_Close,0,0);
//=======================================================================
Comm1.StopComm;
button2.Caption:=＇＇开始运行＇＇;
mem_yh.Lines.Append(＇＇启动数据库连接池关闭完成.＇＇);
Button1.Enabled:=True;
ComboBox1.Enabled:=True;
ComboBox2.Enabled:=True;
mem_yh.Lines.Append(＇＇System Close.＇＇);
except
end;
end;
//=======================================
//2.串口接收处理
procedure Tfrm_DataService.Comm1ReceiveData(Sender: TObject;
Buffer: Pointer; BufferLength: Word);
var
ps:Pchar;
ws,st:String;
s:String;
isockiD:integer;
i:integer;
begin
ps:=Buffer;
ws:=String(ps);
st:=ws;
s:=copy(ws,1,10);
delete(ws,1,10);
try
iSockID:=StrToInt(GetSockID(Ws));
except
exit;
end;
if iSockID=-1 then Exit;
Delete(ws,1,pos(＇＇>＇＇,ws));
// if s=＇＇BANKTODATA＇＇ THEN //银行数据向数据库发送
begin
Try
i:=StrToint(copy(ws,len_sjcd+1,len_jym)); //提取交易码
except
exit;
end;
case i of
1000:s:=＇＇查询 ＇＇;
2000:s:=＇＇缴费 ＇＇;
3000:s:=＇＇撤销 ＇＇;
4000:s:=＇＇对帐 ＇＇;
end;
mem_cx.Lines.Append(FormatDateTime(＇＇yyyy-MM-dd HH:mm:ss＇＇,now)+＇＇ < [＇＇+s+＇＇]＇＇+st);
case i of
1000:ComChaXun(ws,iSockID); //查询
2000:ComJiaoFei(ws,iSockID); //缴款
3000:ComCheXiao(ws,iSockID); //撤销
4000:ComDuiZhang(ws,iSockID); //对帐
end;
end;
end;
//==================================
//3.各个子程序
//查询模块
Procedure Tfrm_DataService.ComChaXun(const S:WideString;ASockID:Integer);
var
sTqfs:String; //提取方式 0-按凭证号提取 1-按驾驶证号提取
bh:String; //编号
sTitle:string; //串口 发送信息报文头(与Socket报文头不是一回事)
i:integer;
xym:String;
sRes:String;
begin
sTitle:=＇＇DATATOBANK＇＇+format(＇＇<%d>＇＇,[ASockID]); //方向+SocketID
i:=StrToInt(copy(s,1,8));
if i<>Length(s)-8 then
begin
xym:=sjcw;
sRes:=FormatCurr(format_StrLeng,length(xym))+xym;
sRes:=format(＇＇数据错误<%d>%s＇＇,[ASockID,sRes]);
EnterCriticalSection(FComsList);
ComSendList.Add(sRes);
LeaveCriticalSection(FComsList);
SendMegToComSendThread;
end
else
begin
//添加数据到列表中
EnterCriticalSection(FWorkList);
AddDataToList(s,AsockID,1000);
LeaveCriticalSection(FWorkList);
end;
end;
//缴费
Procedure Tfrm_DataService.ComJiaoFei(const S:WideString;ASockID:Integer);
var
i,j:integer;
sLsh:string; //流水号
zfkje,zyqfkje,zjehj,c_zfkje,c_zyqfkje,c_fkje,c_yqfkje:Integer; //总罚款金额,总逾期罚款金额,罚款金额总合计(单位:分)
sTitle:String; //串口发送信息头
xym:String; //响应码
jksj:string; //缴款时间 yyyyMMddHHmmss
tqfs:String; //提取方式
iwzcs:integer; //违章次数;
bh:String; //编号 tqfs=0 为 决定书编号 tqfs=1 为驾驶证号
sRet:WideString;
sSQL:wideString;
begin
// TWriteInfoINMemo.create(FormatDateTime(＇＇yyyy-MM-dd HH:mm:ss＇＇,now)+＇＇ : ＇＇+＇＇ - ＇＇+＇＇执行缴费＇＇);
sTitle:=＇＇DATATOBANK＇＇+Format(＇＇<%d>＇＇,[ASockID]);
i:=StrToInt(Copy(s,1,8));
if i<>length(s)-8 then
begin
xym:=sjcw;
sRet:=xym;
sRet:=FormatCurr(format_StrLeng,length(sRet))+sRet;
sRet:=Format(＇＇数据错误<%d>%s＇＇,[ASockID,sRet]);
try
EnterCriticalSection(FComsList);
ComSendList.Add(sRet);
LeaveCriticalSection(FComsList);
SendMegToComSendThread;
except
end;
end
else
begin
AddDataToList(s,AsockID,2000);
end;
end;
//撤销
Procedure Tfrm_DataService.ComCheXiao(const S:WideString;ASockID:Integer);
var
i,j:integer;
sTitle:String; //串口发送信息报文头
xym:String; //响应码
sRet:String;
begin
sTitle:=＇＇DATATOBANK＇＇+Format(＇＇<%d>＇＇,[ASockID]);
i:=StrToInt(Copy(s,1,8));
if i<>length(s)-8 then
begin
xym:=sjcw;
sRet:=xym;
sRet:=FormatCurr(format_StrLeng,length(sRet))+sRet;
sRet:=format(＇＇数据错误<%d>%s＇＇,[ASockID,sRet]);
try
EnterCriticalSection(FComsList);
ComSendList.Add(sRet);
LeaveCriticalSection(FComsList);
SendMegToComSendThread;
except
end;
end
else
begin
AddDataToList(s,AsockID,3000);
end;
end;
//对帐
Procedure Tfrm_DataService.ComDuiZhang(const S:WideString;ASockID:Integer);
var
sTitle:String;//串口发送信息头信息
sRet:String;
xym:String; //响应码
i:integer; //字符长度
begin
i:=StrToInt(copy(s,1,8));
if i<>length(s)-8 then
begin
xym:=sjcw;
sRet:=xym;
sRet:=FormatCurr(format_StrLeng,length(sRet))+sRet;
sRet:=Format(＇＇数据错误<%d>%s＇＇,[ASockID,sRet]);
try
EnterCriticalSection(FComsList);
ComSendList.Add(sRet);
LeaveCriticalSection(FComsList);
SendMegToComSendThread;
except
end;
end
else
begin
AddDataToList(s,AsockID,4000);
end;
end;
//添加任务到列表,并发送新任务消息(TWatch)
procedure Tfrm_DataService.AddDataToList(const Acontext:String;ASockID:Integer;ABusinCode:integer);
begin
RecList.Append(IntToStr(ABusinCode)+＇＇<＇＇+IntToStr(ASockID)+＇＇>＇＇+Acontext);
PostThreadMessage(Wath.ThreadID,UM_NewTask,0,0);
end;
//发送消息,运行串口写数据
procedure Tfrm_DataService.SendMegToComSendThread;
begin
PostThreadMessage(ComSend.ThreadID,UM_SendTask,0,0);
end;
//=========================================================================
//==========线程单元
unit Unit_DataThread;
interface
uses
Classes,SysUtils,{System,}DB, MemDS, DBAccess, Ora,Unit_DataService,ScktComp,
Windows,Messages;
const
UM_ChaXun =WM_User+1000; //查询
UM_JiaoFei =WM_User+2000; //缴费
UM_CheXiao =WM_User+3000; //撤销
UM_DuiZhang =WM_User+4000; //对帐
UM_NewTask =WM_User+1; //有新的任务
UM_SendTask =WM_User+2; //串口发送数据
UM_Close =WM_User+9; //结束线程
type
tDataInfo=Record
host:string;
port:Integer;
User:string;
pass:String;
Serv:String;
Flag:integer;
end;
//==============================================================================
type
TCommand=class(TThread)
private
FJym :string; //交易码
FSockid :integer; //SocketID;
Fcontext:String; //文档行
FSession:TOraSession; //数据库连接
FStore :TOraStoredProc; //存储过程
Function ChaXun:String; //查询
Function JiaoFei:String; //缴费
Function CheXiao:String; //撤销
Function DuiZhang:String; //对帐
procedure ComQuit(Sender: TObject);
protected
procedure SendMessToComSendThread;
Procedure Execute;override;
public
constructor Create(const Sups:boolean);
end;
type
TWorkThread=Record
WorkThread:TCommand;
Flag:integer;
end;
//==============================================================================
type
TComSendData=class(TThread)
Private
FSend:String;
FmemSm:String;
protected
procedure Execute;override;
public
constructor create(const ASend,AmemSm:String);
Destructor Destroy;override;
end;
type
TWatch=Class(TThread)
private
protected
procedure Execute;override;
public
constructor Create;
end;
var
FClientCS:TRTLCriticalSection;
FDataPool:TRTLCriticalSection;
FWorkList:TRTLCriticalSection;
FComsList:TRTLCriticalSection;
FSerial:TRTLCriticalSection;
DataInfo:tDataInfo;
MaxDataPool:integer;
WorkThreadPool:Array of TWorkThread;
RecList:TStringList; //接收数据列表
ComSendList:TStringList; //要发送的数据列表
FreeThreadList:TStringList; //空闲线程列表
Wath:TWatch; //任务监听线程
ComSend:TComSendData; //串口发送线程
implementation
uses Math, Masks;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TDataThread.UpdateCaption;
begin
Form1.Caption := ＇＇Updated in a thread＇＇;
end; }
{ TComSendData }
constructor TComSendData.create(const ASend, AmemSm: String);
begin
inherited Create(True);
FSend:=ASend;
FmemSm:=AmemSm;
Resume;
end;
destructor TComSendData.Destroy;
begin
inherited Destroy;
end;
//通过串口发送数据/把发送的内容显示在mem_cx中
procedure TComSendData.Execute;
var
ps:PChar;
i,j:integer;
St:String;
m:MSG;
FCmdID:Integer;
FCmdTxt:String;
begin
FreeOnTerminate:=True;
while not Terminated do
if WaitMessage then
begin
PeekMessage(M,0,0,0,PM_REMOVE);
begin
if m.message=UM_SendTask then
begin
i:=0;
while ComSendList.Count>0 do
begin
st:=ComSendList.Strings[0];
FCmdTxt:=Copy(st,1,10); //前10位为发送说明如[查询返回]
Delete(St,1,10);
st:=＇＇DATATOBANK＇＇+st;
ps:=pchar(ST);
j:=length(ST);
try
EnterCriticalSection(FSerial);
frm_DataService.Comm1.WriteCommData(ps,j);
frm_DataService.mem_cx.Lines.Append(
FormatDateTime(＇＇yyyy-MM-dd HH:mm:ss＇＇,now)+
＇＇ > ＇＇+FCmdTxt+st);
finally
LeaveCriticalSection(FSerial);
EnterCriticalSection(FComsList);
ComSendList.Delete(i);
if ComSendList.Count=0 then
ComSendList.Clear;
LeaveCriticalSection(FComsList);
end;
inc(i);
if i>ComSendList.Count then
i:=0;
end;
end;
if m.message=UM_Close then
Terminate;
end;
end;
Terminate;
end;
{ TWatch }
constructor TWatch.Create;
begin
inherited Create(False);
end;
procedure TWatch.Execute;
var
i,j:integer;
M:MSG;
begin
FreeOnTerminate:=True;
while Not Terminated do
if WaitMessage then
begin
if PeekMessage(m,0,0,0,PM_REMOVE) then
begin
if m.message=UM_Close then
Terminate
else
if (m.message=UM_NewTask) then
begin
while True do
begin
if FreeThreadList.Count>0 then
begin
j:=StrToInt(FreeThreadList.Strings[0]);
break;
end;
end;
//发送消息到TCommand线程,并把任务列表中的*字符串的指针*发送过去
if PostThreadMessage(j{WorkThreadPool[j].WorkThread.ThreadID},
WM_USER+StrToInt(copy(RecList.Strings[0],1,4)),
0,Integer(pchar(RecList.Strings[0]))) then
begin
EnterCriticalSection(FWorkList);
RecList.Delete(0);
FreeThreadList.Delete(0);
LeaveCriticalSection(FWorkList);
end;
end;
end;
end;
Terminate;
end;
{ TCommand }
function TCommand.ChaXun: String;
var
FJszbh:String;
FTQfs :string;
intRes:Integer;
varRes:String;
varXym:String;
begin
FJszbh:=TrimRight(copy(Fcontext,14,18));
FTQfs :=TrimRight(copy(Fcontext,13,1));
//==========================================================================
FStore.StoredProcName:=＇＇PBankQuery＇＇;
FStore.Params.Clear;
FStore.Params.CreateParam(ftString,＇＇varJdsbh＇＇,ptInput);
FStore.Params.CreateParam(ftInteger,＇＇iRes＇＇,ptOutput);
FStore.Params.CreateParam(ftString,＇＇varRes＇＇,ptOutput);
//==========================================================================
FStore.ParamByName(＇＇varJdsbh＇＇).AsString:=FJszbh;
try
FStore.Prepare;
FStore.ExecProc;
intRes:=FStore.ParamByName(＇＇iRes＇＇).AsInteger;
varRes:=FStore.paramByName(＇＇varRes＇＇).AsString;
FStore.Close;
FStore.Params.Clear;
except
intRes:=-1;
end;
if intRes=0 then
begin
varXym:=cg;
end
else if intRes=-1 then
begin
varXym:=sjdqsb;
end
else
begin
varXym:=wcwzsj;
end;
varRes:=varXym+varRes;
varRes:=Formatcurr(format_StrLeng,Length(VarRes))+varRes;
Result:=VarRes;
end;
function TCommand.JiaoFei: String;
var
i,j :integer;
FWfcs :integer;
FLsh :String; //流水号
FJksj :String; //缴款时间
FWfbh :String; //违法编号
FZfkje :Integer; //总罚款金额
FzYqfkje:Integer; //总逾期罚款金额
FzJehj :Integer; //金额合计
FTqfs :String; //提取方式
FXym :String; //响应码
stmp :string; //保存临时返回值
varRes :String;
c_fkje :integer; //当次罚款金额
c_yqfkje:Integer; //当次逾期罚款
c_jehj :integer;
begin
//==============================================================================
try
Flsh :=copy(Fcontext,13,len_lsh);
FJksj :=copy(Fcontext,29,length(format_DateTime));
FZfkje :=StrToInt(copy(Fcontext,43,7{length(format_money)}));
FzYqfkje:=StrToInt(copy(Fcontext,50,7{length(format_money)}));
Fzjehj :=StrToInt(copy(Fcontext,57,7{length(format_money)}));
FTqfs :=copy(Fcontext,64,1);
Except
Fxym:=sjcw;
varRes:=＇＇＇＇;
varRes:=FXym+varRes;
VarRes:=FormatCurr(format_StrLeng,length(varRes))+varRes;
Result:=varRes;
Exit;
end;
//==========================================================================
FStore.StoredProcName:=＇＇YINHANGJIAOFEI＇＇;
FStore.Params.Clear;
FStore.Params.CreateParam(ftString,＇＇varBh＇＇,ptInput);
FStore.Params.CreateParam(ftString,＇＇varlsh＇＇,ptInput);
FStore.Params.CreateParam(ftString,＇＇varjfsj＇＇,ptInput);
FStore.Params.CreateParam(ftInteger,＇＇intRes＇＇,ptOutput);
FStore.Params.CreateParam(ftString,＇＇varRes＇＇,ptOutput);
FStore.Params.CreateParam(ftInteger,＇＇intOutFkje＇＇,ptOutput);
FStore.Params.CreateParam(ftInteger,＇＇intOutZnj＇＇,ptOutput);
FStore.Params.CreateParam(ftString,＇＇varOutDsr＇＇,ptOutput);
FStore.Params.CreateParam(ftString,＇＇varOutJszh＇＇,ptOutput);
FStore.Params.CreateParam(ftString,＇＇varOutWfsj＇＇,ptOutput);
FStore.Params.CreateParam(ftString,＇＇varOutWfdz＇＇,ptOutput);
FStore.Params.CreateParam(ftString,＇＇varOutWfxw＇＇,ptOutput);
FStore.Params.CreateParam(ftInteger,＇＇varOutJehj＇＇,ptOutput);
//==========================================================================
FWfcs:=StrToInt(copy(Fcontext,65,1));
c_fkje:=0;
c_yqfkje:=0;
j:=1;
for i:=1 to FWfcs do
begin
FWfbh:=TrimRight(copy(Fcontext,66+(j-1)*len_bh,len_bh));
FStore.ParambyName(＇＇varBh＇＇).AsString :=FWfbh;
FStore.ParambyName(＇＇varLsh＇＇).AsString :=FLsh;
FStore.ParambyName(＇＇varJfsj＇＇).AsString :=FJksj;
try
FSession.StartTransaction;
FStore.Prepare;
FStore.ExecProc;
FXym:=FStore.ParambyName(＇＇varRes＇＇).AsString;
if FXym=cg then
with FStore do
begin
c_fkje :=c_fkje+ParambyName(＇＇IntOutFkje＇＇).AsInteger;
c_yqfkje :=c_yqfkje+ParambyName(＇＇IntOutZnj＇＇).AsInteger;
stmp:=stmp+FWfbh;
stmp:=stmp+frm_DataService.GetSubString(ParambyName(＇＇varOutDsr＇＇).AsString,len_dsr);
stmp:=stmp+frm_DataService.GetSubString(ParambyName(＇＇varOutJszh＇＇).AsString,len_jszh);
stmp:=stmp+frm_DataService.GetSubString(ParambyName(＇＇varOutWfsj＇＇).AsString,len_wfsj);
stmp:=stmp+frm_DataService.GetSubString(ParambyName(＇＇varOutWfdz＇＇).AsString,len_wzdd);
stmp:=stmp+frm_DataService.GetSubString(ParambyName(＇＇varOutWfxw＇＇).AsString,len_wzxw);
stmp:=stmp+formatCurr(format_money,c_fkje);
stmp:=stmp+formatCurr(format_money,c_yqfkje);
stmp:=stmp+formatCurr(format_money,c_jehj);
end
else
break;
except
FXym:=jzsb;
Break;
end;
FStore.Close;
inc(j);
end;
c_jehj :=c_fkje+c_yqfkje;
if FXym=cg then
begin
if (c_fkje=FZfkje) and
(c_yqfkje=FzYqfkje) and
(c_jehj=FzJehj) then
begin
FSession.Commit;
FXym:=cg;
end
else
begin
FSession.Rollback;
FXym:=zjebp;
end;
end;
FStore.Params.Clear;
stmp:=stmp+FormatCurr(format_money,FZfkje);
stmp:=stmp+FormatCurr(format_money,FzYqfkje);
stmp:=stmp+FormatCurr(format_money,FzJehj);
varRes:=FXym+IntToStr(j)+stmp;
varRes:=FormatCurr(format_StrLeng,length(varRes))+varRes;
Result:=varRes;
end;
constructor TCommand.Create(const Sups:boolean);
begin
FSession:=TOraSession.Create(nil);
FSession.Username:=DataInfo.User;
FSession.Password:=DataInfo.pass;
FSession.ConnectString:=DataInfo.User+＇＇/＇＇+
DataInfo.pass+＇＇@＇＇+
DataInfo.host+＇＇:＇＇+
IntToSTr(DataInfo.port)+＇＇:＇＇+
DataInfo.Serv;
FStore:=TOraStoredProc.Create(nil);
FStore.Session:=FSession;
FSession.Connect;
inherited Create(Sups);
end;
function TCommand.DuiZhang: String;
var
FDzrq :String; //对帐日期
FYhzbs :Integer; //***总笔数
FYhzje :Integer; //***总金额
varRes :String;
FZdZje :integer; //***总金额
FZdzbs :Integer; //***总笔数
Flsh :string; //流水号
Fxym :String; //响应码
begin
FDzrq :=Copy(Fcontext,29,8);
FLsh :=Copy(Fcontext,13,16);
FYhzbs :=StrToInt(copy(Fcontext,37,10));
Fyhzje :=StrToInt(Copy(Fcontext,47,10));
//==============================================================================
FStore.StoredProcName:=＇＇PDUIZHANGADAY＇＇;
FStore.Params.Clear;
FStore.Params.CreateParam(ftString,＇＇varDzrq＇＇,ptInput);
FStore.Params.CreateParam(ftInteger,＇＇intZbs＇＇,ptOutput);
FStore.Params.CreateParam(ftInteger,＇＇intZje＇＇,ptOutput);
//==============================================================================
with FStore do
begin
try
ParambyName(＇＇varDzrq＇＇).AsString:=FDzrq;
ExecProc;
Fxym :=cg;
except
Fxym :=sjdqsb
end;
if Fxym=cg then
begin
FZdZbs:=ParambyName(＇＇intZbs＇＇).AsInteger;
FZdzje:=ParambyName(＇＇intZje＇＇).AsInteger;
end
else
begin
FZdZje:=0;
FZdzbs:=0;
end;
end;
if (FYhzbs=FZdzbs)and(FYhzje=FZdZje) then
Fxym:=cg
else
Fxym:=sjdqsb;
varRes:=Fxym+Flsh+FDzrq+FormatCurr(format_zbs,FZdZje)+FormatCurr(format_zbs,FZdZje);
varRes:=FormatCurr(format_StrLeng,length(varRes))+varRes;
Result:=varRes;
end;
procedure TCommand.Execute;
var
FRecText:String;
FCommd:String;
FCmdID:integer;
ps:Pchar;
Sockid:integer;
m:MSG;
i:integer;
begin
while Not Terminated do
if WaitMessage then
begin
if PeekMessage(m,0,0,0,PM_REMOVE) then
if (m.message=UM_ChaXun) or
(m.message=Um_JiaoFei) or
(m.message=UM_CheXiao) or
(M.message=UM_DuiZhang) or
(M.message=UM_close) then
begin
if m.message=UM_Close then
begin
FStore.Close;
FreeAndNil(FStore);
FSession.Close;
FSession.Disconnect;
FreeAndNil(FSession);
Break;
end
else
begin
//命令行
Ps:=pchar(m.lParam);
Fcontext:=string(ps);
//删除字符串开始的4位交易号
FCmdID:=StrToInt(copy(Fcontext,1,4));
Delete(Fcontext,1,4);
//提取sockid,并从原是命令字符串中删除它
i:=pos(＇＇>＇＇,Fcontext);
Sockid:=StrToInt(Copy(Fcontext,2,i-2));
delete(Fcontext,1,i);
case m.message of
UM_ChaXun: FRecText:=ChaXun;
UM_JiaoFei: FRecText:=JiaoFei;
UM_CheXiao: FRecText:=CheXiao;
UM_DuiZhang:FRecText:=DuiZhang;
end;
case FCmdID of
1000:FCommd:=＇＇[查询返回]＇＇; //8个字符宽度
2000:FCommd:=＇＇[缴费返回]＇＇;
3000:FCommd:=＇＇[撤销返回]＇＇;
4000:FCommd:=＇＇[对帐返回]＇＇;
end;
//=====================================添加返回值到串口发送列表
FRecText:=format(＇＇%s<%d>%s＇＇,[FCommd,Sockid,FRecText]);
EnterCriticalSection(FComsList);
ComSendList.Add(FRecText);
LeaveCriticalSection(FComsList);
Synchronize(SendMessToComSendThread);
//=====================================设置线程为等待状态
FreeThreadList.Add(IntToStr(Self.ThreadID));
end;
end;
end;
end;
procedure TCommand.SendMessToComSendThread;
begin
frm_DataService.SendMegToComSendThread;
end;
function TCommand.CheXiao: String;
var
Flsh :String; //流水号
FYlsh :String; //原流水号
FCxrq :String; //撤销日期
FZje :integer; //总金额
Fxym :String; //响应码
varRes :String;
begin
Flsh :=copy(fcontext,13,16);
Fzje :=StrToInt(copy(fcontext,47,7));
FCxrq :=copy(fcontext,54,14);
FYlsh :=copy(fcontext,68,16);
//==============================================================================
FStore.StoredProcName:=＇＇PDISFROCK＇＇;//asp.StoredProcName;
FStore.Params.Clear;
FStore.Params.CreateParam(ftString,＇＇chrlsh＇＇,ptInput);
FStore.Params.CreateParam(ftString,＇＇chrYlsh＇＇,ptInput);
FStore.Params.CreateParam(ftString,＇＇dteCxsj＇＇,ptInput);
FStore.Params.CreateParam(ftString,＇＇varBh＇＇,ptInput);
FStore.Params.CreateParam(ftString,＇＇intZje＇＇,ptInput);
FStore.Params.CreateParam(ftInteger,＇＇iRes＇＇,ptOutput);
//==============================================================================
with FStore do
begin
ParambyName(＇＇chrlsh＇＇).AsString :=Flsh;
ParambyName(＇＇chrYlsh＇＇).AsString :=FYlsh;
ParambyName(＇＇dteCxsj＇＇).AsString :=FCxrq;
ParambyName(＇＇varBh＇＇).AsString :=＇＇＇＇;
ParambyName(＇＇intZje＇＇).AsInteger :=Fzje;
end;
try
FSession.StartTransaction;
FStore.Prepare;
FStore.ExecProc;
FSession.Commit;
if FStore.ParambyName(＇＇iRes＇＇).AsInteger=0 then
Fxym:=cg
else
Fxym:=mzbce;
except
FSession.Rollback;
Fxym:=mzbce;
end;
FStore.Close;
FStore.Params.Clear;
varRes:=Fxym+Flsh+FYlsh;
varRes:=FormatCurr(format_StrLeng,length(varRes))+varRes;
Result:=varRes;
end;
procedure TCommand.ComQuit(Sender: TObject);
begin
FStore.Close;
FreeAndNil(FStore);
//FSession.Close;
FSession.Disconnect;
FreeAndNil(FSession);
//Terminate;
end;
end. 如商品管理软件
13楼: 代码太多，卡不过来，不过看到一个疑问，为什么只有TWriteInfoINMemo的Create，没有Free呢？
进销存管理软件版14楼: procedure TWriteInfoINMemo.Execute;
begin
FreeOnTerminate := true;//应该加一句吧
EnterCriticalSection(FClientCS);
frm_DataService.mem_cx.Lines.Append(FInfoTxt);
frm_DataService.update;
LeaveCriticalSection(FClientCS);
end;
15楼: 没注意看到前面已经提出这个问题了，不过，即使加了 FreeOnTerminate := true;
还有内存泄露 ，只能说明内存泄露不止一个地方，不加FreeOnTerminate := true;
肯定会有内存泄露的。
顺便说一下，我的程序看起来似乎也有内存泄露，占用空间越来越大，但是，我查了
一个星期也没有查出来（以前从来没有过），最后我已经初步断定，这个不是内存泄露，
而是Windows的内存管理有问题，由于我大量申请、释放内存，可能造成内存碎片太多，
结果导致好像占用内存越来越多，和内存泄露一样，而且还导致我AllocMem失败，要知道，我的服务器是2G内存，根本没有用完，我只是申请不到2M的内存而已。
16楼: 谢谢SS2000的提示,我也发现了这个问题,现在线程删除掉了(其实它的作用也不到).也删除了所有和它有关的调用,可是问题依旧.
17楼: 请高手指点
18楼: 自由界面和报表的完美解决方案！
http://www.anylib.com
19楼: to Lucker;哥们儿,你的东西做得很好,宣传也很到位,佩服之极,相信你一定是以为高手,帮兄弟研究一下问题出在哪里.
20楼: 楼主代码太长，建议从线程定义和释放入手：
定义：
MyThread:=TMyThread.Create(True);
MyThread.Priority:=tpLower;
MyThread.FreeOnTerminate:=true; //在线程运行之前定义。
MyThread.Resume;
释放:
for i:=0 to MaxDataPool-1 do
begin
PostThreadMessage(workThreadPool[i].WorkThread.ThreadID,
UM_Close,0,0);
//这里可能会有问题，万一PostThreadMessage调用失败怎么办？
//应该加上检测代码，如 if GetLastError=0 then application.messagebox(＇＇线程关闭失败＇＇,＇＇提示＇＇);
//PostThreadMessage 的使用说明可以参考在线帮助。
FreeAndNil(WorkThreadPool[i].WorkThread);
FreeAndNil(WorkThreadPool[i]);
end;
进销存管理软件版21楼: 没做过线程程序，很想帮你，看看吧
22楼: 代码好长，我水平太次了 如速达软件卸载
23楼: 还是慢慢调试吧，先屏蔽掉所有与数据库关联的操作，看看是不是还存在内存泄漏，
如果还有，就一步一步的屏蔽你的某些操作，直到没有内存泄漏为止。
24楼: to chnplzh,yanghai0437,xfz8124:
谢谢各位帮助.
正如 chnplzh 所说,我在线程释放方面有欠考虑,一定在程序中更正.
各个线程是在实在点击＂开始＂按钮启动,点击＂停止＂按钮退出,如下过程:
// 1.启动
procedure Tfrm_DataService.Button2Click(Sender: TObject);
在整个反复地数据接收,处理,发送的过程中不存在线程的创建和释放的操作.我想直接表现出地内存泄露现象可能不是在这里.
有谁使用过ODAC吗,我用CheckMem.pas测试了程序,只要加入ODAC的数据库连接控件TOraSession 或 TOraStoredProc 就有内存泄露报告,我不知道是不是它的原因？
yanghai0437 兄的方法值得参考.
25楼: 1,对数据库,多线程操作是不安全的.所以最好给它加上一个临界区保护.
2,使用Boundcheck,运行你的程序,最后有泄露,这个工具会指示出来的.
祝你好运.
26楼: 看看我写的一个ADOList与你有没有帮助，用ADOList。在线程中使用得当绝不会出问题。经过时间检验了的。使用例子在下一个回复中贴出。
unit ADOList;
interface
uses
SysUtils, Classes, DB, ADODB, windows, ExtCtrls;
type
TDBDriver = (ddMSSQL, ddOracle, ddAccess, ddODBC);
TOnQueryNode = procedure(Index: Integer; ADOQuery: TADOQuery) of object;
TOnStoredProcNode = procedure(Index: Integer; ADOStoredProc: TADOStoredProc) of object;
PMyADOQ = ^TMyADOQ;
TMyADOQ = record
hIndex: Integer;
useing: boolean;
idleMinCount: Integer;
ADOQuery: TADOQuery;
ADOconn: TADOConnection;
end;
PMyADOS = ^TMyADOS;
TMyADOS = record
hIndex: Integer;
useing: boolean;
idleMinCount: Integer;
ADOStore: TADOStoredProc;
ADOconn: TADOConnection;
end;
TADOList = class(TComponent)
private
{ Private declarations }
ADOQList: TList;
ADOSList: TList;
MaxADOQNodeCount: Integer;
MaxADOSNodeCount: Integer;
FADOConnStr, FUserName, FPassword, FDataSource, FDBName: string;
FDBFile: TFileName;
FDBDriver: TDBDriver;
FidleMinCount: integer;
FidleCheckTimer: TTimer;
QueryNodeCreate, QueryNodeGet, QueryNodeFree: TOnQueryNode;
StoredProcNodeCreate, StoredProcNodeGet, StoredProcNodeFree: TOnStoredProcNode;
ADOListQCritical: TRTLCriticalSection;
ADOListSCritical: TRTLCriticalSection;
function getADOQListCount: integer;
function getADOSListCount: integer;
function GetADOConnStr: string;
procedure UserNameWrite(name: string);
procedure PasswordWrite(Pass: string);
procedure DataSoureWrite(Server: string);
procedure DBNameWrtie(DB: string);
function ADOConnStrRead: string;
procedure DBDriverWrite(const Value: TDBDriver);
procedure DBFileWrite(const Value: TFileName);
procedure OnidleCheckTimer(Sender: TObject);
function GetRndInteger: Integer;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property QueryCount: Integer read getADOQListCount;
property StoredProcCount: Integer read getADOSListCount;
property ADOConnectStr: string read ADOConnStrRead;
function GetFreeADOQ(var Index: integer): TADOQuery;
procedure SetFreeADOQ(const Index: integer);
function GetFreeADOS(var Index: integer): TADOStoredProc;
procedure SetFreeADOS(const Index: integer);
procedure SetADOConnStr(ADOConnStr: string);
procedure SetADOQConnStr(const Index: integer);
procedure SetADOSConnStr(const Index: integer);
published
{ Published declarations }
property MaxQueryCount: Integer read MaxADOQNodeCount write MaxADOQNodeCount;
property MaxStoredProcCount: Integer read MaxADOSNodeCount write MaxADOSNodeCount;
property DataBaseUserID: string read FUserName write UserNameWrite;
property DataBasePassword: string read FPassword write PasswordWrite;
property DataSource: string read FDataSource write DataSoureWrite;
property DataBaseName: string read FDBName write DBNameWrtie;
property DataBaseFile: TFileName read FDBFile write DBFileWrite;
property DataBaseDriver: TDBDriver read FDBDriver write DBDriverWrite;
property idleMinCount: integer read FidleMinCount write FidleMinCount;
property OnQueryNodeCreate: TOnQueryNode read QueryNodeCreate write QueryNodeCreate;
property OnStoredProcNodeCreate: TOnStoredProcNode read StoredProcNodeCreate write StoredProcNodeCreate;
property OnQueryNodeGet: TOnQueryNode read QueryNodeGet write QueryNodeGet;
property OnStoredProcNodeGet: TOnStoredProcNode read StoredProcNodeGet write StoredProcNodeGet;
property OnQueryNodeFree: TOnQueryNode read QueryNodeFree write QueryNodeFree;
property OnStoredProcNodeFree: TOnStoredProcNode read StoredProcNodeFree write StoredProcNodeFree;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(＇＇cdhctec＇＇, [TADOList]);
end;
{ TADOList }
constructor TADOList.Create(AOwner: TComponent);
begin
inherited;
MaxADOQNodeCount := 10;
MaxADOSNodeCount := 5;
FidleMinCount := 15;
FUserName := ＇＇sa＇＇;
FPassword := ＇＇＇＇;
FDataSource := ＇＇localhost＇＇;
FDBName := ＇＇＇＇;
FDBDriver := ddMSSQL;
ADOQList := TList.Create;
ADOSList := TList.Create;
FidleCheckTimer := TTimer.Create(nil);
FidleCheckTimer.Interval := 60000;
FidleCheckTimer.Enabled := True;
FidleCheckTimer.OnTimer := onidlechecktimer;
InitializeCriticalSection(ADOListQCritical);
InitializeCriticalSection(ADOListSCritical);
end;
destructor TADOList.Destroy;
var
tempADOQ: PMyADOQ;
tempADOS: PMyADOS;
i: Integer;
begin
FidleCheckTimer.Enabled := False;
FidleCheckTimer.Free;
for i := ADOQList.Count - 1 downto 0 do
begin
tempADOQ := ADOQList.Items[i];
tempADOQ.ADOQuery.Free;
tempADOQ.ADOconn.Free;
dispose(tempADOQ);
end;
for i := ADOSList.Count - 1 downto 0 do
begin
tempADOS := ADOSList.Items[i];
tempADOS.ADOStore.Free;
tempADOS.ADOconn.Free;
dispose(tempADOS);
end;
FreeAndNil(ADOQList);
FreeAndNil(ADOSList);
DeleteCriticalSection(ADOListQCritical);
DeleteCriticalSection(ADOListSCritical);
inherited;
end;
function TADOList.GetRndInteger: Integer;
var
Num: double;
P: PInteger;
begin
sleep(1);
Num := now;
P := addr(Num);
result := P^;
Randomize;
result := result + Random(9999999);
end;
function TADOList.GetADOConnStr: string; //返回数据库联结的字符串(string)
begin
case FDBDriver of
ddMSSQL: result := ＇＇Provider=SQLOLEDB.1;User ID=＇＇ + FUserName + ＇＇;Password=＇＇ + FPassWord + ＇＇;Data Source=＇＇ + FDataSource + ＇＇;Initial Catalog=＇＇ + FDBName + ＇＇;Persist Security Info=False＇＇;
ddOracle: result := ＇＇Provider=OraOLEDB.Oracle.1;User ID=＇＇ + FUserName + ＇＇;Password=＇＇ + FPassWord + ＇＇;Data Source=＇＇ + FDataSource + ＇＇;Persist Security Info=True＇＇;
ddAccess: result := ＇＇Provider=Microsoft.Jet.OLEDB.4.0;User ID=＇＇ + FUserName + ＇＇;Password=＇＇ + FPassWord + ＇＇;Data Source=＇＇ + FDBFile + ＇＇;Persist Security Info=True＇＇;
ddODBC: result := ＇＇Provider=MSDASQL.1;User ID=＇＇ + FUserName + ＇＇;Password=＇＇ + FPassWord + ＇＇;Data Source=＇＇ + FDataSource + ＇＇;Initial Catalog=＇＇ + FDBName + ＇＇;Persist Security Info=True＇＇;
end;
end;
function TADOList.getADOQListCount: integer;
begin
result := ADOQList.Count;
end;
function TADOList.getADOSListCount: integer;
begin
result := ADOSList.Count;
end;
function TADOList.GetFreeADOQ(var Index: integer): TADOQuery;
var
i: integer;
tempADOQ: PMyADOQ;
begin
EnterCriticalSection(ADOListQCritical);
result := nil;
try
while result = nil do
begin
for i := AdoQList.Count - 1 downto 0 do
begin
tempADOQ := AdoQList.Items[i];
if not tempADOQ.useing then
begin
tempADOQ.useing := True;
Index := tempADOQ.hIndex;
result := tempADOQ.ADOQuery;
break;
end;
end;
if (result = nil) and (ADOQList.Count < MaxADOQNodeCount) then
begin
new(tempADOQ);
tempADOQ.useing := True;
tempADOQ.hIndex := GetRndInteger;
tempADOQ.ADOconn := TADOconnection.Create(nil);
tempADOQ.ADOconn.ConnectionString := FADOConnStr;
tempADOQ.ADOconn.LoginPrompt := false;
tempADOQ.ADOQuery := TADOQuery.Create(nil);
tempADOQ.ADOQuery.Connection := tempADOQ.ADOconn;
result := tempADOQ.ADOQuery;
AdoQList.Add(tempADOQ);
Index := tempADOQ.hIndex;
result.Tag := Index;
if assigned(QueryNodeCreate) then QueryNodeCreate(Index, result);
end;
if result = nil then sleep(50);
end;
if assigned(QueryNodeGet) then QueryNodeGet(Index, result);
except
end;
LeaveCriticalSection(ADOListQCritical);
end;
function TADOList.GetFreeADOS(var Index: integer): TADOStoredProc;
var
i: integer;
tempADOS: PMyADOS;
begin
EnterCriticalSection(ADOListSCritical);
result := nil;
try
while result = nil do
begin
for i := ADOSList.Count - 1 downto 0 do
begin
tempADOS := ADOSList.Items[i];
if not tempADOS.useing then
begin
tempADOS.useing := True;
Index := tempADOS.hIndex;
result := tempADOS.ADOStore;
break;
end;
end;
if (result = nil) and (ADOSList.Count < MaxADOSNodeCount) then
begin
new(tempADOS);
tempADOS.useing := True;
tempADOS.hIndex := GetRndInteger;
tempADOS.ADOconn := TADOconnection.Create(nil);
tempADOS.ADOconn.ConnectionString := FADOConnStr;
tempADOS.ADOconn.LoginPrompt := false;
tempADOS.ADOStore := TADOStoredProc.Create(nil);
tempADOS.ADOStore.Connection := tempADOS.ADOconn;
result := tempADOS.ADOStore;
ADOSList.Add(tempADOS);
Index := tempADOS.hIndex;
result.Tag := Index;
if assigned(StoredProcNodeCreate) then StoredProcNodeCreate(Index, result);
end;
if result = nil then sleep(50);
end;
if assigned(StoredProcNodeGet) then StoredProcNodeGet(Index, result);
except
end;
LeaveCriticalSection(ADOListSCritical);
end;
procedure TADOList.DataSoureWrite(Server: string);
begin
FDataSource := Server;
FADOConnStr := GetADOConnStr;
end;
procedure TADOList.PasswordWrite(Pass: string);
begin
FPassword := Pass;
FADOConnStr := GetADOConnStr;
end;
procedure TADOList.SetADOConnStr(ADOConnStr: string);
var
tempADOQ: PMyADOQ;
tempADOS: PMyADOS;
i: Integer;
begin
try
for i := ADOQList.Count - 1 downto 0 do
begin
tempADOQ := ADOQList.Items[i];
tempADOQ.ADOconn.Close;
tempADOQ.ADOconn.ConnectionString := ADOConnStr;
end;
for i := ADOSList.Count - 1 downto 0 do
begin
tempADOS := ADOQList.Items[i];
tempADOS.ADOconn.Close;
tempADOS.ADOconn.ConnectionString := ADOConnStr;
end;
except
end;
end;
procedure TADOList.SetADOQConnStr(const Index: integer);
var
tempADOQ: PMyADOQ;
begin
FADOConnStr := GetADOConnStr;
try
tempADOQ := ADOQList.Items[Index];
tempADOQ.ADOconn.Close;
tempADOQ.ADOconn.ConnectionString := FADOConnStr;
except
end;
end;
procedure TADOList.SetADOSConnStr(const Index: integer);
var
tempADOS: PMyADOS;
begin
FADOConnStr := GetADOConnStr;
try
tempADOS := ADOQList.Items[Index];
tempADOS.ADOconn.Close;
tempADOS.ADOconn.ConnectionString := FADOConnStr;
except
end;
end;
procedure TADOList.SetFreeADOQ(const Index: integer);
var
I: Integer;
tempADOQ: PMyADOQ;
begin
try
for I := AdoQList.Count - 1 downto 0 do // Iterate
begin
tempADOQ := AdoQList.Items[i];
if tempadoq.hIndex = Index then
begin
tempADOQ.ADOQuery.Close;
tempADOQ.ADOQuery.Sql.Clear;
tempADOQ.useing := False;
tempADOQ.idleMinCount := 0;
if assigned(QueryNodeFree) then QueryNodeFree(Index, tempADOQ.ADOQuery);
break;
end;
end; // for
except
end;
end;
procedure TADOList.SetFreeADOS(const Index: integer);
var
I: Integer;
tempADOS: PMyADOS;
begin
try
for I := AdoSList.Count - 1 downto 0 do // Iterate
begin
tempADOS := AdoSList.Items[i];
if tempADOS.hIndex = Index then
begin
tempADOS.ADOStore.Close;
tempADOS.useing := False;
tempADOS.idleMinCount := 0;
if assigned(StoredProcNodeFree) then StoredProcNodeFree(Index, tempADOS.ADOStore);
end;
end; // for
except
end;
end;
procedure TADOList.UserNameWrite(name: string);
begin
FUserName := name;
FADOConnStr := GetADOConnStr;
end;
procedure TADOList.DBNameWrtie(DB: string);
begin
FDBName := DB;
FADOConnStr := GetADOConnStr;
end;
function TADOList.ADOConnStrRead: string;
begin
result := FADOConnStr;
end;
procedure TADOList.DBDriverWrite(const Value: TDBDriver);
begin
FDBDriver := Value;
FADOConnStr := GetADOConnStr;
end;
procedure TADOList.DBFileWrite(const Value: TFileName);
begin
FDBFile := Value;
FADOConnStr := GetADOConnStr;
end;
procedure TADOList.OnidleCheckTimer(Sender: TObject);
var
tempADOQ: PMyADOQ;
tempADOS: PMyADOS;
i: Integer;
begin
FidleCheckTimer.Enabled := false;
EnterCriticalSection(ADOListQCritical);
EnterCriticalSection(ADOListSCritical);
try
for i := ADOQList.Count - 1 downto 0 do
begin
tempADOQ := ADOQList.Items[i];
if tempADOQ.useing then Continue;
if tempADOQ.idleMinCount >= FidleMinCount then
begin
ADOQList.Delete(i);
tempADOQ.ADOQuery.Free;
tempADOQ.ADOconn.Free;
dispose(tempADOQ);
end
else tempADOQ.idleMinCount := tempADOQ.idleMinCount + 1;
end;
for i := ADOSList.Count - 1 downto 0 do
begin
tempADOS := ADOSList.Items[i];
if tempADOS.useing then Continue;
if tempADOS.idleMinCount >= FidleMinCount then
begin
ADOSList.Delete(i);
tempADOS.ADOStore.Free;
tempADOS.ADOconn.Free;
dispose(tempADOS);
end
else tempADOS.idleMinCount := tempADOS.idleMinCount + 1;
end;
except
end;
LeaveCriticalSection(ADOListQCritical);
LeaveCriticalSection(ADOListSCritical);
FidleCheckTimer.Enabled := True;
end;
end.
27楼: 上面的代码写成的是一个控件，当然你可以作为一般的类使用，例子如下：
//------------------------------------------------------------------------------
// 扣分设置
//------------------------------------------------------------------------------
procedure Tnew_AdminDM.AdminDispsubtractsetBeginAction(AThread: TIdPeerThread;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo;
var FDataSet: TDataSet; var FADOIndex: Integer; var Handled: Boolean);
var
index: integer;
TempAdoS: TADOStoredProc;
TempAdoQ: TADOQuery;
begin
if ArequestInfo.Command = ＇＇POST＇＇ then //如果是POST提交修改设置
begin
TempAdoS := Server_PubDM.new_ADOList.GetFreeADOS(index);
with TempAdoS do
try
ProcedureName := ＇＇subtractset＇＇;
Parameters.Refresh;
Parameters.ParamValues[＇＇@departid＇＇] := saftystrtoint(ArequestInfo.Session.Content.Values[＇＇departid＇＇]);
Parameters.ParamValues[＇＇@overtime＇＇] := strtofloat(replacenull(ArequestInfo.Params.Values[＇＇overtime＇＇]));
Parameters.ParamValues[＇＇@reject＇＇] := strtofloat(replacenull(ArequestInfo.Params.Values[＇＇reject＇＇]));
Parameters.ParamValues[＇＇@linelose＇＇] := strtofloat(replacenull(ArequestInfo.Params.Values[＇＇linelose＇＇]));
Parameters.ParamValues[＇＇@cost＇＇] := strtofloat(replacenull(ArequestInfo.Params.Values[＇＇cost＇＇]));
ExecProc;
except
on e: exception do
begin
writeln(LOGFile, ＇＇new_AdminxDMUnit007:[＇＇ + DateTimeToStr(now) + ＇＇]:＇＇ + E.message);
ArequestInfo.Session.Content.SaveToFile(FormatDateTime(＇＇yyyy_mm_dd_hh_mm_ss＂.txt＂＇＇, now));
writeln(LogFile, ArequestInfo.UnparsedParams);
end;
end;
Server_PubDM.new_ADOList.SetFreeADOS(index);
end;
TempAdoQ := Server_PubDM.new_ADOList.GetFreeADOQ(index);
with TempAdoQ do
try
sql.Add(＇＇select * from 扣分定义表 where 单位=:departid＇＇);
Parameters.ParamValues[＇＇departid＇＇] := saftystrtoint(ArequestInfo.Session.Content.Values[＇＇departid＇＇]);
open;
AResponseInfo.ContentText := subtractset.Content(ArequestInfo.Session.Content, ArequestInfo.Params, TempAdoQ);
except
on e: exception do
begin
writeln(LOGFile, ＇＇new_AdminxDMUnit008:[＇＇ + DateTimeToStr(now) + ＇＇]:＇＇ + E.message);
ArequestInfo.Session.Content.SaveToFile(FormatDateTime(＇＇yyyy_mm_dd_hh_mm_ss＂.txt＂＇＇, now));
writeln(LogFile, ArequestInfo.UnparsedParams);
end;
end;
Server_PubDM.new_ADOList.SetFreeADOQ(index);
end;
进销存管理软件版28楼: 谢谢 dedema,genue:两位朋友的指点,我会认真参考的.
29楼: genue 兄的代码对我的启发很大,让我学到了很多东西,对编程又有了更尽一步的认识.非常感谢.
dedema兄,为什么在多线程中操作数据库是不安全的？再有我一直认为在线程中涉及公有变量的时候需要临界区,可是我的数据操作控件是在线程创建的时候创建的,不涉及公有的变量呀.
30楼: 结果通告:
现在问题解决了(是朋友帮助解决的)
问题出现再 watch线程的消息发送部分
原程序是这样的
//发送消息到TCommand线程,并把任务列表中的*字符串的指针*发送过去
if PostThreadMessage(j{WorkThreadPool[j].WorkThread.ThreadID},
WM_USER+StrToInt(copy(RecList.Strings[0],1,4)),
0,Integer(pchar(RecList.Strings[0]))) then
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
RecList.Delete(0);
~~~~~~~~~~~~~~~~~~
修改后是这样
type
TMsgLParam = record //消息参数结构
LParam:string;
end;
pMsgLParam = ^TMsgLParam; //消息参数结构指针
在Watch线程中对应的部分修改是这样的
New(pMLP);
~~~~~~~~~~~~
pMLP^.LParam:=RecList.Strings[0];
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if PostThreadMessage(j{WorkThreadPool[j].WorkThread.ThreadID},
WM_USER+StrToInt(copy(RecList.Strings[0],1,4)),
0,Integer(pMLP)) then
~~~~~~~~~~~~~
在Command 线程中对应的修改如下
pMLP:=pMsgLParam(m.lParam);
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Ps:=pchar(pMLP.LParam);
~~~~~~~~~~~~~~~~~~~~~~~~~
dispose(pMLP);
~~~~~~~~~~~~~~~~~~~~~`
不知道我这样理解对否
首先发送没问题.可是执行RecList.Delete(0)只是删除了列表信息,而这RecList.Strings[0]所对应的常量还没有在内存中删除,因为还存在其他的引用(往Command线程发送的消息参数).所以每次只是删除了列表而没有实质性的删除内存中的数据.还需要在Command线程中释放内存中的数据.
不知道这样理解是否正确,还请朋友们讨论一下.主要是把问题搞明白.
31楼: 看完了，只有学习的份了
32楼: 多线程访问数据库用全局变量TRTLCriticalSection来控制，在线程执行之前调用EnterCriticalSection进入临界区，执行完毕之后调用LeaveCriticalSection来退出，能解决问题的。
33楼: 哦，原来的用法确实是错误的，现在的用法也是很别扭的。不是正常的用法，弄麻烦了，如果你有兴趣，等会我有空给你说说正常的用法
34楼: 祝贺你终于解决了[:)]
进销存管理软件版35楼: To YuD:
代码没有详细的看,但是我觉得你的思路有点问题,根本没有必要建那么多的OraSession,只需要一个OraSession就可以了，在OraSession启动事务的时候加一个保护区保护就可以了。
前段时间用VC开发了一个多线程数据库操作程序，发现出现内存泄漏，利用boundcheck检查发现竟然是微软的MFC中出现内存泄漏，后来改为线程池处理后内存泄漏好多，建议改为线程池来处理，我也哥们也发生过类似的情况一直没有找到解决问题的方法，改为线程池以后完成可以满足日常的业务需求，不会出现大量的内存泄漏了，这也是治标不治本的方法，实在是没有别的招好使了
36楼: 非常感谢给为的支持,谢谢大家.
Sorry,没能即时和大家沟通.
to xfeiffe,你说的设置临界区我知道,程序中之所以没有使用是因为每一个线程都创建对了自己的数据库连接控件和数据存储控件,不涉及对公有变量的操作,所以没有使用.
to lmd,谢谢!!
to hds6400,谢谢你的提示,你说的很有道理,我会采纳的.我感觉OraSession本身存在内存泄露,我反复执行了 OraSession 的连接和断开,通过任务管理器查看程序所占内存在变大(不知道这样测试是否合理).后来改用现在使用的方法.
to SS2000 上边是我自己理解的不知道对否.如果你方便,很希望你能提供一个正确的方法,算是给我等讲课了.
我一点我很困惑,不知道什么原因,偶尔出现数据更新失败的现象.
所谓的更新就是删除一个表的一条记录,由于这种情况偶尔出现,很难捕捉.可以肯定一点是不存在多个过程同时操作一条数据的现象.所有的数据库操作都是交由存储过程完成,即使有对一条数据同时操作的时候Oracle本身也能解决.更何况不存在这种情况.
37楼: 太长了
有空学习学习
38楼: 从原来的代码中，其实并不能看到内存泄露。
原程序是这样的
//发送消息到TCommand线程,并把任务列表中的*字符串的指针*发送过去
if PostThreadMessage(j{WorkThreadPool[j].WorkThread.ThreadID},
WM_USER+StrToInt(copy(RecList.Strings[0],1,4)),
0,Integer(pchar(RecList.Strings[0]))) then
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
RecList.Delete(0);
~~~~~~~~~~~~~~~~~~
这段代码其实并不能明显看到内存泄露（我没看出来），但是却有一个严重的错误。
Integer(pchar(RecList.Strings[0]))把这个字符串的地址当作LParam发送消息出去后，
接着就 RecList.Delete(0);
把这个内存释放了，也就是说，线程得到的地址可能是非法的，为什么你的程序不出错误，
很奇怪。
修改后的代码，改正了这个错误，不过有点别扭。我把常规改法给你看看。
你的代码
type
TMsgLParam = record //消息参数结构
LParam:string;
end;
pMsgLParam = ^TMsgLParam; //消息参数结构指针
在Watch线程中对应的部分修改是这样的
New(pMLP);
~~~~~~~~~~~~
pMLP^.LParam:=RecList.Strings[0];
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if PostThreadMessage(j{WorkThreadPool[j].WorkThread.ThreadID},
WM_USER+StrToInt(copy(RecList.Strings[0],1,4)),
0,Integer(pMLP)) then
~~~~~~~~~~~~~
在Command 线程中对应的修改如下
pMLP:=pMsgLParam(m.lParam);
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Ps:=pchar(pMLP.LParam);
~~~~~~~~~~~~~~~~~~~~~~~~~
dispose(pMLP);
~~~~~~~~~~~~~~~~~~~~~`
我的代码
在Watch线程中对应的部分修改是这样的
var p: PChar;
p := AllocMem(Length(RecList.Strings[0]+1);
Move(PChar(RecList.Strings[0])^,p^,Length(RecList.Strings[0]);
if PostThreadMessage(j{WorkThreadPool[j].WorkThread.ThreadID},
WM_USER+StrToInt(copy(RecList.Strings[0],1,4)),
0,Integer(p)) then
在Command 线程中对应的修改如下
var s: string;
s:=PChar(m.lParam);
FreeMem(PChar(m.lParam));
~~~~~~~~~~~~~~~~~~~~~`
39楼: 谢谢 SS2000 的指导,我发现自己的基础知识差得太多了,应该认真得补一补.
放分很困难,分不多.其实我知道大家不是为了区区几分才回帖的,纯是一片热心,向各位学习.
联系我们
