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 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
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.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řidání prvku do stromu kusovníku
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:
|
|
|