Datasnap + Rest Server -> Evrensel Veri Adaptörü - 001 - Sunucu Uygulaması

[mad85]

Merhaba Arkadaşlar,

"Evrensel Veri Adaptörü" ismini verdiğim proje aşağıdaki gibidir.

Her yazılımcı bir gün PHP tadacak mıdır ? konusunda aşağıdaki paylaşımım olmuştu.

Alıntı:Firebird, MSSQL gibi veri tabanlarında istemci sürücülerinde linux tarafında sorunlar yaşanabileceği için, windowsta çalışan dinamik bir Datasnap+Rest Server yazdım (Standalone web server tipinde). Bağlantı bilgilerini, sorguyu ve parametreleri json olarak alıp, işleyip, dataseti json olarak döndüren ve sonucu bildiren, execute işleminde sonucu bildiren bir yapı oldu. Bu şekilde PHP ile tüm veri tabanlarına çok rahat ve hızlı bir şekilde bağlanabiliyorum. Talep eden arkadaşlarla paylaşabilirim. 

Kısaca bahsedecek olursak bu yapı, aynı zamanda veri tabanını dışarıya açmadan güvenli bir şekilde iletişim kurmanızı sağlayan, aynı networkte çalışan tüm veri tabanlarınıza aynı port üzerinden erişim sağlayan bir yapıdır. Şimdilik şemada belirtilen 5 veri tabanı (PostgreSQL, Oracle, MsSQL, MySQL, Firebird) eklenmiştir. Siz çoğaltabilirsiniz. Ben çoklu db desteği olan UniDac' ı tercih ettim. Siz FireDac ya da başka bir Dac tercih edebilirsiniz.

İstemci tarafından tek JSON objesi içerisinde bağlantı bilgileri ve sorgu bilgileri (sorgu + parametreler) beklenmektedir.
Örn JSON :

{
"connection_info": {
"db_type": "SQLServer",
"host": "x.y.z.t",
"port": 1433,
"database": "ABC",
"user": "aaa",
"password": "bbb",
"additional_specs": ""
},
"query_info": {
"query": "SELECT * FROM xyz where a=:a and b=:b",
"params": {
"a": "5",
"b": "x"
}
},
"type": "Q"
}

Çalışma şeması basitçe aşağıdaki gibidir; 
   

UServerMethods içeriği;

unit UServerMethods;

interface

uses System.SysUtils, System.Classes, System.Json,
   Datasnap.DSServer, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter,
 Data.DB, MemDS, DBAccess, Uni, UniProvider, UMadDB, InterBaseUniProvider,
 Data.FireDACJSONReflect, dialogs, forms,
 Data.DBXCommon, Data.DBXPlatform, inifiles;

type
{$METHODINFO ON}
 TServerMethods = class(TDataModule)
   function Query(Params : TJSONObject) : TJSONArray;
   function Execute(Params : TJSONObject) : Boolean;
 private
   { Private declarations }
 public
   { Public declarations }
 end;
{$METHODINFO OFF}

implementation
uses  DataSetConverter4D, DataSetConverter4D.Impl, UMain;


{$R *.dfm}

function TServerMethods.Query(Params : TJSONObject) : TJSONArray;
var
 ConnectionInfo : TConnectionInfo;
 Con : TUniConnection;
 Qry : TUniQuery;
 db_info : TJSONObject;
 query_info : TJSONObject;
 process_type : String;
 query_params : TJSONObject;
 i : integer;
