Icon View Thread

The following is the text of the current message along with any replies.
Messages 1 to 3 of 3 total
Thread Returning multiple records in a custom dataset module
Fri, Jan 27 2017 2:56 AMPermanent Link

Paul Coshott

Avatar

Hi All,

I have the following code to create a dataset module (adapted from the user login example code) to get a single client record. What changes do I need to make to return multiple records?

Assume the query was searching by "Surname" instead of "ClientID".

Thanks for any help.

Cheers,
Paul

-----------------------------------------------------------------------------------------------------------
unit Main;

interface

uses SysUtils, Classes, DB, ewbhttpmodule,
 FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
 FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
 FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.FB, FireDAC.Stan.Param,
 FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.DataSet,
 FireDAC.Comp.Client, FireDAC.Phys.IBBase, ewbdatasetadapter;

type
 TmodMain = class(TEWBModule)
   fdConnection: TFDConnection;
   fdFBLink: TFDPhysFBDriverLink;
   dsClients: TDataSource;
   ClientsAdapter: TEWBDataSetAdapter;
   qClients: TFDQuery;
   procedure EWBModuleCreate(Sender: TObject);
   procedure EWBModuleDestroy(Sender: TObject);
   procedure EWBModuleExecute(Request: TEWBServerRequest);
 private
   { Private declarations }
   procedure SetupDatabase;
   function ValidClient(const AClientID: String): Boolean;
   function BuildClientInfo: String;
 public
   { Public declarations }
 end;

var
 modMain: TmodMain;

implementation

uses Variants, ewbcommon, ewbhttpcommon, ewbstring;

{$R *.dfm}

procedure TmodMain.SetupDatabase;
begin
 fdConnection.Connected := True;
end;

procedure TmodMain.EWBModuleCreate(Sender: TObject);
begin
 SetupDatabase;
end;

procedure TmodMain.EWBModuleDestroy(Sender: TObject);
begin
 fdConnection.Connected := False;
end;

procedure TmodMain.EWBModuleExecute(Request: TEWBServerRequest);
var
 TempContent: TStrings;
 TempResult: Boolean;
 TempClientID: String;
begin
 with Request do begin
   TempResult := False;
   //Tell the browser not to cache the response
   ResponseHeaders.Add('Cache-Control: no-cache');
   if (RequestMethod = rmPost) then begin
     TempContent := TStringList.Create;
     try
       TempContent.Text := UTF8ToWideString(RequestContent);
       TempClientID := TempContent.Values['ClientID'];
       if TempClientID <> '' then begin
         try
           TempResult := ValidClient(TempClientID);
           if TempResult then begin
             SendCustomContent(UTF8Encode(BuildClientInfo), 'application/json; charset=utf-8', '');
           end;
         except
           on E: Exception do begin
             SendError(HTTP_INTERNAL_ERROR, E.Message);
           end;
         end;
       end;
     finally
       FreeAndNil(TempContent);
     end;
   end;
   if (not TempResult) then begin
      Request.SendError(HTTP_BAD_REQUEST, 'Client retrieval failed.');
   end;
 end;
end;

function TmodMain.ValidClient(const AClientID: String): Boolean;
begin
 with ClientsAdapter.DataSet do begin
   Close;
   qClients.ParamByName('CLIENTID').AsString := AClientID;
   Open;
   Result := (RecordCount=1);
 end;
end;

function TmodMain.BuildClientInfo: String;
var
 TempWriter: TEWBJSONWriter;
begin
 TempWriter:=TEWBJSONWriter.Create;
 try
   with TempWriter do begin
     Initialize;
     BeginObject;
     StringProperty('ID', ClientsAdapter.DataSet.FieldByName('CLIENTID').AsString);
     StringProperty('CompanyName', ClientsAdapter.DataSet.FieldByName('COMPANY').AsString);
     StringProperty('FirstName', ClientsAdapter.DataSet.FieldByName('FIRSTNAME').AsString);
     StringProperty('Surname', ClientsAdapter.DataSet.FieldByName('SURNAME').AsString);
     StringProperty('Mobile', ClientsAdapter.DataSet.FieldByName('MOBILE').AsString);
     EndObject;
   end;
   Result := TempWriter.Output;
 finally
   FreeAndNil(TempWriter);
 end;
end;

initialization

end.
Sat, Jan 28 2017 9:41 AMPermanent Link

