Hello,

My config

D6 upd 2, IBO 4.2.H.g


In all of my app, the app required user_id only connect on 1 pc at the same
time. With this condition, user who want to connected to app always check if
user still have connection on the other machine/pc. If no connection on the
other pc, the user will be connected successfully and mark this user is
still connection on some table. And then if user want to disconnect, there
is a procedure to mark this user was disconnected. There is event after
connect and before disconnect to implement this idea.

In test app, user xxx sucessfully connected. and user xxx attempt to
disconnect.
The problem is, if the code write on BeforeDisconnect event, the query will
raise error like this "FieldName: ip_machine not found".

I move the code (from beforedisconnect event) to btnDisconnect.OnClick, then
this errors DOESNOT appear.

But if i compiled with IBO 4.2.F.r (code still in event beforedisconnect)
this errors DOESNOT appear.

Could you help me ?

Thanks

For your info

// Table Keamanan

CREATE TABLE KEAMANAN (
USER_ID CHAR(8) NOT NULL,
IP VARCHAR(15));


// Procedure Get_Last_Conn

CREATE PROCEDURE GET_LAST_CONN (
USER_IN VARCHAR(8))
RETURNS (
IP_OUT VARCHAR(12))
AS
BEGIN
For Select ip
From Keamanan
where user_id = :user_in
into :ip_out
Do
SUSPEND;
END

// end of procedure


// source for unit1.pas

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IBODataset, DB, IB_Components, IB_StoredProc, IB_Session,
StdCtrls, Psock, NMNNTP;

type
TForm1 = class(TForm)
MyIbConn: TIB_Connection;
spGetLastConn: TIB_StoredProc;
trGetLastConn: TIB_Transaction;
dsqlSetUser: TIB_DSQL;
trSetUser: TIB_Transaction;
quUser: TIBOQuery;
trquUser: TIBOTransaction;
btnConnect: TButton;
btnDisconnect: TButton;
nmNNTP: TNMNNTP;
Query: TIB_Query;
trQuery: TIB_Transaction;
MySession: TIB_Session;
procedure MyIbConnAfterConnect(Sender: TIB_Connection);
procedure MyIbConnBeforeDisconnect(Sender: TIB_Connection);
procedure btnConnectClick(Sender: TObject);
procedure btnDisconnectClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Koneksi : Boolean;

implementation

{$R *.dfm}