begin
 ConnectionInfo := TConnectionInfo.Create;

 db_info := TJSONObject(Params.Get('connection_info').JsonValue);
 query_info := TJSONObject(Params.Get('query_info').JsonValue);
 process_type := Params.Get('type').JsonValue.Value;

 if db_info.Get('db_type').JsonValue.Value = 'SQLServer'
 then begin
   ConnectionInfo.DBType := SQLServer;
 end else if db_info.Get('db_type').JsonValue.Value = 'FireBird'
 then begin
   ConnectionInfo.DBType := FireBird;
 end else if db_info.Get('db_type').JsonValue.Value = 'MySQL'
 then begin
   ConnectionInfo.DBType := MySQL;
 end else if db_info.Get('db_type').JsonValue.Value = 'Oracle'
 then begin
   ConnectionInfo.DBType := Oracle;
 end else if db_info.Get('db_type').JsonValue.Value = 'PostgreSQL'
 then begin
   ConnectionInfo.DBType := PostgreSQL;
 end;

 ConnectionInfo.Host := db_info.Get('host').JsonValue.Value;
 ConnectionInfo.Port := db_info.Get('port').JsonValue.Value.ToInteger;
 ConnectionInfo.Database := db_info.Get('database').JsonValue.Value;
 ConnectionInfo.User := db_info.Get('user').JsonValue.Value;
 ConnectionInfo.Password := db_info.Get('password').JsonValue.Value;
 ConnectionInfo.AdditionalSpecs := db_info.Get('additional_specs').JsonValue.Value;

 Con := MadDB.getConnection(ConnectionInfo);
 Qry := TUniQuery.Create(nil);
 Qry.Connection := Con;
 Qry.SQL.Add(query_info.Get('query').JsonValue.Value);
 if frmMain.chkLogging.Checked then
 begin
   //frmmain.Memo1.Lines.Clear;
   frmMain.memo1.Lines.Add('----- Sorgu -----');
   frmmain.Memo1.Lines.Add(Qry.SQL.Text);
 end;

 query_params := TJSONObject(query_info.Get('params').JsonValue);

 if query_params.Count > 0 then
 begin
   if frmMain.chkLogging.Checked then
   begin
     frmMain.memo1.Lines.Add('----- Parametreler -----');
   end;
 end;

 for i := 0 to query_params.Count - 1 do
 begin
   if frmMain.chkLogging.Checked then
   begin
     frmMain.memo1.Lines.Add(TJSONObject(query_params).Pairs[i].JsonString.Value + ' : ' + TJSONObject(query_params).Pairs[i].JsonValue.Value);
   end;
   Qry.ParamByName(TJSONObject(query_params).Pairs[i].JsonString.Value).Value := TJSONObject(query_params).Pairs[i].JsonValue.Value;
 end;

 try
   Qry.Open;

   Result := TConverter.New.DataSet(Qry).AsJSONArray;
 except on  E : Exception do
   begin
     frmMain.memo1.Lines.Add('----- Hata -----');
     frmmain.Memo1.Lines.Add(E.Message);
     frmMain.memo1.Lines.Add('-----');
     Result := TJSONArray(E.Message);
   end;
 end;

 Qry.Close;
 Con.Disconnect;
 FreeAndNil(Qry);
 FreeAndNil(Con);
 FreeAndNil(ConnectionInfo);
 db_info := nil;
 query_info := nil;
 query_params := nil;
end;

function TServerMethods.Execute(Params : TJSONObject) : Boolean;
var
 ConnectionInfo : TConnectionInfo;
 Con : TUniConnection;
 Qry : TUniQuery;
 db_info : TJSONObject;
 query_info : TJSONObject;
 process_type : String;
 query_params : TJSONObject;
 i : integer;
begin
 ConnectionInfo := TConnectionInfo.Create;

 db_info := TJSONObject(Params.Get('connection_info').JsonValue);
 query_info := TJSONObject(Params.Get('query_info').JsonValue);
 process_type := Params.Get('type').JsonValue.Value;

 if db_info.Get('db_type').JsonValue.Value = 'SQLServer'
 then begin
   ConnectionInfo.DBType := SQLServer;
 end else if db_info.Get('db_type').JsonValue.Value = 'FireBird'
 then begin
   ConnectionInfo.DBType := FireBird;
 end else if db_info.Get('db_type').JsonValue.Value = 'MySQL'
 then begin
   ConnectionInfo.DBType := MySQL;
 end else if db_info.Get('db_type').JsonValue.Value = 'Oracle'
 then begin
   ConnectionInfo.DBType := Oracle;
 end else if db_info.Get('db_type').JsonValue.Value = 'PostgreSQL'
 then begin
   ConnectionInfo.DBType := PostgreSQL;
 end;

 ConnectionInfo.Host := db_info.Get('host').JsonValue.Value;
 ConnectionInfo.Port := db_info.Get('port').JsonValue.Value.ToInteger;
 ConnectionInfo.Database := db_info.Get('database').JsonValue.Value;
 ConnectionInfo.User := db_info.Get('user').JsonValue.Value;
 ConnectionInfo.Password := db_info.Get('password').JsonValue.Value;
 ConnectionInfo.AdditionalSpecs := db_info.Get('additional_specs').JsonValue.Value;

 Con := MadDB.getConnection(ConnectionInfo);
 Qry := TUniQuery.Create(nil);
 Qry.Connection := Con;
 Qry.SQL.Add(query_info.Get('query').JsonValue.Value);
 if frmMain.chkLogging.Checked then
 begin
   frmMain.memo1.Lines.Add('----- Sorgu (E) -----');
   frmmain.Memo1.Lines.Add(Qry.SQL.Text);
 end;
 query_params := TJSONObject(query_info.Get('params').JsonValue);
 for i := 0 to query_params.Count - 1 do
 begin
   Qry.ParamByName(TJSONObject(query_params).Pairs[i].JsonString.Value).Value := TJSONObject(query_params).Pairs[i].JsonValue.Value;
 end;

 try
   Qry.ExecSQL;
   Result := true;
 except
   Result := false;
 end;

 Qry.Close;
 Con.Disconnect;
 FreeAndNil(Qry);
 FreeAndNil(Con);
 FreeAndNil(ConnectionInfo);
 db_info := nil;
 query_info := nil;
 query_params := nil;
