Prvni verze
This commit is contained in:
884
ComObjekt.pas
Normal file
884
ComObjekt.pas
Normal file
@ -0,0 +1,884 @@
|
||||
unit ComObjekt;
|
||||
|
||||
INTERFACE
|
||||
|
||||
uses System.Types, System.SysUtils, Win.ComObj, System.Classes,
|
||||
ddPlugin_TLB, plgKonfig;
|
||||
|
||||
//{$DEFINE IHePlugin3}
|
||||
|
||||
const
|
||||
plgHDCRTNParams_class: TGUID = '{FEDE87D4-E557-48DD-9A35-B13DEF5FE1BB}';
|
||||
CRLF = #13#10;
|
||||
|
||||
type
|
||||
TPlgHDCRootvinParams = class (TComObject, IHePlugin)
|
||||
private
|
||||
procedure Run (const Helios: IHelios); safecall;
|
||||
end;
|
||||
|
||||
// !!! pri zmene IHePluginXX upravit take v plgAbout - info o jadru !!!
|
||||
TPlgHDCRootvin = class(TComObject, {$IFDEF IHePlugin3} IHePlugin3 {$ELSE} IHePlugin {$ENDIF})
|
||||
private
|
||||
FHelios : IHelios;
|
||||
function PartnerIdentification: WideString; safecall;
|
||||
function DelphiCompilerVersion: Single; safecall;
|
||||
procedure OnException(Sender: TObject; E: Exception);
|
||||
procedure Run (const Helios: IHelios); safecall;
|
||||
// procedure Work (const Helios: IHelios); safecall;
|
||||
// procedure About (const Helios: IHelios); safecall;
|
||||
procedure Install (const Helios: IHelios); safecall;
|
||||
procedure ZkotrolujDefiniceSQL (const Helios: IHelios);
|
||||
function NactiKonfig (const Helios: IHelios): boolean;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
IMPLEMENTATION
|
||||
|
||||
uses Vcl.Controls, System.Win.ComServ, Winapi.Windows, Vcl.Graphics, Vcl.Forms, Vcl.Dialogs, System.Variants,
|
||||
System.StrUtils, System.Hash, System.AnsiStrings,
|
||||
plgType, plgMain, plgSpravce,
|
||||
// [RK 13.04.2012] nove komponenty DevExpress toto vyzaduji, jinak zatuhne Helios
|
||||
dxGDIPlusAPI{!initialization!},
|
||||
NativeXml, datMod, helUtils, helTabsBIDs, frmPekarna, frmPlan, frmRamcovyPlan;
|
||||
|
||||
|
||||
var oVar1, oVar2: OleVariant;
|
||||
LocalFormatSettings: TFormatSettings;
|
||||
apiMod, jeTest: boolean;
|
||||
apiServer, plgHDCRTN_Name: string;
|
||||
|
||||
tBid, fId: integer;
|
||||
delkaRC, idKZrodic, idDZrodic, cOrgRodic, cOrgMU, cOrgPrijem, dpzOZ: integer;
|
||||
radaDZ: string;
|
||||
|
||||
|
||||
function TPlgHDCRootvin.DelphiCompilerVersion: Single;
|
||||
begin
|
||||
Result:= System.CompilerVersion;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
function TPlgHDCRootvin.PartnerIdentification: WideString;
|
||||
begin
|
||||
Result:= 'HEOR0400-00044';
|
||||
end;
|
||||
|
||||
|
||||
procedure TPlgHDCRootvin.OnException (Sender: TObject; E: Exception);
|
||||
begin
|
||||
try
|
||||
LockWindowUpdate (0);
|
||||
FHelios.Error (plgPrelozException(E.Message));
|
||||
except
|
||||
Vcl.Forms.Application.ShowException(E); //pro jistotu
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
procedure TPlgHDCRootvin.Work (const Helios: IHelios);
|
||||
var s: WideString;
|
||||
begin
|
||||
s := Concat('Nacházíte se v tabulce ', Helios.MainBrowseTable(), '.');
|
||||
Helios.Info(s);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
procedure TPlgHDCRootvin.About (const Helios: IHelios);
|
||||
var s: WideString;
|
||||
begin
|
||||
s := 'Tento plugin je určen pro testování základních funkcí HELIOS iNuvio Interface.';
|
||||
Helios.Info(s);
|
||||
end;
|
||||
}
|
||||
|
||||
procedure TPlgHDCRootvin.Install (const Helios: IHelios);
|
||||
var s: WideString;
|
||||
begin
|
||||
ZkotrolujDefiniceSQL (Helios);
|
||||
s := 'Instalace proběhla úspěšně.';
|
||||
Helios.Info(s);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
function TPlgHDCRootvin.NactiKonfig (const Helios: IHelios): Boolean;
|
||||
var xml: TNativeXml;
|
||||
r, n1, n2: TXmlNode;
|
||||
fn: string;
|
||||
begin
|
||||
result:= true;
|
||||
datMod.phServer:= 'http://rootvin.datazone.cloud/helios/api';
|
||||
|
||||
fn:= GetModuleName(HInstance);
|
||||
fn:= ChangeFileExt(fn, '.xml');
|
||||
|
||||
if (FileExists(fn)) then
|
||||
begin
|
||||
xml:= TNativeXml.Create(nil);
|
||||
try
|
||||
xml.LoadFromFile(fn);
|
||||
if not(xml.IsEmpty) then
|
||||
begin
|
||||
r:= xml.Root;
|
||||
if (r<>nil) then
|
||||
begin
|
||||
n1:= r.NodeByName('cfgPluginHDCRTN');
|
||||
if (n1<>nil) then
|
||||
datMod.phServer:= n1.ReadAttributeString('phServer', '');
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
xml.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
procedure TPlgHDCRootvin.ZkotrolujDefiniceSQL (const Helios: IHelios);
|
||||
var lSQL, lSQL2, lSQLX, errMsg, srcNazev, objectNazev, trgName, sqlDefDB, sqlDefPlg: string;
|
||||
rs: TResourceStream;
|
||||
ms: TMemoryStream;
|
||||
arrDefs: TStringList;
|
||||
i, pCRLF: integer;
|
||||
canCont, canCont2: boolean;
|
||||
hash1, hash2: string;
|
||||
|
||||
function LoadStringFromStream (const AStream: TStream): String;
|
||||
var lenX: Integer;
|
||||
begin
|
||||
AStream.Seek(0,0);
|
||||
lenX:= AStream.Size - AStream.Position;
|
||||
SetLength(Result, lenX);
|
||||
if (lenX>0) then
|
||||
AStream.ReadBuffer(Result[1], lenX);
|
||||
end;
|
||||
function MemoryStreamToAnsiString (const M: TMemoryStream): AnsiString;
|
||||
begin
|
||||
SetString(Result, PAnsiChar(M.Memory), M.Size);
|
||||
end;
|
||||
|
||||
begin
|
||||
lSQL:= helUtils.getHeliosStrVal(Helios, '', 'SELECT DATEPART(week, CONVERT(datetime, N''11.12.2023'', 104))');
|
||||
lSQL2:= helUtils.getHeliosStrVal(Helios, '', 'SELECT DATEPART(iso_week, CONVERT(datetime, N''11.12.2023'', 104))');
|
||||
if (lSQL='51') and (lSQL2='50') then
|
||||
datMod.sqlLang:= 'czech'
|
||||
else
|
||||
datMod.sqlLang:= 'english';
|
||||
|
||||
|
||||
|
||||
arrDefs:= TStringList.Create;
|
||||
|
||||
arrDefs.Add('tbl_hdc_ph_Log');
|
||||
arrDefs.Add('tbl_hdc_ph_PrijataJsonData');
|
||||
arrDefs.Add('trg__hdc_ph_PrijataJsonData_D');
|
||||
arrDefs.Add('ef_GetDatumASmenu');
|
||||
arrDefs.Add('ef_Bit2Int');
|
||||
|
||||
arrDefs.Add('col_TabEvidRozpracOperR_EXT');
|
||||
arrDefs.Add('col_TabStavSkladu_EXT');
|
||||
arrDefs.Add('col_TabVazbyPrikazu_EXT');
|
||||
arrDefs.Add('col_TabKmenZbozi_EXT');
|
||||
arrDefs.Add('col_TabPohybyZbozi_EXT');
|
||||
arrDefs.Add('col_TabDokladyyZbozi_EXT');
|
||||
|
||||
arrDefs.Add('tbl__TabVyrobaVydejMatSarze');
|
||||
arrDefs.Add('tbl__TabVyrobaPalety');
|
||||
arrDefs.Add('tbl__TabVyrobaPaletyUkonceni');
|
||||
arrDefs.Add('tbl__TabVyrobaPaletyPohybOZ');
|
||||
arrDefs.Add('tbl__TabVyrobaStrojCinnost');
|
||||
arrDefs.Add('tbl__TabVyrobaTestoVyroba');
|
||||
arrDefs.Add('tbl__TabVyrobaTestoSpotreba');
|
||||
|
||||
arrDefs.Add('ef_Vyroba_VratNovyPaletovyList');
|
||||
arrDefs.Add('ef_Vyroba_VratCisloSarze');
|
||||
arrDefs.Add('ef_Kmen_VratPocetKsVKartonu');
|
||||
arrDefs.Add('tbl__TabVyrobaObjednavky');
|
||||
// arrDefs.Add('tbl__TabVyrobaOperaceStartStop');
|
||||
|
||||
arrDefs.Add('ep_P01_HDC1');
|
||||
arrDefs.Add('ep_P01');
|
||||
arrDefs.Add('ep_P03_HDC1');
|
||||
arrDefs.Add('ep_P03');
|
||||
|
||||
arrDefs.Add('ep_V03_HDC1');
|
||||
arrDefs.Add('ep_V03');
|
||||
|
||||
|
||||
arrDefs.Add('ep_Vyroba_VyrobaMimoPlan');
|
||||
arrDefs.Add('ep_Vyroba_Doklady_Micharna');
|
||||
arrDefs.Add('ep_Vyroba_GenVydejZeMzdy');
|
||||
arrDefs.Add('ep_Vyroba_GenOdvodZeMzdy');
|
||||
arrDefs.Add('ep_Vyroba_DoplnSkladProVydejDleDokl');
|
||||
arrDefs.Add('ep_Vyroba_InsertEvidRozpracOperPol');
|
||||
arrDefs.Add('ep_Vyroba_InsertEvidRozpracOper');
|
||||
arrDefs.Add('ep_Vyroba_PrijemNestandard');
|
||||
arrDefs.Add('ep_Vyroba_VyrobaMimoPlan');
|
||||
arrDefs.Add('ep_HDC_PZ_ZapisPolozek');
|
||||
arrDefs.Add('ep_Vyroba_GenerujPalety');
|
||||
arrDefs.Add('ep_Vyroba_GenSouhrnnyVydej');
|
||||
arrDefs.Add('tbl__TabVyrobaVzorky');
|
||||
arrDefs.Add('tbl__TabKontrolyCCP1');
|
||||
arrDefs.Add('tbl__TabVyrobaOdpadPek');
|
||||
|
||||
// planovani
|
||||
arrDefs.Add('col_Prikaz_EXT');
|
||||
arrDefs.Add('col_AdvKPDavky_EXT');
|
||||
arrDefs.Add('tbl__TabVyrobaPlanRozpad');
|
||||
arrDefs.Add('ef_Vyroba_GenerujRozpadCasu');
|
||||
arrDefs.Add('ep_Vyroba_ZapisDoPlanu');
|
||||
arrDefs.Add('ep_Vyroba_ZrusZakazkuPlanuDleFinPrikazu');
|
||||
arrDefs.Add('ep_Vyroba_AdvPlan_ZapisDavkyPrikazu');
|
||||
arrDefs.Add('trg__TabPlan_HDC_D');
|
||||
arrDefs.Add('trg__TabAdvKPDavky_HDC_D');
|
||||
|
||||
|
||||
// arrDefs.Add('spec_Clear');
|
||||
arrDefs.Add('trg__TabVyrobaObjednavky_IU');
|
||||
arrDefs.Add('trg__TabVyrobaObjednavky_Pol_D');
|
||||
arrDefs.Add('trg__TabVyrobaPalety_IU');
|
||||
arrDefs.Add('trg__TabVyrobaPalety_D');
|
||||
arrDefs.Add('trg__TabPohybyZbozi_HDC_IU');
|
||||
arrDefs.Add('trg__TabPohybyZbozi_HDC_D');
|
||||
arrDefs.Add('trg__TabVyrCP_HDC_IU');
|
||||
arrDefs.Add('trg__TabVyrCP_HDC_D');
|
||||
arrDefs.Add('trg__TabVyrobaPaletyUkonceni_D');
|
||||
arrDefs.Add('trg__TabVyrobaVydejMatSarze_IU');
|
||||
arrDefs.Add('trg__TabVyrCisPrikaz_HDC_D');
|
||||
|
||||
for i:=0 to arrDefs.Count-1 do
|
||||
begin
|
||||
ms:= TMemoryStream.Create;
|
||||
try
|
||||
srcNazev:= arrDefs.Strings[i];
|
||||
canCont:= true;
|
||||
|
||||
|
||||
if (canCont) then
|
||||
begin
|
||||
rs:= TResourceStream.Create(HInstance, srcNazev.ToUpper, RT_RCDATA);
|
||||
ms.CopyFrom(rs, rs.Size);
|
||||
|
||||
lSQL:= MemoryStreamToAnsiString(ms);
|
||||
objectNazev:= LeftStr(lSQL, lSQL.IndexOf(Chr(13))).Replace('-- ', '');
|
||||
|
||||
|
||||
if (srcNazev.StartsWith('ep_', true)) or (srcNazev.StartsWith('ef_', true)) or (srcNazev.StartsWith('trg_')) then
|
||||
begin
|
||||
canCont:= false;
|
||||
hash1:= '';
|
||||
hash2:= '';
|
||||
|
||||
if (srcNazev.StartsWith('trg_')) then
|
||||
lSQLX:= 'SELECT m.definition FROM ' + Helios.CurrentDB + '.sys.triggers t INNER JOIN ' + Helios.CurrentDB + '.sys.objects o on t.object_id = o.object_id'
|
||||
+ ' INNER JOIN ' + Helios.CurrentDB + '.sys.sql_modules m on m.object_id = o.object_id WHERE t.name=N' + objectNazev.Replace('dbo.','').QuotedString
|
||||
else
|
||||
lSQLX:= 'SELECT OBJECT_DEFINITION(OBJECT_ID(N' + (Helios.CurrentDB + '.' + objectNazev).QuotedString + '))';
|
||||
|
||||
sqlDefDB:= helUtils.getHeliosStrVal(Helios, '', lSQLX);
|
||||
if (sqlDefDB<>'') then
|
||||
begin
|
||||
sqlDefDB:= sqlDefDB.Replace('/*' + plgHDCRTN_Name + '*/', '');
|
||||
hash1:= THashMD5.GetHashString(sqlDefDB);
|
||||
if (srcNazev.StartsWith('trg_')) then
|
||||
sqlDefPlg:= MidStr(lSQL, lSQL.IndexOf(Chr(13))+3, lSQL.Length)
|
||||
else
|
||||
sqlDefPlg:= lSQL;
|
||||
if (sqlDefPlg.StartsWith(CRLF)) then
|
||||
sqlDefPlg:= MidStr(sqlDefPlg, 3, sqlDefPlg.Length);
|
||||
if (sqlDefPlg.EndsWith(CRLF)) then
|
||||
sqlDefPlg:= LeftStr(sqlDefPlg, sqlDefPlg.Length-2);
|
||||
hash2:= THashMD5.GetHashString(sqlDefPlg);
|
||||
if (hash1<>hash2) then
|
||||
canCont:= true;
|
||||
end
|
||||
else
|
||||
canCont:= true;
|
||||
end;
|
||||
|
||||
if not(canCont) then
|
||||
Continue;
|
||||
|
||||
if (srcNazev.StartsWith('ep_', true)) then
|
||||
Helios.ExecSQL ('DROP PROCEDURE IF EXISTS dbo.' + srcNazev);
|
||||
if (srcNazev.StartsWith('ef_', true)) then
|
||||
Helios.ExecSQL ('DROP FUNCTION IF EXISTS dbo.' + srcNazev);
|
||||
|
||||
|
||||
if (srcNazev.StartsWith('trg_')) then
|
||||
begin
|
||||
if (lSQL.StartsWith('-- ')) then
|
||||
lSQL:= MidStr(lSQL, lSQL.IndexOf(Chr(13))+3, lSQL.Length);
|
||||
trgName:= LeftStr(lSQL, lSQL.IndexOf(' ON dbo.'));
|
||||
trgName:= trgName.Replace ('CREATE TRIGGER ', '');
|
||||
Helios.ExecSQL ('DROP TRIGGER IF EXISTS ' + trgName);
|
||||
end;
|
||||
|
||||
if (srcNazev.StartsWith('tbl_', true)) then
|
||||
lSQL:= lSQL.Trim;
|
||||
|
||||
if (lSQL<>'') then
|
||||
try
|
||||
Helios.ExecSQL (lSQL);
|
||||
except on E:Exception do
|
||||
if not(E.Message.Contains('already')) then
|
||||
Helios.Error(#1'Chyba definice ' + srcNazev + #1 + CRLF + E.Message);
|
||||
end;
|
||||
|
||||
end;
|
||||
finally
|
||||
ms.Free;
|
||||
rs.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
arrDefs.Free;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
procedure TPlgHDCRootvin.Run (const Helios: IHelios);
|
||||
const HeliosMinVersion = $030020240620;
|
||||
BrowseID_PluginInfo = 871;
|
||||
var extId: Integer;
|
||||
errMsg: String;
|
||||
typAkce: integer;
|
||||
browID, cRec, cntID, l_loop, idDZ, dpz, cOrg, newBid: integer;
|
||||
lSQL, lSQLx, autor, radDokl, IDcka, params, paramsBak, vlastPar, vlastPar2, contInfo, sz, rc, podm, sTemp: string;
|
||||
iTemp, iTemp2: integer;
|
||||
arrId: TArray<integer>;
|
||||
term: boolean;
|
||||
i: Integer;
|
||||
|
||||
Browse: TplgBrowse;
|
||||
GUIDAkce: String;
|
||||
Q: IHeQuery;
|
||||
Porovnani: TplgPorovnaniVerzi;
|
||||
VerzeDB: String;
|
||||
ZmenyOK: Boolean;
|
||||
MinVerze: Int64;
|
||||
PomHandle: THandle;
|
||||
SlepaProcName: string;
|
||||
SlepaProcGUID: string;
|
||||
SlepaProcBrowse: string;
|
||||
|
||||
fPekarna: TformPekarna;
|
||||
fPlan: TformPlan;
|
||||
fRamcovyPlan: TformRamcovyPlan;
|
||||
begin
|
||||
UseLatestCommonDialogs:= true;
|
||||
LocalFormatSettings:= TFormatSettings.Create;
|
||||
|
||||
try
|
||||
FHelios:= Helios;
|
||||
SpravceHeliosu.PridejHelios (FHelios);
|
||||
try
|
||||
Application.OnException:= Self.OnException;
|
||||
|
||||
// [RK 10.04.2006] zavedeni PomHandle, problemy s realokaci ikonky
|
||||
// [RK 02.04.2009] doplneno pretypovani na THandle
|
||||
PomHandle := THandle(FHelios.MainApplicationHandle);
|
||||
if PomHandle <> Application.Handle then
|
||||
Application.Handle := PomHandle;
|
||||
|
||||
PomHandle := THandle(FHelios.MainApplicationIconHandle);
|
||||
if PomHandle <> Application.Icon.Handle then
|
||||
Application.Icon.Handle := PomHandle;
|
||||
|
||||
with Application.DefaultFont do
|
||||
begin
|
||||
CharSet := FHelios.Charset;
|
||||
Name := FHelios.Font;
|
||||
Height := FHelios.FontHeight;
|
||||
|
||||
Screen.MenuFont.CharSet := CharSet;
|
||||
Screen.MenuFont.Name := Name;
|
||||
Screen.MenuFont.Height := Height;
|
||||
end;
|
||||
|
||||
// ### INICIALIZACE ###
|
||||
InicializaceJadraPluginu (FHelios);
|
||||
PluginKonfig.VlastniInicializacePluginu (FHelios);
|
||||
|
||||
VerzeDB:= plgNactiVerziPluginuZDB (FHelios, ZmenyOK);
|
||||
Porovnani:= plgPorovnejVerziPluginuSVerziDB (VerzeDB);
|
||||
|
||||
|
||||
// ### INSTALACE PLUGINU ###
|
||||
if (FHelios.BrowseID = BrowseID_PluginInfo) and plgExtKomIDInstalace(FHelios) then
|
||||
begin
|
||||
InstalacePluginu (FHelios, (FHelios.ExtKomID = Cplg_ExtKomID_TichaInstalace));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
NactiKonfig (Helios);
|
||||
|
||||
if (Helios.HeVersion<HeliosMinVersion) then
|
||||
begin
|
||||
errMsg := 'Plugin vyžaduje min verzi Heliosu ' + IntToHex(HeliosMinVersion, 12) + '; Aktuální verze je ' + IntToHex(Helios.HeVersion, 12);
|
||||
Helios.Error(errMsg);
|
||||
raise Exception.Create(errMsg);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
extId:= Helios.ExtKomID;
|
||||
|
||||
|
||||
lSQLx:= 'SELECT UP FROM ' + tblExtKom + ' WHERE ID=' + extId.ToString;
|
||||
plgHDCRTN_Name:= helUtils.getHeliosStrVal(Helios, '', lSQLx);
|
||||
ZkotrolujDefiniceSQL (Helios);
|
||||
|
||||
helUtils.ReseedTable (Helios, tblDZ);
|
||||
helUtils.ReseedTable (Helios, tblPZ);
|
||||
helUtils.ReseedTable (Helios, tblPrikazVC);
|
||||
|
||||
|
||||
with Helios.OpenSQL('SELECT CONVERT(nvarchar(128),CONTEXT_INFO(),2)') do
|
||||
if VarIsNull(FieldValues(0)) then
|
||||
contInfo:= 'NULL'
|
||||
else
|
||||
contInfo:= VarToStr(FieldValues(0));
|
||||
|
||||
Helios.ExecSQL('SET CONTEXT_INFO 0x48444334526F6F7476696E'); // nastav context v sys.sysprocesses (hexadecimalne HDC4Rootvin)
|
||||
|
||||
lSQL:= 'IF OBJECT_ID(''tempdb..#TabExtKom'', N''U'') IS NULL CREATE TABLE #TabExtKom (Typ TINYINT DEFAULT NULL, Poznamka NVARCHAR(255))' + CRLF;
|
||||
lSQL:= lSQL + 'IF OBJECT_ID(N''tempdb..#TabTempUziv'') IS NULL CREATE TABLE #TabTempUziv (Tabulka';
|
||||
lSQL:= lSQL + ' NVARCHAR(255) NOT NULL, SCOPE_IDENTITY INT NULL, Datum DATETIME NULL)';
|
||||
Helios.ExecSQL(lSQL);
|
||||
|
||||
|
||||
|
||||
delkaRC:= helUtils.getHeliosIntVal(Helios, 30, 'SELECT TOP(1) DelkaRegCislaZbozi FROM ' + tblHGlob);
|
||||
|
||||
term:= false;
|
||||
params:= '';
|
||||
vlastPar:= '';
|
||||
vlastPar2:= '';
|
||||
typAkce:= -1;
|
||||
browID:= 0;
|
||||
jeTest:= false;
|
||||
|
||||
|
||||
lSQL:= lSQLx.Replace('T UP F', 'T Parametry F');
|
||||
with Helios.OpenSQL(lSQL) do
|
||||
if (RecordCount=1) then
|
||||
begin
|
||||
params:= VarToStr(FieldValues(0));
|
||||
|
||||
if (params.ToLower.Contains(';test')) then
|
||||
jeTest:= true;
|
||||
|
||||
paramsBak:= VarToStr(FieldValues(0));
|
||||
if (params.Contains(';')) then
|
||||
begin
|
||||
typAkce:= StrToInt(LeftStr(params,Pos(';',params)-1));
|
||||
params:= MidStr(params,Pos(';',params)+1,255);
|
||||
if (params.Contains(';')) then
|
||||
begin
|
||||
if not(TryStrToInt(LeftStr(params,Pos(';',params)-1), browID)) then
|
||||
browID:= 0;
|
||||
params:= MidStr(params,Pos(';',params)+1,255);
|
||||
end
|
||||
else
|
||||
if not(TryStrToInt(params, browID)) then
|
||||
browID:= 0;
|
||||
if (params.Contains(';')) then // zadany 3 parametry (akce, browID, vlastnikID)
|
||||
begin
|
||||
params:= MidStr(params,Pos(';',params)+1,255);
|
||||
if (params.Contains(';')) then
|
||||
begin
|
||||
vlastPar:= LeftStr(params,Pos(';',params)-1);
|
||||
vlastPar2:= MidStr(params,Pos(';',params)+1,255);
|
||||
end
|
||||
else
|
||||
vlastPar:= params;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if (params<>'') then
|
||||
if not(TryStrToInt(params, typAkce)) then
|
||||
typAkce:= -1;
|
||||
end;
|
||||
|
||||
|
||||
if (browID>0) then
|
||||
if (Helios.BrowseID<>browID) then
|
||||
begin
|
||||
typAkce:= 0;
|
||||
Helios.Error('Tento plugin lze volat pouze z přehledu: '#1 + IntToStr(browID) + #1'.');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
|
||||
IDcka:= '';
|
||||
cRec:= 0;
|
||||
if (Helios.SelectedRecordIDs<>'') then
|
||||
IDcka:= Helios.SelectedRecordIDs
|
||||
else
|
||||
if not VarIsNull(Helios.CurrentRecordID) then
|
||||
begin
|
||||
cRec:= StrToInt(VarToStr(Helios.CurrentRecordID));
|
||||
IDcka:= IntToStr(cRec);
|
||||
end;
|
||||
|
||||
if (IDcka<>'') then
|
||||
begin
|
||||
cntID:= 1 + Length(IDcka)-Length(StringReplace(IDcka,',','',[rfReplaceAll]));
|
||||
SetLength(arrID,cntID);
|
||||
for l_loop:=0 to cntID-1 do
|
||||
begin
|
||||
if Pos(',',IDcka)>0 then
|
||||
begin
|
||||
arrID[l_loop]:= StrToInt(LeftStr(IDcka,Pos(',',IDcka)-1));
|
||||
IDcka:= MidStr(IDcka,Pos(',',IDcka)+1,262140) // 65535 * 4 (max. delka pole)
|
||||
end
|
||||
else
|
||||
arrID[l_loop]:= StrToInt(IDcka);
|
||||
end;
|
||||
cRec:= arrID[0];
|
||||
end;
|
||||
|
||||
|
||||
idDZrodic:= -1;
|
||||
idDZ:= -1;
|
||||
cOrgRodic:= -1;
|
||||
cOrg:= -1;
|
||||
cOrgMU:= -1;
|
||||
cOrgPrijem:= -1;
|
||||
dpzOZ:= -1;
|
||||
if (Helios.HeliosVlastnik<>nil) then
|
||||
begin
|
||||
if (Helios.HeliosVlastnik.QueryEdit<>nil) then
|
||||
begin
|
||||
try
|
||||
if (Helios.HeliosVlastnik.QueryEdit.FieldByName('ID')<>nil) then
|
||||
if not(TryStrToInt(VarToStr(Helios.HeliosVlastnik.QueryEdit.FieldByNameValues('ID')), idDZrodic)) then
|
||||
idDZrodic:= -1;
|
||||
finally
|
||||
end;
|
||||
try
|
||||
dpzOZ:= VarToStr(Helios.HeliosVlastnik.QueryEdit.FieldByNameValues('DruhPohybuZbo')).ToInteger;
|
||||
finally
|
||||
end;
|
||||
try
|
||||
radaDZ:= VarToStr(Helios.HeliosVlastnik.QueryEdit.FieldByNameValues('RadaDokladu'));
|
||||
finally
|
||||
end;
|
||||
try
|
||||
if not(TryStrToInt(VarToStr(Helios.HeliosVlastnik.QueryEdit.FieldByNameValues('CisloOrg')), cOrgRodic)) then
|
||||
cOrgRodic:= -1;
|
||||
finally
|
||||
end;
|
||||
try
|
||||
if not(TryStrToInt(VarToStr(Helios.HeliosVlastnik.QueryEdit.FieldByNameValues('MistoUrceni')), cOrgMU)) then
|
||||
cOrgMU:= -1;
|
||||
finally
|
||||
end;
|
||||
try
|
||||
if not(TryStrToInt(VarToStr(Helios.HeliosVlastnik.QueryEdit.FieldByNameValues('Prijemce')), cOrgPrijem)) then
|
||||
cOrgPrijem:= -1;
|
||||
finally
|
||||
end;
|
||||
end;
|
||||
|
||||
if (Helios.QueryEdit<>nil) then
|
||||
begin
|
||||
try
|
||||
if (Helios.QueryEdit.FieldByName('ID')<>nil) then
|
||||
if not(TryStrToInt(VarToStr(Helios.QueryEdit.FieldByName('ID').Value), idDZ)) then
|
||||
idDZ:= -1;
|
||||
finally
|
||||
end;
|
||||
|
||||
if (browID<>959) and (browID<>962) then // ne pro DObj
|
||||
begin
|
||||
try
|
||||
dpzOZ:= VarToStr(Helios.QueryEdit.FieldByName('DruhPohybuZbo').Value).ToInteger;
|
||||
finally
|
||||
end;
|
||||
try
|
||||
radaDZ:= VarToStr(Helios.QueryEdit.FieldByName('RadaDokladu').Value);
|
||||
finally
|
||||
end;
|
||||
end;
|
||||
|
||||
try
|
||||
if (Helios.QueryEdit.FieldByName('CisloOrg')<>nil) then
|
||||
if not(TryStrToInt(VarToStr(Helios.QueryEdit.FieldByName('CisloOrg').Value), cOrg)) then
|
||||
cOrg:= -1;
|
||||
finally
|
||||
end;
|
||||
try
|
||||
if not(TryStrToInt(VarToStr(Helios.QueryEdit.FieldByName('MistoUrceni').Value), cOrgMU)) then
|
||||
cOrgMU:= -1;
|
||||
finally
|
||||
end;
|
||||
try
|
||||
if not(TryStrToInt(VarToStr(Helios.QueryEdit.FieldByName('Prijemce').Value), cOrgPrijem)) then
|
||||
cOrgPrijem:= -1;
|
||||
finally
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
if FHelios.ExtKomID = Cplg_ExtKomID_EditorController then
|
||||
SpustControllerEditoru (FHelios)
|
||||
else
|
||||
if FHelios.ExtKomID = Cplg_ExtKomID_Zpravy then
|
||||
PluginKonfig.ExtKomIDJeRovnoNule (FHelios)
|
||||
else
|
||||
if FHelios.ExtKomID = Cplg_ExtKomID_Konfigurace then
|
||||
PluginKonfig.PluginConfiguration (FHelios)
|
||||
else
|
||||
begin
|
||||
apiMod:= false;
|
||||
datMod.apiMod:= apiMod;
|
||||
apiServer:= '';
|
||||
datMod.apiServer:= apiServer;
|
||||
with Helios.OpenSQL('SELECT CONVERT(nvarchar(255), Poznamka) AS Poznamka FROM ' + tblExtKomPar + ' WHERE IdExtKom=' + extId.ToString + ' AND Popis=N''APIServer''') do
|
||||
if (RecordCount=1) then
|
||||
if (VarToStr(FieldByNameValues('Poznamka'))<>'') then
|
||||
begin
|
||||
datMod.apiMod:= true;
|
||||
datMod.apiServer:= VarToStr(FieldByNameValues('Poznamka'));
|
||||
// fPekarna.apiMod:= datMod.apiMod;
|
||||
// fPekarna.apiServer:= datMod.apiServer;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
case typAkce of
|
||||
-1: begin
|
||||
Install (Helios)
|
||||
{
|
||||
else if extId = -2 then
|
||||
About (Helios)
|
||||
else
|
||||
Work (Helios);
|
||||
}
|
||||
end;
|
||||
|
||||
1: begin
|
||||
fPekarna:= TformPekarna.Create(nil);
|
||||
try
|
||||
try
|
||||
fPekarna.Helios:= Helios;
|
||||
fPekarna.apiMod:= apiMod;
|
||||
fPekarna.apiServer:= apiServer;
|
||||
fPekarna.ShowModal;
|
||||
except on E:Exception do
|
||||
if not(term) then
|
||||
begin
|
||||
errMsg:= 'Chyba fPekarna: ' + E.Message;
|
||||
Helios.Error(errMsg);
|
||||
raise Exception.Create(errMsg);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
fPekarna.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
2: begin
|
||||
if not((dpzOZ=4) and (radaDZ='231')) then
|
||||
Helios.Error(#1'Akci můžete spustit jen nad dokladem Výdejky/převodky řady 231'#1)
|
||||
else
|
||||
begin
|
||||
tBid:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT DPBID FROM ' + tblObecPrehled + ' WHERE NazevSys=N''hvw_Vyroba_Micharna_PozadavkyObj''');
|
||||
if (tBid>0) then
|
||||
begin
|
||||
lSQL:= 'DROP TABLE IF EXISTS #TabZapisPolozekOZ' + CRLF + 'CREATE TABLE #TabZapisPolozekOZ (ID INT IDENTITY(1,1) NOT NULL, IDPolozky INT NOT NULL, PRIMARY KEY (ID))' + CRLF;
|
||||
podm:= '(hvw_Vyroba_Micharna_PozadavkyObj.Blokovano=0 OR hvw_Vyroba_Micharna_PozadavkyObj.MnozKVydeji>0) AND hvw_Vyroba_Micharna_PozadavkyObj.Splneno=0';
|
||||
if Helios.Prenos2 (tBid, 'ID', 'ID', oVar1, oVar2, podm, 'Vyberte položky', false, true, false, 1) then
|
||||
begin
|
||||
arrId:= helUtils.StrToArrayInt (VarToStr(oVar1), ',');
|
||||
for i:=Low(arrId) to High(arrId) do
|
||||
lSQL:= lSQL + 'INSERT #TabZapisPolozekOZ (IDPolozky) SELECT ' + arrId[i].ToString + CRLF;
|
||||
end;
|
||||
if (helUtils.SQLObjectExists(Helios, 'dbo.ep_HDC_PZ_ZapisPolozek')) and (Length(arrId)>0) then
|
||||
begin
|
||||
lSQL:= lSQL + 'EXEC dbo.ep_HDC_PZ_ZapisPolozek @typ=1, @idDokladOZDst=' + idDZ.ToString; // 1=zapis z dbo._TabVyroba_Objednavky do dokladu OZ
|
||||
try
|
||||
Helios.ExecSQL(lSQL);
|
||||
except on E:Exception do
|
||||
Helios.Error(#1'Chyba zápisu položek:'#1 + CRLF + E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
3: begin
|
||||
fRamcovyPlan:= TformRamcovyPlan.Create (nil);
|
||||
try
|
||||
fRamcovyPlan.Helios:= Helios;
|
||||
fRamcovyPlan.ShowModal;
|
||||
finally
|
||||
fRamcovyPlan.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
101: begin
|
||||
fPlan:= TformPlan.Create (nil);
|
||||
try
|
||||
try
|
||||
fPlan.Helios:= Helios;
|
||||
fPlan.ShowModal;
|
||||
except on E:Exception do
|
||||
if not(term) then
|
||||
begin
|
||||
errMsg:= 'Chyba fPlan: ' + E.Message;
|
||||
Helios.Error(errMsg);
|
||||
raise Exception.Create(errMsg);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(fPlan);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
Helios.Refresh(true);
|
||||
if (contInfo='NULL') then
|
||||
Helios.ExecSQL('SET CONTEXT_INFO 0x')
|
||||
else
|
||||
Helios.ExecSQL('SET CONTEXT_INFO 0x' + contInfo);
|
||||
|
||||
// ukoncit Helios, lze pouzit v Automatech
|
||||
if (term) then
|
||||
Application.Terminate;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
finally
|
||||
SpravceHeliosu.OdeberHelios (FHelios);
|
||||
end;
|
||||
except
|
||||
// neni to pres Application.HandleException() kvuli probublani vyjimky
|
||||
// do Heliosu (konkretni pouziti napr. v Automatu)
|
||||
on E: EExternal do
|
||||
begin
|
||||
LockWindowUpdate(0); // jistota, kdyby nekde zustalo viset
|
||||
raise EExternal.Create(E.Message);
|
||||
end;
|
||||
|
||||
on E: Exception do
|
||||
begin
|
||||
LockWindowUpdate(0); // jistota, kdyby nekde zustalo viset
|
||||
E.Message:= plgPrelozException(E.Message);
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
// param plugin ????
|
||||
procedure TPlgHDCRootvinParams.Run (const Helios: IHelios);
|
||||
var lSQL: string;
|
||||
begin
|
||||
lSQL:= 'DECLARE @p1 NVARCHAR(10)=N''''' + CRLF
|
||||
+ 'IF OBJECT_ID(N''tempdb..#TabExtKomParPlugin'',''U'') IS NOT NULL' + CRLF
|
||||
+ ' SELECT TOP(1) @p1=HIQPar1 FROM #TabExtKomParPlugin' + CRLF
|
||||
+ 'SELECT @p1 AS Par1';
|
||||
with Helios.OpenSQL(lSQL) do
|
||||
Helios.Info('Par1: ' + VarToStr(FieldByName('Par1').Value));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{ =========================================================================== }
|
||||
|
||||
function PluginGetSysAndClassName(Vysl: PAnsiChar): DWORD; stdcall;
|
||||
begin
|
||||
with PluginKonfig do
|
||||
begin
|
||||
Result := Length(PluginSystemoveJmeno + '.' + PluginClassName);
|
||||
if Assigned(Vysl) then
|
||||
System.AnsiStrings.StrPCopy(Vysl, AnsiString(PluginSystemoveJmeno + '.' + PluginClassName));
|
||||
end;
|
||||
end;
|
||||
|
||||
{ --------------------------------------------------------------------------- }
|
||||
(*
|
||||
procedure PluginGetDelphiVersion(Vysl: PAnsiChar); stdcall;
|
||||
var
|
||||
LVer: AnsiString;
|
||||
begin
|
||||
if Assigned(Vysl) then
|
||||
begin
|
||||
{$IFDEF VER220} { Embarcadero Delphi 15 XE}
|
||||
LVer := 'XE';
|
||||
{$ELSE}
|
||||
{$IFDEF VER240} { Embarcadero Delphi 17 XE3}
|
||||
LVer := 'XE3';
|
||||
{$ELSE}
|
||||
LVer := '??';
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
StrPCopy(Vysl, LVer);
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
{ --------------------------------------------------------------------------- }
|
||||
|
||||
procedure PluginReadyForSilentInstall; stdcall;
|
||||
begin
|
||||
// nic, pouze flag pro pouziti tiche instalace
|
||||
end;
|
||||
|
||||
{ --------------------------------------------------------------------------- }
|
||||
|
||||
// AJ, 8.12.2015 - Administrátorská podpora v HeO
|
||||
procedure PluginReadyForSuperSilentInstall; stdcall;
|
||||
begin
|
||||
// nic, pouze flag pro použití super tiché instalace (tj. instalace, která požírá SQL raiserrory, hlášky a chyby a vše zaloguje do logu)
|
||||
end;
|
||||
|
||||
{ --------------------------------------------------------------------------- }
|
||||
|
||||
exports
|
||||
DllGetClassObject,
|
||||
DllCanUnloadNow,
|
||||
DllRegisterServer,
|
||||
DllUnregisterServer,
|
||||
PluginGetSysAndClassName,
|
||||
// PluginGetDelphiVersion,
|
||||
PluginReadyForSilentInstall,
|
||||
PluginReadyForSuperSilentInstall // AJ, 8.12.2015 - Administrátorská podpora v HeO
|
||||
;
|
||||
|
||||
initialization
|
||||
TComObjectFactory.Create(ComServer, TPlgHDCRootvin, PluginKonfig.PluginClass_ID, PluginKonfig.PluginClassName, '', ciMultiInstance, tmSingle);
|
||||
// TComObjectFactory.Create(ComServer, TPlgHDCRootvin, plgHDCRTN_class, 'run', '', ciMultiInstance, tmSingle);
|
||||
// TComObjectFactory.Create(ComServer, TPlgHDCRootvinParams, plgHDCRTNParams_class, 'params', '', ciMultiInstance, tmSingle);
|
||||
END.
|
||||
Reference in New Issue
Block a user