Příklady pokročilého skriptování
Tato kapitola doplňuje obecný úvod do problematiky skriptování v systému ABRA Flores o ukázky pokročilých praktických příkladů.
Pokročilé příklady skriptování
Příklady skriptování pro pokročilé
Příklad demonstruje vytvoření XML dokumentu s digitálním podpisem a jeho vložení do SOAP obálky za účelem komunikace se SÚKL (Státní ústav pro kontrolu léčiv):
procedure SignXmlSukl(Sender: TComponent);
var
mSite: TSiteForm;
mOS: TNxCustomObjectSpace;
mXML, mXMLEnvelope: TNxScriptingXMLWrapper;
mCertStore, mCertHash, mMsgGUID: String;
mContext: TNxContext;
begin
mSite:= Sender.Site;
mOS:= mSite.BaseObjectSpace;
mContext:= NxCreateContext(mOS);
try
//vyvoláme dialog s výběrem podpisového certifikátu a uložíme si jeho hash a místo uložení
mCertHash:= SelectCertificateDlg(mContext, mCertStore, mSite);
//vygenerujeme si GUID odesílané zprávy
mMsgGUID:= NxTrim(LowerCase(GUIDToString(CFxGuid.CreateNew())),'{}');
mXML:= TNxScriptingXMLWrapper.Create;
try
//vytvoříme zprávu k podepsání
mXML.DateTimeFormat:= 'yyyy-mm-dd"T"hh:nn:ss.zzz';
mXML.CreateEmpty('com:AppPingZEPDotaz', 'xmlns:com="http://www.sukl.cz/erp/common"');
mXML.setAttributeValue('com:AppPingZEPDotaz', 'xmlns:com', 'http://www.sukl.cz/erp/common');
mXML.setElementAsString('com:Doklad.com:Pristupujici.com:Uzivatel', cUserLogin);
mXML.setElementAsString('com:Doklad.com:Pristupujici.com:Pracoviste', cPremiseCode);
mXML.setElementAsString('com:Zprava.com:ID_Zpravy', mMsgGUID);
mXML.setElementAsString('com:Zprava.com:Verze', cSUKLInterfaceVersion);
mXML.setElementAsDateTime('com:Zprava.com:Odeslano', Now);
mXML.setElementAsString('com:Zprava.com:SW_Klienta', 'ABRASW');
//uděláme XML kanonickým, a podepíšeme (Kanonozizace upraví xml do konzistentní standardizované formy)
mXML.MakeXMLCannonical(0, false);
mXML.SignXML(mCertHash, mCertStore, 1, mContext, 'ds');
//vytvoříme obálku
mXMLEnvelope:= TNxScriptingXMLWrapper.Create;
try
mXMLEnvelope.CreateEmpty('soapenv:Envelope', 'xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/"');
mXMLEnvelope.setAttributeValue('soapenv:Envelope', 'xmlns:soapenv', 'http://schemas.xmlsoap.org/soap/envelope/');
mXMLEnvelope.setAttributeValue('soapenv:Envelope', 'xmlns:com', 'http://www.sukl.cz/erp/common');
mXMLEnvelope.setAttributeValue('soapenv:Envelope', 'xmlns:ds', 'http://www.w3.org/2000/09/xmldsig#');
mXMLEnvelope.addElement('soapenv:Header');
//podepsanou XML zprávu vložíme do obálky
mXMLEnvelope.AddXMLEncodedElement('soapenv:Body', mXML.getElementXML('com:AppPingZEPDotaz'));
mXMLEnvelope.saveToFile('F:\testXML1.xml', 'UTF-8');
finally
mXMLEnvelope.Free;
end;
finally
mXML.Free;
end;
finally
mContext.Free;
end;
end;
Pro agendu Artikly se v okně náhledů zobrazí záložka Prodej, kde bude na Google Charts grafech ukázán prodej
Je třeba mít vystavěné faktury se zbožím za posledních 14 a 30 dnů na různá střediska, aby skript zobrazoval data.
Druh skriptu je Aplikační modul - Systémové události.
{
Vyvolá se během načítání záložek pro náhled příloh.
}
procedure DocumentsViewer_AddTabs_Hook(const AContext: TNxContext; const ASourceObject: TNxCustomBusinessObject; const ASiteCLSID: string; var AParams: TNxParameters);
var
mTabData: TNxParameters;
begin
if ASourceObject.CLSID = Class_StoreCard then
begin
mTabData := TNxParameters.Create;
mTabData.GetOrCreateParam(dtString, 'Name').AsString := 'Prodeje';
mTabData.GetOrCreateParam(dtString, 'ID').AsString := ASourceObject.OID;
AParams.AsList.Add(mTabData);
end;
end;
{
Vyvolá se při kliknutí na záložku bez dat vytvořenou skriptem.
}
procedure DocumentsViewer_AddContent_Hook(const AContext: TNxContext; const ASourceObject: TNxCustomBusinessObject; const ASiteCLSID: string; AID: string; var AParams: TNxParameters);
var
mInputParams: TNxParameters;
mTableParams: TNxParameters;
mParams, mSteppedChartParams: TNxParameters;
mMemTable: TMemTable;
mChartPage: TGoogleChartsHtmPage;
mTableChart, mPieChart, mSteppedChart: string;
mTableColumns, mPieChartNames: array of string;
mPieChartValues: array of Double;
I: Integer;
begin
if (ASourceObject.CLSID = Class_StoreCard) then
begin
mInputParams := TNxParameters.Create;
mMemTable := TMemTable.Create(nil);
mTableParams := TNxParameters.Create;
mSteppedChartParams := TNxParameters.Create;
try
mInputParams.NewFromDataType(dtString, 'ID').AsString := ASourceObject.OID;
mInputParams.NewFromDataType(dtDate, 'DateFrom30').AsDateTime := Now - 30;
mInputParams.NewFromDataType(dtDate, 'DateFrom14').AsDateTime := Now - 14;
AContext.SQLSelect2(
'SELECT D.Code AS Code, '+
'(SELECT SUM(II2.QUANTITY) '+
'FROM ISSUEDINVOICES2 II2 '+
'LEFT JOIN ISSUEDINVOICES II ON II2.Parent_ID = II.ID '+
'WHERE '+
' II2.DIVISION_ID = D.ID AND '+
' II2.StoreCard_ID = :ID AND '+
' II.DOCDATE$DATE >= :DateFrom30 '+
') AS Q30, '+
'(SELECT SUM(II2.QUANTITY) '+
'FROM ISSUEDINVOICES2 II2 '+
'LEFT JOIN ISSUEDINVOICES II ON II2.Parent_ID = II.ID '+
' WHERE '+
' II2.DIVISION_ID = D.ID AND '+
' II2.StoreCard_ID = :ID AND '+
' II.DOCDATE$DATE >= :DateFrom14 '+
') AS Q14 '+
'FROM DIVISIONS D',
mMemTable, mInputParams);
SetLength(mPieChartNames, mMemTable.RecordCount);
SetLength(mPieChartValues, mMemTable.RecordCount);
mParams := mSteppedChartParams.NewFromDataType(dtList, '').AsList;
mParams.NewFromDataType(dtString, '').AsString := 'Středisko';
mParams.NewFromDataType(dtString, '').AsString := 'Q14';
mParams.NewFromDataType(dtString, '').AsString := 'Q30';
mMemTable.First;
while not mMemTable.Eof do
begin
mParams := mTableParams.NewFromDataType(dtList, IntToStr(mMemTable.RecNo)).AsList;
mParams.NewFromDataType(dtString, 'Středisko').AsString := mMemTable.FieldByName('Code').AsString;
mParams.NewFromDataType(dtFloat, 'Q14').AsFloat := mMemTable.FieldByName('Q14').AsFloat;
mParams.NewFromDataType(dtFloat, 'Q30').AsFloat := mMemTable.FieldByName('Q30').AsFloat;
mPieChartNames[mMemTable.RecNo - 1] := mMemTable.FieldByName('Code').AsString;
mPieChartValues[mMemTable.RecNo - 1] := mMemTable.FieldByName('Q30').AsFloat;
mParams := mSteppedChartParams.NewFromDataType(dtList, '').AsList;
mParams.NewFromDataType(dtString, '').AsString := mMemTable.FieldByName('Code').AsString;
mParams.NewFromDataType(dtFloat, '').AsFloat := mMemTable.FieldByName('Q14').AsFloat;
mParams.NewFromDataType(dtFloat, '').AsFloat := mMemTable.FieldByName('Q30').AsFloat;
mMemTable.Next;
end;
SetLength(mTableColumns, 3);
mTableColumns[0] := 'Středisko';
mTableColumns[1] := 'Q14';
mTableColumns[2] := 'Q30';
mTableChart := CFxGoogleCharts.RenderTableChart('tablechart_Sales', 'Sales', mTableColumns, mTableParams);
mPieChart := CFxGoogleCharts.RenderPieChart('piechart_Sales', 'Sales', 'Střediska', 'Počet prodaných kusů', mPieChartNames, mPieChartValues);
mSteppedChart := CFxGoogleCharts.RenderSteppedAreaChart('steppedchart_Sales', 'Sales', mSteppedChartParams);
mChartPage := TGoogleChartsHtmPage.Create;
try
mChartPage.AddChart(mTableChart);
mChartPage.AddChart(mPieChart);
mChartPage.AddChart(mSteppedChart);
AParams.NewFromDataType(dtString, 'Content').AsString := mChartPage.Render('Sales Chart');;
AParams.NewFromDataType(dtString, 'Format').AsString := 'HTML';
finally
mChartPage.Free;
end;
finally
mMemTable.Free;
mInputParams.Free;
mTableParams.Free;
mSteppedChartParams.Free;
end;
end;
end;
begin
end.
Následující skript načítá pro okno náhledů v agendě Servisované předměty z definovatelné extra položky s názvem Folder a datového typu Znaky cestu k adresáři (cestu zadáváme bez uvozovek), ve kterém můžeme mít uložené přílohy. Ty se zobrazí v samostatných záložkách okna náhledů. Pokud je navíc v této externí složce podsložka s názvem Fotodokumentace, ve které jsou uložené obrázky, vytvoří z těchto obrázků skript náhledovou HTML galerii, která je v okně náhledů zobrazena jako jedna samostatná záložka.
Druh skriptu je Aplikační modul - Systémové události.
procedure DocumentsViewer_AddTabs_Hook(const AContext: TNxContext; const ASourceObject: TNxCustomBusinessObject; const ASiteCLSID: string; var AParams: TNxParameters);
var
mPath: string;
mData: TmemoryDataSet;
procedure FillParametersFromUNCFiles;
var
mList: TStringList;
i: integer;
mTabData: TNxParameters;
mName: string;
mPathName: string;
begin
mList := TStringList.Create();
try
NxGetFileList(mPath, mList, '*.*', false);
if mList.Count > 0 then
begin
for i := 0 to mList.Count - 1 do
begin
mName := extractFileName(mList[i]);
mPathName := mPath + '\' + mList[i];
if (not DirectoryExists(mPathName)) then
begin
mTabData := TNxParameters.Create;
mTabData.GetOrCreateParam(dtString, 'Name').AsString := mName;
mTabData.GetOrCreateParam(dtString, 'ID').AsString := mPath + IntToStr(i);
mTabData.GetOrCreateParam(dtString, 'Path').AsString := mPathName;
AParams.AsList.Add(mTabData);
end;
end;
end;
finally
mList.Free;
end;
end;
procedure FillGaleryTabFromUNCFiles(aName: String);
var
mTabData: TNxParameters;
begin
mTabData := TNxParameters.Create;
mTabData.GetOrCreateParam(dtString, 'Name').AsString := aName;
mTabData.GetOrCreateParam(dtString, 'ID').AsString := mPath;
AParams.AsList.Add(mTabData);
end;
begin
case ASourceObject.CLSID of
Class_Storecard:
begin
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'X_Folder', '');
if DirectoryExists(mPath) and (mPath <> '') then FillParametersFromUNCFiles;
end;
Class_BusOrder:
begin
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'X_Folder', '');
if DirectoryExists(mPath) and (mPath <> '') then FillParametersFromUNCFiles;
end;
Class_PLMProduceRequest, Class_PLMJobOrder:
begin
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'Storecard_ID.X_Folder', '');
if DirectoryExists(mPath) and (mPath <> '') then FillParametersFromUNCFiles;
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'BusOrder_ID.X_Folder', '');
if DirectoryExists(mPath) and (mPath <> '') then FillParametersFromUNCFiles;
end;
Class_ServiceDocument:
begin
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'ServicedObject_ID.X_Folder', '');
if DirectoryExists(mPath) and (mPath <> '') then FillParametersFromUNCFiles;
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'BusOrder_ID.X_Folder', '');
if DirectoryExists(mPath) and (mPath <> '') then FillParametersFromUNCFiles;
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'ServicedObject_ID.X_Folder', '') + '\Fotodokumentace';
if DirectoryExists(mPath) and (mPath <> '') then FillGaleryTabFromUNCFiles('Fotodokumentace');
end;
Class_ServicedObject:
begin
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'X_Folder', '');
if DirectoryExists(mPath) and (mPath <> '') then FillParametersFromUNCFiles;
mPath := NxEvalObjectExprAsStringDef(ASourceObject, 'X_Folder', '') + '\Fotodokumentace';
if DirectoryExists(mPath) and (mPath <> '') then FillGaleryTabFromUNCFiles('Fotodokumentace');
end;
Class_ServicedObjectType:
begin
try
mData := TMemoryDataSet.Create(nil);
ASourceObject.ObjectSpace.SQLSElect2('select x_folder,x_sn from servicedobjects where servicedobjecttype_id = ' + QuotedStr(ASourceObject.OID), mData);
if mData.Active then
begin
mData.First;
while not mData.Eof do
begin
mPath := mData.FieldByName('X_Folder').AsString + '\Fotodokumentace';
if DirectoryExists(mPath) and (mPath <> '') then FillGaleryTabFromUNCFiles(mData.FieldByName('x_sn').AsString);
mData.Next;
end;
end;
finally
mData.Free;
end;
end;
end;
end;
procedure DocumentsViewer_AddContent_Hook(const AContext: TNxContext; const ASourceObject: TNxCustomBusinessObject; const ASiteCLSID: string; AID: string; var AParams: TNxParameters);
var
mPath: string;
procedure FillDataSetFromUNCPictures;
var
mList, mHTMLPict: TStringList;
i: integer;
mFileNamepict: string;
mContent: TNxParameters;
begin
mList := TStringList.Create();
mHTMLPict := TStringList.Create();
try
NxGetFileList(mPath, mList, '*.jpg', false);
if mList.Count > 0 then
for i := 0 to mList.Count - 1 do
if Fileexists(mPath + '\' + mList[i]) then
mHTMLPict.Add('<strong>' + mList[i] + '</strong><br /><a href="' + mPath + '\' + mList[i] + '" target="_blank"><img src="' + mPath + '\' + mList[i] + '" width="350" /></a><br />');
NxGetFileList(mPath, mList, '*.jpeg', false);
if mList.Count > 0 then
for i := 0 to mList.Count - 1 do
if Fileexists(mPath + '\' + mList[i]) then
mHTMLPict.Add('<strong>' + mList[i] + '</strong><br /><a href="' + mPath + '\' + mList[i] + '" target="_blank"><img src="' + mPath + '\' + mList[i] + '" width="350" /></a><br />');
NxGetFileList(mPath, mList, '*.png', false);
if mList.Count > 0 then
for i := 0 to mList.Count - 1 do
if Fileexists(mPath + '\' + mList[i]) then
mHTMLPict.Add('<strong>' + mList[i] + '</strong><br /><a href="' + mPath + '\' + mList[i] + '" target="_blank"><img src="' + mPath + '\' + mList[i] + '" width="350" /></a><br />');
NxGetFileList(mPath, mList, '*.bmp', false);
if mList.Count > 0 then
for i := 0 to mList.Count - 1 do
if Fileexists(mPath + '\' + mList[i]) then
mHTMLPict.Add('<strong>' + mList[i] + '</strong><br /><a href="' + mPath + '\' + mList[i] + '" target="_blank"><img src="' + mPath + '\' + mList[i] + '" width="350" /></a><br />');
if mHTMLPict.Count > 0 then
begin
AParams.NewFromDataType(dtString, 'Content').AsString := mHTMLPict.Text;
AParams.NewFromDataType(dtString, 'Format').AsString := 'HTML';
end;
finally
mList.Free;
mHTMLPict.Free;
end;
end;
begin
mPath := AID;
case ASourceObject.CLSID of
Class_ServiceDocument:
begin
if DirectoryExists(mPath) and (mPath <> '') then FillDataSetFromUNCPictures;
end;
Class_ServicedObject:
begin
if DirectoryExists(mPath) and (mPath <> '') then FillDataSetFromUNCPictures;
end;
Class_ServicedObjectType:
begin
if DirectoryExists(mPath) and (mPath <> '') then FillDataSetFromUNCPictures;
end;
end;
end;
begin
end.
Následující příklad ukazuje, jak získat přístupový token potřebný pro autentizaci při komunikaci s novým Firebase Cloud Messaging API (V1) pomocí protokolu OAuth 2.0. Token je generován na základě privátního klíče servisního účtu Google a obsahuje oprávnění specifická pro službu Firebase Messaging. Tento přístup je nezbytný pro odesílání notifikací z backendové aplikace MyFLORES a zajišťuje bezpečný způsob autorizace při volání API.
procedure GetAccessToken(Sender: TBasicAction);
const
GOOGLE_AUTH_JSON = '{' +
'"type": "service_account",' +
'"project_id": "**********",' +
'"private_key_id": "**************************************",' +
'"private_key": "-----BEGIN PRIVATE KEY-----\*******************************' +
'****************************\n-----END PRIVATE KEY-----\n",' +
'"client_email": "firebase-adminsdk-*****@********.iam.gserviceaccount.com",' +
'"client_id": "*******************",' +
'"auth_uri": "https://accounts.google.com/o/oauth2/auth",' +
'"token_uri": "https://oauth2.googleapis.com/token",' +
'"auth_provider_x509_cert_url": "https://www.googleapis.com/oauth2/v1/certs",' +
'"client_x509_cert_url": "https://www.googleapis.com/robot/v1/metadata/x509/firebase-adminsdk-************.iam.gserviceaccount.com",' +
'"universe_domain": "googleapis.com"' +
'}';
begin
// získáme access token ke službě "firebase.messaging" přes OAuth 2.0 na základě údajů Google servisního účtu
ShowMessage(CFxInternet.GetGoogleOAuth2AccessToken(GOOGLE_AUTH_JSON, 'https://www.googleapis.com/auth/firebase.messaging', jwtaRS256, 60));
end;
procedure InitSite_Hook(Self: TSiteForm);
var
mAction: TMultiAction;
begin
mAction := Self.GetNewMultiAction;
mAction.ShowControl := True;
mAction.ShowMenuItem := True;
mAction.Caption := 'Dohledat ve fakturách';
mAction.Items.Add('Dohledat ve fakturách vydaných (script)');
mAction.Category := 'tabList';
mAction.OnExecuteItem := @Test;
end;
procedure Test(Sender: TObject; AIndex :Integer);
var
mSite: TSiteForm;
mParams, mDefaultSelection: TNxParameters;
mParCondition: TNxParameter;
mTmpList: TStringList;
mTmpPar: TNxParameter;
mValues: TNxParameters;
begin
mSite := TComponent(Sender).Site;
mParams := TNxParameters.Create;
try
mParams.NewFromDataType(dtString, '_SelectionCaption').AsString := 'Otevřeno ze skriptování řada FV nezaplacené pro firmy A%';
mDefaultSelection := mParams.NewFromDataType(dtList, '_DefaultSelection').AsList;
mParCondition := mDefaultSelection.AsList.NewFromDataType(dtList, 'CONDITIONS');
mTmpPar := mParCondition.AsList.NewFromDataType(dtList, 'DocDate');
mTmpPar.AsList.NewFromDataType(dtInteger, 'USEDKIND').AsInteger := ckRange;
mValues := mTmpPar.AsList.NewFromDataType(dtList, 'VALUES').AsList;
mValues.NewFromDataType(dtString, '{:LOW}').AsString := '0';
mValues.NewFromDataType(dtString, '{:HIGH}').AsString := '45659';
mTmpPar := mParCondition.AsList.NewFromDataType(dtList, 'PaidStatus');
mTmpPar.AsList.NewFromDataType(dtInteger, 'USEDKIND').AsInteger := ckSingle;
mValues := mTmpPar.AsList.NewFromDataType(dtList, 'VALUES').AsList;
mValues.NewFromDataType(dtString, '{:VALUE}').AsString := '1;2;';
mTmpPar := mParCondition.AsList.NewFromDataType(dtList, 'UserDynSQLCondition');
mTmpPar.AsList.NewFromDataType(dtInteger, 'USEDKIND').AsInteger := ckSingle;
mValues := mTmpPar.AsList.NewFromDataType(dtList, 'VALUEBAG').AsList;
mValues.NewFromDataType(dtString, 'DYNUSERSQL').AsString := '(SELECT Name FROM Firms UserSQLFirm WHERE UserSQLFirm.ID = A.Firm_ID) LIKE ''A%''';
mTmpPar := mParCondition.AsList.NewFromDataType(dtList, 'DocQueue_ID');
mTmpPar.AsList.NewFromDataType(dtInteger, 'USEDKIND').AsInteger := ckList;
mTmpPar.AsList.NewFromDataType(dtString, 'VALUELIST').AsString := '''5600000101''';
mSite.ShowDynForm(Site_IssuedInvoices, mParams, nil, True, '');
finally
mParams.Free;
end;
end;
begin
end.
Od verze 25.0.93 lze využít tento poměrně rozšířený a bezpečný standard přímo z prostředí skriptování pomocí třídy TOAuth2Wizard. Díky tomu jsme schopni využívat služeb poskytovatelů, kteří podporují ověření uživatele prostřednictvím třetí strany, případně sami používají vlastní identity server.
Příklad napojení na službu Everifin, která poskytuje služby otevřeného bankovnictví s licencí PSD2:
procedure UserLogin(aSite: TSiteForm);
var
mOauth: TOAuth2Wizard;
begin
mOauth := TOAuth2Wizard.Create(aSite.SiteContext);
try
mOauth.ClientSecret := 'XXXXX';
mOauth.ClientId := 'abra-test';
mOauth.Scope := 'ais';
mOauth.AuthorizationUrl := 'https://api.everifin.com/auth/realms/everifin_app/protocol/openid-connect/auth?...';
mOauth.OnResponse := @OAuth2Wizard_Response;
mOauth.SkipLoginPage := True;
mOauth.Execute(aSite.FindParentForm);
finally
mOauth.Free;
end;
end;procedure OAuth2Wizard_Response(Sender: TObject; aRequestParams: TStrings; var aState: TNxOAuth2ResultAuthorizationStatus; var aMessage: string);
var
mCode: String;
mOS: TNxCustomObjectSpace;
mToken: String;
mTokenEncrypted: String;
begin
aState := noasNone;
aMessage := '';
try
mCode := aRequestParams.Values('code');
if NxIsBlank(mCode) then begin
RaiseException('Parameter ''code'' se nenašel.');
end;
if not (Sender is TOAuth2Wizard) then begin
RaiseException('Incompatible sender type.');
end;
mOS := TOAuth2Wizard(Sender).ObjectSpace;
mToken := ObtainAccessToken(mOS, mCode); // Získání přístupového tokenu přes Web API
mTokenEncrypted := CFxCrypt.EncryptWithANSIKeyToBase64(cCryptoSecretKey, TEncoding.UTF8.GetBytes(mToken)); // Zašifrování tokenu
// Zde může přijít uchování zašifrovaného tokenu.
aState := noasOK;
except
aState := noasError;
aMessage := TrimExMessage(ExceptionMessage);
end;
end;
Proces ověření ve zkratce:
-
Vyvolání průvodce OAuth2
-
Zadání přihlašovacích údajů
-
V případě úspěšného ověření přesměrování na adresu uvedenou v parametru „redirect_uri“ vlastnosti AuthorizationURL
-
V obsluze události OnResponse získáme autorizační kód, pomocí kterého požádáme o přístupový token
-
Získaný token zašifrujeme s využitím třídy CFxCrypt a uložíme např. do CompanyCache ABRA Gen
Pro agendu Objednávky přijaté (OP) se v okně náhledů zobrazí záložka Objednávka přijatá, kde bude zobrazeno číslo dokladu, celková lokální cena a řádky dané objednávky
Nejprve je třeba vytvořit soubor style.css, který umístíme do instalačního adresář sytému ABRA Flores, podsložky _Nahledy. V našem příkladu se jedná o cestu:
c:/ABRA/INSTALACE/DEVELOP/CS/25.2/AbraGen-25.3.0-cs-CZ-debug-250318-1919-d2fc8a6/_Nahledy/style.css
Ve skriptu níže je tuto cestu třeba nahradit dle vaší potřeby.
Obsah style.css:
body {
font-family: Arial, sans-serif;
margin: 20px;
background-color: #f8f8f8;
color: #333;
}
h1 {
color: #0057a3;
font-size: 24px;
margin-bottom: 10px;
}
h2 {
color: #0057a3;
font-size: 18px;
margin-bottom: 10px;
}
p {
font-size: 14px;
line-height: 1.6;
}
Dále vytvoříme skript v agendě Balíčky skriptů. Druh skriptu bude Aplikační modul - Systémové události.
procedure DocumentsViewer_AddTabs_Hook(const AContext: TNxContext; const ASourceObject: TNxCustomBusinessObject;
const ASiteCLSID: string; var AParams: TNxParameters);
var
mTabData: TNxParameters;
begin
if ASourceObject.CLSID = Class_ReceivedOrder then
begin
mTabData := TNxParameters.Create;
mTabData.GetOrCreateParam(dtString, 'Name').AsString := 'Objednávka přijatá'; // Název záložky
mTabData.GetOrCreateParam(dtString, 'ID').AsString := 'HTMLFormTab_' + ASourceObject.OID;
AParams.AsList.Add(mTabData);
end;
end;
procedure DocumentsViewer_AddContent_Hook(const AContext: TNxContext; const ASourceObject: TNxCustomBusinessObject;
const ASiteCLSID: string; AID: string; var AParams: TNxParameters);
var
mHtml: string;
mMemTableAmount, mMemTableRows: TMemTable;
mInputParams: TNxParameters;
mAmount: Double;
mRowType: Integer;
mText, mStoreCardName, mDisplayText: string;
mOrderNumber: string;
mDocQueueCode, mPeriodCode: string;
begin
if (ASourceObject.CLSID = Class_ReceivedOrder) and (AID = 'HTMLFormTab_' + ASourceObject.OID) then
begin
mInputParams := TNxParameters.Create;
mMemTableAmount := TMemTable.Create(nil);
mMemTableRows := TMemTable.Create(nil);
try
mInputParams.NewFromDataType(dtString, 'ID').AsString := ASourceObject.OID;
// Načtení hlavičkových údajů: Amount, DQ.Code, OrdNumber, P.Code
AContext.SQLSelect2(
'SELECT RO.LOCALAMOUNT, RO.ORDNUMBER, DQ.CODE AS DOCQUEUECODE, P.CODE AS PERIODCODE ' +
'FROM RECEIVEDORDERS RO ' +
'JOIN PERIODS P ON P.ID = RO.PERIOD_ID ' +
'JOIN DOCQUEUES DQ ON DQ.ID = RO.DOCQUEUE_ID ' +
'WHERE RO.ID = :ID',
mMemTableAmount,
mInputParams
);
if not mMemTableAmount.IsEmpty then
begin
mAmount := mMemTableAmount.FieldByName('LOCALAMOUNT').AsFloat;
mDocQueueCode := mMemTableAmount.FieldByName('DOCQUEUECODE').AsString;
mPeriodCode := mMemTableAmount.FieldByName('PERIODCODE').AsString;
mOrderNumber := mDocQueueCode + '-' + IntToStr(mMemTableAmount.FieldByName('ORDNUMBER').AsInteger) + '/' + mPeriodCode;
end
else
begin
mAmount := 0;
mOrderNumber := '[neznámé číslo]';
end;
// Načtení řádků objednávky
AContext.SQLSelect2(
'SELECT RO2.ROWTYPE, RO2.TEXT, SC.NAME ' +
'FROM RECEIVEDORDERS2 RO2 ' +
'LEFT JOIN STORECARDS SC ON SC.ID = RO2.STORECARD_ID ' +
'WHERE RO2.PARENT_ID = :ID',
mMemTableRows,
mInputParams
);
// HTML výstup
mHtml :=
'<!DOCTYPE html>'#13#10 +
'<html>'#13#10 +
'<head>'#13#10 +
' <meta charset="UTF-8">'#13#10 +
' <link rel="stylesheet" href="file:///c:/ABRA/INSTALACE/DEVELOP/CS/25.2/AbraGen-25.3.0-cs-CZ-debug-250318-1919-d2fc8a6/_Nahledy/style.css">'#13#10 +
' <title>Objednávka přijatá</title>'#13#10 +
'</head>'#13#10 +
'<body>'#13#10 +
' <h1>' + mOrderNumber + '</h1>'#13#10 +
' <p><strong>Celková cena (lok.):</strong> ' + FormatFloat('#,##0.00 Kč', mAmount) + '</p>'#13#10 +
' <h2>Řádky:</h2>'#13#10 +
' <ul>'#13#10;
mMemTableRows.First;
while not mMemTableRows.Eof do
begin
mRowType := mMemTableRows.FieldByName('ROWTYPE').AsInteger;
mText := mMemTableRows.FieldByName('TEXT').AsString;
mStoreCardName := mMemTableRows.FieldByName('NAME').AsString;
if mRowType = 3 then
mDisplayText := mStoreCardName
else
mDisplayText := mText;
mHtml := mHtml + ' <li>Typ (' + IntToStr(mRowType) + ') - ' + mDisplayText + '</li>'#13#10;
mMemTableRows.Next;
end;
mHtml := mHtml +
' </ul>'#13#10 +
'</body>'#13#10 +
'</html>'#13#10;
AParams.NewFromDataType(dtString, 'Content').AsString := mHtml;
AParams.NewFromDataType(dtString, 'Format').AsString := 'HTML';
finally
mMemTableAmount.Free;
mMemTableRows.Free;
mInputParams.Free;
end;
end;
end;
begin
end.
Toto je příklad skriptu, který vyplňuje text do políčka “Popis slevy” v závislosti na hodnotách objektu slev. V tomto skriptu je využit háček BeforeShowPOSCashDiscountParamsForm_Hook. Háček je dostupný ve všech aplikačních modulech kas. Háček se vyvolá před zobrazením formuláře pro zadání slevy. V parametrech háčku je předávaný objekt slev na kase a vlastní formulář pro zadání slev.
{
Vyvolá se před zobrazením formuláře pro zadání slevy.)
}
procedure BeforeShowPOSCashDiscountParamsForm_Hook(AContext: TNxContext; ADiscount: TNxCustomBusinessObject; var APOSCashDiscountParamsForm: TForm);
var
edDiscountText: TEdit;
mDiscountKind: integer;
mDiscountKindText: string;
begin
edDiscountText := TEdit(APOSCashDiscountParamsForm.FindChildControl('edDiscountText'));
//edDiscountText.Text := 'init sleva kód: ' + ADiscount.GetFieldValueAsString('Code');
mDiscountKind := ADiscount.GetFieldValueAsInteger('DiscountKind');
{
0 - Akční sleva
1 - Finanční na zboží automatická
2 - Finanční na řádek
3 - Finanční na zboží
4 - Finanční na doklad
5 - Procentní na doklad
6 - Automatická procentní na zboží na dokladu
7 - Procentní řádková
8 - Procentní řádková na zboží
9 - Procentní...
}
case mDiscountKind of
0: mDiscountKindText := 'Akční';
1..4: mDiscountKindText := 'Finanční';
5..9: mDiscountKindText := 'Procentní';
else
mDiscountKindText := 'Mimo rozsah';
end;
edDiscountText.Text := ADiscount.GetFieldValueAsString('Code') + '-' + mDiscountKindText + ': ' + ADiscount.GetFieldValueAsString('DiscountDescription') + ' (' + IntToStr(mDiscountKind) + ')';
end;
begin
end.;
Přiklady použití NxPrintByIDs, NxPrintByConditions:
procedure PrintReports_Test(Sender: TControl);
var
mContext: TNxContext;
i: Integer;
mSite: TSiteForm;
mSCList: TStringList;
mConditions, mCondParams, mCondParamsValues, mExtraParams: TNxParameters;
begin
mSite := TSiteForm(TComponent(Sender).Site);
mContext := NxCreateContext(mSite.BaseObjectSpace);
try
mConditions := TNxParameters.Create;
try
mSCList := TStringList.Create;
try
//Tisk Reportu (Agenda Reporty)
//Nastavení omezení reportu za datum, sklady a skladové karty
//Omezení za Datum
mCondParams := mConditions.NewFromDataType(dtList, 'Date').AsList;
mCondParams.NewFromDataType(dtInteger, 'UsedKind').AsInteger := ckRange;
mCondParamsValues := mCondParams.NewFromDataType(dtList, 'Values').AsList;
// Omezení za datum je sice typu ckRange, ale jako údaj pro omezení (k datu)
// se bere jenom hodnota "LOW"
mCondParamsValues.NewFromDataType(dtFloat, '{:LOW}').AsFloat := 43449; // 15.12.2018
//mCondParamsValues.NewFromDataType(dtFloat, '{:HIGH}').AsFloat := Date; // dnes
// Omezení za sklady (výběr seznamem - řetězec reprezentující seznam ID - oddělené Entrem)
mCondParams := mConditions.NewFromDataType(dtList, 'Store_ID').AsList;
mCondParams.NewFromDataType(dtInteger, 'UsedKind').AsInteger := ckList;
mCondParams.NewFromDataType(dtString, 'ValueList').AsString := '2100000101'#13#10'3500000101';
// Omezení za skladové karty (výběr seznamem - TStringList)
// StringList naplníme přes SQL SELECT
mSite.BaseObjectSpace.SQLSelect('SELECT ID FROM StoreCards WHERE Code LIKE ''0%''', mSCList);
mCondParams := mConditions.NewFromDataType(dtList, 'StoreCard_ID').AsList;
mCondParams.NewFromDataType(dtInteger, 'UsedKind').AsInteger := ckList;
mCondParams.NewFromDataType(dtString, 'ValueList').AsString := NxStringsToCkListStr(mSCList);
//Provede tisk přímo na tiskárnu dle omezení v mConditions - Report "Stav skladu k datu"
// tisk přímo na tiskárnu
NxPrintByConditions(mContext,
mConditions, // Omezení pro report - podmínky
'DCGGWH4VRREL3FWD002BG34ZPK', // DynSQL - "Sklad - Stav k datu"
'V700000001', // Report ID - "Stav skladu k datu"
rtoPrint, // Typ operace - Tisk na tiskárnu
pekARP, // Typ exportu
'KONICA MINOLTA C223', // Výstup - název tiskárny
''); // (slouží pro název souboru v případě tisku do souboru)
//Provede tisk do souboru PDF dle omezení v mConditions - Report "Stav skladu k datu"
// tisk do souboru PDF
NxPrintByConditions(mContext,
mConditions, // Omezení pro report - podmínky
'DCGGWH4VRREL3FWD002BG34ZPK', // DynSQL - "Sklad - Stav k datu"
'V700000001', // Report ID - "Stav skladu k datu"
rtoFile, // Typ operace - Tisk na tiskárnu
pekPDF, // Typ expByCoortu
'C:\ABRA', // Výstup - cesta k souboru (zadávat formát C:\ABRA\)
'Report Skladu - Stav k datu.pdf'); // Název souboru
//Tisk tiskových sestav dle identifikací objektů
//S rozšířeným nastavením tiskárny (Collate, Duplex)
// Rozšířené nastavení riskárny
mExtraParams := TNxParameters.Create;
try
// Zapneme kompletování kopií
// true -> kopie budou tisknuty 1,2,3 1,2,3
// false -> kopie budou tisknuty 1,1 2,2 3,3
mExtraParams.GetOrCreateParam(dtBoolean, 'REPORT_COLLATE').AsBoolean := True;
// Zapneme oboustranný tisk
mExtraParams.GetOrCreateParam(dtBoolean, 'REPORT_DUPLEX').AsBoolean := True;
//Provede tisk tiskové sestavy “Seznam zboží (kód)” přímo na tiskárnu - omezení je dáno seznamem ID skladových karet
// tisk tiskové sestavy
NxPrintByIDs(mContext,
mSCList, // Seznam ID skladových karet
'OGQQA2C25JDL342N01C0CX3FCC', // DynSource - Skladové karty
'F300000001', // Report ID - "Seznam zboží (kód)"
rtoPrint, // Typ operace - Tisk na tiskárnu
pekARP, // Typ expByCoortu
'KONICA MINOLTA C223', // Výstup - cesta k souboru
'', // Název souboru
2, // Počet kopií
false, // Emulovat kopie
mExtraParams); // Předává parametry pro tisk - Duplex nebo Collate
//Provede tisk tiskové sestavy “Seznam zboží (kód)” do souboru PDF - omezení je dáno seznamem ID skladových karet
// tisk tiskové sestavy.do souboru
NxPrintByIDs(mContext,
mSCList, // Seznam ID skladových karet
'OGQQA2C25JDL342N01C0CX3FCC', // DynSource - Skladové karty
'F300000001', // Report ID - "Seznam zboží (kód)"
rtoFile, // Typ operace - Tisk na tiskárnu
pekPDF, // Typ expByCoortu
'C:\ABRA', // Výstup - cesta k souboru (zadávat formát C:\ABRA\)
'Seznam zboží(kód).pdf', // Název souboru
2); // Počet kopií
// Provede tisk tiskové sestavy "Seznam zboží (kód)" do souboru PDF - omezení je dáno seznamem ID skladových karet
// Parametr tiskárny při tisku do souboru způsobí, že se vynutí převzetí nastavení papíru z této tiskárny
CFxReportManager.PrintByIDs(mContext,
mSCList, // Seznam ID skladových karet
'OGQQA2C25JDL342N01C0CX3FCC', // DynSource - Skladové karty
'F300000001', // Report ID - "Seznam zboží (kód)"
rtoFile, // Typ operace - Tisk na tiskárnu
pekPDF, // Typ exoortu
'C:\ABRA\test\develop', // Výstup - cesta k souboru
'Seznam zboží(kód)_printer_KM.pdf', // Název souboru
1, false, nil, // Počet kopií + emulateCopies + AParams
'KONICA MINOLTA C223'); // Název tiskárny, z které se přebírá nastavení stránky/papíru
finally
mExtraParams.Free;
end;
finally
mSCList.Free;
end;
finally
mConditions.Free;
end;
finally
mContext.Free;
end;
end; Nastavení kompletace a oboustranný tisk se předává pomocí parametru třídy TNxParameters.
Emulace kopií se používá pro tiskárny, které nepřebírají počet kopií.
POZOR: Pokud tiskárna umožňuje přebírání počtu kopií, mějte parametr EmulateCopies vypnutý. V opačném případě bude tiskárna tisknout exponenciální počet kopií, místo 2 vytiskne 4, místo 3 vytiskne 9 atd.
Funkce NxPrintByConditions umožňuje tisk Reportů (agenda Reporty) dle zadaného omezení, například Stav skladu k datu , Prodané zboží dle skladů, Obraty účtů atd.
Parametr určující název tiskárny Počet kopií a emulace byli přidány jako parametry funkce již ve verzi 19.0.
Od verze 25.3 byla přidána možnost výběru tiskárny při tisku do souboru - tím se vynutí převzetí nastavení .
Příklad na přidání náhledu obrázku skladové karty do levé části stromu kusovníku. Při přechodu položkami stromu se v levé části zobrazuje obrázek z dané skladové karty. Pokud položka obrázek nemá, načteme předem připraven obrázek no_image. To může být například bílý obrázek nebo upozoronění, že obrázek nebyl načten.
{
Vyvolává se po provedení inicializace agendy/formuláře. V tento okamžik je již na formuláři dostupný SiteContext.
}
procedure InitSite_Hook(Self: TSiteForm);
var
TreeView: TVirtualStringTree;
begin
With TPanel.Create(Self) do
begin
Parent:= TTabSheet(Self.FindChildControl('tabTree'));
Align:= alLeft;
Width:= 600;
Name:= 'Tree_Pict';
Caption:= '';
end;
with TImage.Create(TPanel(Self.FindChildControl('Tree_Pict'))) do
begin
Parent:= TPanel(Self.FindChildControl('Tree_Pict'));
Name:= 'pctStoreCard_Picture';
Align:= alClient;
AutoSize:=True;
end;
TreeView:= TVirtualStringTree(TTabSheet(Self.FindChildControl('tabTree')).FindChildControl('TreeView'));
if Assigned(TreeView) then
begin
TreeView.OnAfterFocusChanged := @My_OnAfterFocusChanged;
end;
end;
{
Vyvolá se před zobrazením formuláře pro zadání slevy.)
}
procedure My_OnAfterFocusChanged(Sender: TObject);
var
mPicture: TNxCustomBusinessObject;
mStream: TMemoryStream;
mBO: TNxCustomBusinessObject;
mSQL,mID: String;
begin
try
if Assigned(TImage(TVirtualStringTree(Sender).GetParentForm.FindChildControl('pctStoreCard_Picture'))) then
if TVirtualStringTree(Sender).GetFocusedNodeTextByColumn(0) <> '' then
begin
mBO:= TVirtualStringTree(Sender).Site.BaseObjectSpace.CreateObject(Class_StoreCard);
try
// TVirtualStringTree(Sender).GetFocusedNodeTextByColumn(0) - získá z prvního sloupce kód skladové karty
mSQL:= 'Select ID '+
'From StoreCards '+
'Where Hidden = ''N'' and Code = '+QuotedStr(TVirtualStringTree(Sender).GetFocusedNodeTextByColumn(0));
mID:= TVirtualStringTree(Sender).Site.BaseObjectSpace.SQLSelectFirstAsString(mSQL,'');
// Obrázek uložený na Skl. Kartě
if Not NxIsEmptyOID(mID) then
begin
mBO.Load(mID,nil);
mStream:= TMemoryStream.Create;
mPicture:= TVirtualStringTree(Sender).Site.BaseObjectSpace.CreateObject(Class_Picture);
try
if mPicture.Test(mBO.GetFieldValueAsString('Picture_ID')) then
begin
mPicture.Load(mBO.GetFieldValueAsString('Picture_ID'),nil);
mStream.SetBytes(mPicture.GetFieldValueAsBytes('BlobData'));
TImage(TVirtualStringTree(Sender).Site.FindChildControl('pctStoreCard_Picture')).Picture.LoadMultiFormatFromStream(mStream);
end
else
// Pokud položka nemá obrázek, načteme předem připraven obrázek no_image - to může být například upozornění, že neobsahuje obrázek nebo prázdný obrázek
TImage(TVirtualStringTree(Sender).Site.FindChildControl('pctStoreCard_Picture')).Picture.LoadFromFile('.\no_image.png');
finally
mPicture.Free;
mStream.Free;
end;
end;
finally
mBO.Free;
end;
end;
except
// Zahazuju chyby - případně vyvést chybu pomocí RaiseException
// nebo do okna s obrázkem vypsat text chyby (ExceptionMessage)
end;
end;
null a existence parametru v objektu TJSONSuperObject
Tento příklad ukazuje, jak v prostředí skriptování testovat, zda má parametr v objektu TJSONSuperObject hodnotu null, a jak takovou hodnotu výslovně zapsat. Zároveň ukazuje, jak ověřit existenci parametru, který může nebo nemusí být ve vstupním JSONu přítomen.
var
mSQL: string;
mJSON: TJSONSuperObject;
mO: TJSONSuperObject;
begin
mJSON := TJSONSuperObject.Create;
try
mJSON.O['hodnotaNull'] := TJSONSuperObject.CreateByDataType(jtNull); // Nastavení null hodnoty
mJSON.I['cislo_cele'] := 12345;
ShowMessage(mJSON.AsJson);
mO := mJSON.O['neexistuje'];
if not mO.Exists then // Test existence parametru
ShowMessage('O[''neexistuje''].Exists = False');
if mJSON.O['hodnotaNull'].DataType = jtNull then // Test null hodnoty
ShowMessage('mJSON.O[''hodnotaNull''].DataType = jtNull');
finally
mJSON.Free;
end;
end;
Výsledek skriptu:
NxScriptDebuggerBreakPoint pro zastavení kódu ve ScriptDebuggeru
Následující příklad, který do agendy Adresář firem přidává tlačítko pro hromadnou tvorbu firem, slouží hlavně jako ukázka, jak použít proceduru NxScriptDebuggerBreakPoint, která, pokud je k systému ABRA Flores připojen nástroj ScriptDebugger, zastaví kód na vybraném místě.
Vytvoříme nový balíček skriptů a na záložce projekt vytvoříme druh skriptu Knihovna a pojmenuje me ji CreateObjects:
function CreateFirm(AObjectSpace: TNxCustomObjectSpace; AName: String): TNxOID;
var
mBO: TNxCustomBusinessObject;
begin
mBO := AObjectSpace.CreateObject(Class_Firm);
try
NxScriptDebuggerBreakPoint;
mBO.New;
mBO.Prefill;
mBO.SetFieldValueAsString('Name', AName);
mBO.Validate;
mBO.Save;
Result := mBO.OID;
finally
mBO.Free;
end;
end;
begin
end.
Dále vytvoříme druh skriptu Agenda a vybereme Adresář firem:
uses
'CreateObjects';
procedure FormCreate_Hook(Self: TSiteForm);
var
mAction: TBasicAction;
begin
mAction := Self.GetNewAction;
mAction.ShowControl := True;
mAction.ShowMenuItem := True;
mAction.Caption := 'Hromadná tvorba firem';
mAction.Category := 'tabList';
mAction.OnExecute := @ButtonCreateFirmsClick;
end;
procedure ButtonCreateFirmsClick(Sender : TObject);
var
I: Integer;
mSite : TSiteForm;
mCount: Integer;
begin
mSite := TComponent(Sender).Site;
NxScriptDebuggerBreakPoint;
mCount := StrToInt(InputBox('Hromadná tvorba firem', 'Zadejte počet', '10'));
for I:=0 to mCount - 1 do
CreateFirm(mSite.BaseObjectSpace,'Generated firm ' + IntToStr(I));
end;
begin
end.
Pokud je následně k systému ABRA Flores připojen ScriptDebugger (viz daná kapitola), zastaví se po spuštění funkce Hromadná tvorba firem skript na daném breakpointu.
Následující příklad přidává do agendy Skladové karty tlačítko, které při stisku ukazuje použití skriptingových funkcí pro správu bezpečného úložiště:
Vytvoříme nový balíček skriptů a na záložce projekt vytvoříme druh skriptu Agenda a pojmenuje me ji SecureStore:
procedure Main(Sender : TObject);
var
mSite: TSiteForm;
mObjectSpace: TNxCustomObjectSpace;
mKeyValue: String;
begin
// Funkce pro bezpečné úložiště jsou na ObjectSpace
mSite := TComponent(Sender).Site;
mObjectSpace := mSite.BaseObjectSpace;
// Pokud klíč existuje, pak načteme hodnotu do proménné a zobrazíme ji
if mObjectSpace.ReadFromSecureStore('mujklic', mKeyValue) then
begin
// Vypsání načtené hodnoty
ShowMessage(mKeyValue);
// Tímto voláním klíč opět vymažeme
mObjectSpace.DeleteFromSecureStore('mujklic');
ShowMessage('Klíč byl odstraněn');
end else
begin
// Vytvoření klíče "mujklic" s hodnotou aktuálního data
// Po spuštění tohoto kódu si můžeme hodnotu klíče zobrazit v nástroji AppServerProp.exe > Funkce > Bezpečné úložiště.
mObjectSpace.WriteToSecureStore('mujklic', DateTimeToStr(Now));
ShowMessage('Klíč byl založen a můžete jej uživatelsky zobrazit v nástroji AppServerProp.exe');
// Opětovným zápisem provedeme přepsání již uložené hodnoty
mObjectSpace.WriteToSecureStore('mujklic', 'Opětovně změněno: ' + DateTimeToStr(Now));
end;
// Pokud chceme, aby hodnota klíče byla uložena pro konkrétního uživatele, musíme do názvu klíče uložit identifikátor uživatele
// Seznam existujících zakázkových klíčů nelze načíst. Je k dispozici pouze správcům v nástroiji AppServerProp.exe
mObjectSpace.WriteToSecureStore('Klíč na uživatele/' + NxGetActualUserID(mObjectSpace), DateTimeToStr(Now));
end;
procedure FormCreate_Hook(Self: TSiteForm);
var
mAction, mAction2: TBasicAction;
begin
mAction := Self.GetNewAction;
mAction.ShowControl := True;
mAction.ShowMenuItem := True;
mAction.Caption := 'Bezpečné úložiště';
mAction.Category := 'tabList,tabDetail';
mAction.OnExecute := @Main;
end;
begin
end.
Další způsoby správy bezpečného úložiště (Web API a AppServerProp) viz kap. Bezpečnost dat.
Následující příklad ukazuje, jak lze do agendy definovatelných položek přidat tlačítko, které provede synchronizaci definovatelných položek napříč předem definovanými databázovými spojeními. Skript využívá rozhraní Web API a jeho endpoint /installsets/distribution, který umožňuje jednoduchý export a import různých systémových nastavení. Podrobnější popis tohoto API endpointu a jeho možností naleznete v kapitole PŘÍKLAD 22 - Synchronizace definic mezi spojeními.
Skript nejprve z aktuálního spojení vyexportuje definovatelné položky (pomocí GET požadavku na API), a následně je naimportuje do ostatních definovaných spojení (pomocí POST požadavků).
Druh skriptu: Agenda - Definovatelné položky.
const
mAPIUrl = 'http://localhost/';
mUser = 'Supervisor';
mPass = '';
mGetRoute = '/installsets/distribution?specific=userdeffieldsx';
mPostRoute = '/installsets/distribution';
mConnections = ['Demodata', 'Demodata2', 'Demodata3', 'Demodata4'];
procedure FormCreate_Hook(Self: TSiteForm);
var
mAction, mAction2: TBasicAction;
begin
mAction := Self.GetNewAction;
mAction.ShowControl := True;
mAction.ShowMenuItem := True;
mAction.Caption := 'Synchronize';
mAction.Category := 'tabList';
mAction.OnExecute := @Main;
end;
procedure Main(Sender : TObject);
var
mWinHttpRequest: Variant;
mSite: TSiteForm;
mAuth, mTemp: String;
mBytes : TBytes;
I : Integer;
mMS: TMemoryStream;
begin
mSite := TComponent(Sender).Site;
mAuth := 'Basic ' + EncodeBase64(TEncoding.UTF8.GetBytes(mUser + ':' + mPass));
mWinHttpRequest := CreateOleObject('WinHttp.WinHttpRequest.5.1');
mWinHttpRequest.Open('GET', mAPIUrl + mSite.CentralCache.ConnectionName + mGetRoute, False);
mWinHttpRequest.SetTimeouts(5000, 5000, 5000, 600000); // 600000 ms = 10 minutes for receiving the response
mWinHttpRequest.SetRequestHeader('Authorization', mAuth);
mWinHttpRequest.Send;
if not ((mWinHttpRequest.Status = 200) or (mWinHttpRequest.Status = 201)) then
begin
ShowMessage('Request failed with status code: ' + IntToStr(mWinHttpRequest.Status) + nxCrLf + TEncoding.UTF8.GetString(mWinHttpRequest.ResponseBody));
exit;
end;
mBytes := mWinHttpRequest.ResponseBody;
mMS := TMemoryStream.Create;
try
mMS.SetBytes(mBytes);
mMS.SaveToFile('c:\Nexus\_Devel_1\response.zip');
finally
mMS.Free;
end;
mTemp := '';
for I := 0 to Length(mConnections) - 1 do
begin
if mConnections[I] <> mSite.CentralCache.ConnectionName then
begin
mWinHttpRequest.Open('POST', mAPIUrl + mConnections[I] + mPostRoute, False);
mWinHttpRequest.SetRequestHeader('Authorization', mAuth);
mWinHttpRequest.SetRequestHeader('Content-Type', 'application/zip');
mWinHttpRequest.Send(mBytes);
mTemp := mTemp + mConnections[I] + ': ';
mTemp := mTemp + FloatToStr(mWinHttpRequest.Status) + ' ';
if mWinHttpRequest.ResponseText <> '' then
begin
mTemp := mTemp + '- ' + TEncoding.UTF8.GetString(mWinHttpRequest.ResponseBody);
end;
mTemp := mTemp + nxCrLf;
end;
end;
ShowMessage(mTemp);
end;
begin
end.
Popis problému
Při volání SQL dotazu ze skriptu může dojít k chybě "Byla překročena max. velikost alokované paměti pro řádek datasetu". Tento problém se týká všech databázových platforem (MSSQL, Oracle, Firebird) a dochází k němu, pokud dotaz vrací více sloupců, jejichž obsah je upraven funkcemi. Ať už se jedná o funkci FORMAT na MSSQL, TO_CHAR na Oracle nebo zřetězení pomocí + či ||, databázový server často implicitně přiřadí výslednému sloupci maximální textový datový typ (např. NVARCHAR(4000)). I když skutečná data jsou krátká, součet maximálních délek všech sloupců v jednom řádku může překročit limit datasetu v aplikaci (typicky 65 536 bajtů).
Chybná konstrukce
Následující dotaz připravuje data pro tiskový výstup. Formátuje několik číselných a textových polí. Každý z těchto upravených sloupců je databází vrácen s velkým implicitním datovým typem, což ve výsledku způsobí přetečení paměti pro řádek.
SELECT
'FA-' + OrdNumber AS InvoiceID,
UPPER(FirmName) AS CustomerName,
REPLACE(FORMAT(TotalAmount, 'N2'), ',', '.') + ' CZK' AS FormattedTotal,
REPLACE(FORMAT(TotalVAT, 'N2'), ',', '.') + ' CZK' AS FormattedVAT,
'Splatnost: ' + FORMAT(DueDate, 'dd.MM.yyyy') AS DueDateInfo
FROM
IssuedInvoices
WHERE
IsStorno = 0
Důsledky
Zatímco dotaz se v nástrojích pro správu databáze (např. SQL Management Studio) provede bez problémů, při spuštění ze skriptu v aplikaci selže s chybou o překročení velikosti řádku. Důvodem je, že skriptovací prostředí alokuje paměť podle definice sloupců, nikoliv podle skutečné délky dat. Součet teoretických délek (např. 5x NVARCHAR(4000)) snadno překročí povolený limit.
Optimální řešení
Řešením je explicitně definovat datový typ a jeho velikost pro každý transformovaný sloupec pomocí funkce CAST. Tím zajistíme, že celková definovaná velikost řádku zůstane v limitu datasetu. Funkce CAST je standardní součástí SQL a je dostupná na všech podporovaných databázích.
SELECT
CAST('FA-' + OrdNumber AS VARCHAR(50)) AS InvoiceID,
CAST(UPPER(FirmName) AS VARCHAR(150)) AS CustomerName,
CAST(REPLACE(FORMAT(TotalAmount, 'N2'), ',', '.') + ' CZK' AS VARCHAR(40)) AS FormattedTotal,
CAST(REPLACE(FORMAT(TotalVAT, 'N2'), ',', '.') + ' CZK' AS VARCHAR(40)) AS FormattedVAT,
CAST('Splatnost: ' + FORMAT(DueDate, 'dd.MM.yyyy') AS VARCHAR(30)) AS DueDateInfo
FROM
IssuedInvoices
WHERE
IsStorno = 0
Jak snadno zjistit, které sloupce problém způsobují? V nástroji pro správu databáze lze dotaz dočasně upravit tak, aby jeho výsledek vložil do nové tabulky (např. pomocí klauzule INTO new_table na MSSQL). Následnou inspekcí sloupců nově vytvořené tabulky lze odhalit, jaké datové typy databáze automaticky přiřadila, a které je tedy potřeba omezit pomocí CAST.
Skriptovací systém byl rozšířen o podporu automatické dokumentace API funkcí, kterou lze volat přímo z API. Dokumentace je registrována přímo v balíčcích skriptů společně s implementací API funkcí.
Dokumentační procedury mají název s prefixem OPENAPIDOC_ následovaným názvem API funkce. Hlavičku dokumentace lze také automaticky vygenerovat pomocí akce „vygenerovat hlavičku → volání OpenAPI dokumentace funkce“, která vytvoří základní strukturu pro definici dokumentace.
Dokumentace se vytváří pomocí objektu ARoutesBuilder, který umožňuje definovat:
- jednotlivé HTTP routy,
- HTTP metody (GET, POST, PUT, DELETE),
- parametry (query, path, header),
- formát a obsah odpovědí,
- strukturu a obsah těla požadavku,
- příklady JSON dat,
- JSON schémata pro validaci těla dotazu.
Příklad založení dokumentace s názvem OPENAPIDOC_xxx
procedure OPENAPIDOC_xxx(AContext:TNxContext; ARoutesBuilder: TApiRoutesBuilder);
const
cSchema =
'{' +
'"$schema": "http://json-schema.org/draft-05/schema#" ,' +
'"name": "UserData",' +
'"type": "object",' +
'"properties": {' +
'"id": {' +
'"type": "string"' +
'},' +
'"name": {' +
'"type": "string"' +
'},' +
'"age": {' +
'"type": "integer", "minimum": 0' +
'},' +
'"email": {' +
'"type": "string", "format": "email"' +
'},' +
'"isActive": {' +
'"type": "boolean", "default": true' +
'},' +
'"roles": {' +
'"type": "array", "items": { "type": "string" }' +
'}' +
'},' +
'"required": ["name", "email"]' +
'}';
cExample =
'{' +
' "id": "1",' +
' "name": "Alice",' +
' "age": 30,' +
' "email": "alice@example.com",' +
' "isActive": false,' +
' "roles": ["admin", "user"]' +
'}';
begin
ARoutesBuilder
.AddRoute('/' )
.Get('Ziska seznam zaznamu')
.AddResponses
.Ok('Zaznamy byly ziskany')
.JSONContent(cSchema, cExample)
.FinishMethod
.FinishResponses
.FinishDefinition
.Post('Založí zaznam metodou POST')
.AddParams
.BooleanParam('Force', 'Parametr vynutí uložení objektu i přes softvalidace', False, rplQuery)
.FinishParams
.AddRequestBody
.JSONContent(cSchema, cExample)
.FinishRequestBody
.AddResponses
.Created('Byl vytvoren novy zaznam')
.JSONContent(cSchema, cExample)
.FinishMethod
.FinishResponses
.FinishDefinition
.FinishRoute
.AddRoute('/{id}')
.Put('Modifikuje záznam')
.AddParams
.StringParam('id', 'id zaznamu', True, rplPath)
.BooleanParam('Force', 'Parametr vynutí uložení objektu i přes softvalidace', False, rplQuery)
.FinishParams
.AddRequestBody
.JSONContent(cSchema, cExample)
.FinishRequestBody
.AddResponses
.Ok('Zaznam byl modifikovan')
.JSONContent(cSchema, cExample)
.FinishMethod
.FinishResponses
.FinishDefinition
.Delete('Smaze zaznam')
.AddParams
.StringParam('id', 'id zaznamu', True, rplPath)
.FinishParams
.AddResponses
.NoContent('Zaznam byl smazan')
.FinishMethod
.FinishResponses
.FinishDefinition
.FinishRoute;
end;