888 lines
28 KiB
ObjectPascal
888 lines
28 KiB
ObjectPascal
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_Doklady_PomocPrijemka');
|
|
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_Vyroba_GenObjednavkuMatDoVyroby');
|
|
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');
|
|
arrDefs.Add('trg__TabPrikazMzdyAZmetky_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_ObjednavkyMat''');
|
|
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_ObjednavkyMat.Blokovano=0 OR hvw_Vyroba_ObjednavkyMat.MnozKVydeji>0) AND hvw_Vyroba_ObjednavkyMat.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.
|