478 lines
15 KiB
ObjectPascal
478 lines
15 KiB
ObjectPascal
unit ComObjekt;
|
||
|
||
interface
|
||
|
||
uses System.SysUtils, System.Win.ComObj, ddPlugin_TLB;
|
||
|
||
const
|
||
Class_plgPolanskych: TGUID = '{0E52DB47-274A-44D3-A492-85BD0BE8760E}';
|
||
|
||
type
|
||
TUctenkaVydejItem = record
|
||
id, idZboSklad, idUctoR: integer;
|
||
jcEvid, jcJC: single;
|
||
end;
|
||
|
||
TUctenkaItem = record
|
||
id, idZboSklad, idKmen, idUctoR: integer;
|
||
isVyrobek: boolean;
|
||
rada: string;
|
||
mnozstvi, jcEvid, jcJC: single;
|
||
end;
|
||
|
||
TUctenkaHlava = record
|
||
id, typDokladu: integer;
|
||
rada: string;
|
||
vydejkyItems: TArray<TUctenkaVydejItem>;
|
||
end;
|
||
|
||
TUctenkaDoklad = record
|
||
id, druhPohybu, vstupniCena: integer;
|
||
mena, doklad: string;
|
||
kurz, jednotkaMeny, kurzEuro: single;
|
||
end;
|
||
|
||
TplgPolanskych = class(TComObject, IHePlugin)
|
||
private
|
||
procedure Run(const Helios: IHelios); safecall;
|
||
public
|
||
function KontrolyLikvidaceOK(const Helios: IHelios): boolean; safecall;
|
||
procedure VytvorStornoVydejky (const Helios: IHelios; const idDZ: integer); safecall;
|
||
procedure VytvorVydejkaDoSpotreby (const Helios: IHelios; const idDZ: integer); safecall;
|
||
procedure ZrusCertifikatEETTrzby (const Helios: IHelios; arrID: TArray<integer>); safecall;
|
||
procedure OdeslatEmail(const Helios: IHelios; idDZ: integer; idTiskFrm: integer); safecall;
|
||
end;
|
||
|
||
|
||
|
||
implementation
|
||
|
||
uses System.Win.ComServ, System.Variants, System.StrUtils, System.UITypes, Vcl.Themes, Vcl.Forms,
|
||
frmOrder, frmOrder2, frmOrder21024, frmOrder21366, frmLikvidace, frmLikvidace1024, frmPrijem, frmPrijem1024,
|
||
frmZamena,
|
||
helUtils, myUtils;
|
||
|
||
var
|
||
oVar1, oVar2: OleVariant;
|
||
jeTest: boolean;
|
||
stylWin10: TStyleManager.TStyleServicesHandle;
|
||
delkaPoradCisla: byte;
|
||
|
||
|
||
|
||
|
||
procedure TplgPolanskych.OdeslatEmail(const Helios: IHelios; idDZ: Integer; idTiskFrm: Integer);
|
||
var lSQL: string;
|
||
begin
|
||
if (idDZ>0) and (idTiskFrm>0) then
|
||
begin
|
||
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
function TplgPolanskych.KontrolyLikvidaceOK(const Helios: IHelios): Boolean;
|
||
var lSQL: string;
|
||
begin
|
||
{
|
||
result:= false;
|
||
|
||
lSQL:= 'SELECT ID FROM ' + tblKZ + ' WHERE Aktu'
|
||
with Helios.OpenSQL(lSQL) do
|
||
if (RecordCount=0) then
|
||
}
|
||
result:= true;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TplgPolanskych.VytvorVydejkaDoSpotreby (const Helios: IHelios; const idDZ: integer);
|
||
var lSQL: string;
|
||
uct: TUctenkaHlava;
|
||
begin
|
||
uct.id:= idDZ;
|
||
uct.rada:= '';
|
||
uct.typDokladu:= helUtils.getHeliosIntVal(Helios, -1, 'SELECT TypDokladu FROM ' + tblUctenkaH + ' WHERE ID=' + idDZ.ToString);
|
||
if (uct.typDokladu=1) or (uct.typDokladu=2) then
|
||
begin
|
||
uct.rada:= helUtils.getHeliosStrVal(Helios, '', 'SELECT Rada FROM ' + tblUctenkaH + ' WHERE ID=' + idDZ.ToString);
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TplgPolanskych.VytvorStornoVydejky(const Helios: IHelios; const idDZ: integer);
|
||
var uct: TUctenkaHlava;
|
||
itm: TUctenkaItem;
|
||
begin
|
||
uct.id:= idDZ;
|
||
uct.rada:= '';
|
||
uct.typDokladu:= helUtils.getHeliosIntVal(Helios, -1, 'SELECT TypDokladu FROM ' + tblUctenkaH + ' WHERE ID=' + idDZ.ToString);
|
||
if (uct.typDokladu=1) or (uct.typDokladu=2) then
|
||
begin
|
||
uct.rada:= helUtils.getHeliosStrVal(Helios, '', 'SELECT Rada FROM ' + tblUctenkaH + ' WHERE ID=' + idDZ.ToString);
|
||
with Helios.OpenSQL('SELECT * FROM ' + tblUctenkaR + ' WHERE IDHlava=' + idDZ.ToString + ' ORDER BY PoradiPolozky') do
|
||
begin
|
||
First;
|
||
while not(EOF) do
|
||
begin
|
||
itm.id:= StrToInt(VarToStr(FieldByNameValues('ID')));
|
||
itm.idZboSklad:= StrToInt(VarToStr(FieldByNameValues('IDZboSklad')));
|
||
itm.idKmen:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT IDKmenZbozi FROM ' + tblSS + ' WHERE ID=' + itm.idZboSklad.ToString);
|
||
itm.mnozstvi:= StrToFloat(VarToStr(FieldByNameValues('Mnozstvi')));
|
||
// itm.isVyrobek
|
||
itm.jcEvid:= StrToFloat(VarToStr(FieldByNameValues('ID')));
|
||
itm.jcJC:= StrToFloat(VarToStr(FieldByNameValues('ID')));
|
||
Next;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TplgPolanskych.ZrusCertifikatEETTrzby(const Helios: IHelios; arrID: TArray<integer>);
|
||
var lSQL: string;
|
||
i: Integer;
|
||
begin
|
||
lSQL:= '';
|
||
for i:=0 to Length(arrID)-1 do
|
||
begin
|
||
lSQL:= 'UPDATE dbo.TabEETTrzba SET SCertByName=NULL, SCertSN=NULL, SCertStoreLocation=NULL, SCertStoreName=NULL, Pocitac=N'''' WHERE ID=' + arrID[i].ToString ;
|
||
Helios.ExecSQL(lSQL);
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
procedure TplgPolanskych.Run(const Helios: IHelios);
|
||
const MinVerzeHeO = $030020220300;
|
||
var sql, IDcka, podm: string;
|
||
params, vlastTbl, vlastTbl2, verText: string;
|
||
browId, typAkce, cRec, cntID, l_loop, scrW: integer;
|
||
arrId: TArray<integer>;
|
||
contInfo, sTmp1, sTmp2: string;
|
||
fOrd: TformOrder;
|
||
fOrd2: TformOrder2;
|
||
fOrd21024: TformOrder21024;
|
||
fOrd21366: TformOrder21366;
|
||
fLikv: TformLikvidace;
|
||
fLikv1024: TformLikvidace1024;
|
||
fPrij: TformPrijem;
|
||
fPrij1024: TformPrijem1024;
|
||
fZamena: TformZamena;
|
||
begin
|
||
// Application.Handle:= Helios.MainApplicationHandle;
|
||
// Application.Icon.Handle:= Helios.MainApplicationIconHandle;
|
||
|
||
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 0x' + StringToHex2('HDC - plgPolanskych')); // nastav context v sys.sysprocesses
|
||
|
||
verText:= StringReplace(GetFileVersion2(GetModuleName(HInstance)),'.','',[rfReplaceAll]);
|
||
verText:= '0300' + MidStr(verText,3,8);
|
||
if Length(verText)=11 then
|
||
verText:= LeftStr(verText,8) + '0' + RightStr(verText,3);
|
||
|
||
{$REGION 'Region - zjistit jeTest, typAkce, browID, vlastTbl, vytvor #TabExtKom'}
|
||
jeTest:= false;
|
||
typAkce:= 0;
|
||
vlastTbl:= '';
|
||
vlastTbl2:= '';
|
||
params:= '';
|
||
with Helios.OpenSQL('SELECT Parametry FROM TabExtKom WHERE ID=' + IntToStr(Helios.ExtKomID)) do
|
||
begin
|
||
params:= VarToStr(FieldValues(0));
|
||
jeTest:= ContainsText(params, ';test');
|
||
|
||
if Pos(';',params)>0 then
|
||
begin
|
||
typAkce:= StrToInt(LeftStr(params, Pos(';', params)-1));
|
||
params:= MidStr(params,Pos(';',params)+1,255);
|
||
if (Pos(';',params)>0) then
|
||
begin
|
||
if not(TryStrToInt(LeftStr(params, Pos(';', params)-1), browId)) then
|
||
browID:= 0;
|
||
end
|
||
else
|
||
if not(TryStrToInt(params, browId)) then
|
||
browID:= 0;
|
||
if (Pos(';', params)>0) then // zadany 3 parametry (akce, browID, vlastnikID)
|
||
begin
|
||
params:= MidStr(params, Pos(';', params)+1,255);
|
||
vlastTbl:= params;
|
||
if (Pos(';', vlastTbl)>0) then
|
||
begin
|
||
vlastTbl:= LeftStr(vlastTbl, Pos(';', vlastTbl)-1);
|
||
vlastTbl2:= MidStr(vlastTbl, Pos(';', vlastTbl)+1,255);
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
raise Exception.Create('Nem<65>m pot<6F>ebn<62> po<70>et parametr<74> !');
|
||
end;
|
||
|
||
sql:= 'IF OBJECT_ID(N''tempdb..#TabExtKom'', N''U'') IS NOT NULL DROP TABLE #TabExtKom' + CRLF;
|
||
sql:= sql + 'CREATE TABLE #TabExtKom (Poznamka nvarchar(255) NOT NULL, Typ TINYINT)';
|
||
Helios.ExecSQL(sql);
|
||
{$ENDREGION}
|
||
|
||
if (Helios.HeVersion<MinVerzeHeO) then
|
||
raise Exception.Create('Plugin vy<76>aduje min verzi Heliosu ' + IntToHex(MinVerzeHeO, 12));
|
||
|
||
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, 20*1024)
|
||
end
|
||
else
|
||
arrID[l_loop]:= StrToInt(IDcka);
|
||
end;
|
||
cRec:= arrID[0];
|
||
end;
|
||
|
||
vlastTbl:= vlastTbl.Replace('''', '').Replace(';','');
|
||
|
||
scrW:= Screen.WorkAreaWidth;
|
||
|
||
case typAkce of
|
||
1: begin
|
||
sql:= 'SELECT s.ID FROM ' + tblStrom + ' s LEFT JOIN ' + tblStromE + ' se ON (se.ID=s.ID) WHERE s.Cislo=N';
|
||
sql:= sql + Helios.Sklad.QuotedString + ' AND ISNULL(se._App_Objednavka,0)=1';
|
||
with Helios.OpenSQL(sql) do
|
||
if (RecordCount>0) then
|
||
begin
|
||
helUtils.waitStart(nil, 'Na<4E><61>t<EFBFBD>m historick<63> data...', 0, 0);
|
||
if (scrW>1020) and (scrW<1030) then
|
||
begin
|
||
fOrd21024:= TformOrder21024.Create(nil);
|
||
try
|
||
fOrd21024.Helios:= Helios;
|
||
fOrd21024.jeTest:= jeTest;
|
||
fOrd21024.oznacKOdeslani:= (vlastTbl='1');
|
||
fOrd21024.ShowModal;
|
||
finally
|
||
fOrd21024.Free;
|
||
end;
|
||
end
|
||
else
|
||
if (scrW>1360) and (scrW<1380) then
|
||
begin
|
||
fOrd21366:= TformOrder21366.Create(nil);
|
||
try
|
||
fOrd21366.Helios:= Helios;
|
||
fOrd21366.jeTest:= jeTest;
|
||
fOrd21366.oznacKOdeslani:= (vlastTbl='1');
|
||
fOrd21366.ShowModal;
|
||
finally
|
||
fOrd21366.Free;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
fOrd2:= TformOrder2.Create(nil);
|
||
try
|
||
fOrd2.Helios:= Helios;
|
||
fOrd2.jeTest:= jeTest;
|
||
fOrd2.oznacKOdeslani:= (vlastTbl='1');
|
||
fOrd2.ShowModal;
|
||
finally
|
||
fOrd2.Free;
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
Helios.Error('Na tomto sklad<61> nen<65> aplikace Objedn<64>vka povolena.');
|
||
|
||
helUtils.waitEnd;
|
||
end;
|
||
|
||
2: begin
|
||
if (Length(arrID)>1) then
|
||
Helios.Error(#1'Akci lze spustit pouze nad jednim dokladem'#1)
|
||
else
|
||
VytvorStornoVydejky(Helios, cRec);
|
||
end;
|
||
|
||
3: begin
|
||
if Length(arrId)>0 then
|
||
ZrusCertifikatEETTrzby(Helios, arrID);
|
||
end;
|
||
|
||
4: begin // z <20><>tenky generuj v<>d/stor (plg)
|
||
if (Length(arrID)>1) then
|
||
Helios.Error(#1'Akci lze spustit pouze nad jednim dokladem'#1)
|
||
else
|
||
// VytvorVydejkaDoSpotreby(Helios, cRec);
|
||
if (vlastTbl<>'') and (LeftStr(vlastTbl,4)='dbo.') then
|
||
try
|
||
sql:= 'IF OBJECT_ID(N' + vlastTbl.QuotedString + ', N''P'') IS NOT NULL EXEC ' + vlastTbl + ' ' + cRec.ToString;
|
||
if (vlastTbl2<>'') then
|
||
sql:= sql + ', ' + vlastTbl2;
|
||
Helios.ExecSQL(sql);
|
||
except on E:Exception do
|
||
Helios.Error(#1'Chyba HDC plg (4) - '#1 + E.Message);
|
||
end;
|
||
end;
|
||
|
||
5: begin
|
||
// if (KontrolyLikvidaceOK(Helios)) then
|
||
begin
|
||
sql:= 'SELECT s.ID FROM ' + tblStrom + ' s LEFT JOIN ' + tblStromE + ' se ON (se.ID=s.ID) WHERE s.Cislo=N';
|
||
sql:= sql + Helios.Sklad.QuotedString + ' AND ISNULL(se._App_Likvidace,0)=1';
|
||
with Helios.OpenSQL(sql) do
|
||
if (RecordCount>0) then
|
||
begin
|
||
helUtils.waitStart(nil, 'Na<4E><61>t<EFBFBD>m data skladu...', 0, 0);
|
||
if (scrW>1020) and (scrW<1030) then
|
||
begin
|
||
fLikv1024:= TformLikvidace1024.Create(nil);
|
||
try
|
||
fLikv1024.Helios:= Helios;
|
||
fLikv1024.jeTest:= jeTest;
|
||
fLikv1024.ShowModal;
|
||
finally
|
||
fLikv1024.Free;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
fLikv:= TformLikvidace.Create(nil);
|
||
try
|
||
fLikv.Helios:= Helios;
|
||
fLikv.jeTest:= jeTest;
|
||
fLikv.ShowModal;
|
||
finally
|
||
fLikv.Free;
|
||
end;
|
||
end
|
||
end
|
||
else
|
||
Helios.Error('Na tomto sklad<61> nen<65> aplikace Likvidace povolena.');
|
||
helUtils.waitEnd;
|
||
end;
|
||
end;
|
||
|
||
6: begin
|
||
sql:= 'SELECT ID FROM ' + tblPZ + ' WHERE DruhPohybuZbo=6 AND IDDoklad=' + cRec.ToString;
|
||
with Helios.OpenSQL(sql) do
|
||
if (RecordCount>0) then
|
||
begin
|
||
sql:= 'SELECT p.ID FROM ' + tblPZ + ' p LEFT JOIN ' + tblPZe + ' pe ON (pe.ID=p.ID) INNER JOIN ' + tblDZ + ' d ON (d.ID=p.IDDoklad) WHERE d.DruhPohybuZbo=6 AND d.ID=' + cRec.ToString;
|
||
sql:= sql + ' AND (p.Mnozstvi-p.MnOdebrane-p.MnozstviStorno)>0 AND d.Splneno=0';
|
||
with Helios.OpenSQL(sql) do
|
||
if (RecordCount=0) then
|
||
begin
|
||
Helios.Error(#1'Vydan<61> objedn<64>vka je pln<6C> p<>evedena do p<><70>jemky, akci nelze opakovat.'#1);
|
||
Exit;
|
||
end;
|
||
|
||
helUtils.waitStart(nil, 'Na<4E><61>t<EFBFBD>m data objedn<64>vky...', 0, 0);
|
||
if (scrW>1020) and (scrW<1030) then
|
||
begin
|
||
fPrij1024:= TformPrijem1024.Create(nil);
|
||
try
|
||
fPrij1024.idDZ:= cRec;
|
||
fPrij1024.Helios:= Helios;
|
||
fPrij1024.jeTest:= jeTest;
|
||
fPrij1024.ShowModal;
|
||
finally
|
||
fPrij1024.Free;
|
||
end;
|
||
end
|
||
else
|
||
if (scrW>1360) then
|
||
begin
|
||
fPrij:= TformPrijem.Create(nil);
|
||
try
|
||
fPrij.idDZ:= cRec;
|
||
fPrij.Helios:= Helios;
|
||
fPrij.jeTest:= jeTest;
|
||
fPrij.ShowModal;
|
||
finally
|
||
fPrij.Free;
|
||
end;
|
||
end;
|
||
helUtils.waitEnd;
|
||
end
|
||
else
|
||
Helios.Error(#1'! Na dokladu Vydan<61> objedn<64>vky nejsou polo<6C>ky !'#1);
|
||
end;
|
||
|
||
7: begin
|
||
sql:= 'SELECT s.ID FROM ' + tblStrom + ' s LEFT JOIN ' + tblStromE + ' se ON (se.ID=s.ID) WHERE s.Cislo=N';
|
||
sql:= sql + Helios.Sklad.QuotedString + ' AND ISNULL(se._App_Zamena,0)=1';
|
||
with Helios.OpenSQL(sql) do
|
||
if (RecordCount>0) then
|
||
begin
|
||
fZamena:= TformZamena.Create(nil);
|
||
try
|
||
fZamena.Helios:= Helios;
|
||
fZamena.jeTest:= jeTest;
|
||
fZamena.ShowModal;
|
||
finally
|
||
fZamena.Free;
|
||
end;
|
||
end
|
||
else
|
||
Helios.Error('Na tomto sklad<61> nen<65> aplikace Z<>m<EFBFBD>na povolena.');
|
||
end;
|
||
|
||
8: begin
|
||
if (cRec>0) then
|
||
begin
|
||
try
|
||
Helios.ExecSQL('IF OBJECT_ID(N''dbo.ep_HDC_NavazneDoklady'', N''P'') IS NOT NULL EXEC dbo.ep_HDC_NavazneDoklady @IDSrc=' + cRec.ToString);
|
||
Helios.OpenBrowse(231, '');
|
||
except
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
Helios.Refresh(true);
|
||
if (contInfo='NULL') then
|
||
Helios.ExecSQL('SET CONTEXT_INFO 0x00')
|
||
else
|
||
Helios.ExecSQL('SET CONTEXT_INFO 0x' + contInfo); // vymaz context v sys.sysprocesses
|
||
end;
|
||
|
||
initialization
|
||
TComObjectFactory.Create(ComServer, TplgPolanskych, Class_plgPolanskych, 'runMe', '', ciMultiInstance, tmSingle);
|
||
TStyleManager.SystemHooks := [];
|
||
// stylWin10:= TStyleManager.LoadFromResource(HInstance, 'stylWin10Blue');
|
||
// TStyleManager.SetStyle(stylWin10);
|
||
|
||
finalization
|
||
|
||
end.
|