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é
Digitální podpis XML zprávy pro komunikaci se SÚKL
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;
Příklad zadaných podmínek omezení v agendě Faktury vydané
Příklad vybraných dokladů v agendě Faktury vydané dle výše zadaných podmínek
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 REST 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
Zobrazení údajů z objednávky přijaté v okně náhledů
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.