lazarus CRUD

历史第一人乔帮主 發表於 2022-3-13 07:51:00

lazarus CRUD
<div class="cnblogs_Highlighter">
<pre class="brush:csharp;gutter:true;">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.
</pre>
</div>
　
<div class="cnblogs_code">
<pre>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.</pre>
</div>
 
　
<div class="cnblogs_code">
<pre>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.</pre>
</div>
 

</div>
<div id="MySignature" role="contentinfo">
本文来自博客园，作者：{咏南中间件}，转载请注明原文链接：https://www.cnblogs.com/hnxxcxg/p/15999453.html 
来源：https://www.cnblogs.com/hnxxcxg/p/15999453.html

頁: [1]

琼殿技术论坛's Archiver

lazarus CRUD