end;

end.

UMadDB içeriği;

unit UMadDB;

interface

uses
 System.SysUtils, System.Classes, Data.DB, DBAccess, Uni, InterBaseUniProvider,
 UniProvider, SQLServerUniProvider, PostgreSQLUniProvider, OracleUniProvider,
 MySQLUniProvider;

type
 TDBType = (SQLServer, FireBird, MySQL, Oracle, PostgreSQL);

 TConnectionInfo = Class
 private
   FDBType : TDBType;
   FHost : String;
   FPort : Integer;
   FDatabase : String;
   FUser : String;
   FPassword : String;
   FAdditionalSpecs : String;
 public
   property DBType : TDBType read FDBType write FDBType;
   property Host : String read FHost write FHost;
   property Port : Integer read FPort write FPort;
   property Database : String read FDatabase write FDatabase;
   property User : String read FUser write FUser;
   property Password : String read FPassword write FPassword;
   property AdditionalSpecs : String read FAdditionalSpecs write FAdditionalSpecs;
 end;

 TMadDB = class(TDataModule)
   SQLServerUniProvider1: TSQLServerUniProvider;
   InterBaseUniProvider1: TInterBaseUniProvider;
   MySQLUniProvider1: TMySQLUniProvider;
   OracleUniProvider1: TOracleUniProvider;
   PostgreSQLUniProvider1: TPostgreSQLUniProvider;
   function getConnection(dbInfo : TConnectionInfo) : TUniConnection;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 MadDB: TMadDB;

implementation

function TMadDB.getConnection(dbInfo : TConnectionInfo) : TUniConnection;
var
 conn : TUniConnection;
begin
 conn := TUniConnection.Create(nil);
 case dbInfo.DBType of
   SQLServer   : begin
                   conn.ProviderName := 'SQL Server';
                 end;
   FireBird    : begin
                   conn.ProviderName := 'InterBase';
                 end;
   MySQL       : begin
                   conn.ProviderName := 'MySQL';
                 end;
   Oracle      : begin
                   conn.ProviderName := 'Oracle';
                 end;
   PostgreSQL  : begin
                   conn.ProviderName := 'PostgreSQL';
                 end;
 end;

 if dbInfo.DBType = Oracle then
 begin
   conn.SpecificOptions.Add('Oracle.Direct=True');
   conn.Server := dbInfo.Host + ':' + inttostr(dbInfo.Port) + ':' + dbInfo.Database;
 end else begin
   conn.Server := dbInfo.Host;
   conn.Port := dbInfo.Port;
   conn.Database := dbInfo.Database;
 end;

 conn.Username := dbInfo.User;
 conn.Password := dbInfo.Password;
 conn.SpecificOptions.Add(dbInfo.AdditionalSpecs);
 // conn.SpecificOptions.Values['Direct'] := true;
 conn.LoginPrompt := false;

 result := conn;
end;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

end.

UWebModule içeriği;

unit UWebModule;

interface

uses
 System.SysUtils, System.Classes, Web.HTTPApp, Datasnap.DSHTTPCommon,
 Datasnap.DSHTTPWebBroker, Datasnap.DSServer,
 Web.WebFileDispatcher, Web.HTTPProd,
 DataSnap.DSAuth,
 Datasnap.DSProxyJavaScript, IPPeerServer, Datasnap.DSMetadata,
 Datasnap.DSServerMetadata, Datasnap.DSCommonServer, Datasnap.DSHTTP,
 Forms, Dialogs, System.JSON, Data.DBXCommon, Data.DBXPlatform,
 Generics.Collections;