procedure TForm1.MyIbConnAfterConnect(Sender: TIB_Connection);
var
main_ip,
status_ip : string[15];
begin
main_ip := nmNNTP.LocalIP;
spGetLastConn.StoredProcName := 'Get_Last_Conn';
spGetLastConn.ParamByName('user_in').AsString := myIbConn.Username;
spGetLastConn.Prepare;
spGetLastConn.ExecProc;
status_ip := spGetLastConn.ParamByName('ip_out').AsString;
trGetLastConn.Commit;
if status_ip <> '' then begin
if main_ip <> TrimRight(status_ip) then begin
MyIbConn.Disconnect;
ShowMessage('user '+myIbConn.Username+' still accessed at '+Status_ip+'
Access denied ');
end
else if main_ip = status_ip then begin
Koneksi := True;
ShowMessage('Connected');
end; // if main_ip <> status_ip
end
else begin
with dsqlSetUser do begin
Sql.Clear;
Sql.Add(' Update Keamanan ');
Sql.Add(' set ip = :ip_machine ');
Sql.Add(' where user_id = :user ');
ParamByName('ip_machine').AsString := Main_Ip;
ParamByName('user').AsString := MyIbConn.Username;
Prepare;
try
ExecSql;
trSetUser.Commit;//Retaining;
Koneksi := True;
ShowMessage('Connected');
except
trSetUser.Rollback;
end;
end;
end; // else
end;

procedure TForm1.MyIbConnBeforeDisconnect(Sender: TIB_Connection);
begin
// fired if first connection success
if Koneksi then begin
// disable existing connection
Koneksi := False;
with Query do begin
Unprepare;
Sql.Clear;
Sql.Add(' Update Keamanan ');
Sql.Add(' set ip = :ip_machine ');
Sql.Add(' where user_id = :user ');
ParamByName('ip_machine').AsString := ' ';
ParamByName('user').AsString := MyIbConn.Username;
Prepare;
ExecSql;
trQuery.Commit;//Retaining;
end;
end;
end;

procedure TForm1.btnConnectClick(Sender: TObject);
begin
MyIbConn.Connect;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
MyIbConn.Disconnect;
end;

end.


// end of unit1.pas

// unit1.dfm

object Form1: TForm1
Left = 192
Top = 107
Width = 544
Height = 375
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btnConnect: TButton
Left = 96
Top = 168
Width = 75
Height = 25
Caption = 'Connect'
TabOrder = 0
OnClick = btnConnectClick
end
object btnDisconnect: TButton
Left = 224
Top = 168
Width = 75
Height = 25
Caption = 'Disconnect'
TabOrder = 1
OnClick = btnDisconnectClick
end
object MyIbConn: TIB_Connection
LoginPrompt = True
Params.Strings = (
'PATH=d:\project\specimen\files\specimen.gdb')
AfterConnect = MyIbConnAfterConnect
BeforeDisconnect = MyIbConnBeforeDisconnect
Left = 80
Top = 32
end
object spGetLastConn: TIB_StoredProc
DatabaseName = 'd:\project\specimen\files\specimen.gdb'
IB_Connection = MyIbConn
IB_Transaction = trGetLastConn
Left = 144
Top = 32
end
object trGetLastConn: TIB_Transaction
IB_Connection = MyIbConn
Isolation = tiCommitted
Left = 192
Top = 32
end
object dsqlSetUser: TIB_DSQL
DatabaseName = 'd:\project\specimen\files\specimen.gdb'
IB_Connection = MyIbConn
IB_Transaction = trSetUser
Left = 144
Top = 72
end
object trSetUser: TIB_Transaction
IB_Connection = MyIbConn
Isolation = tiCommitted
Left = 192
Top = 72
end
object quUser: TIBOQuery
Params = <>
DatabaseName = 'd:\project\specimen\files\specimen.gdb'
IB_Connection = MyIbConn
IB_Transaction = trquUser
RecordCountAccurate = True
ParamCheck = False
FieldOptions = []
Left = 144
Top = 104
end
object trquUser: TIBOTransaction
IB_Connection = MyIbConn
Isolation = tiCommitted
Left = 192
Top = 104
end
object nmNNTP: TNMNNTP
Port = 119
ReportLevel = 0
CacheMode = cmMixed
ParseAttachments = False
Left = 272
Top = 24
end
object Query: TIB_Query
DatabaseName = 'd:\project\specimen\files\specimen.gdb'
IB_Connection = MyIbConn
IB_Transaction = trQuery
ColorScheme = False
MasterSearchFlags = [msfOpenMasterOnOpen, msfSearchAppliesToMasterOnly]
BufferSynchroFlags = []
FetchWholeRows = True
Left = 144
Top = 136
end
object trQuery: TIB_Transaction
IB_Connection = MyIbConn
Isolation = tiCommitted
Left = 192
Top = 136
end
object MySession: TIB_Session
AllowDefaultConnection = True
AllowDefaultTransaction = True
DefaultConnection = MyIbConn
EditingColor = clYellow
InsertingColor = clLime
DeletingColor = clRed
SearchingColor = clAqua
ReadOnlyColor = clSilver
SelectedColor = clBlue
InvalidColor = clNone
PreparedColor = clGrayText
BrowsingColor = clWindow
StoreActive = False
Left = 32
Top = 32
end
end

// end of unit1.dfm





--------------------------- Yang Mudah dan Menghibur ---------------------------------
Hosting menjadi mudah dan murah hanya di PlasaCom. Klik http://idc.plasa.com
F1 Mania!! Ikuti F1 Game di Obelix Game Corner di http://www.plasa.com/infotel/f1.html
---------------------------------------------------------------------------------------