Added a simple Lazarus LCL example for how to create a server/client …

…streamed CRUD.
alantelles · May 7, 2021 · 4c2c76e · 4c2c76e
1 parent 97a373c
commit 4c2c76e
Show file tree

Hide file tree

Showing 12 changed files with 917 additions and 0 deletions.
diff --git a/Examples/LCL/CRUDClient/CRUDClient.lpi b/Examples/LCL/CRUDClient/CRUDClient.lpi
@@ -0,0 +1,95 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <Title Value="CRUDClient"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+    </General>
+    <BuildModes Count="1" Active="Default">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="CRUDClient.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="frmMain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="frMain"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <IsVisibleTab Value="True"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="DMClient.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Client"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="DataModule"/>
+        <UsageCount Value="20"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="CRUDClient"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </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/Examples/LCL/CRUDClient/CRUDClient.lpr b/Examples/LCL/CRUDClient/CRUDClient.lpr
@@ -0,0 +1,48 @@
+(*   _                     _
+ *  | |__  _ __ ___   ___ | | __
+ *  | '_ \| '__/ _ \ / _ \| |/ /
+ *  | |_) | | | (_) | (_) |   <
+ *  |_.__/|_|  \___/ \___/|_|\_\
+ *
+ * Microframework which helps to develop web Pascal applications.
+ *
+ * Copyright (c) 2012-2019 Silvio Clecio <[email protected]>
+ *
+ * Brook framework is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * Brook framework is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with Brook framework; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *)
+
+program CRUDClient;
+
+{$MODE DELPHI}
+
+uses
+{$IFDEF UNIX}
+  CThreads,
+{$ENDIF}
+  Interfaces,
+  Forms,
+  frmMain,
+  DMClient;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Scaled := True;
+  Application.Initialize;
+  Application.CreateForm(TClient, Client);
+  Application.CreateForm(TfrMain, frMain);
+  Application.Run;
+end.
diff --git a/Examples/LCL/CRUDClient/DMClient.lfm b/Examples/LCL/CRUDClient/DMClient.lfm
@@ -0,0 +1,12 @@
+object Client: TClient
+  OldCreateOrder = False
+  Height = 150
+  HorizontalOffset = 340
+  VerticalOffset = 119
+  Width = 150
+  object BufDataset: TBufDataset
+    FieldDefs = <>
+    Left = 64
+    Top = 41
+  end
+end
diff --git a/Examples/LCL/CRUDClient/DMClient.pas b/Examples/LCL/CRUDClient/DMClient.pas
@@ -0,0 +1,86 @@
+(*   _                     _
+ *  | |__  _ __ ___   ___ | | __
+ *  | '_ \| '__/ _ \ / _ \| |/ /
+ *  | |_) | | | (_) | (_) |   <
+ *  |_.__/|_|  \___/ \___/|_|\_\
+ *
+ * Microframework which helps to develop web Pascal applications.
+ *
+ * Copyright (c) 2012-2019 Silvio Clecio <[email protected]>
+ *
+ * Brook framework is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * Brook framework is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with Brook framework; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *)
+
+unit DMClient;
+
+{$MODE DELPHI}
+
+interface
+
+uses
+  DB,
+  Classes,
+  BufDataset,
+  FPHTTPClient;
+
+type
+  TClient = class(TDataModule)
+    BufDataset: TBufDataset;
+  public
+    procedure LoadPersons(const AURL: string);
+    procedure SavePersons(const AURL: string);
+  end;
+
+var
+  Client: TClient;
+
+implementation
+
+{$R *.lfm}
+
+procedure TClient.LoadPersons(const AURL: string);
+var
+  VData: TStream;
+begin
+  VData := TBytesStream.Create;
+  try
+    TFPHTTPClient.SimpleGet(AURL, VData);
+    VData.Seek(0, TSeekOrigin.soBeginning);
+    BufDataset.Close;
+    BufDataset.LoadFromStream(VData, dfBinary);
+  finally
+    VData.Free;
+  end;
+end;
+
+procedure TClient.SavePersons(const AURL: string);
+var
+  VClient: TFPHTTPClient;
+begin
+  if BufDataset.State in dsEditModes then
+    BufDataset.Post;
+  VClient := TFPHTTPClient.Create(nil);
+  VClient.RequestBody := TBytesStream.Create;
+  try
+    BufDataset.SaveToStream(VClient.RequestBody, dfBinary);
+    VClient.RequestBody.Seek(0, TSeekOrigin.soBeginning);
+    VClient.Post(AURL);
+  finally
+    VClient.RequestBody.Free;
+    VClient.Free;
+  end;
+end;
+
+end.
diff --git a/Examples/LCL/CRUDClient/frmMain.lfm b/Examples/LCL/CRUDClient/frmMain.lfm
@@ -0,0 +1,80 @@
+object frMain: TfrMain
+  Left = 340
+  Height = 240
+  Top = 119
+  Width = 320
+  Caption = 'Simple CRUD client example'
+  ClientHeight = 240
+  ClientWidth = 320
+  Position = poDesktopCenter
+  LCLVersion = '2.0.12.0'
+  object DBGrid: TDBGrid
+    Left = 0
+    Height = 181
+    Top = 0
+    Width = 320
+    Align = alClient
+    Color = clWindow
+    Columns = <>
+    DataSource = DataSource
+    TabOrder = 0
+  end
+  object DBNavigator: TDBNavigator
+    Left = 0
+    Height = 25
+    Top = 181
+    Width = 320
+    Align = alBottom
+    BevelOuter = bvNone
+    ChildSizing.EnlargeHorizontal = crsScaleChilds
+    ChildSizing.EnlargeVertical = crsScaleChilds
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 100
+    ClientHeight = 25
+    ClientWidth = 320
+    DataSource = DataSource
+    Options = []
+    TabOrder = 1
+    VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete, nbEdit, nbPost, nbCancel]
+  end
+  object pnBottom: TPanel
+    Left = 0
+    Height = 34
+    Top = 206
+    Width = 320
+    Align = alBottom
+    ClientHeight = 34
+    ClientWidth = 320
+    TabOrder = 2
+    object btLoad: TButton
+      Left = 3
+      Height = 28
+      Top = 3
+      Width = 75
+      Align = alLeft
+      BorderSpacing.Around = 2
+      Caption = 'Load'
+      OnClick = btLoadClick
+      TabOrder = 0
+    end
+    object btSave: TButton
+      Left = 242
+      Height = 28
+      Top = 3
+      Width = 75
+      Align = alRight
+      BorderSpacing.Around = 2
+      Caption = 'Save'
+      Enabled = False
+      OnClick = btSaveClick
+      TabOrder = 1
+    end
+  end
+  object DataSource: TDataSource
+    DataSet = Client.BufDataset
+    Left = 144
+    Top = 72
+  end
+end