type
 TfrmWebModule = class(TWebModule)
   DSRESTWebDispatcher1: TDSRESTWebDispatcher;
   WebFileDispatcher1: TWebFileDispatcher;
   DSServerMetaDataProvider1: TDSServerMetaDataProvider;
   procedure WebModuleCreate(Sender: TObject);
   procedure DSRESTWebDispatcher1FormatResult(Sender: TObject;
     var ResultVal: TJSONValue; const Command: TDBXCommand;
     var Handled: Boolean);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 WebModuleClass: TComponentClass = TfrmWebModule;

implementation


{$R *.dfm}

uses UServerMethods, UServerContainer, Web.WebReq, UMain;

procedure TfrmWebModule.DSRESTWebDispatcher1FormatResult(Sender: TObject;
 var ResultVal: TJSONValue; const Command: TDBXCommand; var Handled: Boolean);
var
 Aux: TJSONValue;   
 Aux2 : TJSONArray;
 Aux3 : TJSONArray;
 jso : TJsonObject;
 jsp_data, jsp_res : TJSONPair;
 res : TJSONObject;
begin                 
 jso := TJsonObject.Create();
 //add object pairs
 jso.AddPair(TJsonPair.Create('code', '0000'));
 jso.AddPair(TJsonPair.Create('message', 'Success'));   

 jsp_res := TJsonPair.Create('result', jso);

 jsp_data := TJsonPair.Create('data', TJSONArray(ResultVal).Get(0));

 res := TJSONObject.Create();
 res.AddPair(jsp_data);
 res.AddPair(jsp_res);

 GetInvocationMetadata().ResponseContentType := 'application/json';
 ResultVal := res;
 Handled := true; // -> bu baştaki result objesini kaldırıyor...

 if frmMain.chkLogging.Checked then
 begin
   frmMain.memo1.Lines.Add('----- Sonuç -----');
   frmmain.Memo1.Lines.Add(ResultVal.ToString);
   frmMain.memo1.Lines.Add('-----');
 end;
end;

procedure TfrmWebModule.WebModuleCreate(Sender: TObject);
begin
 DSRESTWebDispatcher1.Server := DSServer;
 if DSServer.Started then
 begin
   DSRESTWebDispatcher1.DbxContext := DSServer.DbxContext;
   DSRESTWebDispatcher1.Start;
 end;
 DSRESTWebDispatcher1.AuthenticationManager := DSAuthenticationManager;
end;

initialization
finalization
 Web.WebReq.FreeWebModules;

end.

Proje ekte yer almaktadır.
Konunun 2. aşamasında PHP client tarafından bahsedeceğim.
Umarım faydası olur...

[hi_selamlar]

Hocam teşekkürler paylaşım ve bilgiler için.

[klavye]

Teşekkürler.

[TescilsizUzman]

Merhaba,
Detaylı anlatım için teşekkür ederim. 
Not: Konu, makale niteliğinde olduğundan, Makale Bölümüne taşınmıştır.

[frmman]

Teşekkürler, ellerinize sağlık.

[mad85]

Rica ederim. Faydalı olabildiysem ne ala...

[SimaWB]

Çok yararlı bir makale olmuş. Paylaşım için teşekkürler.
connection_info verisi şifrelenmiş şekilde giderse daha iyi olur bence.

[mad85]

(17-11-2017, Saat: 21:35)SimaWB Adlı Kullanıcıdan Alıntı: Çok yararlı bir makale olmuş. Paylaşım için teşekkürler.
connection_info verisi şifrelenmiş şekilde giderse daha iyi olur bence.

Rica ederim.
Şimdiki güvenlik önlemleri : 

• Arada basic authentication var.
  
• IP bazlı izin veriyorum porta.
  
  

Söylediğiniz aklıma geldi ama PHP ve Delphi arasında encrypt-decrypt yapabileceğim bir yapı arıyorum bazı önemli bilgileri şifreleyebilmek için. (Java ve PHP arasında olan mevcut bende)
Ayrıca şöyle bir kontrol daha eklemeyi düşünüyorum:
Headerda göndereceğimiz ekstra bir parametreyi sadece bizim bileceğimiz bir şekilde hashleyip örn md5('xyz'+'_'+request_data+'_'+abc) ) sunucu tarafında da tekrar aynı kontrolü yapıp verinin değişmesini de engellemeyi düşünüyorum. Hatta aynı işlemi dönüş tarafında da yapabilirim.