OnThreadError Question

CQHALL

Member
I wrote a simple application to connect and disconnect to a database over a link as part of a deamon that will report various system problems via email to our DBA.

To accelerate testing, the process is on a 5 second timer (which is disabled while the session status changes), so the process takes 10 seconds PLUS the connect/disconnect time. Eventually, the timer will be set to one minute or more.

Initially, the program had a memory leak. I set the threaded property to true, which seemed to solve the memory leak, and I added an OnThreadError event handler that incremented a counter.

Initial testing looked pretty good with the program using about 8MB of memory (according to Windows 2000 task manager). However, over the weekend the memory usage grew to 16MB and had counted over 21,000 OnThreadError events. I am not accumulating the errormessages in any kind of list - just the count.

Why is the memory usage growing - is DOA accumulating thread errors somewhere?

///testdoa1.pas...
unit testDOA1;

interface

uses
Windows, SysUtils, Classes, Controls, Forms, dialogs, Graphics,
{StdCtrls,} Oracle, Buttons, ExtCtrls, StdCtrls, utillib;

type
TForm1 = class(TForm)
OracleSession1: TOracleSession;
Timer1: TTimer;
OracleQuery1: TOracleQuery;
Label1: TLabel;
Panel1: TPanel;
Memo1: TMemo;
btnStart: TBitBtn;
btnStop: TBitBtn;
lblCount: TStaticText;
lblThread: TStaticText;
procedure Timer1Timer(Sender: TObject);
procedure OracleQuery1ThreadError(Sender: TOracleQuery;
ErrorCode: Integer; const ErrorMessage: String);
procedure FormCreate(Sender: TObject);
procedure btnStartClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
total: array[0..1] of integer;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
uses queue;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
timer1.enabled:=false;
try
if oraclesession1.connected then
begin
oraclesession1.connected:=false;
label1.caption:='Disconnected';
label1.font.color:=clred;
end else
begin
oraclesession1.connected:=true;
oraclequery1.Close;
oraclequery1.execute;
inc(total[1]);
label1.caption:='Connected';
label1.font.color:=clgreen;
lblthread.caption:=inttostr(total[0])+' thread error'+iif(total[0]=1,'','s');
lblCount.caption:=inttostr(total[1])+' connect'+iif(total[1]=1,'','s');
application.Title:=' t: '+inttostr(total[0])+' c: '+inttostr(total[1]);
caption:=application.Title;
end;
finally
application.processmessages;
timer1.enabled:=true;
end;
end;

procedure TForm1.OracleQuery1ThreadError(Sender: TOracleQuery;
ErrorCode: Integer; const ErrorMessage: String);
begin
inc(total[0]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
fillchar(total,sizeof(total),0);
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
if sender=btnStart then
begin
oraclequery1.SQL.Assign(memo1.lines);
timer1.enabled:=true;
btnStart.enabled:=false;
btnStop.enabled:=true;
end else
begin
timer1.enabled:=false;
btnStart.enabled:=true;
btnStop.enabled:=false;
end;
end;

end.

//testdoa1.dfm

object Form1: TForm1
Left = 360
Top = 162
Width = 224
Height = 270
Caption = '0'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 0
Top = 0
Width = 216
Height = 24
Align = alTop
Alignment = taCenter
Caption = 'Disconnected'
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
end
object Panel1: TPanel
Left = 0
Top = 202
Width = 216
Height = 41
Align = alBottom
TabOrder = 0
object btnStart: TBitBtn
Left = 24
Top = 8
Width = 75
Height = 25
TabOrder = 0
OnClick = btnStartClick
Kind = bkOK
end
object btnStop: TBitBtn
Left = 112
Top = 8
Width = 75
Height = 25
Enabled = False
TabOrder = 1
OnClick = btnStartClick
Kind = bkCancel
end
end
object Memo1: TMemo
Left = 0
Top = 24
Width = 216
Height = 170
Align = alClient
Lines.Strings = (
'SELECT SYSDATE FROM DUAL@PLOG')
TabOrder = 1
end
object lblCount: TStaticText
Left = 0
Top = 198
Width = 216
Height = 4
Align = alBottom
BorderStyle = sbsSunken
TabOrder = 2
end
object lblThread: TStaticText
Left = 0
Top = 194
Width = 216
Height = 4
Align = alBottom
BorderStyle = sbsSunken
TabOrder = 3
end
object OracleSession1: TOracleSession
Cursor = crSQLWait
DesignConnection = False
LogonUsername = 'cqh'
LogonPassword = 'qflex'
LogonDatabase = 'TECHSYS'
ConnectAs = caNormal
ThreadSafe = True
Preferences.FloatPrecision = 0
Preferences.IntegerPrecision = 0
Preferences.SmallIntPrecision = -1
Preferences.UseOCI7 = False
Preferences.ConvertCRLF = True
Preferences.TrimStringFields = True
Preferences.MaxStringFieldSize = 0
Preferences.ZeroDateIsNull = True
Preferences.NullLOBIsEmpty = False
Pooling = spNone
MTSOptions = [moImplicit, moUniqueServer]
Connected = False
RollbackOnDisconnect = False
NullValue = nvUnAssigned
SQLTrace = stFalse
OptimizerGoal = ogUnchanged
IsolationLevel = ilUnchanged
BytesPerCharacter = bc1Byte
Left = 16
Top = 16
end
object Timer1: TTimer
Enabled = False
Interval = 5000
OnTimer = Timer1Timer
Left = 88
Top = 16
end
object OracleQuery1: TOracleQuery
SQL.Strings = (
'')
Session = OracleSession1
ReadBuffer = 25
Optimize = True
Debug = False
Cursor = crSQLWait
StringFieldsOnly = False
Threaded = True
ThreadSynchronized = True
OnThreadError = OracleQuery1ThreadError
Left = 56
Top = 16
end
end
 
A little more info. We have Oracle 8.05 running on a DEC Alpha under NT4 (so we can't get a newer version of Oracle until we upgrade our hardware).

I saw the forum thread on the memory leak. I believe pooling the sessions would defeat the purpose in my case. "Can I obtain a pooled session?" is a different question from "Can I obtain a new session?" Most of the applications that need to connect are outside of my control and weren't written in DOA so I can't adopt a pooled approach.
 
Direct Oracle Access is not accumulating anything. To verify if this is a Net 8 leak, you can maybe set TOracleSession.Preferences.UseOCI7 to True. You can only use this option if you are not using any Net 8 specific features (CLOB's, BLOB's, Objects).

If this does not affect the problem, let me know what the ThreadError is.

------------------
Marco Kalter
Allround Automations
 
Back
Top