diff options
Diffstat (limited to 'packages/fcl-web/examples')
17 files changed, 891 insertions, 0 deletions
diff --git a/packages/fcl-web/examples/combined/combined.html b/packages/fcl-web/examples/combined/combined.html new file mode 100644 index 0000000000..377a592a90 --- /dev/null +++ b/packages/fcl-web/examples/combined/combined.html @@ -0,0 +1,20 @@ +<html> +<head> +<title>ExtJS application demo</title> +<link rel="stylesheet" type="text/css" href="/ext/resources/css/ext-all.css"/> +<script src="/ext/adapter/ext/ext-base.js"></script> +<script src="/ext/ext-all-debug.js"></script> +<script src="combined.cgi/Login/API"></script> +<script src="login.js"></script> +<script> +Ext.onReady(function() { + // API is registered under FPWeb by default. + Ext.Direct.addProvider(FPWeb); + fpWeb.login=new fpWeb.LoginForm({}); + fpWeb.login.show(); +}); +</script> +</head> +<body> +</body> +</html>
\ No newline at end of file diff --git a/packages/fcl-web/examples/combined/combined.ico b/packages/fcl-web/examples/combined/combined.ico Binary files differnew file mode 100644 index 0000000000..0341321b5d --- /dev/null +++ b/packages/fcl-web/examples/combined/combined.ico diff --git a/packages/fcl-web/examples/combined/combined.ini b/packages/fcl-web/examples/combined/combined.ini new file mode 100644 index 0000000000..4220bcf27d --- /dev/null +++ b/packages/fcl-web/examples/combined/combined.ini @@ -0,0 +1,4 @@ +[Database] +Path=/home/firebird/combined.fb +UserName=WISASOFT +Password=SysteemD diff --git a/packages/fcl-web/examples/combined/combined.lpi b/packages/fcl-web/examples/combined/combined.lpi new file mode 100644 index 0000000000..beb1bbc61e --- /dev/null +++ b/packages/fcl-web/examples/combined/combined.lpi @@ -0,0 +1,116 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + <MainUnitHasCreateFormStatements Value="False"/> + <Runnable Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="Combined RPC/Webdata example"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="5"> + <Item1> + <PackageName Value="SQLDBLaz"/> + <MinVersion Major="1" Release="1" Valid="True"/> + </Item1> + <Item2> + <PackageName Value="lazwebextra"/> + <MinVersion Minor="9" Valid="True"/> + </Item2> + <Item3> + <PackageName Value="WebLaz"/> + </Item3> + <Item4> + <PackageName Value="LCL"/> + </Item4> + <Item5> + <PackageName Value="FCL"/> + </Item5> + </RequiredPackages> + <Units Count="5"> + <Unit0> + <Filename Value="combined.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="combined"/> + </Unit0> + <Unit1> + <Filename Value="wmlogin.pp"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="SessionManagement"/> + <ResourceBaseClass Value="DataModule"/> + <UnitName Value="wmlogin"/> + </Unit1> + <Unit2> + <Filename Value="wmusers.pp"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="CombinedModule"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="DataModule"/> + <UnitName Value="wmusers"/> + </Unit2> + <Unit3> + <Filename Value="login.js"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="users.js"/> + <IsPartOfProject Value="True"/> + </Unit4> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="10"/> + <Target> + <Filename Value="combined.cgi"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + </SearchPaths> + <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/packages/fcl-web/examples/combined/combined.lpr b/packages/fcl-web/examples/combined/combined.lpr new file mode 100644 index 0000000000..a1450e60c6 --- /dev/null +++ b/packages/fcl-web/examples/combined/combined.lpr @@ -0,0 +1,15 @@ +program combined; + +{$mode objfpc}{$H+} + +uses + fpCGI, wmusers, httpdefs, websession,wmlogin; + +{$R *.res} + +begin + Application.Title:='Combined RPC/Webdata example'; + Application.Initialize; + Application.Run; +end. + diff --git a/packages/fcl-web/examples/combined/combined.res b/packages/fcl-web/examples/combined/combined.res Binary files differnew file mode 100644 index 0000000000..7c6cf3e4be --- /dev/null +++ b/packages/fcl-web/examples/combined/combined.res diff --git a/packages/fcl-web/examples/combined/combined.sql b/packages/fcl-web/examples/combined/combined.sql new file mode 100644 index 0000000000..e5b4c595aa --- /dev/null +++ b/packages/fcl-web/examples/combined/combined.sql @@ -0,0 +1,11 @@ +CREATE TABLE USERS ( + U_ID BIGINT NOT NULL, + U_LOGIN VARCHAR(40) NOT NULL, + U_NAME VARCHAR(30) NOT NULL, + U_EMAIL VARCHAR(100), + U_PASSWORD VARCHAR(100) NOT NULL, + CONSTRAINT PK_FPCUSERS PRIMARY KEY (U_ID), + CONSTRAINT U_USERNAME UNIQUE (U_LOGIN) +); + +
\ No newline at end of file diff --git a/packages/fcl-web/examples/combined/login.js b/packages/fcl-web/examples/combined/login.js new file mode 100644 index 0000000000..8d78375d30 --- /dev/null +++ b/packages/fcl-web/examples/combined/login.js @@ -0,0 +1,105 @@ +Ext.ns("fpWeb"); +fpWeb.LoginForm = Ext.extend (Ext.Window, { + /* Control references */ + blogin : null, + eusername : null, + epassword : null, + plock : null, + fform : null, + /* Callbacks */ + OnLogin : function (Provider,Response) { + if (!Ext.isEmpty(Response.error)) { + Ext.Msg.show({ + title : 'Login failed', + msg : 'An error occurred during login: '+Response.error.message+'. Please try again.', + icon : Ext.Msg.ERROR, + buttons : Ext.Msg.OK + }); + } else if (Response.result > 0) { + // here code to switch to data editing + window.location='users.html'; +/* + Ext.Msg.show({ + title : 'Login OK', + msg : 'Your username/pasword was accepted. We will now proceed to the editing form', + icon : Ext.Msg.ERROR, + buttons : Ext.Msg.OK + }); +*/ + } else { + Ext.Msg.show({ + title : 'Login failed', + msg : 'Your username/pasword is incorrect. Please try again.', + icon : Ext.Msg.ERROR, + buttons : Ext.Msg.OK + }); + } + }, + loginbuttonclick : function (sender) { + SessionManagement.Login(this.eusername.getValue(), this.epassword.getValue(),this.OnLogin.createDelegate(this)); + }, + focususer : function () { + this.eusername.focus(); + }, + /* Build the actual form */ + constructor : function (config) { + this.eusername = new Ext.form.TextField({ + name:"user", + fieldLabel:"Login", + inputType:"text" + }); + this.epassword = new Ext.form.TextField({ + name:"pass", + fieldLabel:"Password", + inputType:"password" + }); + this.blogin = new Ext.Button({ + text:"Login", + handler : this.loginbuttonclick, + scope : this + }); + this.fform = new Ext.form.FormPanel({ + width: 350, + labelWidth:150, + border:false, + xtype: "form", + buttonAlign: "right", + bodyStyle: "padding: 10px 15px", + defaultType: "textfield", + defaults: {width: 150}, + items: [this.eusername,this.epassword], + buttons:[this.blogin], + keys: {key: Ext.EventObject.ENTER, + handler: function(){ + this.blogin.focus(); + }, + scope: this + } + }); + this.plock = new Ext.Panel({ + border:false, + html:"<img src='login.png' width=114 height=128/>", + width:114, + height:128 + }); + Ext.apply(config, { + title: "Login", + width: 500, + height: 200, + plain: true, + layout: "hbox", + defaultButton: this.eusername, + layoutConfig: { + align : "middle", + pack: "center" + }, + closable: false, + listeners: { + 'show' : { fn: this.focususer.createDelegate(this) } + }, + items: [ this.fform, this.plock ] + }); + fpWeb.LoginForm.superclass.constructor.call(this,config); + } /* constructor*/ +}); + diff --git a/packages/fcl-web/examples/combined/login.png b/packages/fcl-web/examples/combined/login.png Binary files differnew file mode 100644 index 0000000000..e1a2633df2 --- /dev/null +++ b/packages/fcl-web/examples/combined/login.png diff --git a/packages/fcl-web/examples/combined/users.html b/packages/fcl-web/examples/combined/users.html new file mode 100644 index 0000000000..ea47d6f45d --- /dev/null +++ b/packages/fcl-web/examples/combined/users.html @@ -0,0 +1,18 @@ +<html> +<head> +<title>Edit users in database</title> +<link rel="stylesheet" type="text/css" href="/ext/resources/css/ext-all.css"/> +<script src="/ext/adapter/ext/ext-base.js"></script> +<script src="/ext/ext-all-debug.js"></script> +<script src="combined.cgi/Login/API"></script> +<script src="users.js"></script> +<script> +Ext.onReady(function() { + // API is registered under FPWeb by default. + Ext.Direct.addProvider(FPWeb); +}); +</script> +</head> +<body> +</body> +</html>
\ No newline at end of file diff --git a/packages/fcl-web/examples/combined/users.js b/packages/fcl-web/examples/combined/users.js new file mode 100644 index 0000000000..063c2dca6f --- /dev/null +++ b/packages/fcl-web/examples/combined/users.js @@ -0,0 +1,108 @@ +Ext.ns('fpWeb'); + +fpWeb.ShowPage = function () { + var myproxy = new Ext.data.HttpProxy ( { + api : { + read: "combined.cgi/Provider/Users/Read/", + update: "combined.cgi/Provider/Users/Update/", + create: "combined.cgi/Provider/Users/Insert/", + destroy: "combined.cgi/Provider/Users/Delete/" + } + }); + var myreader = new Ext.data.JsonReader ({ + root: "rows", + successProperty : 'success', + idProperty: "U_ID", + messageProperty: 'message', // Must be specified here + fields: ["U_ID","U_LOGIN","U_NAME","U_EMAIL", "U_PASSWORD"] + }); + var mywriter = new Ext.data.JsonWriter({ + encode: true, + writeAllFields: true, + idProperty: "U_ID" + }); + var data = new Ext.data.Store({ + proxy: myproxy, + reader: myreader, + writer: mywriter, + autoSave: false, + idProperty: "U_ID", + }); + // Listen to errors. + data.addListener('exception', function(proxy, type, action, options, res) { + if (type === 'remote') { + Ext.Msg.show({ + title: 'REMOTE EXCEPTION', + msg: res.message, + icon: Ext.MessageBox.ERROR, + buttons: Ext.Msg.OK + }); + } + }); + data.load({ params:{start: 0, limit: 30}}); + var grid = new Ext.grid.EditorGridPanel({ + renderTo: Ext.getBody(), + frame: true, + title: "Known users", + height: 600, + width: 800, + store: data, + columns: [ + {header: 'ID', dataIndex: "U_ID", sortable: true, hidden: true}, + {header: 'Login', dataIndex: "U_LOGIN", sortable: true, editor: new Ext.form.TextField({allowBlank: false})}, + {header: 'Name', dataIndex: "U_NAME", sortable: true, editor: new Ext.form.TextField({allowBlank: false}), width : 200}, + {header: 'Email', dataIndex: "U_EMAIL", sortable: true, editor: new Ext.form.TextField({allowBlank: false}), width : 200}, + {header: 'Password', dataIndex: "U_PASSWORD", sortable: true, editor: new Ext.form.TextField()}, + ], + bbar: new Ext.PagingToolbar({ + pageSize: 30, + store: data, + displayInfo: true + }), + tbar : [{ + text: 'Add', + iconCls: 'icon-add', + handler: function(btn, ev) { + var u = new grid.store.recordType(); + grid.stopEditing(); + grid.store.insert(0, u); + grid.startEditing(0, 1); + }, + scope: grid + }, '-', { + text: 'Delete', + iconCls: 'icon-delete', + handler: function(btn, ev) { + var index = grid.getSelectionModel().getSelectedCell(); + if (!index) { + return false; + } + var rec = grid.store.getAt(index[0]); + grid.store.remove(rec); + }, + scope: grid + }, '-', { + text: 'Save', + iconCls: 'icon-save', + handler: function(btn, ev) { + grid.store.save(); + }, + scope: grid + },'->', { + text: 'Log out', + iconCls: 'logout', + handler: function () { + SessionManagement.Logout(function (provider,response) { + if (response.result=='Bye') { + window.location='combined.html'; + } + }); + } + } + ] + // F.ContentToStream(M); + + }); + grid.show(); +} +Ext.onReady(fpWeb.ShowPage); diff --git a/packages/fcl-web/examples/combined/users.sql b/packages/fcl-web/examples/combined/users.sql new file mode 100644 index 0000000000..daec6fb64d --- /dev/null +++ b/packages/fcl-web/examples/combined/users.sql @@ -0,0 +1,15 @@ +CREATE TABLE USERS ( +U_ID BIGINT Not Null , +U_LOGIN VARCHAR(40) Not Null, +U_NAME VARCHAR(30) Not Null, +U_EMAIL VARCHAR(100), +U_PASSWORD VARCHAR(100) Not Null, +CONSTRAINT PK_FPCUSERS Primary key (U_ID), +CONSTRAINT U_USERNAME Unique key (U_LOGIN) +); + +COMMIT; + +CREATE GENERATOR GEN_USERS; + +COMMIT; diff --git a/packages/fcl-web/examples/combined/wmlogin.lfm b/packages/fcl-web/examples/combined/wmlogin.lfm new file mode 100644 index 0000000000..e41c9d2bc0 --- /dev/null +++ b/packages/fcl-web/examples/combined/wmlogin.lfm @@ -0,0 +1,76 @@ +object SessionManagement: TSessionManagement + OnCreate = DataModuleCreate + OldCreateOrder = False + DispatchOptions = [jdoSearchRegistry, jdoSearchOwner, jdoJSONRPC1, jdoJSONRPC2, jdoNotifications] + APIPath = 'API' + RouterPath = 'router' + Height = 200 + HorizontalOffset = 582 + VerticalOffset = 455 + Width = 295 + object Login: TJSONRPCHandler + OnExecute = LoginExecute + Options = [] + ParamDefs = < + item + Name = 'UserName' + end + item + Name = 'Password' + end> + left = 24 + top = 24 + end + object IBConnection1: TIBConnection + Connected = False + LoginPrompt = False + KeepConnection = False + Transaction = SQLTransaction1 + LogEvents = [] + left = 24 + top = 117 + end + object SQLTransaction1: TSQLTransaction + Active = False + Action = caNone + Database = IBConnection1 + left = 26 + top = 72 + end + object QAuthenticate: TSQLQuery + AutoCalcFields = False + Database = IBConnection1 + Transaction = SQLTransaction1 + ReadOnly = False + SQL.Strings = ( + 'SELECT' + ' U_ID, U_NAME' + 'From' + ' USERS' + 'WHERE' + ' (U_LOGIN = :LOGIN)' + ' AND (U_PASSWORD=:PASSWORD);' + '' + ) + Params = < + item + DataType = ftUnknown + Name = 'LOGIN' + ParamType = ptUnknown + end + item + DataType = ftUnknown + Name = 'PASSWORD' + ParamType = ptUnknown + end> + left = 128 + top = 117 + end + object Logout: TJSONRPCHandler + OnExecute = LogoutExecute + Options = [] + ParamDefs = <> + left = 120 + top = 16 + end +end diff --git a/packages/fcl-web/examples/combined/wmlogin.pp b/packages/fcl-web/examples/combined/wmlogin.pp new file mode 100644 index 0000000000..671dedcd27 --- /dev/null +++ b/packages/fcl-web/examples/combined/wmlogin.pp @@ -0,0 +1,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. + diff --git a/packages/fcl-web/examples/combined/wmusers.lfm b/packages/fcl-web/examples/combined/wmusers.lfm new file mode 100644 index 0000000000..15f6dcad02 --- /dev/null +++ b/packages/fcl-web/examples/combined/wmusers.lfm @@ -0,0 +1,94 @@ +object CombinedModule: TCombinedModule + OnCreate = DataModuleCreate + OldCreateOrder = False + InputAdaptor = ProviderInputAdaptor + ContentProducer = ProviderFormatter + OnGetContentProducer = DataModuleGetContentProducer + OnGetInputAdaptor = DataModuleGetInputAdaptor + OnNewSession = DataModuleNewSession + Height = 300 + HorizontalOffset = 635 + VerticalOffset = 230 + Width = 400 + object ProviderFormatter: TExtJSJSONDataFormatter + AllowPageSize = False + BeforeDataToJSON = ProviderFormatterBeforeDataToJSON + BeforeUpdate = ProviderFormatterBeforeUpdate + BeforeInsert = ProviderFormatterBeforeInsert + BeforeDelete = ProviderFormatterBeforeDelete + left = 272 + top = 72 + end + object Users: TSQLDBWebDataProvider + SelectSQL.Strings = ( + 'SELECT FIRST :limit SKIP :start U_ID, U_NAME, U_LOGIN, U_PASSWORD, U_EMAIL FROM USERS' + ) + UpdateSQL.Strings = ( + 'UPDATE USERS SET' + ' U_NAME=:U_NAME,' + ' U_LOGIN=:U_LOGIN,' + ' U_EMAIL=:U_EMAIL,' + ' U_PASSWORD=:U_PASSWORD' + 'WHERE' + ' (U_ID=:U_ID)' + ) + DeleteSQL.Strings = ( + 'DELETE FROM USERS WHERE (U_ID=:ID)' + ) + InsertSQL.Strings = ( + 'INSERT INTO USERS' + '(U_ID, U_LOGIN, U_NAME, U_EMAIL, U_PASSWORD)' + 'VALUES' + '(:U_ID, :U_LOGIN, :U_NAME, :U_EMAIL, :U_PASSWORD)' + ) + Connection = IBConnection1 + IDFieldName = 'U_ID' + OnGetNewID = UsersGetNewID + Options = [] + Params = < + item + DataType = ftUnknown + Name = 'limit' + ParamType = ptUnknown + end + item + DataType = ftUnknown + Name = 'start' + ParamType = ptUnknown + end> + left = 32 + top = 72 + end + object IBConnection1: TIBConnection + Connected = False + LoginPrompt = False + KeepConnection = False + Transaction = SQLTransaction1 + LogEvents = [] + left = 32 + top = 16 + end + object QGetID: TSQLQuery + AutoCalcFields = False + Database = IBConnection1 + Transaction = SQLTransaction1 + ReadOnly = False + SQL.Strings = ( + 'SELECT GEN_ID(GEN_USERS,1) AS THEID FROM RDB$DATABASE' + ) + Params = <> + left = 32 + top = 128 + end + object SQLTransaction1: TSQLTransaction + Active = False + Action = caNone + Database = IBConnection1 + left = 144 + top = 16 + end + object ProviderInputAdaptor: TExtJSJSonWebdataInputAdaptor + left = 272 + top = 16 + end +end diff --git a/packages/fcl-web/examples/combined/wmusers.lrs b/packages/fcl-web/examples/combined/wmusers.lrs new file mode 100644 index 0000000000..7d7cb7082d --- /dev/null +++ b/packages/fcl-web/examples/combined/wmusers.lrs @@ -0,0 +1,35 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TCombinedModule','FORMDATA',[ + 'TPF0'#15'TCombinedModule'#14'CombinedModule'#8'OnCreate'#7#16'DataModuleCrea' + +'te'#14'OldCreateOrder'#8#12'InputAdaptor'#7#20'ProviderInputAdaptor'#15'Con' + +'tentProducer'#7#17'ProviderFormatter'#20'OnGetContentProducer'#7#28'DataMod' + +'uleGetContentProducer'#17'OnGetInputAdaptor'#7#25'DataModuleGetInputAdaptor' + +#12'OnNewSession'#7#20'DataModuleNewSession'#6'Height'#3','#1#16'HorizontalO' + +'ffset'#3'{'#2#14'VerticalOffset'#3#230#0#5'Width'#3#144#1#0#23'TExtJSJSONDa' + +'taFormatter'#17'ProviderFormatter'#13'AllowPageSize'#8#16'BeforeDataToJSON' + +#7'!ProviderFormatterBeforeDataToJSON'#12'BeforeUpdate'#7#29'ProviderFormatt' + +'erBeforeUpdate'#12'BeforeInsert'#7#29'ProviderFormatterBeforeInsert'#12'Bef' + +'oreDelete'#7#29'ProviderFormatterBeforeDelete'#4'left'#3#16#1#3'top'#2'H'#0 + +#0#21'TSQLDBWebDataProvider'#5'Users'#17'SelectSQL.Strings'#1#6'USELECT FIRS' + +'T :limit SKIP :start U_ID, U_NAME, U_LOGIN, U_PASSWORD, U_EMAIL FROM USERS' + +#0#17'UpdateSQL.Strings'#1#6#16'UPDATE USERS SET'#6#17' U_NAME=:U_NAME,'#6 + +#19' U_LOGIN=:U_LOGIN,'#6#19' U_EMAIL=:U_EMAIL,'#6#24' U_PASSWORD=:U_PASS' + +'WORD'#6#5'WHERE'#6#14' (U_ID=:U_ID)'#0#17'DeleteSQL.Strings'#1#6'"DELETE F' + +'ROM USERS WHERE (U_ID=:ID)'#0#17'InsertSQL.Strings'#1#6#17'INSERT INTO USER' + +'S'#6',(U_ID, U_LOGIN, U_NAME, U_EMAIL, U_PASSWORD)'#6#6'VALUES'#6'1(:U_ID, ' + +':U_LOGIN, :U_NAME, :U_EMAIL, :U_PASSWORD)'#0#10'Connection'#7#13'IBConnecti' + +'on1'#11'IDFieldName'#6#4'U_ID'#10'OnGetNewID'#7#13'UsersGetNewID'#7'Options' + +#11#0#6'Params'#14#1#8'DataType'#7#9'ftUnknown'#4'Name'#6#5'limit'#9'ParamTy' + +'pe'#7#9'ptUnknown'#0#1#8'DataType'#7#9'ftUnknown'#4'Name'#6#5'start'#9'Para' + +'mType'#7#9'ptUnknown'#0#0#4'left'#2' '#3'top'#2'H'#0#0#13'TIBConnection'#13 + +'IBConnection1'#9'Connected'#8#11'LoginPrompt'#8#14'KeepConnection'#8#11'Tra' + +'nsaction'#7#15'SQLTransaction1'#9'LogEvents'#11#0#4'left'#2' '#3'top'#2#16#0 + +#0#9'TSQLQuery'#6'QGetID'#14'AutoCalcFields'#8#8'Database'#7#13'IBConnection' + +'1'#11'Transaction'#7#15'SQLTransaction1'#8'ReadOnly'#8#11'SQL.Strings'#1#6 + +'6SELECT GEN_ID(GEN_USERS,1) AS THEID FROM RDB$DATABASE'#0#6'Params'#14#0#4 + +'left'#2' '#3'top'#3#128#0#0#0#15'TSQLTransaction'#15'SQLTransaction1'#6'Act' + +'ive'#8#6'Action'#7#6'caNone'#8'Database'#7#13'IBConnection1'#4'left'#3#144#0 + +#3'top'#2#16#0#0#29'TExtJSJSonWebdataInputAdaptor'#20'ProviderInputAdaptor'#4 + +'left'#3#16#1#3'top'#2#16#0#0#0 +]); diff --git a/packages/fcl-web/examples/combined/wmusers.pp b/packages/fcl-web/examples/combined/wmusers.pp new file mode 100644 index 0000000000..752b03af52 --- /dev/null +++ b/packages/fcl-web/examples/combined/wmusers.pp @@ -0,0 +1,145 @@ +unit wmusers; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, HTTPDefs, websession, fpHTTP, fpWeb, + IBConnection, sqldb, fpwebdata, fpjson, extjsjson, extjsxml, sqldbwebdata; + +type + + { TCombinedModule } + + TCombinedModule = class(TFPWebProviderDataModule) + ProviderFormatter: TExtJSJSONDataFormatter; + ProviderInputAdaptor: TExtJSJSonWebdataInputAdaptor; + IBConnection1: TIBConnection; + Users: TSQLDBWebDataProvider; + QGetID: TSQLQuery; + SQLTransaction1: TSQLTransaction; + procedure DataModuleNewSession(Sender: TObject); + procedure ProviderFormatterBeforeDataToJSON(Sender: TObject; + AObject: TJSONObject); + procedure ProviderFormatterBeforeDelete(Sender: TObject); + procedure ProviderFormatterBeforeInsert(Sender: TObject); + procedure ProviderFormatterBeforeUpdate(Sender: TObject); + procedure UsersGetNewID(Sender: TObject; out AID: String); + procedure DataModuleCreate(Sender: TObject); + procedure DataModuleGetContentProducer(Sender: TObject; + var AContentProducer: TCustomHTTPDataContentProducer); + procedure DataModuleGetInputAdaptor(Sender: TObject; + var AInputAdaptor: TCustomWebdataInputAdaptor); + private + procedure CheckLoggedIn; + { private declarations } + public + { public declarations } + end; + +var + CombinedModule: TCombinedModule; + +implementation + +uses inifiles; + +{ TCombinedModule } + +procedure TCombinedModule.DataModuleGetContentProducer( + Sender: TObject; var AContentProducer: TCustomHTTPDataContentProducer); +begin +end; + +procedure TCombinedModule.DataModuleCreate(Sender: TObject); + +Var + FN : String; + Ini : TMemIniFile; + +begin + // Not yet published. + 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; + +procedure TCombinedModule.UsersGetNewID(Sender: TObject; out + AID: String); +begin + With QGetID Do + begin + Close; + Open; + try + if (EOF and BOF) then + Raise Exception.Create('No ID generated'); + AID:=Fields[0].AsString; + finally + Close; + end; + end; +end; + +procedure TCombinedModule.CheckLoggedIn; + +begin + If StrToIntDef(Session.Variables['UserID'],-1)=-1 then + Raise Exception.Create('You must be logged in to see or modify data'); +end; +procedure TCombinedModule.ProviderFormatterBeforeDataToJSON( + Sender: TObject; AObject: TJSONObject); +begin + CheckLoggedIn; +end; + +procedure TCombinedModule.DataModuleNewSession(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 TCombinedModule.ProviderFormatterBeforeDelete( + Sender: TObject); +begin + CheckLoggedIn; +end; + +procedure TCombinedModule.ProviderFormatterBeforeInsert( + Sender: TObject); +begin + CheckLoggedIn; +end; + +procedure TCombinedModule.ProviderFormatterBeforeUpdate( + Sender: TObject); +begin + CheckLoggedIn; +end; + +procedure TCombinedModule.DataModuleGetInputAdaptor(Sender: TObject; + var AInputAdaptor: TCustomWebdataInputAdaptor); +begin +end; + +initialization + {$I wmusers.lrs} + + RegisterHTTPModule('Provider', TCombinedModule); +end. + |
