Trang chủ Khám phá Trợ giúp
Đăng nhập
pascal
/
fpc
mirror of https://gitlab.com/freepascal.org/fpc/source.git
2
0
Fork 0
Các tập tin Các vấn đề 0 Wiki
Browse Source

* Added combined example: login using RPC and edit data using FPWebdata

git-svn-id: trunk@17283 -
michael 14 năm trước cách đây
mục cha
eb2e21587b
commit
1d07ae97c4
18 tập tin đã thay đổi với 908 bổ sung và 0 xóa
Split View Hiển thị tình trạng sai khác
  1. 17 0
      .gitattributes
  2. 20 0
      packages/fcl-web/examples/combined/combined.html
  3. BIN
      packages/fcl-web/examples/combined/combined.ico
  4. 4 0
      packages/fcl-web/examples/combined/combined.ini
  5. 116 0
      packages/fcl-web/examples/combined/combined.lpi
  6. 15 0
      packages/fcl-web/examples/combined/combined.lpr
  7. BIN
      packages/fcl-web/examples/combined/combined.res
  8. 11 0
      packages/fcl-web/examples/combined/combined.sql
  9. 105 0
      packages/fcl-web/examples/combined/login.js
  10. BIN
      packages/fcl-web/examples/combined/login.png
  11. 18 0
      packages/fcl-web/examples/combined/users.html
  12. 108 0
      packages/fcl-web/examples/combined/users.js
  13. 15 0
      packages/fcl-web/examples/combined/users.sql
  14. 76 0
      packages/fcl-web/examples/combined/wmlogin.lfm
  15. 129 0
      packages/fcl-web/examples/combined/wmlogin.pp
  16. 94 0
      packages/fcl-web/examples/combined/wmusers.lfm
  17. 35 0
      packages/fcl-web/examples/combined/wmusers.lrs
  18. 145 0
      packages/fcl-web/examples/combined/wmusers.pp

+ 17 - 0
.gitattributes
Xem Tập Tin 

@@ -2343,6 +2343,23 @@ packages/fcl-web/Makefile svneol=native#text/plain
 
 packages/fcl-web/Makefile.fpc svneol=native#text/plain
 
 packages/fcl-web/Makefile.org svneol=native#text/plain
 
 packages/fcl-web/Makefile_fpmake.fpc svneol=native#text/plain
 
+packages/fcl-web/examples/combined/combined.html svneol=native#text/plain
 
+packages/fcl-web/examples/combined/combined.ico -text
 
+packages/fcl-web/examples/combined/combined.ini svneol=native#text/plain
 
+packages/fcl-web/examples/combined/combined.lpi svneol=native#text/plain
 
+packages/fcl-web/examples/combined/combined.lpr svneol=native#text/plain
 
+packages/fcl-web/examples/combined/combined.res -text
 
+packages/fcl-web/examples/combined/combined.sql svneol=native#text/plain
 
+packages/fcl-web/examples/combined/login.js svneol=native#text/plain
 
+packages/fcl-web/examples/combined/login.png -text svneol=unset#image/png
 
+packages/fcl-web/examples/combined/users.html svneol=native#text/plain
 
+packages/fcl-web/examples/combined/users.js svneol=native#text/plain
 
+packages/fcl-web/examples/combined/users.sql svneol=native#text/plain
 
+packages/fcl-web/examples/combined/wmlogin.lfm svneol=native#text/plain
 
+packages/fcl-web/examples/combined/wmlogin.pp svneol=native#text/plain
 
+packages/fcl-web/examples/combined/wmusers.lfm svneol=native#text/plain
 
+packages/fcl-web/examples/combined/wmusers.lrs svneol=native#text/plain
 
+packages/fcl-web/examples/combined/wmusers.pp svneol=native#text/plain
 
 packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain
 
 packages/fcl-web/examples/jsonrpc/demo1/demo.lpi svneol=native#text/plain
 
 packages/fcl-web/examples/jsonrpc/demo1/demo.lpr svneol=native#text/plain

+ 20 - 0
packages/fcl-web/examples/combined/combined.html
Xem Tập Tin 

@@ -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>

BIN
packages/fcl-web/examples/combined/combined.ico
Xem Tập Tin


+ 4 - 0
packages/fcl-web/examples/combined/combined.ini
Xem Tập Tin 

@@ -0,0 +1,4 @@
 
+[Database]
 
+Path=/home/firebird/combined.fb
 
+UserName=WISASOFT
 
+Password=SysteemD

+ 116 - 0
packages/fcl-web/examples/combined/combined.lpi
Xem Tập Tin 

@@ -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>

+ 15 - 0
packages/fcl-web/examples/combined/combined.lpr
Xem Tập Tin 

@@ -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.
 
+

BIN
packages/fcl-web/examples/combined/combined.res
Xem Tập Tin


+ 11 - 0
packages/fcl-web/examples/combined/combined.sql
Xem Tập Tin 

@@ -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)
 
+);
 
+
 
+

+ 105 - 0
packages/fcl-web/examples/combined/login.js
Xem Tập Tin 

@@ -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*/
 
+});
 
+

BIN
packages/fcl-web/examples/combined/login.png
Xem Tập Tin


+ 18 - 0
packages/fcl-web/examples/combined/users.html
Xem Tập Tin 

@@ -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>

+ 108 - 0
packages/fcl-web/examples/combined/users.js
Xem Tập Tin 

@@ -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);

+ 15 - 0
packages/fcl-web/examples/combined/users.sql
Xem Tập Tin 

@@ -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;

+ 76 - 0
packages/fcl-web/examples/combined/wmlogin.lfm
Xem Tập Tin 

@@ -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

+ 129 - 0
packages/fcl-web/examples/combined/wmlogin.pp
Xem Tập Tin 

@@ -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.
 
+

+ 94 - 0
packages/fcl-web/examples/combined/wmusers.lfm
Xem Tập Tin 

@@ -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

+ 35 - 0
packages/fcl-web/examples/combined/wmusers.lrs
Xem Tập Tin 

@@ -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
 
+]);

+ 145 - 0
packages/fcl-web/examples/combined/wmusers.pp
Xem Tập Tin 

@@ -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.
 
+