Files
MONTEKORD-plgHDCMontekord/ComObjekt.pas
T
2026-04-20 16:57:38 +02:00

974 lines
38 KiB
ObjectPascal

unit ComObjekt;
{$I HeODefine.inc}
INTERFACE
uses System.Win.ComObj, System.Classes, System.StrUtils, System.SysUtils, ddPlugin_TLB, Winapi.Windows;
const
Class_Monte: TGUID = '{32EAE564-687F-475D-9CFC-49F18260D835}';
CRLF = #13#10;
clRed = $0000FF;
tblImpKusXLS = '[dbo].[_HDC_ImportKusovnikXLS]';
BrowseID_PluginInfo = 871;
type
TKmen = record
poz, idKmen, vyrobceCisOrg: integer;
cislo, nazev, vyrobce, norma, rozmer, material, pu, pozn, jakObj: string;
mnoz: Extended;
{$IF CompilerVersion>=34} // Sydney a vys
class operator Initialize (out Dest: TKmen);
{$ENDIF}
end;
TKmenHelper = record helper for TKmen
function Clear: Boolean;
end;
// !!! pri zmene IHePluginXX upravit take v plgAbout - info o jadru !!!
TplgHDCMontekord = class(TComObject, {$IFDEF IHePlugin3} IHePlugin3 {$ELSE} IHePlugin {$ENDIF})
protected
// function DelphiCompilerVersion: Single; safecall;
// function PartnerIdentification: WideString; safecall;
procedure Run (const Helios: IHelios); safecall;
private
FHelios: IHelios;
procedure OnException (Sender: TObject; E: Exception);
public
procedure ImportKusovniku (const Helios: IHelios); safecall;
end;
IMPLEMENTATION
uses System.Variants, Vcl.Controls, System.Win.ComServ, System.Types, Vcl.Forms, Winapi.ShlObj, Vcl.Dialogs,
Vcl.StdCtrls, System.DateUtils, Vcl.Clipbrd,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MSSQL, FireDAC.Phys.MSSQLDef, FireDAC.VCLUI.Wait,
FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Phys.ODBCBase, Data.DB,
FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.Comp.UI,
frmImportKusovnik,
{$IFDEF Helios_Space}
plgKonfig, plgType, plgMain, plgSpravce,
// [RK 13.04.2012] nove komponenty DevExpress toto vyzaduji, jinak zatuhne Helios
dxGDIPlusAPI, dxCore, {!initialization!}
{$ENDIF}
nExcel, xlsxwrite, helUtils;
var HeliosX: IHelios;
oVar1, oVar2: OleVariant;
LocalFormatSettings: TFormatSettings;
jeTest: boolean;
bidPrednaOpAll: integer;
cestaExport, verText: string;
kartyImport: TArray<TKmen>;
vTab, vTab2: TFDMemTable;
ds, ds2: TDataSource;
sql, sql2: TFDQuery;
function NullOrQuotedString(inStr: string): string;
begin
inStr:= Trim(inStr);
if (inStr='') then
result:= 'NULL'
else
result:= QuotedStr(inStr);
end;
{ TKmenHelper }
function TKmenHelper.Clear: Boolean;
begin
result:= true;
try
self.idKmen:= 0;
self.poz:= 0;
self.vyrobceCisOrg:= 0;
self.mnoz:= 0;
self.cislo:= '';
self.nazev:= '';
self.vyrobce:= '';
self.norma:= '';
self.jakObj:= '';
self.rozmer:= '';
self.material:= '';
self.pu:= '';
self.pozn:= '';
except
result:= false;
end;
end;
{$IF CompilerVersion>=34} // Sydney a vys
class operator TKmen.Initialize (out Dest: TKmen);
begin
Dest.idKmen:= 0;
Dest.poz:= 0;
Dest.vyrobceCisOrg:= 0;
Dest.mnoz:= 0;
Dest.cislo:= '';
Dest.nazev:= '';
Dest.vyrobce:= '';
Dest.norma:= '';
Dest.rozmer:= '';
Dest.material:= '';
Dest.pu:= '';
Dest.pozn:= '';
Dest.jakObj:= '';
end;
{$ENDIF}
function VyberAdresar (var Foldr: string; Title: string): Boolean;
var BrowseInfo: TBrowseInfo;
ItemIDList: PItemIDList;
DisplayName: array[0..MAX_PATH] of Char;
begin
Result := False;
FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pszDisplayName := @DisplayName[0];
lpszTitle := PChar(Title);
ulFlags := BIF_RETURNONLYFSDIRS;
end;
ItemIDList := SHBrowseForFolder(BrowseInfo);
if Assigned(ItemIDList) then
if SHGetPathFromIDList(ItemIDList, DisplayName) then
begin
Foldr := DisplayName;
Result := True;
end;
end;
function OtevriSoubor (flt1,flt2: string; var nazev: string): Boolean;
var dlgOpenW7: TFileOpenDialog; // dialog pro Windows Vista a novejsi
titulek, filtr1, filtr2: string;
iniDir: string;
begin
result:= false;
titulek:= 'Vyberte soubor pro import';
filtr1:= IfThen(flt1<>'',flt1,'XLS/X soubory');
filtr2:= IfThen(flt2<>'',flt2,'*.xls, *.xlsx');
nazev:= '';
iniDir:= GetEnvironmentVariable('USERPROFILE') + '\Desktop';
try
dlgOpenW7:= TFileOpenDialog.Create(nil);
dlgOpenW7.Title:= titulek;
dlgOpenW7.OkButtonLabel:= 'Vybrat';
with dlgOpenW7.FileTypes.Add do
begin
DisplayName:= filtr1;
FileMask:= filtr2;
end;
dlgOpenW7.DefaultFolder:= iniDir;
if dlgOpenW7.Execute then
begin
nazev:= dlgOpenW7.FileName;
result:= true;
end;
finally
dlgOpenW7.Free;
end;
end;
procedure TplgHDCMontekord.OnException (Sender: TObject; E: Exception);
begin
try
LockWindowUpdate (0);
{$IFDEF Helios_Space}
FHelios.Error (plgPrelozException (E.Message));
{$ENDIF}
except
Vcl.Forms.Application.ShowException (E); //pro jistotu
end;
end;
procedure TplgHDCMontekord.ImportKusovniku (const Helios: IHelios);
var lSQL, lSQL2, podm: string;
xls: IXLSWorkBook;
shKarty: IXLSWorksheet;
karta: TKmen;
iTemp, idKZ, idKZFin: integer;
sTemp: string;
filtr1, filtr2, fName, colName, readVal, lastNRC, lastVRC, rcFin: string;
insId, idxR, iRowMax, iCol, iColMax, cEmptyRadek: integer;
mnoz, ztraty: Extended;
i_Poz, i_CisloDilu, i_Nazev, i_Ks, i_Vyrobce, i_Norma, i_Rozmer, i_Material, i_PU, i_ziskani, i_pozn: integer;
radekV00: boolean;
begin
filtr1:= 'Sešit MS Excel 2003-2019';
filtr2:= '*.xls;*.xlsx;';
if OtevriSoubor(filtr1, filtr2, fName) then
if (FileExists(fName)) then
begin
Screen.Cursor:= crHourGlass;
xls:= TXLSWorkbook.Create;
try
xls.Open(fName);
shKarty:= xls.Sheets.Entries[1];
i_Poz:= 0;
lastNRC:= '';
lastVRC:= '';
iRowMax:= 0;
cEmptyRadek:= 0;
try
for idxR:=1 to 60000 do
begin
if (cEmptyRadek>5) then
begin
iRowMax:= idxR;
Break;
end;
if (VarIsNull(shKarty.Cells.Item[idxR, 1].Value)) then
Inc(cEmptyRadek)
else
if (VarToStr(shKarty.Cells.Item[idxR, 1].Value)='') then
Inc(cEmptyRadek)
else
cEmptyRadek:= 0;
end;
except on E:Exception do
Helios.Error(#1'idxR: ' + idxR.ToString + CRLF + E.Message + #1)
end;
for idxR:=iRowMax downto 1 do
begin
if (not VarIsNull(shKarty.Cells.Item[idxR, 1].Value)) then
if (VarToStr(shKarty.Cells.Item[idxR, 1].Value)<>'') then
begin
iRowMax:= idxR;
Break;
end;
end;
if (iRowMax>1) then
begin
rcFin:= '';
if (jeTest) then
begin
lSQL:= 'IF OBJECT_ID(N''dbo._TabHDCKusovnik'', N''U'') IS NULL' + CRLF;
lSQL:= lSQL + ' CREATE TABLE dbo._TabHDCKusovnik (ID INT IDENTITY(1,1) NOT NULL, IDKmenVyssi INT, IDKmenNizsi INT, Pozice SMALLINT, CisloDilu NVARCHAR(50)';
lSQL:= lSQL + ', Nazev NVARCHAR(100), Mnozstvi NUMERIC(19,6) NOT NULL DEFAULT 0.0, Vyrobce NVARCHAR(100), CisOrgDod INT, Norma NVARCHAR(100), Rozmer NVARCHAR(50), Material NVARCHAR(50)';
lSQL:= lSQL + ', PovrchovaUprava NVARCHAR(100), JakZiskat NVARCHAR(50), Poznamka NVARCHAR(500) )' + CRLF;
lSQL:= lSQL + ' ELSE TRUNCATE TABLE dbo._TabHDCKusovnik';
end
else
begin
lSQL:= 'DROP TABLE IF EXISTS #TabHDCKusovnik' + CRLF;
lSQL:= lSQL + 'CREATE TABLE #TabHDCKusovnik (ID INT IDENTITY(1,1) NOT NULL, IDKmenVyssi INT, IDKmenNizsi INT, Pozice SMALLINT, CisloDilu NVARCHAR(50)';
lSQL:= lSQL + ', Nazev NVARCHAR(100), Mnozstvi NUMERIC(19,6) NOT NULL DEFAULT 0.0, Vyrobce NVARCHAR(100), CisOrgDod INT, Norma NVARCHAR(100), Rozmer NVARCHAR(50), Material NVARCHAR(50)';
lSQL:= lSQL + ', PovrchovaUprava NVARCHAR(100), JakZiskat NVARCHAR(50), Poznamka NVARCHAR(500) )' + CRLF;
end;
Helios.ExecSQL(lSQL);
for iCol:=1 to 30 do
begin
{
if (VarIsNull(shKarty.Cells.Item[1, iCol].Value)) then
begin
iColMax:= iCol-1;
Break;
end;
if (VarToStr(shKarty.Cells.Item[1, iCol].Value)='') then
begin
iColMax:= iCol-1;
Break;
end;
}
if (shKarty.Cells.Item[1, iCol].Value='POZ') then
i_Poz:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='Číslo dílu') then
i_CisloDilu:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='Název') then
i_Nazev:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='KS') then
i_Ks:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='Výrobce') then
i_Vyrobce:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='NORMA') then
i_Norma:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='ROZMĚR') then
i_Rozmer:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='MATER.') then
i_Material:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='PÚ') then
i_PU:= iCol;
if (shKarty.Cells.Item[1, iCol].Value='získání') then
i_ziskani:= iCol;
if (VarToStr(shKarty.Cells.Item[1, iCol].Value).Trim='Pozn před') then
i_pozn:= iCol;
end;
if (i_Poz=0) or (i_CisloDilu=0) or (i_Norma=0) then
begin
Helios.Error(#1'Tabulka není v požadovaném formátu'#1);
Exit;
end;
if (i_Poz>0) and (i_CisloDilu>0) and (i_Norma>0) then
begin
// helUtils.waitStart(nil, 'Import dat...', iRowMax, clRed);
vTab:= TFDMemTable.Create(nil);
try
with vTab do
begin
FieldDefs.Add('vPoz', ftInteger, 0, true);
FieldDefs.Add('vCisloDilu', ftString, 50, true);
FieldDefs.Add('vNazev', ftString, 100, true);
FieldDefs.Add('vKs', ftFloat, 0, true);
FieldDefs.Add('vVyrobce', ftString, 100, false);
FieldDefs.Add('vCisOrgDod', ftInteger, 0, false);
FieldDefs.Add('vNorma', ftString, 100, false);
FieldDefs.Add('vRozmer', ftString, 100, false);
FieldDefs.Add('vMaterial', ftString, 100, false);
FieldDefs.Add('vPU', ftString, 100, false);
FieldDefs.Add('vZiskani', ftString, 50, false);
FieldDefs.Add('vPozn', ftString, 1000, false);
FieldDefs.Add('vIdKmen', ftInteger, 0, false);
CreateDataSet;
Open;
end;
// waitStart(nil, 'Vytváření pomocné tabulky...', sheet.LastRow, $0000FF); // clRed
// helUtils.waitSetMsg('Probíhá zápis dat...');
idxR:= 2;
// nacti radky
while (idxR<=iRowMax) do
begin
karta.Clear;
if not(VarIsNull(shKarty.Cells.Item[idxR, i_Poz].Value)) then
begin
if not(TryStrToInt(shKarty.Cells.Item[idxR, i_Poz].Value, karta.poz)) then
karta.poz:= 0;
if (i_CisloDilu>0) then
karta.cislo:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_CisloDilu].Value), VarToStr(shKarty.Cells.Item[idxR, i_CisloDilu].Value), '').Replace(#10, '');
if (i_Nazev>0) then
karta.nazev:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Nazev].Value), VarToStr(shKarty.Cells.Item[idxR, i_Nazev].Value), '').Replace(#10, '');
if not(TryStrToFloat(shKarty.Cells.Item[idxR, i_Ks].Value, karta.mnoz)) then
karta.mnoz:= 0;
if (i_Vyrobce>0) then
begin
karta.vyrobce:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Vyrobce].Value), VarToStr(shKarty.Cells.Item[idxR, i_Vyrobce].Value), '').Replace(#10, '');
if (karta.vyrobce<>'') then
begin
lSQL2:= 'SELECT TOP(1) c.CisloOrg FROM ' + tblCOrg + ' c INNER JOIN ' + tblCOrgE + ' ce ON (ce.ID=c.ID) WHERE ce._NazevProImportKusovniku=N' + karta.vyrobce.QuotedString;
karta.vyrobceCisOrg:= helUtils.getHeliosIntVal(Helios, 0, lSQL2);
end;
end;
if (i_Norma>0) then
karta.norma:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Norma].Value), VarToStr(shKarty.Cells.Item[idxR, i_Norma].Value), '').Replace(#10, '');
if (i_Rozmer>0) then
karta.rozmer:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Rozmer].Value), VarToStr(shKarty.Cells.Item[idxR, i_Rozmer].Value), '').Replace(#10, '');
if (i_Material>0) then
karta.material:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_Material].Value), VarToStr(shKarty.Cells.Item[idxR, i_Material].Value), '').Replace(#10, '');
if (i_PU>0) then
karta.pu:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_PU].Value), VarToStr(shKarty.Cells.Item[idxR, i_PU].Value), '').Replace(#10, '');
if (i_ziskani>0) then
karta.jakObj:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_ziskani].Value), VarToStr(shKarty.Cells.Item[idxR, i_ziskani].Value), '');
if (i_pozn>0) then
karta.pozn:= IfThen(not VarIsNull(shKarty.Cells.Item[idxR, i_pozn].Value), VarToStr(shKarty.Cells.Item[idxR, i_pozn].Value), '').Replace(#10, CRLF);
end;
lSQL:= 'INSERT ' + tblImpKusXLS + ' (Pozice, CisloDilu, Nazev, Mnozstvi, Vyrobce, Norma, Rozmer, Material, PU, JakZiskat, Poznamka) SELECT ' + karta.poz.ToString;
lSQL:= lSQL + ', N' + karta.cislo.QuotedString + ', N' + karta.nazev.QuotedString + ', ' + karta.mnoz.ToString.Replace(',', '.') + ', N' + karta.vyrobce.QuotedString;
lSQL:= lSQL + ', N' + karta.norma.QuotedString + ', N' + karta.rozmer.QuotedString + ', N' + karta.material.QuotedString + ', N' + karta.pu.QuotedString;
lSQL:= lSQL + ', N' + karta.jakObj.QuotedString + ', N' + karta.pozn.QuotedString;
try
Helios.ExecSQL(lSQL);
finally
end;
karta.idKmen:= 0;
if (karta.poz>0) then
begin
if (rcFin='') and (karta.cislo<>'') and (idKZFin=0) then
begin
idKZFin:= 0;
rcFin:= LeftStr(karta.cislo, karta.cislo.IndexOf('-')) + MidStr(karta.cislo, karta.cislo.IndexOf('-')+2, 255);
rcFin:= LeftStr(rcFin, rcFin.IndexOf('-'));
rcFin:= LeftStr(rcFin, 2) + '-' + MidStr(rcFin, 3, 30);
idKZFin:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT ID FROM ' + tblKZ + ' WHERE RegCis=N' + rcFin.QuotedString + ' AND SkupZbo=N''500''');
if (idKZFin=0) then
begin
lSQL2:= 'DECLARE @idKZ INT' + CRLF + 'EXEC @idKZ=dbo.hp_VytvorPolozkuKmeneZbozi @SZ=N''500'', @RegCis=N' + rcFin.QuotedString;
lSQL2:= lSQL2 + ', @Nazev1=N' + rcFin.QuotedString +', @Dilec=1' + CRLF + 'SELECT @idKZ AS newid';
with Helios.OpenSQL(lSQL2) do
if (RecordCount=1) then
idKZFin:= VarToStr(FieldByNameValues('newid')).ToInteger;
end;
end;
if (karta.poz<300) and (karta.idKmen=0) then
begin
karta.idKmen:= helUtils.getHeliosIntVal(Helios, 0, 'SELECT ID FROM ' + tblKZ + ' WHERE RegCis=N' + karta.cislo.QuotedString + ' AND SkupZbo=N''300''');
if (karta.idKmen=0) then
begin
lSQL2:= 'DECLARE @idKZ INT' + CRLF + 'EXEC @idKZ=dbo.hp_VytvorPolozkuKmeneZbozi @SZ=N''300'', @RegCis=N' + karta.cislo.QuotedString;
lSQL2:= lSQL2 + ', @Nazev1=N' + karta.nazev.QuotedString +', @Dilec=1' + CRLF + 'SELECT @idKZ AS newid';
with Helios.OpenSQL(lSQL2) do
if (RecordCount=1) then
karta.idKmen:= VarToStr(FieldByNameValues('newid')).ToInteger;
end;
if (karta.idKmen>0) then
begin
lSQL2:= 'DECLARE @zmenaOd INT, @zmenaOdOld INT' + CRLF + 'SET @zmenaOdOld=(SELECT TOP(1) ID FROM ' + tblCZmen + ' WHERE datum<=GETDATE() AND Platnost=1)' + CRLF;
lSQL2:= lSQL2 + 'IF NOT EXISTS (SELECT 1 FROM ' + tblKVaz + ' WHERE vyssi=' + idKZFin.ToString + ' AND nizsi=' + karta.idKmen.ToString + ' AND ZmenaDo IS NULL)' + CRLF;
lSQL2:= lSQL2 + ' BEGIN' + CRLF + ' SET @zmenaOd=(SELECT MAX(ZmenaOd) FROM ' + tblKVaz + ' WHERE vyssi=' + idKZFin.ToString + ' AND nizsi=' + karta.idKmen.ToString + ')' + CRLF;
lSQL2:= lSQL2 + ' IF (@zmenaOd IS NULL) AND (@zmenaOdOld IS NOT NULL) SET @zmenaOd = @zmenaOdOld' + CRLF;
lSQL2:= lSQL2 + ' INSERT ' + tblKVaz + ' (vyssi, nizsi, mnozstvi, mnozstviSeZtratou, Prirez, Pozice, ZmenaOd) SELECT ' + idKZFin.ToString + ', ' + karta.idKmen.ToString;
lSQL2:= lSQL2 + ', ' + karta.mnoz.ToString.Replace(',', '.') + ', ' + karta.mnoz.ToString.Replace(',', '.') + ', 1, N' + karta.poz.ToString.QuotedString + ', @zmenaOd' + CRLF;
lSQL2:= lSQL2 + ' END' + CRLF;
Helios.ExecSQL(lSQL2);
end;
karta.idKmen:= 0;
end
else
begin
lSQL:= 'SELECT d.IDKmenZbozi FROM ' + tblDodavateleZboziE + ' e JOIN ' + tblDodavateleZbozi + ' d ON (d.ID=e.ID) WHERE e._KodDodavatele LIKE N';
lSQL:= lSQL + ('%' + karta.norma + '%').QuotedString;
iTemp:= helUtils.getHeliosRowCount(Helios, lSQL);
if (iTemp=0) then
begin // zalozeni nove karty
lSQL2:= 'DECLARE @idKZ INT' + CRLF + 'EXEC @idKZ=dbo.hp_VytvorPolozkuKmeneZbozi @SZ=N''100'', @RegCis=NULL, @Nazev1=N' + karta.nazev.QuotedString +', @Material=1' + CRLF;
lSQL2:= lSQL2 + 'SELECT @idKZ AS newid';
with Helios.OpenSQL(lSQL2) do
if (RecordCount=1) then
karta.idKmen:= VarToStr(FieldByNameValues('newid')).ToInteger;
if (karta.idKmen>0) then
begin
lSQL2:= 'UPDATE ' + tblKZ + ' SET Aktualni_Dodavatel=' + karta.vyrobceCisOrg.ToString + ' WHERE ID=' + karta.idKmen.ToString;
Helios.ExecSQL(lSQL2);
end;
end
else
if (iTemp=1) then
karta.idKmen:= helUtils.getHeliosIntVal(Helios, 0, lSQL)
else
begin
podm:= 'TabKmenZbozi.ID IN (' + lSQL + ')';
podm:= 'TabKmenZbozi.Sluzba=0';
if (Helios.Prenos(bidKZ, 'TabKmenZbozi.ID', oVar1, podm, 'Vyberte materiál pozice ' + karta.poz.ToString + ' / číslo dílu ' + karta.cislo
+ ' / název ' + karta.nazev + ' >> norma (kód dodavatele) ' + karta.norma, false)) then
karta.idKmen:= VarToStr(oVar1).ToInteger;
end;
end;
if (karta.idKmen>0) then
begin
lSQL:= 'INSERT #TabHDCKusovnik (IDKmenVyssi, IDKmenNizsi, Pozice, CisloDilu, Nazev, Mnozstvi, Vyrobce, CisOrgDod, Norma, Rozmer, Material, PovrchovaUprava, JakZiskat, Poznamka)';
lSQL:= lSQL + ' SELECT ' + idKZFin.ToString + ', ' + karta.idKmen.ToString + ', ' + karta.poz.ToString + ', N' + karta.cislo.QuotedString + ', N' + karta.nazev.QuotedString;
lSQL:= lSQL + ', ' + karta.mnoz.ToString.Replace(',', '.') + ', N' + karta.vyrobce.QuotedString + ', ' + karta.vyrobceCisOrg.ToString + ', N' + karta.norma.QuotedString;
lSQL:= lSQL + ', N' + karta.rozmer.QuotedString + ', ' + karta.material.QuotedString + ', N' + karta.pu.QuotedString + ', N' + karta.jakObj.QuotedString;
lSQL:= lSQL + ', N' + karta.pozn.QuotedString;
if (jeTest) then
lSQL:= lSQL.Replace('#Tab', 'dbo._Tab');
Helios.ExecSQL(lSQL);
end;
end;
Inc(idxR);
end;
try
Helios.ExecSQL('UPDATE ' + tblImpKusXLS + ' SET Projekt=N' + rcFin.QuotedString + 'WHERE Projekt IS NULL');
Helios.ExecSQL('IF OBJECT_ID(N''dbo.ep_HDC_VytvorKusovnikXLS'', N''P'') IS NOT NULL EXEC dbo.ep_HDC_VytvorKusovnikXLS @projekt=N' + rcFin.QuotedString);
except on E:Exception do
Helios.Error(#1'Chyba vytváření kusovníku'#1 + CRLF + E.Message);
end;
finally
vTab.Free;
end;
// helUtils.waitEnd;
end;
end;
finally
{$IF CompilerVersion < 34.0} // SYDNEY
FreeAndNil(xls);
{$ENDIF}
end;
Screen.Cursor:= crDefault;
end;
Helios.Info(#1'Akce ukončena'#1);
end;
procedure TplgHDCMontekord.Run (const Helios: IHelios);
const MinVerzeHelios = $030020260300;
var typAkce: integer;
browID, cRec, cntID, l_loop, idDZ, dpz, cOrg, newBid: integer;
verzePlg, verzePlg2, plgNazev: string;
verzePlg64: Int64;
lSQL, autor, radDokl, IDcka, params, paramsBak, vlastPar, vlastPar2, contInfo, sz, podm: string;
arrId: TArray<integer>;
term: boolean;
f1: TformImportKusovnik;
{$IFDEF Helios_Space}
PomHandle: THandle;
MinVerze: Int64;
Porovnani: TplgPorovnaniVerzi;
VerzeDB: String;
ZmenyOK: Boolean;
SlepaProcName: string;
SlepaProcGUID: string;
SlepaProcBrowse: string;
Browse: TplgBrowse;
GUIDAkce: String;
Q: IHeQuery;
{$ENDIF}
begin
try
FHelios := Helios;
{$IFDEF Helios_Space}
SpravceHeliosu.PridejHelios (FHelios);
{$ENDIF}
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;
// ### INICIALIZACE ###
InicializaceJadraPluginu (FHelios);
PluginKonfig.VlastniInicializacePluginu (FHelios);
// ### O PLUGINU ###
if FHelios.BrowseID = BrowseID_PluginInfo then
begin
case FHelios.ExtKomID of
Cplg_ExtKomID_About:
begin
InformaceOPluginu (FHelios);
Exit;
end;
Cplg_ExtKomID_HlaskyNaWeb:
begin
plgPresunHlaskyNaWeb (FHelios);
Exit;
end;
Cplg_ExtKomID_HlaskyDoDLL:
begin
plgStahniZWebuJazykovaDLL (FHelios);
Exit;
end;
// AJ, 14./17.12.2015 - Administrátorská podpora v HeO - Odinstalace
Cplg_ExtKomID_Odinstalace:
begin
PluginKonfig.PluginUninstall (FHelios);
Exit;
end;
end;
end;
// ### test na verzi SQL Serveru ###
if FHelios.SQLVersion < PluginKonfig.PluginMinimalniPozadovanaVerzeSQLServeru then
raise Exception.Create(
Format('%s (%s)'#13#13+plgCtiOznam(plxJadroPluginVyzadujeMinVerziSQL_X),
[PluginKonfig.PluginVerejneJmeno, PluginKonfig.PluginSystemoveJmeno,
plgVerzeSQLServeru(PluginKonfig.PluginMinimalniPozadovanaVerzeSQLServeru)]));
// ### test na verzi Heliosu ###
if plgObecnaVerze(FHelios.HeVersion, jvMajor) >= '3' then
begin
// Helios 3.x
MinVerze := PluginKonfig.PluginMinimalniPozadovanaVerzeHeliosu_ver3;
if MinVerze < Cplg_Jadro_MinimalniPozadovanaVerzeHeliosu_ver3 then
MinVerze := Cplg_Jadro_MinimalniPozadovanaVerzeHeliosu_ver3;
end
else
begin
// Helios 2.x
MinVerze := PluginKonfig.PluginMinimalniPozadovanaVerzeHeliosu;
if MinVerze < Cplg_Jadro_MinimalniPozadovanaVerzeHeliosu then
MinVerze := Cplg_Jadro_MinimalniPozadovanaVerzeHeliosu;
end;
if FHelios.HeVersion < MinVerze then
raise Exception.Create(
Format('%s (%s)'#13#13+plgCtiOznam(plxJadroPluginVyzadujeMinVerziX),
[PluginKonfig.PluginVerejneJmeno, PluginKonfig.PluginSystemoveJmeno,
plgObecnaVerze(MinVerze, jvCela)]));
VerzeDB := plgNactiVerziPluginuZDB(FHelios, ZmenyOK);
Porovnani := plgPorovnejVerziPluginuSVerziDB(VerzeDB);
if Porovnani = pvDBMaVetsi then
raise Exception.Create(
Format('%s (%s)'#13#13'%s'#13#13'%s: %s'#13'%s: %s',
[PluginKonfig.PluginVerejneJmeno, PluginKonfig.PluginSystemoveJmeno,
plgCtiOznam(plxJadroVerzePluginuJeNizsiNezVDB),
plgCtiOznam(plxJadroVerze_V_DB), VerzeDB,
plgCtiOznam(plxJadroVerzePluginu), plgVerzePluginu(jvHexa)]));
// ### INSTALACE PLUGINU ###
if (FHelios.BrowseID = BrowseID_PluginInfo) and plgExtKomIDInstalace(FHelios) then
begin
InstalacePluginu(FHelios, (FHelios.ExtKomID = Cplg_ExtKomID_TichaInstalace));
Exit;
end;
if not ZmenyOK then
raise Exception.Create(
Format('%s (%s)'#13#13'%s'#13#1'%s'#1,
[PluginKonfig.PluginVerejneJmeno, PluginKonfig.PluginSystemoveJmeno,
plgCtiOznam(plxJadroMinulaInstalaceNeprobehlaKorektne),
plgCtiOznam(plxJadroJeTrebaSpustitInstalaciPluginu)]));
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
// ### nacteni parametru akce ###
Q := FHelios.OpenSQL(
Format(
'SELECT CAST(CAST(GUID AS UNIQUEIDENTIFIER) AS NVARCHAR(36)) AS GUIDAkce, Parametry'#13+
' FROM ' + tblExtKom + ' WHERE ID=%d', [FHelios.ExtKomID]));
GUIDAkce:= Format('{%s}', [varToStr(Q.FieldValues(0))]);
params:= Format('%s', [varToStr(Q.FieldByNameValues('Parametry'))]);
paramsBak:= params;
// ### SPUSTENI AKCE ###
// [JAS 17.8.2015] - moznost spustit externi akci pluginu i z rucne vytvorene definice EA
// Postup je nasledujici:
// 1. V Heliosu vytvorit rucne externi akci typu plugin, doplnit spravne ProgID COM pluginu. Tato externi akce dostane automaticky prideleny novy GUID
// 2. Vytvorit slepou proceduru, jejiz nazev musi byt tvoren maskou: epx_<SYS_NAZEV_PLUGINU>_<GUID_BEZ_POMLCEK>
// Jako GUID se do nazvu dava nove prideleny GUID rucne vytvorene akce z kroku 1.
// 3. Slepa procedura musi vracet SELECTem dve hodnoty:
// - GUID akce (vcetne slozenych zavorek!!), ktera se ma ve skutecnosti spustit (musi byt soucasti daneho pluginu)
// - cislo prehledu nebo systemovy nazev (pokud jde o prehled daneho pluginu), ve kterem je puvodni akce definovana
//
//Priklad:
// CREATE PROC dbo.epx_rpMujPlugin_9549A0D78192439C803255B8AD5484AD
// AS
// SELECT N'{506E3776-B9F0-4F37-97E3-5CBB78BC67A5}', N'hvw_MujPlugin_DefPrehled'
SlepaProcName := 'dbo.epx_' + PluginKonfig.PluginSystemoveJmeno + '_' + plgGUIDBezPomlcek(GUIDAkce);
if FHelios.OpenSQL('IF OBJECT_ID(' + plgNQuotedStr(SlepaProcName) + ', N''P'') IS NULL SELECT 0 ELSE SELECT 1').FieldValues(0)=1 then
begin
with FHelios.OpenSQL('EXEC ' + SlepaProcName)
do
begin
SlepaProcGUID := VarToStr(FieldValues(0));
SlepaProcBrowse := VarToStr(FieldValues(1));
end;
if plgJeObecnyPrehled(SlepaProcBrowse) then
Browse := plgJmenoView2Browse (SlepaProcBrowse)
else
Browse := bZadny;
if Browse <> bZadny then
// akce nad prehledem pluginu
SpustAkciPluginu(FHelios, Browse, SlepaProcGUID)
else
// akce nad tabulkou Heliosu, popr. jinym definovanym prehledem
SpustAkciPluginuProTab(FHelios, StrToInt(SlepaProcBrowse), SlepaProcGUID);
end
else
begin
if plgJeObecnyPrehled(FHelios.BrowseID) then
Browse := plgJmenoView2Browse(FHelios.MainBrowseTable)
else
Browse := bZadny;
if Browse <> bZadny then
// akce nad prehledem pluginu
SpustAkciPluginu(FHelios, Browse, GUIDAkce)
else
// akce nad tabulkou Heliosu, popr. jinym definovanym prehledem
SpustAkciPluginuProTab (FHelios, FHelios.BrowseID, GUIDAkce);
end;
term := false;
jeTest := false;
{$REGION 'Zapis do TabPluginInfo'}
plgNazev := ExtractFileName(GetModuleName(HInstance));
if (plgNazev.Contains('.dll')) then
plgNazev := LeftStr(plgNazev, plgNazev.IndexOf('.dll'));
lSQL := 'IF NOT EXISTS (SELECT 1 FROM ' + tblPlgInfo + ' WHERE NazevSys=N' + plgNazev.QuotedString + ') INSERT ' + tblPlgInfo
+ ' (NazevSys, NazevObjektu, NazevVerejny) SELECT N' + plgNazev.QuotedString + ', N''runMe'', N''Plugin HDC pro Montekord''';
Helios.ExecSQL(lSQL);
verzePlg:= GetFileVersion2(GetModuleName(HInstance));
if (Length(verzePlg)=12) then
verzePlg:= LeftStr(verzePlg,9) + '0' + RightStr(verzePlg,3);
verzePlg2:= verzePlg.Replace('.', '');
if (Length(verzePlg2)=10) then
verzePlg2:= '0' + LeftStr(verzePlg2,1) + '0' + RightStr(verzePlg2, 9);
verzePlg64:= verzePlg2.ToInt64;
{$ENDREGION}
if (Helios.HeVersion<MinVerzeHelios) then
raise Exception.Create('Plugin vyžaduje min verzi Heliosu ' + IntToHex(MinVerzeHelios, 12))
else
begin
if (Helios.ExtKomID>0) then
begin
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 0x484443344d6f6e74656b6f7264'); // nastav context v sys.sysprocesses (hexadecimalne HDC4Montekord)
UseLatestCommonDialogs:= true;
LocalFormatSettings:= TFormatSettings.Create;
{
lSQL:= 'IF OBJECT_ID(N' + QuotedStr('tempdb..#TabExtKom') + ') IS NOT NULL DROP TABLE #TabExtKom' + CRLF;
lSQL:= lSQL + 'CREATE TABLE #TabExtKom (Poznamka nvarchar(255))';
Helios.ExecSQL(lSQL);
}
lSQL:= 'IF OBJECT_ID(' + QuotedStr('tempdb..#TabExtKom') + ', ''U'') IS NULL CREATE TABLE #TabExtKom (Typ TINYINT, Poznamka NVARCHAR(255))' + CRLF;
lSQL:= lSQL + 'IF OBJECT_ID(N' + QuotedStr('tempdb..#TabTempUziv') + ', ''U'') IS NULL CREATE TABLE #TabTempUziv (Tabulka NVARCHAR(255) NOT NULL, SCOPE_IDENTITY INT NULL, Datum DATETIME NULL)';
Helios.ExecSQL(lSQL);
params := '';
vlastPar := '';
vlastPar2 := '';
cestaExport := '';
typAkce := 0;
HeliosX := Helios;
with Helios.OpenSQL('SELECT Parametry FROM ' + tblExtKom + ' WHERE ID=' + IntToStr(Helios.ExtKomID)) do
begin
params := VarToStr(FieldValues(0));
paramsBak := VarToStr(FieldValues(0));
if (params.Contains(';')) then
begin
typAkce := StrToInt(LeftStr(params,Pos(';',params)-1));
params := MidStr(params,Pos(';',params)+1,255);
if Pos(';',params)>0 then
browID := StrToInt(LeftStr(params,Pos(';',params)-1))
else
browID := StrToInt(params);
if Pos(';',params)>0 then // zadany 3 parametry (akce, browID, vlastnikID)
begin
params := MidStr(params,Pos(';',params)+1,255);
if Pos(';', params)>0 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;
verText := GetFileVersion2(GetModuleName(HInstance));
if Length(verText)=12 then
verText := LeftStr(verText,9) + '0' + RightStr(verText,3);
if (RightStr(LeftStr(vlastPar,2),1)=':') or (LeftStr(vlastPar,2)='\\') then
cestaExport := vlastPar;
vlastPar := Trim(vlastPar);
vlastPar2 := Trim(vlastPar2);
{
jeTest:= UpperCase(vlastPar)='TEST';
if (vlastPar2<>'') then
jeTest:= UpperCase(vlastPar2)='TEST';
}
if AnsiContainsText(UpperCase(paramsBak), ';TEST') then
jeTest := true;
if (Helios.BrowseID<>browID) then
begin
typAkce := 0;
Helios.Error ('Tento plugin lze volat pouze z přehledu: '#1 + IntToStr(browID) + #1'.');
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 // IDcka<>''
else
typAkce := Helios.ExtKomID;
case typAkce of
-2: Helios.Info (#1'About'#1);
-1: begin
Helios.ExecSQL('UPDATE ' + tblPlgInfo + ' SET DatumInstalace=GETDATE(), VerzePluginu=N' + verzePlg2.QuotedString + ' WHERE NazevSys=N' + plgNazev.QuotedString);
Helios.Info (#1'Instalace OK'#1);
end;
1: ImportKusovniku (Helios);
2: begin
f1:= TformImportKusovnik.Create (nil);
try
f1.Helios := Helios;
f1.jeTest := jeTest;
f1.ShowModal;
finally
FreeAndNil (f1);
end;
end;
end; // case
Helios.Refresh(true);
if (contInfo='NULL') then
Helios.ExecSQL('SET CONTEXT_INFO 0x')
else
Helios.ExecSQL('SET CONTEXT_INFO 0x' + contInfo);
end; // Helios.ExtKomID>0
end; // druha cast if Helios.HeVersion<MinVerzeHelios
end; // FHelios.ExtKomID <> Cplg_ExtKomID_Konfigurace
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
{$IFDEF Helios_Space}
E.Message := plgPrelozException(E.Message);
{$ENDIF}
raise;
end;
end;
if (term) then
Application.Terminate;
end;
initialization
{$IFDEF Helios_Space}
dxCore.dxInitialize;
{$ENDIF}
// System.ReportMemoryLeaksOnShutdown:= true;
TComObjectFactory.Create (ComServer, TplgHDCMontekord, Class_Monte, 'runMe', '', ciMultiInstance, tmSingle);
finalization
// dxUnitsLoader.Finalize;
{$IFDEF Helios_Space}
dxCore.dxFinalize;
{$ENDIF}
END.