AV error in multi-thread application

[Davidl]

Hi
I have a multi-thread / multi-session application which is giving me access violation errors ( and ORA-12154 errors as it happens ). I have seen a few posts on this whereby you were looking for a test app which fails. I scaled my application down to the bare minimum code, and using the code below, I invariably get errors. Can you take a look and see what is wrong please. It could be a bug in my test app - but I just can't see it.

Additionally, there is a sleep statement in the thread execute code. If this is uncommented everything seems to work. The errors generally seem to occur on the
OCICall(OCIServerAttach(srvhp, errhp, PChar(FDatabase), Length(FDatabase), OCI_DEFAULT));
... call in the Oracle.pas unit. If I put a critical section around this, then everything works ok, but I don't want the databases connected to serially.
Thanks.

unit fmTestConnect;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Oracle;

type
TTestThread = class(TThread)
private
protected
procedure Execute; override;
public
ConnectResult: String;
Completed: Boolean;
OracleSession: TOracleSession;
end;

TForm1 = class(TForm)
cmdConnect: TButton;
txtTNSAlias1: TEdit;
txtLogonName1: TEdit;
txtPassword1: TEdit;
txtTNSAlias2: TEdit;
txtLogonName2: TEdit;
txtPassword2: TEdit;
lbDBConnection1: TLabel;
lbDBConnection2: TLabel;
lbTNSAlias: TLabel;
lbLogonName: TLabel;
lbPassword: TLabel;
txtConnectResult1: TEdit;
txtConnectResult2: TEdit;
lbRunning: TLabel;
Label1: TLabel;
procedure cmdConnectClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
OracleSessions: Array[ 1..2 ] Of TOracleSession;
TestThreads: Array[ 1..2 ] Of TTestThread;
procedure CreateArrayObjects;
procedure FreeArrayObjects;
procedure CreateThreads;
procedure StartThreads;
procedure WaitForThreads;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.cmdConnectClick(Sender: TObject);
begin
If lbRunning.Visible Then
Exit;
Try
Screen.Cursor := crHourglass;
lbRunning.Visible := True;
CreateArrayObjects;
CreateThreads;
StartThreads;
WaitForThreads;
FreeArrayObjects;
Finally
lbRunning.Visible := False;
Screen.Cursor := crDefault;
End;
end;

procedure TForm1.CreateArrayObjects;
var
LoopVar: Integer;
begin
For LoopVar := 1 To 2 Do
Begin
OracleSessions[ LoopVar ] := TOracleSession.Create( Self );
Case LoopVar Of
1:
Begin
OracleSessions[ LoopVar ].LogonDatabase := txtTNSAlias1.Text;
OracleSessions[ LoopVar ].LogonUsername := txtLogonName1.Text;
OracleSessions[ LoopVar ].LogonPassword := txtPassword1.Text;
End;
2:
Begin
OracleSessions[ LoopVar ].LogonDatabase := txtTNSAlias2.Text;
OracleSessions[ LoopVar ].LogonUsername := txtLogonName2.Text;
OracleSessions[ LoopVar ].LogonPassword := txtPassword2.Text;
End;
End;
OracleSessions[ LoopVar ].ThreadSafe := False;
OracleSessions[ LoopVar ].Name := 'Session' + IntToStr( LoopVar );
End;
end;

procedure TForm1.FreeArrayObjects;
var
LoopVar: Integer;
begin
For LoopVar := 2 downto 1 Do
Begin
If Assigned( OracleSessions[ LoopVar ] ) Then
Begin
OracleSessions[ LoopVar ].LogOff;
OracleSessions[ LoopVar ].Free;
OracleSessions[ LoopVar ] := Nil;
End;
End;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeArrayObjects;
end;

procedure TForm1.CreateThreads;
var
LoopVar: Integer;
begin
For LoopVar := 1 To 2 Do
Begin
TestThreads[ LoopVar ] := TTestThread.Create( True );
TestThreads[ LoopVar ].OracleSession := OracleSessions[ LoopVar ];
End;
end;

procedure TForm1.StartThreads;
var
LoopVar: Integer;
begin
For LoopVar := 1 To 2 Do
If Assigned( TestThreads[ LoopVar ] ) Then
TestThreads[ LoopVar ].Resume;
end;

procedure TForm1.WaitForThreads;
var
LoopVar: Integer;
StillRunning: Boolean;
begin
While True Do
Begin
Sleep( 10 );
Application.ProcessMessages;
StillRunning := False;
For LoopVar := 1 To 2 Do
Begin
If Assigned( TestThreads[ LoopVar ] ) Then
Begin
If TestThreads[ LoopVar ].Completed Then
Begin
Case LoopVar Of
1: txtConnectResult1.Text := TestThreads[ LoopVar ].ConnectResult;
2: txtConnectResult2.Text := TestThreads[ LoopVar ].ConnectResult;
End;
TestThreads[ LoopVar ].Free;
TestThreads[ LoopVar ] := Nil;
End
Else
StillRunning := True;
End;
End;
If Not StillRunning Then
Break;
End;
end;

{ TTestThread }

procedure TTestThread.Execute;
begin
Completed := False;
ConnectResult := 'Ok';
//Sleep( 1000 );

Try
OracleSession.LogOn;
OracleSession.LogOff;
Except
On E: Exception Do
ConnectResult := E.Message;
End;

Completed := True;
end;

end.

 

[Marco Kalter]

Perhaps you can send me the complete delphi project by e-mail?

 

[Davidl]

Sent yesterday morning.
Can you confirm please.
Thanks

 

[Marco Kalter]

Confirmed. I have responded by e-mail reply.