mOrmot 服务端 方法 代码载录

2018-02-09 12:38:21来源:oschina作者:vga人点击

分享
/// some common definitions shared by both client and server side
unit ServerIntf;
interface
uses
SynCommons, mORMot;type
TRemoteSQLEngine = (rseOleDB, rseODBC, rseOracle, rseSQlite3, rseJet, rseMSSQL, resMySQL);
IRemoteSQL = interface(IInvokable)
['{051C8EC8-921D-4248-88E8-489E3B869F50}']
function Execute(const aSQL: RawUTF8; aExpectResults, aExpanded: Boolean): RawJSON;
//执行多条语句
function MulExecute(const QSQL: TRawUTF8DynArray; aExpectResults: Boolean): Boolean;
end;
ICalculator = interface(IInvokable)
['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
function Add(a, b: integer): integer;
function GetQuery(vData :RawUTF8): RawUTF8;
end;
IQueryData = interface(IInvokable)
['{B1793EB7-764D-4B8E-8012-BA13D188493A}']
function GetQueryReslt(vData: RawUTF8): RawUTF8;
//function ExecSql(SqlStr: string): RawUTF8;
end;
const
ROOT_NAME = 'root';
PORT_NAME = '888';
APPLICATION_NAME = 'RestService';
implementation
initialization
// so that we could use directly ICalculator instead of TypeInfo(ICalculator)
TInterfaceFactory.RegisterInterfaces([TypeInfo(ICalculator)]);
TInterfaceFactory.RegisterInterfaces([TypeInfo(IQueryData)]);
TInterfaceFactory.RegisterInterfaces([TypeInfo(IRemoteSQL)]);
end.unit ServerMethod;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, ServerIntf, Dialogs,
SynCommons, SynLog, mORMot, mORMotDB, mORMotHttpServer, SynDB,
SynDBZeos, DB;
type
TServiceCalculator = class(TInterfacedObject, ICalculator)
public
function Add(a, b: integer): integer;
function GetQuery(vData: RawUTF8): RawUTF8;
end;TServiceQueryData = class(TInterfacedObject, IQueryData)
public
function GetQueryReslt(vData: RawUTF8): RawUTF8;
end;TServiceRemoteSQL = class(TInterfacedObject, IRemoteSQL)
public
// constructor Create;
destructor Destroy; override;
function GetTableNames: TRawUTF8DynArray;
function Execute(const aSQL: RawUTF8; aExpectResults, aExpanded: Boolean): RawJSON;
//执行多条语句
function MulExecute(const QSQL: TRawUTF8DynArray; aExpectResults: Boolean): Boolean;
function DataSetToJSON(Data: TDataSet; const RecNo:Integer=0): RawUTF8;
end;TConnDataSQL = class
protected
fProps: TSQLDBConnectionProperties;
// fServer: TSQLDBServerSockets;
public
constructor Create;
destructor Destroy; override;
function GetDBConnectionProperties: TSQLDBConnectionProperties;
end;var
Pub_ConnDataSQL: TConnDataSQL;implementation
uses uSysCFG;function TConnDataSQL.GetDBConnectionProperties: TSQLDBConnectionProperties;
begin
Result := fProps;
end;destructor TConnDataSQL.Destroy;
begin
FreeAndNil(fProps);
inherited;
end;constructor TConnDataSQL.Create;
const
MYSQL_CONSTR = 'zdbc:mysql://%s:%d/%s?username=%s;password=%s;LibLocation=ht.dll';
var
constr, dbserver, dbdatabase, dbusername, dbpassword: string;
dbport: Integer;
begin
// 连接数据库
dbserver := IniOptions.dbServer;
dbdatabase := IniOptions.dbDatabase;
dbusername := IniOptions.dbUserName;
dbpassword := IniOptions.dbPassword;
dbport := IniOptions.dbPort;
constr := Format(MYSQL_CONSTR, [dbserver, dbport, dbdatabase, dbusername, dbpassword]);
try
fProps := TSQLDBZEOSConnectionProperties.Create(constr, '', '', '');
except
raise Exception.Create('数据连接失败,请检数据库查配置参数!');
end;
// fServer := TSQLDBServerSockets.Create(fProps, 'myserver', '8192', 'wjs', '123');
// Connect(rseODBC,'127.0.0.1:3306','mysql5.6','root','1234567');
// Connect(rseMSSQL,'zhy/sql2008','jxtestdataytnew','sa','sql');
end;
function TServiceCalculator.Add(a, b: integer): integer;
begin
result := a + b;
end;function TServiceCalculator.GetQuery(vData: RawUTF8): RawUTF8;
begin
result := StringToUTF8(vData + '<錦------------錦>' + vData);
end;function TServiceQueryData.GetQueryReslt(vData: RawUTF8): RawUTF8;
begin
result := vData + '--錦--' + vData;
end;function TServiceRemoteSQL.DataSetToJSON(Data: TDataSet; const RecNo:Integer=0): RawUTF8;
var
W: TJSONWriter;
f: integer;
blob: TRawByteStringStream;
begin
result := 'null';
if Data = nil then
exit;
if (RecNo = 0) then
Data.First;
if Data.Eof then
exit;
W := TJSONWriter.Create(nil, true, false);
try
// get col names and types
SetLength(W.ColNames, Data.FieldCount);
for f := 0 to high(W.ColNames) do
StringToUTF8(Data.FieldDefs[f].Name, W.ColNames[f]);
W.AddColumns;
if (RecNo=0) then
W.Add('[');
repeat
W.Add('{');
for f := 0 to Data.FieldCount-1 do begin
W.AddString(W.ColNames[f]);
with Data.Fields[f] do
if IsNull then
W.AddShort('null') else
case DataType of
ftBoolean:
W.Add(AsBoolean);
ftSmallint, ftInteger, ftWord, ftAutoInc:
W.Add(AsInteger);
ftLargeint:
W.Add(TLargeintField(Data.Fields[f]).AsLargeInt);
ftFloat, ftCurrency: // TCurrencyField is sadly a TFloatField
W.Add(AsFloat,TFloatField(Data.Fields[f]).Precision);
ftBCD:
W.AddCurr64(AsCurrency);
//ftFMTBcd:
//AddBcd(W,AsBCD);
ftTimeStamp, ftDate, ftTime, ftDateTime: begin
W.Add('"');
W.AddDateTime(AsDateTime);
W.Add('"');
end;
ftString, ftFixedChar, ftMemo: begin
W.Add('"');
W.AddAnsiString({$ifdef UNICODE}AsAnsiString{$else}AsString{$endif},
twJSONEscape);
W.Add('"');
end;
ftWideString: begin
W.Add('"');
W.AddJSONEscapeW(pointer(TWideStringField(Data.Fields[f]).Value));
W.Add('"');
end;
ftVariant:
W.AddVariant(AsVariant);
ftBytes, ftVarBytes, ftBlob, ftGraphic, ftOraBlob, ftOraClob: begin
blob := TRawByteStringStream.Create;
try
(Data.Fields[f] as TBlobField).SaveToStream(blob);
W.WrBase64(pointer(blob.DataString),length(blob.DataString),true);
finally
blob.Free;
end;
end;
{$ifdef ISDELPHI2007ANDUP}
ftWideMemo, ftFixedWideChar: begin
W.Add('"');
W.AddJSONEscapeW(pointer(AsWideString));
W.Add('"');
end;
{$endif}
{$ifdef UNICODE}
ftShortint, ftByte:
W.Add(AsInteger);
ftLongWord:
W.AddU(TLongWordField(Data.Fields[f]).Value);
ftExtended:
W.Add(AsFloat,DOUBLE_PRECISION);
ftSingle:
W.Add(AsFloat,SINGLE_PRECISION);
{$endif}
else W.AddShort('null'); // unhandled field type
end;// case
W.Add(',');
end;// for
W.CancelLastComma;
W.Add('}',',');
if (RecNo=0) then Data.Next else break;
until (Data.Eof);W.CancelLastComma;
if (RecNo=0) then
W.Add(']');
W.SetText(result);
finally
W.Free;
end;
end;function TServiceRemoteSQL.Execute(const aSQL: RawUTF8; aExpectResults,
aExpanded: Boolean): RawJSON;
var
res: ISQLDBRows;
fProps: TSQLDBConnectionProperties;
begin
fProps := Pub_ConnDataSQL.GetDBConnectionProperties;
if fProps=nil then
begin
raise Exception.Create('Connect call required before Execute');
end;
res := fProps.ExecuteInlined(aSQL, aExpectResults);
if res=nil then
result := ''
else
result := res.FetchAllAsJSON(aExpanded);
end;function TServiceRemoteSQL.GetTableNames: TRawUTF8DynArray;
var
fProps: TSQLDBConnectionProperties;
begin
fProps := Pub_ConnDataSQL.GetDBConnectionProperties;
if fProps=nil then
raise Exception.Create('Connect call required before GetTableNames');
fProps.GetTableNames(result);
end;destructor TServiceRemoteSQL.Destroy;
begin
inherited;
end;functionTServiceRemoteSQL.MulExecute(const QSQL: TRawUTF8DynArray;
aExpectResults: Boolean): Boolean;
var
i: Integer;
newCon: TSQLDBConnection;
fProps: TSQLDBConnectionProperties;
query: TQuery;
begin
Result := True;
try
fProps := Pub_ConnDataSQL.GetDBConnectionProperties;
if fProps = nil then
raise Exception.Create('Connect call required before Execute');
newCon := fProps.ThreadSafeConnection;
if not newCon.Connected thennewCon.Connect;
query := TQuery.Create(newCon);
try
newCon.StartTransaction;
for I := Low(QSQL) to High(QSQL) do
begin
with query do
begin
Close;
SQL.Clear;
SQL.Add(QSQL[i]);
Open;
end;
end;
newCon.Commit;
except
newCon.Rollback;
Result := False;
end;
finally
FreeAndNil(query);
end;
end;end.

最新文章

123

最新摄影

闪念基因

微信扫一扫

第七城市微信公众平台