Uli Becker

Paulm

> Assume the query was searching by "Surname" instead of "ClientID".

I don't use "SendCustomContent"; here a kind of template that I use for
my queries and tables in modules.

Hope that helps:

-------------------------------------------------------------------------

unit main;

interface

uses SysUtils, Classes, DB, ewbhttpmodule, ewbdatasetadapter, DBClient,
  edbcomps, vcl.Dialogs;

type
  TDataSetModule = class(TEWBModule)
    DatabaseAdapter: TEWBDatabaseAdapter;
    DatasetAdapter: TEWBDataSetAdapter;
    MyTable: TEDBTable;
    MyEngine: TEDBEngine;
    MySession: TEDBSession;
    MyDatabase: TEDBDatabase;
    MyQuery: TEDBQuery;
    LeaderBoardGesamtTable: TEDBTable;
    DataQuery: TEDBQuery;
    ActionQuery: TEDBQuery;
    LeaderBoardBLTable: TEDBTable;
    LeaderBoardCLTable: TEDBTable;
    LeaderBoardDFBTable: TEDBTable;
    LeaderBoardChallengeTable: TEDBTable;
    LeaderBoardMonatTable: TEDBTable;
    LeaderBoardImagesTable: TEDBTable;
    SpieltagTabelleTable: TEDBTable;
    TempQuery: TEDBQuery;
    procedure EWBModuleExecute(Request: TEWBServerRequest);
    procedure DatabaseAdapterGetDataSetAdapter(const DataSetName:
string; var Adapter: TEWBDataSetAdapter);
    procedure DatabaseAdapterAuthenticateUser(const RequestUserName,
RequestPassword: string; var Authenticated: Boolean);
  private
    procedure EmptyTable(FTablename: string);
    procedure PopulateLeaderBoardGesamt(FSaison, FMonat: integer);
    procedure PopulateLeaderBoardImagesTable;

  public
    { Public declarations }
  end;

var
  DataSetModule: TDataSetModule;

implementation

uses Variants, ewbcommon, ewbhttpcommon, ewbstring;

{$R *.dfm}

procedure TDataSetModule.DatabaseAdapterAuthenticateUser(const
RequestUserName, RequestPassword: string; var Authenticated: Boolean);
begin
  Authenticated := (RequestUserName = 'Administrator') and
(RequestPassword = 'EDBDefault');
end;

procedure TDataSetModule.DatabaseAdapterGetDataSetAdapter(const
DataSetName: string; var Adapter: TEWBDataSetAdapter);
begin
  Adapter := DatasetAdapter;
end;

procedure TDataSetModule.EmptyTable(FTablename: string);
begin
  with ActionQuery do
  begin
    sql.clear;
    sql.add('DELETE FROM ' + FTablename);
    ExecSQL;
  end;
end;

procedure TDataSetModule.EWBModuleExecute(Request: TEWBServerRequest);
var
  TempAdapter: TEWBDataSetAdapter;
  TempContentType: String;
  FDatasetName: String;
  FModus: integer;
begin

  with Request do
  begin
    ResponseHeaders.add('Cache-Control: no-cache');

    FDatasetName := RequestParams.Values['dataset'];

    if FDatasetName = 'LeaderBoardImages' then
    begin
      PopulateLeaderBoardImagesTable;
      LeaderBoardImagesTable.Open;
      DatasetAdapter.DataSet := LeaderBoardImagesTable;
    end
    else if FDatasetName = 'LeaderBoardGesamt' then
    begin
   
