1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
unit wmlogin;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, HTTPDefs, websession, fpHTTP, fpWeb, fpjsonrpc,
fpjson, IBConnection, sqldb, webjsonrpc, fpextdirect, sqldbwebdata;
type
{ TSessionManagement }
TSessionManagement = class(TExtDirectModule)
IBConnection1: TIBConnection;
Logout: TJSONRPCHandler;
Login: TJSONRPCHandler;
SessionManagement: TJSONRPCHandler;
QAuthenticate: TSQLQuery;
SQLTransaction1: TSQLTransaction;
procedure DataModuleCreate(Sender: TObject);
procedure LoginExecute(Sender: TObject; const Params: TJSONData;
out Res: TJSONData);
procedure LogoutExecute(Sender: TObject; const Params: TJSONData;
out Res: TJSONData);
private
function AuthenticateUser(AUsername, APassword: String): Integer;
procedure DoOnNewSession(Sender: TObject);
{ private declarations }
public
{ public declarations }
end;
var
SessionManagement: TSessionManagement;
implementation
uses inifiles;
{$R *.lfm}
{ TSessionManagement }
function TSessionManagement.AuthenticateUser(AUsername,APassword : String) : Integer;
begin
With QAuthenticate do
begin
ParamByName('Login').AsString:=AUserName;
ParamByName('Password').AsString:=APassword;
Open;
try
if (EOF and BOF) then
Result:=-1
else
begin
Result:=FieldByName('U_ID').AsInteger;
Session.Variables['UserName']:=FieldByName('U_NAME').AsString;
end;
Session.Variables['UserID']:=IntToStr(Result);
finally
Close;
end;
end;
end;
procedure TSessionManagement.LoginExecute(Sender: TObject;
const Params: TJSONData; out Res: TJSONData);
Var
A : TJSONArray ;
AUserName,APassword : String;
begin
A:=Params as TJSONArray;
AUserName:=A.Strings[0];
APassword:=A.Strings[1];
Res:=TJSONIntegerNumber.Create(AuthenticateUser(AUsername,APassword));
end;
procedure TSessionManagement.LogoutExecute(Sender: TObject;
const Params: TJSONData; out Res: TJSONData);
begin
// To be sure
Session.Variables['UserID']:='-1';
Session.Terminate;
// A result must always be sent back.
Res:=TJSONString.Create('Bye');
end;
procedure TSessionManagement.DoOnNewSession(Sender : TObject);
begin
// The cookies must all originate from the same path, otherwise the 2 datamodules will use a different session.
(Sender as TFPWebSession).SessionCookiePath:='/';
end;
procedure TSessionManagement.DataModuleCreate(Sender: TObject);
Var
FN : String;
Ini : TMemIniFile;
begin
// The following 2 statements are needed because the 2 properties are (currently) not published.
OnNewSession:=@DoOnNewSession;
CreateSession:=True;
FN:=ChangeFileExt(Paramstr(0),'.ini');
If FileExists(FN) then
begin
Ini:=TMemIniFile.Create(FN);
try
With IBConnection1 do
begin
DatabaseName:=Ini.ReadString('Database','Path',DatabaseName);
UserName:=Ini.ReadString('Database','UserName',UserName);
Password:=Ini.ReadString('Database','Password',Password);
end;
finally
Ini.Free;
end;
end;
IBConnection1.Connected:=True;
end;
initialization
RegisterHTTPModule('Login', TSessionManagement);
end.
|
