unit ucfNetProxy;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, jsonConf, Forms,
//SynDBMidasVCLExtra,
mORMot,
SynDBMidasVCL,
SynDB, //TQuery
SynTable, //SynDBVCL, mORMotMidasVCL,
SynDBRemote, // Remote Access
SynCommons
//SynDBDataset,
;
type
TUCCntConfig = record
host, port, // 127.0.0.1:7443
db, // medic
user, pass: String; // user/pass
end;
// DLL related
procedure Dll_UC_EntryPoint(dllparam : PtrInt);
procedure Dll_UC_ExitPoint(dllparam : PtrInt);
function fQueryInitConnectionsToServer ():Boolean; stdcall;
function fQueryGetSQLQR ( var oQuery: TQuery; iSQLRQ: Integer): Boolean; stdcall;
function fQueryExportConnection (): Pointer; stdcall;
{ ------------------------------------------------------------------------------------------------------- }
{ Global vars }
var
gfP : TSQLDBConnectionProperties;
gSQLCache : TStringList;
gJConfig : TUCCntConfig;
gId : Integer ; // Id for patients global
gBUseCache: Boolean;
implementation
function fQueryGetConfig(): TUCCntConfig;
var
fJson: TJSONConfig;
fApp: String;
begin
fApp := ChangeFileExt(Application.ExeName, '.json');
fJson := TJSONConfig.Create( nil );
fJson.Filename := fApp;
try
Result.host := fJson.GetValue('/httpcnt/host' ,'127.0.0.1');
Result.port := fJson.GetValue('/httpcnt/port' ,'7443' );
Result.db := fJson.GetValue('/httpcnt/dbase' ,'medic1' );
Result.user := fJson.GetValue('/httpcnt/user' ,'user' );
Result.pass := fJson.GetValue('/httpcnt/pass' ,'pass' );
finally
fJson.Free;
end;
end;
function fQueryHttpConnectionSQL ( ): TSQLDBConnectionProperties;
var
sHostPort: String;
begin
// Result is NULL
Result := nil;
// See if Global gfP is, and FreeIt
if gfP <> nil then
FreeAndNil(gfP);
// construct host:port
sHostPort := gJConfig.host + ':' + gJConfig.port;
// construct Connection String
Result := TSQLDBWinHTTPConnectionProperties.Create( sHostPort , gJConfig.db, gJConfig.user, gJConfig.pass);
// Add widestring support
Result.VariantStringAsWideString := true;
// see if object is Created.
if Result = nil then
raise exception.Create( 'Error connecting to server... ' );
end;
procedure Dll_UC_EntryPoint(dllparam: PtrInt);
begin
fQueryInitConnectionsToServer();
end;
procedure Dll_UC_ExitPoint(dllparam: PtrInt);
begin
if gfP <> nil then
begin
FreeAndNil(gfP);
end;
end;
function fQueryInitConnectionsToServer(): Boolean; stdcall;
begin
Result := False;
gJConfig := fQueryGetConfig();
gfP := fQueryHttpConnectionSQL();
Result := True;
end;
function fQueryGetSQLQR (var oQuery: TQuery; iSQLRQ: Integer): Boolean; stdcall;
var
fQuery: TQuery ;
fSQL: string;
fIndex: Integer;
fNc: TSQLDBConnection;
begin
Result := False;
//Screen.Cursor := crHourGlass;
try
//if oQuery = nil then
// oQuery := TQuery.Create( gfP.NewConnection );
//
//oQuery.SQL.Clear;
//if ( gSQLCache.IndexOfObject(TObject(iSQLRQ)) <> -1 ) and ( gBUseCache ) then
//begin
// fIndex := gSQLCache.IndexOfObject(TObject(iSQLRQ));
// fSQL := gSQLCache.Strings[fIndex];
// oQuery.SQL.Text := fSQL;
// oQuery.Tag := iSQLRQ;
//end
//else
begin
fNc := gfP.NewConnection;
fQuery := TQuery.Create( fNc );
try
try
fQuery.SQL.Add( ' SELECT qr_sqltxt FROM uc_qrsql WHERE qr_id = ' + IntToStr(iSQLRQ) ) ;
fQuery.Open;
//if fQuery.RecordCount = 0 then
//begin
// Lnc := oQuery.Connection;
// FreeAndNil( Lnc );
// FreeAndNil( oQuery );
// raise Exception.Create('No SQLQr N: in the scope !!');
//end;
fSQL := fQuery.FieldByName('qr_sqltxt').AsString;
oQuery.SQL.Text := fSQL;
oQuery.Tag := iSQLRQ;
//gSQLCache.AddObject( fSQL, TObject(iSQLRQ) ); // Add SQL text to Cach
except
raise;
end;
finally
fQuery.Free;
fNc.Free;
end;
end;
finally
//Screen.Cursor := crDefault;
end;
Result := True;
//
end;
function fQueryExportConnection(): Pointer; stdcall;
begin
Result := @gfP;
end;
end.