PopulateLeaderBoardGesamt(StrToInt(Request.RequestParams.Values['Saison']),
StrToInt(Request.RequestParams.Values['Monat']));
      LeaderBoardGesamtTable.Open;
      DatasetAdapter.DataSet := LeaderBoardGesamtTable;
    end
    else if FDatasetName = 'LeaderBoardBL' then
    begin
      LeaderBoardBLTable.Open;
      DatasetAdapter.DataSet := LeaderBoardBLTable;
    end
    else if FDatasetName = 'LeaderBoardCL' then
    begin
      LeaderBoardCLTable.Open;
      DatasetAdapter.DataSet := LeaderBoardCLTable;
    end
    else if FDatasetName = 'LeaderBoardDFB' then
    begin
      LeaderBoardDFBTable.Open;
      DatasetAdapter.DataSet := LeaderBoardDFBTable;
    end
    else if FDatasetName = 'LeaderBoardChallenge' then
    begin
      LeaderBoardChallengeTable.Open;
      DatasetAdapter.DataSet := LeaderBoardChallengeTable;
    end
    else if FDatasetName = 'LeaderBoardMonat' then
    begin
      LeaderBoardMonatTable.Open;
      DatasetAdapter.DataSet := LeaderBoardMonatTable;
    end
    else
    begin
      MyTable.close;
      MyTable.TableName := FDatasetName;
      MyTable.Open;
      DatasetAdapter.DataSet := MyTable;
    end;

    if (RequestMethod = rmGet) then
    begin
      if AnsiSameText(RequestParams.Values['method'], 'columns') then
      begin
        try
          DatabaseAdapter.HandleRequest(Request);
        except
          on E: Exception do
            SendError(HTTP_INTERNAL_ERROR, E.Message);
        end;
      end
      else if AnsiSameText(RequestParams.Values['method'], 'rows') then
      begin
        try
          DatabaseAdapter.HandleRequest(Request);
        except
          on E: Exception do
            SendError(HTTP_INTERNAL_ERROR, E.Message);
        end;
      end
      else if AnsiSameText(RequestParams.Values['method'], 'load') then
      begin
        try
          DatabaseAdapter.HandleRequest(Request);
        except
          on E: Exception do
            SendError(HTTP_INTERNAL_ERROR, E.Message);
        end;
      end
      else
        SendError(HTTP_BAD_REQUEST, 'Invalid method');
    end
    else if (RequestMethod = rmPost) then
    begin
      if AnsiSameText(RequestParams.Values['method'], 'commit') then
      begin
        try
          { The RequestUser and RequestPassword properties can be used
to perform
            further security validation here, if necessary }
          DatabaseAdapter.Commit(RequestContent);
          DatabaseAdapter.HandleRequest(Request);
        except
          on E: Exception do
            SendError(HTTP_INTERNAL_ERROR, E.Message);
        end;
      end
      else
        SendError(HTTP_BAD_REQUEST, 'Invalid method');
    end;
  end;
end;

procedure TDataSetModule.PopulateLeaderBoardGesamt(FSaison, FMonat:
integer);
begin
  { Gesamte Tippliga }
  EmptyTable('LeaderBoardGesamt');
  with ActionQuery do
  begin
    sql.clear;
    sql.add('INSERT INTO LeaderBoardGesamt SELECT 1, Kuerzel,
SUM(PrecisionValue), SUM(Punkte) FROM TippTabelle ');
    sql.add('WHERE Saison = :FSaison  AND AnzahlSpiele > 0 AND spieltag
< 100 GROUP BY Benutzerid');
    ParamByName('FSaison').asInteger := FSaison;
    ExecSQL;
  end;
end;

procedure TDataSetModule.PopulateLeaderBoardImagesTable;
begin
  EmptyTable('LeaderBoardImages');
  with ActionQuery do
  begin
    sql.clear;
    sql.add('INSERT INTO LeaderBoardImages (Gesamt, BL, CL, DFB,
Challenge, Monat) values');
    sql.add('(');
    sql.add('SELECT Kuerzel FROM LeaderBoardGesamt WHERE Platz = 1,');
    sql.add('SELECT Kuerzel FROM LeaderBoardBL WHERE Platz = 1,');
    sql.add('SELECT Kuerzel FROM LeaderBoardCL WHERE Platz = 1,');
    sql.add('SELECT Kuerzel FROM LeaderBoardDFB WHERE Platz = 1,');
    sql.add('SELECT Kuerzel FROM LeaderBoardChallenge WHERE Platz = 1,');
    sql.add('SELECT Kuerzel FROM LeaderBoardMonat WHERE Platz = 1');
    sql.add(')');
    ExecSQL;
  end;
end;

end.

-----------------------------------------------------------------------

Uli
Mon, Jan 30 2017 4:11 AMPermanent Link

Paul Coshott

Avatar

Uli Becker wrote:

Paulm

> Assume the query was searching by "Surname" instead of "ClientID".

I don't use "SendCustomContent"; here a kind of template that I use for
my queries and tables in modules.

Hope that helps:

-------------------------------------------------------------------------

Hi Uli,

Thanks so much for the code. Any chance you could send me your email address? I have a request for you.

paul@coshott.com

Cheers,
Paul
Image