lazarus CRUD

lazarus CRUD

?

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

unit Persistence;   {$MODE DELPHI}   interface   uses   SysUtils,   Classes,   BufDataset,   SQLdb,   SQLite3Conn;   function ListPersons: TStream; procedure SavePersons(const ABytes: TBytes);   implementation   const   SQL_SELECT_PERSONS = 'SELECT * FROM persons';   SQL_UDPATE_PERSONS = 'UPDATE persons SET name = :name WHERE id = :id';   var   DBConnection: TSQLConnector;   procedure CreateAndConfigureDBConnection; begin   DBConnection := TSQLConnector.Create(nil);   DBConnection.Transaction := TSQLTransaction.Create(DBConnection);   DBConnection.ConnectorType := 'SQLite3';   DBConnection.DatabaseName := '../../../DB/DataBase.sqlite3'; end;   procedure DestroyDBConnection; begin   FreeAndNil(DBConnection); end;   function CreateQuery(const ASQL: string): TSQLQuery; begin   Result := TSQLQuery.Create(nil);   Result.SQLConnection := DBConnection;   Result.SQLTransaction := DBConnection.Transaction;   Result.SQL.Text := ASQL; end;   function ListPersons: TStream; var   VQuery: TSQLQuery; begin   Result := TBytesStream.Create;   VQuery := CreateQuery(SQL_SELECT_PERSONS);   try     VQuery.Open;     VQuery.SaveToStream(Result, dfBinary);     Result.Seek(0, TSeekOrigin.soBeginning);   finally     VQuery.Destroy;   end; end;   procedure SavePersons(const ABytes: TBytes); var   VQuery: TSQLQuery;   VData: TBytesStream; begin   VQuery := CreateQuery(SQL_SELECT_PERSONS);   VData := TBytesStream.Create(ABytes);   try     VQuery.UpdateSQL.Text := SQL_UDPATE_PERSONS;     VQuery.Prepare;     VQuery.LoadFromStream(VData, dfBinary);     VQuery.ApplyUpdates;     DBConnection.Transaction.Commit;   finally     VQuery.Destroy;     VData.Free;   end; end;   initialization   CreateAndConfigureDBConnection;   finalization   DestroyDBConnection;   end.

　

uses
  BrookHTTPRequest,
  BrookHTTPResponse,
  BrookHTTPServer,
  Persistence;

type
  THTTPServer = class(TBrookHTTPServer)
  protected
    procedure DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest;
      AResponse: TBrookHTTPResponse); override;
  end;

procedure THTTPServer.DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest;
  AResponse: TBrookHTTPResponse);
begin
  if ARequest.Payload.Length > 0 then
    SavePersons(ARequest.Payload.Content)
  else
    AResponse.SendStream(ListPersons, 200);
end;

begin
  with THTTPServer.Create(nil) do
  try
    Port := 8080;
    Open;
    if not Active then
      Exit;
    WriteLn('Server running at http://localhost:', Port);
    ReadLn;
  finally
    Free;
  end;
end.

 

　

unit Client;

{$MODE DELPHI}

interface

uses
  SysUtils,
  Classes,
  DB,
  BufDataset,
  FPHTTPClient;

function NewGuid: string;
function ListPersons(const AURL: string): TDataSet;
procedure SavePersons(const AURL: string; ADataSet: TDataSet);
function CreatePersonsDataSet: TDataSet;

implementation

function NewGuid: string;
begin
  Result := TGuid.NewGuid.ToString(True);
end;

function ListPersons(const AURL: string): TDataSet;
var
  VData: TStream;
begin
  Result := TBufDataset.Create(nil);
  VData := TBytesStream.Create;
  try
    TFPHTTPClient.SimpleGet(AURL, VData);
    TBufDataset(Result).LoadFromStream(VData, dfBinary);
  finally
    VData.Free;
  end;
end;

procedure SavePersons(const AURL: string; ADataSet: TDataSet);
var
  VClient: TFPHTTPClient;
begin
  if ADataSet.State in dsEditModes then
    ADataSet.Post;
  try
    VClient := TFPHTTPClient.Create(nil);
    VClient.RequestBody := TBytesStream.Create;
    try
      TBufDataset(ADataSet).SaveToStream(VClient.RequestBody, dfBinary);
      VClient.RequestBody.Seek(0, TSeekOrigin.soBeginning);
      VClient.Post(AURL);
    finally
      VClient.RequestBody.Free;
      VClient.Free;
    end;
  finally
    FreeAndNil(ADataSet);
  end;
end;

function CreatePersonsDataSet: TDataSet;
begin
  Result := TBufDataset.Create(nil);
  Result.FieldDefs.Add('name', ftString, 100);
  TBufDataset(Result).CreateDataSet;
end;

end.