738 lines
19 KiB
ObjectPascal
738 lines
19 KiB
ObjectPascal
unit uMain;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Mask, Vcl.ExtCtrls, System.IOUtils,
|
|
System.StrUtils, Vcl.Imaging.pngimage, System.IniFiles, Winapi.ShlObj,
|
|
Xml.XmlIntf, Xml.XMLDoc,
|
|
flcCipher, System.ImageList, Vcl.ImgList, Vcl.VirtualImageList,
|
|
Vcl.BaseImageCollection, Vcl.ImageCollection, Vcl.Buttons;
|
|
|
|
const
|
|
eKey2 = '9!81Aq#cU:MCntb6';
|
|
sName = 'DBName';
|
|
sSSLKey = 'SSLKeyFile';
|
|
eKey1 = 'qe*cX!8k@4WA!gQ5';
|
|
sEncConn = 'DBEncConn';
|
|
sDZTasksIntZapisHeO = 'DZTasksIntervalZapisHeO';
|
|
sServer = 'DBServer';
|
|
pwd1 = 'L~4';
|
|
sPortS = 'DBPort';
|
|
sSSL = 'SSL';
|
|
pwd2 = 'Qe!r';
|
|
sHeliosStoreURL = 'HeliosStoreURL';
|
|
sUser = 'DBUser';
|
|
iVect2 = '3r!9q$';
|
|
sDZTaskIntZapisTypCas = 'DZTaskZapisIntervalTypCas';
|
|
sLCh = 'licCheck';
|
|
sPwd = 'DBPwd';
|
|
sDzKlic = 'DataZoneKey';
|
|
sDZTasksIntDown = 'DZTasksIntervalDownload';
|
|
sSSLCert = 'SSLCertFile';
|
|
sHeoPath = 'HEOPath';
|
|
iVect1 = 's4W*ERr9';
|
|
sCfgComp = 'confComp';
|
|
sLoginMod = 'JWTAuthMod';
|
|
sDZTasksDownURL = 'DZTasksDownloadURL';
|
|
sHeoLic = 'HEOLicence';
|
|
sPort = 'APIPort';
|
|
cfgFName = 'hdcDZAPIcfg.dat';
|
|
|
|
|
|
|
|
type
|
|
TfrmMain = class(TForm)
|
|
edtServer: TLabeledEdit;
|
|
edtPwd: TLabeledEdit;
|
|
edtPort: TLabeledEdit;
|
|
edtDB: TLabeledEdit;
|
|
edtUser: TLabeledEdit;
|
|
edtAPIport: TLabeledEdit;
|
|
bntSave: TButton;
|
|
gbAPI: TGroupBox;
|
|
gbSQL: TGroupBox;
|
|
btnClose: TButton;
|
|
Image1: TImage;
|
|
Label1: TLabel;
|
|
lblIniPath: TLabel;
|
|
cbxEncConn: TCheckBox;
|
|
cbxSSL: TCheckBox;
|
|
edtSSLCert: TButtonedEdit;
|
|
edtSSLKey: TButtonedEdit;
|
|
cbxJWTLogin: TCheckBox;
|
|
imgList: TVirtualImageList;
|
|
imgColl: TImageCollection;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
selHeoCfg: TSpeedButton;
|
|
lblDZKlic: TLabeledEdit;
|
|
edtDZTasksDown: TLabeledEdit;
|
|
Label4: TLabel;
|
|
edtHeoLic: TLabeledEdit;
|
|
grpDZ: TGroupBox;
|
|
edtDZTasksZapis: TLabeledEdit;
|
|
edtDZTasksURL: TLabeledEdit;
|
|
edtLicCheckURL: TLabeledEdit;
|
|
cbL: TCheckBox;
|
|
lblCompname: TLabeledEdit;
|
|
cbTypIntervalZapis: TComboBox;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure btnCloseClick(Sender: TObject);
|
|
procedure bntSaveClick(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure cbxSSLClick(Sender: TObject);
|
|
function Encrypt(const AStr: string): RawByteString;
|
|
function Decrypt(const AStr: string): RawByteString;
|
|
function ReturnEncrypted(const AStr: string): string;
|
|
function ReturnDecrypted(const AStr: string): string;
|
|
procedure edtSSLKeyRightButtonClick(Sender: TObject);
|
|
procedure edtSSLCertRightButtonClick(Sender: TObject);
|
|
procedure selHeoCfgClick(Sender: TObject);
|
|
procedure edtDBChange(Sender: TObject);
|
|
procedure edtDZTasksDownExit(Sender: TObject);
|
|
procedure edtAPIportExit(Sender: TObject);
|
|
procedure edtDZTasksZapisKeyPress(Sender: TObject; var Key: Char);
|
|
public
|
|
end;
|
|
|
|
var
|
|
frmMain: TfrmMain;
|
|
s, fleName: string;
|
|
cfgXML: IXMLDocument;
|
|
n1: IXMLNode;
|
|
|
|
dbPwd, dbUsr, apiLic, iniFPath: string;
|
|
intDown: integer;
|
|
sTemp: RawByteString;
|
|
|
|
implementation
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
System.Hash;
|
|
|
|
|
|
|
|
function IsEmptyOrNull(const Value: Variant): Boolean;
|
|
begin
|
|
result := VarIsClear(Value) or VarIsEmpty(Value) or VarIsNull(Value) or (VarCompareValue(Value, Unassigned) = vrEqual);
|
|
if (not result) and VarIsStr(Value) then
|
|
result:= Value = '';
|
|
end;
|
|
|
|
|
|
|
|
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 StringToMemoryStream(const AString: string): TMemoryStream;
|
|
var M: TMemoryStream;
|
|
begin
|
|
M:= TMemoryStream.Create;
|
|
try
|
|
M.Size:= (Length(AString)*SizeOf(Char)) div 2;
|
|
if (M.Size>0) then
|
|
begin
|
|
HexToBin(PChar(AString), M.Memory, M.Size);
|
|
M.Position:= 0;
|
|
end;
|
|
finally
|
|
result:= M;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function SimpleXOR(Buffer: String; Key: integer): String;
|
|
var i, c, x: integer;
|
|
begin
|
|
for i:= 1 to Length(Buffer) do
|
|
begin
|
|
c:= integer(Buffer[i]);
|
|
x:= c xor Key;
|
|
result:= result + Char(x);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TfrmMain.Encrypt(const AStr: string): RawByteString;
|
|
begin
|
|
result:= flcCipher.Encrypt(ctRC4, cmECB, cpNone, 256, RawByteString(eKey1+eKey2), RawByteString(AStr), iVect1+iVect2);
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TfrmMain.Decrypt(const AStr: string): RawByteString;
|
|
begin
|
|
result:= flcCipher.Decrypt(ctRC4, cmECB, cpNone, 256, RawByteString(eKey1+eKey2), RawByteString(AStr), iVect1+iVect2);
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.edtAPIportExit(Sender: TObject);
|
|
var i: integer;
|
|
begin
|
|
i:= -1;
|
|
if not(TryStrToInt(edtAPIport.Text, i)) then
|
|
i:= -1;
|
|
|
|
if (i<1) or (i>65535) then
|
|
begin
|
|
ShowMessage('Port nesmí být musí být v rozmezí 1-65535');
|
|
edtAPIport.Text:= '8080';
|
|
if (edtAPIport.CanFocus) then
|
|
edtAPIport.SetFocus;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.edtDBChange(Sender: TObject);
|
|
var dbLic: string;
|
|
begin
|
|
dbLic:= edtHeoLic.Text + edtDB.Text;
|
|
|
|
dbLic:= SimpleXOR(dbLic, 57846218);
|
|
lblDZKlic.Text:= THashMD5.GetHashString(dbLic).ToUpper;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.edtDZTasksDownExit(Sender: TObject);
|
|
var i: integer;
|
|
begin
|
|
i:= -1;
|
|
if not(TryStrToInt(edtDZTasksDown.Text, i)) then
|
|
i:= -1;
|
|
|
|
if (i<0) then
|
|
begin
|
|
ShowMessage('Interval stahování nesmí být záporný.');
|
|
edtDZTasksDown.Text:= '15';
|
|
if (edtDZTasksDown.CanFocus) then
|
|
edtDZTasksDown.SetFocus;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.edtDZTasksZapisKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
if (Key='.') or (Key=',') then
|
|
Key:= #0;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.edtSSLCertRightButtonClick(Sender: TObject);
|
|
var fod: TFileOpenDialog;
|
|
fn, initF: string;
|
|
begin
|
|
fn:= '';
|
|
fod:= TFileOpenDialog.Create(nil);
|
|
try
|
|
initF:= GetEnvironmentVariable('USERPROFILE') + System.SysUtils.PathDelim + 'Desktop';
|
|
if (edtSSLCert.Text<>'') then
|
|
if (ExtractFilePath(edtSSLCert.Text)<>'') then
|
|
if (DirectoryExists(ExtractFilePath(edtSSLCert.Text))) then
|
|
initF:= ExtractFilePath(edtSSLCert.Text);
|
|
fod.DefaultFolder:= initF;
|
|
fod.Options:= [fdoShareAware, fdoPathMustExist, fdoFileMustExist];
|
|
|
|
fod.FileTypes.Clear;
|
|
with fod.FileTypes.Add do
|
|
begin
|
|
DisplayName:= 'Soubor certifikátu';
|
|
FileMask:= 'cacert.pem';
|
|
end;
|
|
|
|
if (fod.Execute) then
|
|
fn:= fod.FileName;
|
|
finally
|
|
fod.Free;
|
|
end;
|
|
|
|
if (fn<>'') then
|
|
if (FileExists(fn)) then
|
|
edtSSLCert.Text:= fn;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.edtSSLKeyRightButtonClick(Sender: TObject);
|
|
var fod: TFileOpenDialog;
|
|
fn, initF: string;
|
|
begin
|
|
fn:= '';
|
|
fod:= TFileOpenDialog.Create(nil);
|
|
try
|
|
initF:= GetEnvironmentVariable('USERPROFILE') + System.SysUtils.PathDelim + 'Desktop';
|
|
if (edtSSLKey.Text<>'') then
|
|
if (ExtractFilePath(edtSSLKey.Text)<>'') then
|
|
if (DirectoryExists(ExtractFilePath(edtSSLKey.Text))) then
|
|
initF:= ExtractFilePath(edtSSLKey.Text);
|
|
fod.DefaultFolder:= initF;
|
|
fod.Options:= [fdoShareAware, fdoPathMustExist, fdoFileMustExist];
|
|
|
|
fod.FileTypes.Clear;
|
|
with fod.FileTypes.Add do
|
|
begin
|
|
DisplayName:= 'Soubor privátního klíče';
|
|
FileMask:= 'privkey.pem';
|
|
end;
|
|
|
|
if (fod.Execute) then
|
|
fn:= fod.FileName;
|
|
finally
|
|
fod.Free;
|
|
end;
|
|
|
|
if (fn<>'') then
|
|
if (FileExists(fn)) then
|
|
edtSSLKey.Text:= fn;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TfrmMain.ReturnEncrypted(const AStr: string): string;
|
|
var i: integer;
|
|
sTemp: RawByteString;
|
|
begin
|
|
sTemp:= Encrypt(AStr);
|
|
result:= '';
|
|
for i:=1 to Length(sTemp) do
|
|
result:= result + IntToHex(Byte(sTemp[i]));
|
|
end;
|
|
|
|
|
|
|
|
function TfrmMain.ReturnDecrypted(const AStr: string): string;
|
|
var i: integer;
|
|
sText: string;
|
|
sTemp: RawByteString;
|
|
begin
|
|
result:= '';
|
|
sTemp:= '';
|
|
sText:= AStr;
|
|
for i:=0 to (Length(sText) div 2)-1 do
|
|
sTemp:= sTemp + AnsiChar(StrToInt('$' + Copy(sText, (i*2)+1, 2)));
|
|
if (sTemp<>'') then
|
|
result:= Decrypt(sTemp);
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.FormCreate (Sender: TObject);
|
|
var i: integer;
|
|
s, obsahXML: string;
|
|
t1: integer;
|
|
fs: TFileStream;
|
|
ms: TMemoryStream;
|
|
attribs: IXMLNodeList;
|
|
begin
|
|
fleName:= ExtractFileDir(Application.ExeName) + '\' + cfgFName;
|
|
cfgXML:= TXMLDocument.Create(nil);
|
|
|
|
cbL.Visible:= (FileExists('lic'));
|
|
lblCompname.Visible:= cbL.Visible;
|
|
if (cbL.Visible) then
|
|
self.Height:= self.Height + 30;
|
|
|
|
cbL.Checked:= true;
|
|
lblCompname.Text:= GetEnvironmentVariable('COMPUTERNAME');
|
|
|
|
if (FileExists(fleName)) then
|
|
try
|
|
s:= '';
|
|
|
|
try
|
|
fs:= TFileStream.Create(fleName, fmOpenRead);
|
|
if (fs.Size>0) then
|
|
begin
|
|
SetLength(s, (fs.Size div SizeOf(Char)));
|
|
fs.Read(s[Low(s)], fs.Size);
|
|
end;
|
|
s:= ReplaceStr(s, #0, '');
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
|
|
if (LeftStr(s, 2)='7D') then
|
|
s:= ReturnDecrypted(s);
|
|
s:= s.Replace(#13#10,'');
|
|
|
|
if (LeftStr(s, 2)='<?') then
|
|
cfgXML.LoadFromXML(s);
|
|
cfgXML.Active:= true;
|
|
|
|
iniFPath:= '';
|
|
edtServer.Text:= '';
|
|
edtDB.Text:= '';
|
|
edtPort.Text:= '';
|
|
edtPwd.Text:= '';
|
|
edtUser.Text:= '';
|
|
edtDZTasksDown.Text:= '15';
|
|
edtHeoLic.Text:= '';
|
|
|
|
edtAPIport.Text:= '8080';
|
|
cbxSSL.Checked:= false;
|
|
edtSSLCert.Text:= '';
|
|
edtSSLCert.Enabled:= (cbxSSL.Checked);
|
|
edtSSLKey.Text:= '';
|
|
edtSSLKey.Enabled:= (cbxSSL.Checked);
|
|
cbxEncConn.Checked:= false;
|
|
|
|
|
|
if not(cfgXML.IsEmptyDoc) then
|
|
begin
|
|
if (cfgXML.DocumentElement<>nil) then
|
|
begin
|
|
n1:= cfgXML.DocumentElement;
|
|
if (n1.NodeName='config') then
|
|
begin
|
|
attribs:= n1.AttributeNodes;
|
|
|
|
i:= attribs.IndexOf(sPort);
|
|
if (i>-1) then
|
|
edtAPIport.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf('IniPath');
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
iniFPath:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sCfgComp);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
lblCompname.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sServer);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtServer.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sName);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtDB.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sPortS);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtPort.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sUser);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
begin
|
|
dbUsr:= attribs.Get(i).NodeValue;
|
|
edtUser.Text:= ReturnDecrypted(dbUsr);
|
|
end;
|
|
|
|
i:= attribs.IndexOf(sPwd);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
begin
|
|
dbPwd:= attribs.Get(i).NodeValue;
|
|
edtPwd.Text:= ReturnDecrypted(dbPwd);
|
|
end;
|
|
|
|
i:= attribs.IndexOf(sEncConn);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
if (attribs.Get(i).NodeValue='1') then
|
|
cbxEncConn.Checked:= true;
|
|
|
|
|
|
i:= attribs.IndexOf(sSSL);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
cbxSSL.Checked:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sLoginMod);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
cbxJWTLogin.Checked:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sLCh);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
cbL.Checked:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sSSLCert);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtSSLCert.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sSSLKey);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtSSLKey.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sDzKlic);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
lblDZKlic.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sDZTasksIntDown);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtDZTasksDown.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sDZTasksDownURL);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtDZTasksURL.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sDZTasksIntZapisHeO);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtDZTasksZapis.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sDZTaskIntZapisTypCas);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
begin
|
|
t1:= attribs.Get(i).NodeValue;
|
|
if (t1>-1) and (t1<3) then
|
|
cbTypIntervalZapis.ItemIndex:= t1;
|
|
end;
|
|
|
|
|
|
i:= attribs.IndexOf(sHeoLic);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtHeoLic.Text:= attribs.Get(i).NodeValue;
|
|
|
|
i:= attribs.IndexOf(sHeliosStoreURL);
|
|
if (i>-1) then
|
|
if (attribs.Get(i).NodeValue<>null) then
|
|
edtLicCheckURL.Text:= attribs.Get(i).NodeValue;
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
lblIniPath.Caption:= iniFPath;
|
|
except
|
|
end
|
|
else
|
|
try
|
|
cfgXML.Active:= true;
|
|
cfgXML.Options:= [doNodeAutoIndent];
|
|
cfgXML.NodeIndentStr:= ' ';
|
|
cfgXML.Version:= '1.0';
|
|
cfgXML.AddChild('config');
|
|
n1:= cfgXML.DocumentElement;
|
|
except
|
|
end;
|
|
|
|
// TODO: JWT autentifikaci
|
|
cbxJWTLogin.Checked:= false;
|
|
cbxJWTLogin.Visible:= false;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TfrmMain.FormShow (Sender: TObject);
|
|
begin
|
|
iniFPath:= '';
|
|
if (edtAPIport.CanFocus) then
|
|
edtAPIport.SetFocus;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
edtPwd.PasswordChar:= #0;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
edtPwd.PasswordChar:= '*';
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.cbxSSLClick(Sender: TObject);
|
|
begin
|
|
edtSSLCert.Enabled:= (cbxSSL.Checked);
|
|
edtSSLKey.Enabled:= (cbxSSL.Checked);
|
|
end;
|
|
|
|
|
|
|
|
procedure TfrmMain.selHeoCfgClick(Sender: TObject);
|
|
var ini: TIniFile;
|
|
srv, dbLic, selDirTit, fld, fn, DZLic: string;
|
|
i: integer;
|
|
md5hex: THashMD5;
|
|
begin
|
|
fn:= '';
|
|
selDirTit:= 'Vyberte adresář Heliosu s konfiguračními soubory (Helios.ini/Licence.ini)';
|
|
if (VyberAdresar(fld, selDirTit)) then
|
|
begin
|
|
fn:= fld + '\Helios.ini';
|
|
if (FileExists(fn)) then
|
|
begin
|
|
iniFPath:= ExtractFileDir(fn);
|
|
lblIniPath.Caption:= iniFPath;
|
|
ini:= TIniFile.Create(fn);
|
|
srv:= ini.ReadString('SQLServer', 'Server', '');
|
|
if (srv.Substring(0, 4).ToLower='tcp:') then
|
|
srv:= srv.Substring(4, 255);
|
|
i:= AnsiPos(srv, ',');
|
|
if (i>0) then
|
|
begin
|
|
edtServer.Text:= LeftStr(srv, i);
|
|
edtPort.Text:= MidStr(srv, i, 255);
|
|
end
|
|
else
|
|
edtServer.Text:= srv;
|
|
edtDB.Text:= ini.ReadString('SQLServer', 'SystemDB', '');
|
|
if (edtUser.CanFocus) then
|
|
edtUser.SetFocus;
|
|
ini.Free;
|
|
end;
|
|
|
|
fn:= fld + '\Licence.ini';
|
|
if (FileExists(fn)) then
|
|
begin
|
|
ini:= TIniFile.Create(fn);
|
|
edtHeoLic.Text:= ini.ReadString('HELIOS', 'Licence', '');
|
|
dbLic:= edtHeoLic.Text + edtDB.Text;
|
|
|
|
dbLic:= SimpleXOR(dbLic, 57846218);
|
|
lblDZKlic.Text:= THashMD5.GetHashString(dbLic).ToUpper;
|
|
|
|
ini.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.bntSaveClick(Sender: TObject);
|
|
var s: AnsiString;
|
|
sx: string;
|
|
fs: TFileStream;
|
|
begin
|
|
|
|
edtPort.Text:= Trim(edtPort.Text);
|
|
if (edtPort.Text='') then
|
|
edtPort.Text:= '1433';
|
|
|
|
edtSSLCert.Text:= Trim(edtSSLCert.Text);
|
|
edtSSLKey.Text:= Trim(edtSSLKey.Text);
|
|
|
|
if (cbxSSL.Checked) and ((edtSSLCert.Text='') or (edtSSLKey.Text='')) then
|
|
begin
|
|
ShowMessage('Mód SSL - je nutno zadat soubory certifikátu a klíče !!');
|
|
Exit;
|
|
end;
|
|
|
|
dbPwd:= ReturnEncrypted(edtPwd.Text);
|
|
dbUsr:= ReturnEncrypted(edtUser.Text);
|
|
|
|
if (lblIniPath.Caption<>'') then
|
|
iniFPath:= lblIniPath.Caption;
|
|
|
|
if (Assigned(n1)) then
|
|
begin
|
|
n1.SetAttributeNS(sCfgComp, '', Trim(lblCompname.Text));
|
|
n1.SetAttributeNS(sPort, '', Trim(edtAPIport.Text).ToInteger);
|
|
n1.SetAttributeNS(sLoginMod, '', IfThen(cbxJWTLogin.Checked, '1', '0'));
|
|
n1.SetAttributeNS(sSSL, '', IfThen(cbxSSL.Checked, '1', '0'));
|
|
n1.SetAttributeNS(sEncConn, '', IfThen(cbxEncConn.Checked, '1', '0'));
|
|
n1.SetAttributeNS(sSSLCert, '', IfThen(cbxSSL.Checked, Trim(edtSSLCert.Text), ''));
|
|
n1.SetAttributeNS(sSSLKey, '', IfThen(cbxSSL.Checked, Trim(edtSSLKey.Text), ''));
|
|
n1.SetAttributeNS(sServer, '', Trim(edtServer.Text));
|
|
n1.SetAttributeNS(sPortS, '', Trim(edtPort.Text).ToInteger);
|
|
n1.SetAttributeNS(sName, '', Trim(edtDB.Text));
|
|
n1.SetAttributeNS(sUser, '', dbUsr);
|
|
n1.SetAttributeNS(sPwd, '', dbPwd);
|
|
n1.SetAttributeNS(sDzKlic, '', Trim(lblDZKlic.Text));
|
|
n1.SetAttributeNS(sDZTasksDownURL, '', Trim(edtDZTasksURL.Text));
|
|
n1.SetAttributeNS(sDZTasksIntDown, '', Trim(edtDZTasksDown.Text));
|
|
n1.SetAttributeNS(sDZTasksIntZapisHeO, '', Trim(edtDZTasksZapis.Text));
|
|
n1.SetAttributeNS(sDZTaskIntZapisTypCas, '', cbTypIntervalZapis.ItemIndex.ToString);
|
|
n1.SetAttributeNS(sLCh, '', IfThen(cbL.Checked, '1', '0'));
|
|
n1.SetAttributeNS(sHeoLic, '', edtHeoLic.Text);
|
|
n1.SetAttributeNS(sHeliosStoreURL, '', Trim(edtLicCheckURL.Text));
|
|
n1.SetAttributeNS('IniPath', '', iniFPath);
|
|
s:= cfgXML.XML.Text;
|
|
sx:= ReturnEncrypted(s);
|
|
try
|
|
fs:= TFileStream.Create(fleName, fmCreate or fmOpenWrite);
|
|
fs.Write(PChar(sx)^, Length(sx)*SizeOf(Char));
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
Close;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.btnCloseClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
end.
|