
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5562 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1512 lines
52 KiB
ObjectPascal
1512 lines
52 KiB
ObjectPascal
unit umain;
|
|
|
|
{$DEFINE PO_BUILTINRES}// Use built-in resources for .po files
|
|
// If compiling with Laz Version < 1.7 then use lazres to make a translate.lrs from the .po files
|
|
// If compiling Laz V >=1.7 then add the .po files in Project/Options/resources
|
|
// Without this DEFINE, include the /locale folder in the distribution
|
|
|
|
{ OnlinePackageManager Update JSON Editor
|
|
|
|
Copyright (C)2016 usernames lainz, minesadorada, GetMem @ http://forum.lazarus.freepascal.org/index.php
|
|
|
|
This source is free software; you can redistribute it and/or modify it under
|
|
the terms of the GNU General Public License as published by the Free
|
|
Software Foundation; either version 2 of the License, or (at your option)
|
|
any later version.
|
|
|
|
This code is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
|
details.
|
|
|
|
A copy of the GNU General Public License is available on the World Wide Web
|
|
at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
|
|
to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
|
|
MA 02111-1307, USA.
|
|
|
|
Version History
|
|
===============
|
|
0.0.0.0 Original code by lainz
|
|
..to 0.1.6.0 Refactored and updated (minesadorada)
|
|
0.1.7.0: Bugfix (lainz)
|
|
0.1.8.0: Config file change (minesadorada)
|
|
0.1.9.0: Error check for duplicate lpk entries (minesadorada)
|
|
0.1.10.0: Exception handling for Load + Save (minesadorada)
|
|
0.1.11.0: Cleaned up code formatting etc. (minesadorada)
|
|
0.1.12.0: Rename Global DownloadURL to DownloadZipURL (minesadorada)
|
|
0.1.13.0: Renamed TPackageData -> TUpdatePackageData (GetMem)
|
|
Renamed TPackageFiles -> TUpdatePackageFiles (GetMem)
|
|
Comment out Self.AutoAdjustLayout line in Form.Create (GetMem)
|
|
Removed StrUtils from uses (minesadorada)
|
|
Fixed memory leaks with CFG and slErrorList (minesadorada)
|
|
Moved inline procedure CreateUniqueINI to separate function (minesadorada)
|
|
Added Const C_DEBUGMESSAGES=TRUE/FALSE (minesadorada)
|
|
0.1.14.0: Various changes (GetMem)
|
|
BugFix: FormCloseQuery(minesadorada)
|
|
0.1.15.0: BugFix: File/Save didn't add the '.json' suffix in Linux (minesadorada)
|
|
Addition: After Loading, run validation tests(minesadorada)
|
|
0.1.16.0: Renamed ForceUpdate to ForceNotify (GetMem/minesadorada)
|
|
0.1.17.0: po files stored in executable's resources (minesadorada)
|
|
Use Project/Options/Resources in Laz 1.7+ to add the .po files
|
|
or.. Use (Gl)LazRes to make a file 'translate.lrs' in older Laz (minesadorada)
|
|
This can be disabled by commenting out $DEFINE PO_BUILTINRES
|
|
This system means you do not have to deploy the /locale folder - just the executable.
|
|
Portability: On startup, it will make a unique cfg file in the GetAppConfig folder based
|
|
on the executable's location on disk, so you can have copies of jsoneditor
|
|
in each component's dev folder that uses its own config file, language and updates folder.
|
|
0.1.18.0: Bugfix: Linux path error when creating locale folder (minesadorada)
|
|
0.1.19.0: Added IntrnalVersion integer field to json (getmem/minesadorada)
|
|
Added SpinEdit to control the above (minesadorada)
|
|
In Laz 1.7 DPIAwareness configured
|
|
0.2.0.0: Refactored GUI(minesadorada)
|
|
0.2.1.0: Added scrollbox to contain package info (GetMem)
|
|
0.2.2.0: Hints and Validation updated (minesadorada)
|
|
0.2.3.0: ResourceStrings Updated (minesadorada)
|
|
0.2.4.0: Bugfix: regression error: DisableInOPM (minesadorada)
|
|
0.2.5.0: BugFix: regression error: CreateUniqueINIFile (minesadorada)
|
|
0.2.6.0: Added feature: Help menu/AutoLoad Last File (minesadorada)
|
|
0.2.7.0: Updated: Save procedure (minesadorada)
|
|
0.2.8.0: BugFix: ValidationFailed repeated messages about FoundDuplicates
|
|
BugFix: SetDefaultLang added to AddPackageFileToList
|
|
0.2.9.0: Added $DEFINE LAZ17
|
|
0.2.10.0: ??
|
|
}
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
{DefaultTranslator not used}
|
|
uses
|
|
lclVersion, Classes, Forms, Controls, StdCtrls, Menus, ActnList, StdActns,
|
|
Graphics, Buttons, fileutil, LazFileUtils, fileinfo, ugenericcollection,
|
|
fpjsonrtti, Dialogs, LCLTranslator, PopupNotifier, SysUtils, inifiles,
|
|
lclintf, LResources, Spin, {$IFDEF PO_BUILTINRES}LazUTF8Classes{$ENDIF};
|
|
{$IF LCL_FULLVERSION >= 1070000}
|
|
{$DEFINE LAZ17}
|
|
{$ENDIF}
|
|
|
|
const
|
|
C_DEBUGMESSAGES = False; // TRUE ONLY IN DEV MODE!
|
|
|
|
type
|
|
|
|
|
|
{ TUpdatePackageFiles }
|
|
|
|
TUpdatePackageFiles = class(TCollectionItem)
|
|
private
|
|
FName: string;
|
|
FVersion: string;
|
|
FForceNotify: boolean;
|
|
FInternalVersion: integer;
|
|
published
|
|
property Name: string read FName write FName;
|
|
property Version: string read FVersion write FVersion;
|
|
property ForceNotify: boolean read FForceNotify write FForceNotify;
|
|
property InternalVersion: integer read FInternalVersion write FInternalVersion;
|
|
end;
|
|
|
|
TPackageFilesList = specialize TGenericCollection<TUpdatePackageFiles>;
|
|
|
|
{ TUpdatePackageData }
|
|
|
|
TUpdatePackageData = class(TPersistent)
|
|
private
|
|
FDownloadZipURL: string;
|
|
FDisableInOPM: boolean;
|
|
FName: string;
|
|
public
|
|
constructor Create;
|
|
published
|
|
property Name: string read FName write FName;
|
|
property DownloadZipURL: string read FDownloadZipURL write FDownloadZipURL;
|
|
property DisableInOPM: boolean read FDisableInOPM write FDisableInOPM;
|
|
end;
|
|
|
|
{ TUpdatePackage }
|
|
|
|
TUpdatePackage = class(TPersistent)
|
|
private
|
|
FUpdatePackageData: TUpdatePackageData;
|
|
FUpdatePackageFiles: TPackageFilesList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function LoadFromFile(AFileName: string): boolean;
|
|
function SaveToFile(AFileName: string): boolean;
|
|
published
|
|
property UpdatePackageData: TUpdatePackageData
|
|
read FUpdatePackageData write FUpdatePackageData;
|
|
property UpdatePackageFiles: TPackageFilesList
|
|
read FUpdatePackageFiles write FUpdatePackageFiles;
|
|
end;
|
|
|
|
{ TfrmMain }
|
|
|
|
TfrmMain = class(TForm)
|
|
ActionList1: TActionList;
|
|
chk_DisableInOPM: TCheckBox;
|
|
cmd_Close: TBitBtn;
|
|
cmd_save: TBitBtn;
|
|
cmd_AddPackageFile: TButton;
|
|
cmd_RemoveLastPackageFile: TButton;
|
|
edt_UpdateZipName: TEdit;
|
|
edt_DownloadZipURL: TEdit;
|
|
FileOpen1: TFileOpen;
|
|
FileSaveAs1: TFileSaveAs;
|
|
lbl_PackageFiles: TLabel;
|
|
lbl_UpdateZipName: TLabel;
|
|
lbl_DownloadZipURL: TLabel;
|
|
MainMenu1: TMainMenu;
|
|
FileMenu: TMenuItem;
|
|
LoadItem: TMenuItem;
|
|
mnu_helpAutoloadLastFile: TMenuItem;
|
|
mnu_fileExit: TMenuItem;
|
|
mnu_fileNew: TMenuItem;
|
|
mnu_helpDisableWarnings: TMenuItem;
|
|
mnu_lang_es: TMenuItem;
|
|
mnu_lang_en: TMenuItem;
|
|
mnu_lang: TMenuItem;
|
|
mnu_helpAbout: TMenuItem;
|
|
mnu_helpShowHints: TMenuItem;
|
|
mnu_help: TMenuItem;
|
|
mnu_fileSave: TMenuItem;
|
|
popup_hint: TPopupNotifier;
|
|
SaveAsItem: TMenuItem;
|
|
sb_editName: TSpeedButton;
|
|
sb_PackageFiles: TScrollBox;
|
|
spd_CheckURL: TSpeedButton;
|
|
procedure chk_DisableInOPMMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
procedure cmd_AddPackageFileClick(Sender: TObject);
|
|
procedure cmd_RemoveLastPackageFileClick(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure LoadItemClick(Sender: TObject);
|
|
procedure mnu_fileExitClick(Sender: TObject);
|
|
procedure mnu_fileNewClick(Sender: TObject);
|
|
procedure mnu_fileSaveClick(Sender: TObject);
|
|
procedure mnu_helpAboutClick(Sender: TObject);
|
|
procedure mnu_helpAutoloadLastFileClick(Sender: TObject);
|
|
procedure mnu_helpDisableWarningsClick(Sender: TObject);
|
|
procedure mnu_helpShowHintsClick(Sender: TObject);
|
|
procedure mnu_lang_enClick(Sender: TObject);
|
|
procedure mnu_lang_esClick(Sender: TObject);
|
|
procedure SaveAsItemClick(Sender: TObject);
|
|
procedure sb_editNameClick(Sender: TObject);
|
|
procedure spd_CheckURLClick(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
JSONPackage: TUpdatePackage;
|
|
bForceSaveAs, bShowPopupHints, bDisableWarnings,bAutoLoadLast,
|
|
bDirty, bIsVirgin: boolean;
|
|
sJSONFilePath: string;
|
|
sUpdateDirectory, sZipDirectory: string;
|
|
slErrorList: TStrings;
|
|
CFG: TIniFile;
|
|
INIFilePath: string;
|
|
// Start of Package Information controls
|
|
ArrayGrpBox: array of TGroupBox;
|
|
ArrayLblPackageFileName: array of TLabel;
|
|
ArrayEdtPackageFileName: array of TEdit;
|
|
ArrayLblPackageVersion: array of TLabel;
|
|
ArraySpinEditV1: array of TSpinEdit;
|
|
ArraySpinEditV2: array of TSpinEdit;
|
|
ArraySpinEditV3: array of TSpinEdit;
|
|
ArraySpinEditV4: array of TSpinEdit;
|
|
ArrayChkBoxForceNotify: array of TCheckBox;
|
|
ArraySpinEditInternalVersion: array of TSpinEdit;
|
|
ArrayLblPackageInternalVersion: array of TLabel;
|
|
// End of Package Information controls
|
|
iNumLpkFilesVisible: integer;
|
|
procedure LoadJSONFromFile(sFileName:String);
|
|
procedure AddPackageFileToList;
|
|
procedure RemovePackageFileFromList;
|
|
procedure ResetPackageFileControlsToOne;
|
|
procedure AddNewControlArray;
|
|
procedure DestroyControlArrays;
|
|
procedure RemoveLastControlArray;
|
|
procedure ProcessNotify(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
procedure CtrlShowPopup(Sender: TObject);
|
|
procedure CtrlHidePopup(Sender: TObject);
|
|
procedure CtrlSetUpPopupHandlers;
|
|
procedure CtrlMakeDirty(Sender: TObject);
|
|
procedure CreateUniqueINI(var aCount: integer);
|
|
function ValidationFailed: boolean;
|
|
function FoundADuplicateLPK: boolean;
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
frmMain: TfrmMain;
|
|
sPoPath_en, sPoPath_es: string;
|
|
{$IFDEF PO_BUILTINRES}
|
|
aLRes: TLResource;
|
|
aSS: TStringListUTF8;
|
|
S: TResourceStream;
|
|
F: TFileStream;
|
|
{$ENDIF}
|
|
|
|
implementation
|
|
{$R *.lfm}
|
|
|
|
resourcestring
|
|
rsOneOfTheReq1 =
|
|
'One of the required fields is missing or wrong.';
|
|
rsOneOfTheReqn =
|
|
'One or more of the required fields are missing or wrong.';
|
|
rsSavedOK = 'Saved OK';
|
|
rsSaveUnsucces = 'Save unsuccessful';
|
|
rsOverwrite = 'Overwrite';
|
|
rsTurnHintsOff = '(You can toggle these hints on/off in the Help menu)';
|
|
rsHelpAndInfor = 'Help and Information';
|
|
rsAbout = 'About';
|
|
rsUpdate = 'Update';
|
|
rsFileMayBeUns = 'JSON may be unsaved. Are you sure you want to quit?';
|
|
rsMypackagenam = 'mypackagename.zip';
|
|
rsMypackagelpk = 'mypackagename.lpk';
|
|
rsHttpWwwUpdat = 'http://www.updatesite.com/myupdate/mypackagename.zip';
|
|
rsFixThenTryAg = 'Fix, then try again.';
|
|
rsUpdateZipNam = '- Update zip name is too short or missing';
|
|
rsDownloadZipURLI = '- Download URL is too short or missing';
|
|
rsUpdateZipNam2 = '- Update zip name missing extension ".zip"';
|
|
rsDownloadZipURLI2 = '- Download URL is incomplete';
|
|
rsDownloadZipURLS = '- Download URL should start with "http"';
|
|
rsDownloadZipURLD = '- Download URL does not contain the zipfile name';
|
|
rsWouldYouLike = 'Would you like to copy %s to the %s folder?';
|
|
rsSWasSuccessf = '%s was successfully copied to the %s folder';
|
|
rsSorryCopyOpe = 'Sorry - copy operation was unsuccessful';
|
|
rsCompiledWith2 = 'Compiled with FPC V:%s and Lazarus V:%d.%d%s for the %s -' +
|
|
' %s platform%s%s';
|
|
rsTheLpkEntryD = 'The .lpk entry #%d is missing the .lpk extension';
|
|
rsTheLpkEntryD2 = 'The .lpk entry #%d is is absent';
|
|
rsThisOptionSh =
|
|
'This option should only be used for crucial updates or bug-fixed packages.';
|
|
rsLanguageChan = 'Language changed to "%s".';
|
|
rsSorryThisLan = 'Sorry, this language is unavailable at this time.';
|
|
rsYouMayNeedTo = '(You may need to restart the app to see the change)';
|
|
rsThereAreOneO = '- There are one or more .lpk entries with the same name.%s' +
|
|
'- Every .lpk entry must have a unique name.';
|
|
rsUpdateJsonSF = 'Update file "%s" failed to load correctly.';
|
|
rsNotifyUpdate = 'Notify Update';
|
|
rsUseInCombina = 'Use in combination with';
|
|
rsPackageDInfo = 'Package #%d Information';
|
|
rsThePackageFi = 'The package filename (No path e.g. package.lpk)';
|
|
rsVersion = 'Version: ';
|
|
rsFormatIsNNNN = 'Package version:%sFormat is: n.n.n.n';
|
|
rsCheckThisIfY = 'Check this if you don''t want to increment the package '
|
|
+ 'version';
|
|
rsInternalVers = 'Internal Version: ';
|
|
rsFilename = 'Filename: ';
|
|
rsThisWillDisa = 'This will disable your package in Online Package Manager!%'
|
|
+ 'sAre you SURE you want to do this?';
|
|
rsThereWasAPro = 'There was a problem loading "%s" - is it corrupted or in '
|
|
+ 'the wrong format?';
|
|
rsVersionForPa = 'Version for package %d is zero';
|
|
rsInternalVers2 = 'Internal version number should not be Zero%s';
|
|
rsOpeningYourB = 'Opening your browser...';
|
|
rsFileSCanBeAu = 'File "%s" can be auto-loaded next time you start %s%sWould'
|
|
+' you like to enable this?%s(It can be changed in menu item Help/%s later)';
|
|
|
|
{ TUpdatePackageData }
|
|
|
|
constructor TUpdatePackageData.Create;
|
|
begin
|
|
FName := '';
|
|
FDisableInOPM := False;
|
|
FDownloadZipURL := '';
|
|
end;
|
|
|
|
{ TfrmMain }
|
|
procedure TfrmMain.CtrlMakeDirty(Sender: TObject);
|
|
begin
|
|
bDirty := True;
|
|
end;
|
|
|
|
procedure TfrmMain.CtrlHidePopup(Sender: TObject);
|
|
// Get rid of highlighting
|
|
begin
|
|
popup_hint.Hide;
|
|
slErrorList.Clear;
|
|
if Sender.ClassName <> 'TLabel' then
|
|
TControl(Sender).Color := clWindow;
|
|
end;
|
|
|
|
procedure TfrmMain.CtrlShowPopup(Sender: TObject);
|
|
// Use the control's Hint property to populate the popup text
|
|
begin
|
|
if not bShowPopupHints then
|
|
exit;
|
|
popup_hint.Text := '';
|
|
popup_hint.Title := '';
|
|
if (Sender.InheritsFrom(TControl) = False) then
|
|
exit;
|
|
|
|
popup_hint.Text := TControl(Sender).Hint;
|
|
if (popup_hint.Text <> '') then
|
|
begin
|
|
popup_hint.Title := rsHelpAndInfor;
|
|
popup_hint.Text := popup_hint.Text;
|
|
if bIsVirgin then
|
|
popup_hint.Text := popup_hint.Text + LineEnding + rsTurnHintsOff;
|
|
popup_hint.showatpos(Mouse.CursorPos.X, Mouse.CursorPos.Y);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.CtrlSetUpPopupHandlers;
|
|
// Use different handlers for some controls
|
|
var
|
|
iCount: integer;
|
|
begin
|
|
with frmMain do
|
|
begin
|
|
for iCount := 0 to Pred(ControlCount) do
|
|
begin
|
|
if (Controls[iCount].InheritsFrom(TControl) = False) then
|
|
continue;
|
|
{ // (Kept for reference)
|
|
if (Controls[iCount] is TGroupBox) then
|
|
// Iterate through the children of GroupBox
|
|
for jCount := 0 to Pred(TGroupBox(Controls[iCount]).ControlCount) do
|
|
begin
|
|
if TGroupBox(Controls[iCount]).Controls[jCount] is TSpinEdit then
|
|
begin
|
|
TSpinEdit(TGroupBox(Controls[iCount]).Controls[jCount]).OnMouseEnter :=
|
|
@CtrlShowPopup;
|
|
end;
|
|
end;
|
|
}
|
|
if (Controls[iCount] is TEdit) then
|
|
begin
|
|
TEdit(Controls[iCount]).OnMouseEnter := @CtrlShowPopup;
|
|
TEdit(Controls[iCount]).OnMouseLeave := @CtrlHidePopup;
|
|
TEdit(Controls[iCount]).OnClick := @CtrlHidePopup;
|
|
TEdit(Controls[iCount]).OnEditingDone := @CtrlMakeDirty;
|
|
end;
|
|
if (Controls[iCount] is TCheckBox) then
|
|
begin
|
|
TCheckBox(Controls[iCount]).OnMouseEnter := @CtrlShowPopup;
|
|
TCheckBox(Controls[iCount]).OnMouseLeave := @CtrlHidePopup;
|
|
TCheckBox(Controls[iCount]).OnClick := @CtrlHidePopup;
|
|
TCheckBox(Controls[iCount]).OnEditingDone := @CtrlMakeDirty;
|
|
end;
|
|
if (Controls[iCount] is TLabel) then
|
|
begin
|
|
TLabel(Controls[iCount]).OnMouseEnter := @CtrlShowPopup;
|
|
TLabel(Controls[iCount]).OnMouseLeave := @CtrlHidePopup;
|
|
TLabel(Controls[iCount]).OnClick := @CtrlHidePopup;
|
|
end;
|
|
if (Controls[iCount] is TButton) then
|
|
begin
|
|
TButton(Controls[iCount]).OnMouseEnter := @CtrlShowPopup;
|
|
TButton(Controls[iCount]).OnMouseLeave := @CtrlHidePopup;
|
|
end;
|
|
if (Controls[iCount] is TSpeedButton) then
|
|
begin
|
|
TSpeedButton(Controls[iCount]).OnMouseEnter := @CtrlShowPopup;
|
|
TSpeedButton(Controls[iCount]).OnMouseLeave := @CtrlHidePopup;
|
|
end;
|
|
if (Controls[iCount] is TBitBtn) then
|
|
begin
|
|
TBitBtn(Controls[iCount]).OnMouseEnter := @CtrlShowPopup;
|
|
TBitBtn(Controls[iCount]).OnMouseLeave := @CtrlHidePopup;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.DestroyControlArrays;
|
|
var
|
|
i: integer;
|
|
begin
|
|
// Callked on Form_Destroy
|
|
for i := 0 to High(ArrayGrpBox) do
|
|
begin
|
|
FreeAndNil(ArraySpinEditInternalVersion[i]);
|
|
FreeAndNil(ArrayLblPackageInternalVersion[i]);
|
|
FreeAndNil(ArrayChkBoxForceNotify[i]);
|
|
FreeAndNil(ArraySpinEditV4[i]);
|
|
FreeAndNil(ArraySpinEditV3[i]);
|
|
FreeAndNil(ArraySpinEditV2[i]);
|
|
FreeAndNil(ArraySpinEditV1[i]);
|
|
FreeAndNil(ArrayLblPackageVersion[i]);
|
|
FreeAndNil(ArrayEdtPackageFileName[i]);
|
|
FreeAndNil(ArrayLblPackageFileName[i]);
|
|
FreeAndNil(ArrayGrpBox[i]);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.AddNewControlArray;
|
|
{For reference:
|
|
ArrayGrpBox:Array of TGroupBox;
|
|
// Line 1
|
|
ArrayLblPackageFileName:Array of TLabel;
|
|
ArrayEdtPackageFileName:Array of TEdit;
|
|
ArrayLblPackageVersion:Array of TLabel;
|
|
ArraySpinEditV1:Array of TSpinEdit;
|
|
ArraySpinEditV2:Array of TSpinEdit;
|
|
ArraySpinEditV3:Array of TSpinEdit;
|
|
ArraySpinEditV4:Array of TSpinEdit;
|
|
// Line 2
|
|
ArrayChkBoxForceNotify:Array of TCheckBox;
|
|
ArrayLblPackageInternalVersion:Array of TLabel;
|
|
ArraySpinEditInternalVersion:Array of TSpinEdit;
|
|
SetBounds(Left,Top,Width,Height);
|
|
}
|
|
begin
|
|
SetLength(ArrayGrpBox, Succ(iNumLpkFilesVisible));
|
|
ArrayGrpBox[iNumLpkFilesVisible] := TGroupBox.Create(Self);
|
|
|
|
SetLength(ArrayLblPackageFileName, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArrayEdtPackageFileName, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArrayLblPackageVersion, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArraySpinEditV1, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArraySpinEditV2, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArraySpinEditV3, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArraySpinEditV4, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArrayChkBoxForceNotify, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArrayLblPackageInternalVersion, Succ(iNumLpkFilesVisible));
|
|
SetLength(ArraySpinEditInternalVersion, Succ(iNumLpkFilesVisible));
|
|
|
|
with ArrayGrpBox[iNumLpkFilesVisible] do
|
|
begin
|
|
Caption := Format(rsPackageDInfo, [Succ(iNumLpkFilesVisible)]);
|
|
if (iNumLpkFilesVisible > 0) then
|
|
SetBounds(8, ArrayGrpBox[Pred(iNumLpkFilesVisible)].Top +
|
|
ArrayGrpBox[Pred(iNumLpkFilesVisible)].Height + 10, frmMain.Width - 16, 100)
|
|
else
|
|
SetBounds(8, cmd_AddPackageFile.Top + cmd_AddPackageFile.Height + 10,
|
|
frmMain.Width - 16, 100);
|
|
Visible := False;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
// Label - Package name
|
|
ArrayLblPackageFileName[iNumLpkFilesVisible] := TLabel.Create(nil);
|
|
with ArrayLblPackageFileName[iNumLpkFilesVisible] do
|
|
begin
|
|
Caption := rsFilename;
|
|
SetBounds(8, 10, 50, 23);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
Hint := Format('%s%s%s', [rsFilename, LineEnding, rsThePackageFi]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// EditBox - Package name
|
|
ArrayEdtPackageFileName[iNumLpkFilesVisible] := TEdit.Create(nil);
|
|
with ArrayEdtPackageFileName[iNumLpkFilesVisible] do
|
|
begin
|
|
Text := rsMypackagelpk;
|
|
SetBounds(64, 8, 256, 23);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
OnEditingDone := @CtrlMakeDirty;
|
|
Hint := Format('%s%s%s', [rsFilename, LineEnding, rsThePackageFi]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// Label - Package Version
|
|
ArrayLblPackageVersion[iNumLpkFilesVisible] := TLabel.Create(nil);
|
|
with ArrayLblPackageVersion[iNumLpkFilesVisible] do
|
|
begin
|
|
Caption := rsVersion;
|
|
SetBounds(330, 10, 50, 23);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
Hint := Format(rsFormatIsNNNN, [LineEnding]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// SpinEdit V1
|
|
ArraySpinEditV1[iNumLpkFilesVisible] := TSpinEdit.Create(nil);
|
|
with ArraySpinEditV1[iNumLpkFilesVisible] do
|
|
begin
|
|
Value := 0;
|
|
SetBounds(380, 8, 40, 20);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
OnChange := @CtrlMakeDirty;
|
|
Hint := Format(rsFormatIsNNNN, [LineEnding]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// SpinEdit V2
|
|
ArraySpinEditV2[iNumLpkFilesVisible] := TSpinEdit.Create(nil);
|
|
with ArraySpinEditV2[iNumLpkFilesVisible] do
|
|
begin
|
|
Value := 0;
|
|
SetBounds(430, 8, 40, 20);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
OnChange := @CtrlMakeDirty;
|
|
Hint := Format(rsFormatIsNNNN, [LineEnding]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// SpinEdit V3
|
|
ArraySpinEditV3[iNumLpkFilesVisible] := TSpinEdit.Create(nil);
|
|
with ArraySpinEditV3[iNumLpkFilesVisible] do
|
|
begin
|
|
Value := 0;
|
|
SetBounds(480, 8, 40, 20);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
OnChange := @CtrlMakeDirty;
|
|
Hint := Format(rsFormatIsNNNN, [LineEnding]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// SpinEdit V4
|
|
ArraySpinEditV4[iNumLpkFilesVisible] := TSpinEdit.Create(nil);
|
|
with ArraySpinEditV4[iNumLpkFilesVisible] do
|
|
begin
|
|
Value := 0;
|
|
SetBounds(530, 8, 40, 20);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
OnChange := @CtrlMakeDirty;
|
|
Hint := Format(rsFormatIsNNNN, [LineEnding]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// ChkBox Notify
|
|
ArrayChkBoxForceNotify[iNumLpkFilesVisible] := TCheckBox.Create(nil);
|
|
with ArrayChkBoxForceNotify[iNumLpkFilesVisible] do
|
|
begin
|
|
Checked := False;
|
|
Caption := rsNotifyUpdate;
|
|
SetBounds(8, 50, 40, 20);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
OnMouseUp := @ProcessNotify;
|
|
OnEditingDone := @CtrlMakeDirty;
|
|
Hint := Format('%s:%s%s', [rsNotifyUpdate, LineEnding, rsCheckThisIfY]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// Label Internal version
|
|
ArrayLblPackageInternalVersion[iNumLpkFilesVisible] := TLabel.Create(nil);
|
|
with ArrayLblPackageInternalVersion[iNumLpkFilesVisible] do
|
|
begin
|
|
Caption := rsInternalVers;
|
|
SetBounds(180, 50, 40, 23);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
Hint := Format('%s%s%s %s',
|
|
[rsInternalVers, LineEnding, rsUseInCombina, rsNotifyUpdate]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// SpinEdit Internal Version
|
|
ArraySpinEditInternalVersion[iNumLpkFilesVisible] := TSpinEdit.Create(nil);
|
|
with ArraySpinEditInternalVersion[iNumLpkFilesVisible] do
|
|
begin
|
|
Value := 1;
|
|
SetBounds(280, 48, 40, 20);
|
|
Visible := True;
|
|
Tag := Pred(iNumLpkFilesVisible);
|
|
OnMouseEnter := @CtrlShowPopup;
|
|
OnMouseLeave := @CtrlHidePopup;
|
|
OnClick := @CtrlHidePopup;
|
|
OnChange := @CtrlMakeDirty;
|
|
Hint := Format('%s%s%s %s',
|
|
[rsInternalVers, LineEnding, rsUseInCombina, rsNotifyUpdate]);
|
|
Parent := ArrayGrpBox[iNumLpkFilesVisible];
|
|
end;
|
|
// This sets the subcontrols up correctly
|
|
Parent := sb_PackageFiles;
|
|
end;
|
|
SetDefaultLang(CFG.ReadString('Options', 'Language', 'en'), 'locale', True);
|
|
end;
|
|
|
|
procedure TfrmMain.RemoveLastControlArray;
|
|
// Uses iLpkFilesCount
|
|
var
|
|
iLast: integer;
|
|
begin
|
|
iLast := High(ArrayGrpBox);
|
|
// Makes the group control invisible
|
|
ArrayGrpBox[iLast].Parent := nil;
|
|
|
|
// Tidy up memory
|
|
FreeAndNil(ArrayChkBoxForceNotify[iLast]);
|
|
FreeAndNil(ArrayLblPackageInternalVersion[iLast]);
|
|
FreeAndNil(ArraySpinEditInternalVersion[iLast]);
|
|
FreeAndNil(ArraySpinEditV4[iLast]);
|
|
FreeAndNil(ArraySpinEditV3[iLast]);
|
|
FreeAndNil(ArraySpinEditV2[iLast]);
|
|
FreeAndNil(ArraySpinEditV1[iLast]);
|
|
FreeAndNil(ArrayLblPackageVersion[iLast]);
|
|
FreeAndNil(ArrayEdtPackageFileName[iLast]);
|
|
FreeAndNil(ArrayLblPackageFileName[iLast]);
|
|
FreeAndNil(ArrayGrpBox[iLast]);
|
|
|
|
// Tidy up control array lengths
|
|
SetLength(ArrayChkBoxForceNotify, iLast);
|
|
SetLength(ArrayLblPackageInternalVersion, iLast);
|
|
SetLength(ArraySpinEditInternalVersion, iLast);
|
|
SetLength(ArraySpinEditV4, iLast);
|
|
SetLength(ArraySpinEditV3, iLast);
|
|
SetLength(ArraySpinEditV2, iLast);
|
|
SetLength(ArraySpinEditV1, iLast);
|
|
SetLength(ArrayLblPackageVersion, iLast);
|
|
SetLength(ArrayEdtPackageFileName, iLast);
|
|
SetLength(ArrayLblPackageFileName, iLast);
|
|
SetLength(ArrayGrpBox, iLast);
|
|
end;
|
|
|
|
procedure TfrmMain.AddPackageFileToList;
|
|
begin
|
|
AddNewControlArray; // Construct another one
|
|
|
|
// Makes it visible and aligns it
|
|
ArrayGrpBox[High(ArrayGrpBox)].Visible := True;
|
|
ArrayGrpBox[High(ArrayGrpBox)].Align := alTop;
|
|
Inc(iNumLpkFilesVisible);// Note: = Succ(High(Array))
|
|
CtrlSetUpPopupHandlers;
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TfrmMain.ResetPackageFileControlsToOne;
|
|
// Used in File/New and File/Load
|
|
var
|
|
iCount: integer;
|
|
begin
|
|
if (iNumLpkFilesVisible = 1) then
|
|
exit;
|
|
for iCount := iNumLpkFilesVisible downto 1 do
|
|
begin
|
|
RemovePackageFileFromList;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.RemovePackageFileFromList;
|
|
begin
|
|
// Always have one set of controls present
|
|
if (iNumLpkFilesVisible > 1) then
|
|
begin
|
|
RemoveLastControlArray;
|
|
Dec(iNumLpkFilesVisible);
|
|
CtrlSetUpPopupHandlers;
|
|
end;
|
|
end;
|
|
|
|
function TfrmMain.FoundADuplicateLPK: boolean;
|
|
// Add lpk entries one-by-one to a temp stringlist looking for a duplicate
|
|
var
|
|
TempStringList: TStrings;
|
|
iCount: integer;
|
|
begin
|
|
Result := False;
|
|
TempStringList := TStringList.Create;
|
|
try
|
|
for iCount := 0 to High(ArrayEdtPackageFileName) do
|
|
begin
|
|
if TempStringlist.IndexOf(ArrayEdtPackageFileName[iCount].Text) = -1 then
|
|
TempStringList.Add(ArrayEdtPackageFileName[iCount].Text)
|
|
else
|
|
Result := True;
|
|
end;
|
|
finally
|
|
TempStringList.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.ProcessNotify(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
// Special hint
|
|
if not bShowPopupHints then
|
|
exit;
|
|
popup_hint.Text := rsThisOptionSh;
|
|
popup_hint.Title := rsHelpAndInfor;
|
|
popup_hint.Text := popup_hint.Text;
|
|
popup_hint.showatpos(Mouse.CursorPos.X, Mouse.CursorPos.Y);
|
|
end;
|
|
|
|
procedure TfrmMain.cmd_AddPackageFileClick(Sender: TObject);
|
|
begin
|
|
AddPackageFileToList;
|
|
end;
|
|
|
|
procedure TfrmMain.chk_DisableInOPMMouseUp(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
// Warn user about DisableInOPM
|
|
if chk_DisableInOPM.Checked = True then
|
|
if MessageDlg(Format(rsThisWillDisa, [LineEnding]),
|
|
mtWarning, [mbYes, mbNo], 0, mbNo) = mrNo then
|
|
chk_DisableInOPM.Checked := False;
|
|
end;
|
|
|
|
procedure TfrmMain.cmd_RemoveLastPackageFileClick(Sender: TObject);
|
|
begin
|
|
RemovePackageFileFromList;
|
|
end;
|
|
|
|
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
begin
|
|
CanClose := True;
|
|
if ((bDirty = True) and (bDisableWarnings = False)) then
|
|
begin
|
|
if MessageDlg(rsFileMayBeUns, mtConfirmation, [mbYes, mbNo], 0, mbNo) = mrNo then
|
|
CanClose := False;
|
|
end;
|
|
if CanClose = True then
|
|
begin
|
|
CFG.WriteBool('Options', 'Virgin', False); // Suppresses PopUp hints on next run
|
|
CFG.WriteBool('Options', 'DiableWarnings', bDisableWarnings);
|
|
CFG.UpdateFile;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.CreateUniqueINI(var aCount: integer);
|
|
// Recursively loop until correct INI found, or new one created
|
|
// Based on Executable's path location
|
|
begin
|
|
INIFilePath := GetAppConfigFile(False) + IntToStr(aCount);
|
|
If C_DEBUGMESSAGES then ShowMessage(INIFilePath);
|
|
if FileExistsUTF8(INIFilePath) then
|
|
begin
|
|
CFG := TIniFile.Create(INIFilePath);
|
|
CFG.CacheUpdates := True;
|
|
if CFG.ReadString('Options', 'AppPath', 'unknown') = ProgramDirectory then
|
|
begin
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
FreeAndNil(CFG); // Ditch the old one
|
|
Inc(aCount);
|
|
CreateUniqueINI(aCount); // Make a new one
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
CFG := TIniFile.Create(INIFilePath);
|
|
CFG.CacheUpdates := True;
|
|
CFG.WriteString('Options', 'AppPath', ProgramDirectory);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.FormCreate(Sender: TObject);
|
|
var
|
|
sLang: string;
|
|
iIniCount: integer;
|
|
begin
|
|
// Enable AutoSize again to get correct Height
|
|
edt_UpdateZipName.AutoSize := True;
|
|
edt_DownloadZipURL.AutoSize := True;
|
|
// Furniture
|
|
Caption := Application.Title;
|
|
Icon := Application.Icon;
|
|
// Popup hint window
|
|
popup_hint.vNotifierForm.Color:=clForm;
|
|
popup_hint.vNotifierForm.Font.Size:=8;
|
|
popup_hint.vNotifierForm.Font.Style:=[fsBold];
|
|
{$IFDEF LINUX}
|
|
popup_hint.vNotifierForm.Height:=popup_hint.vNotifierForm.Height + 50;
|
|
{$ENDIF}
|
|
popup_hint.vNotifierForm.AlphaBlend:=TRUE;
|
|
popup_hint.vNotifierForm.AlphaBlendValue:=200;
|
|
if (lcl_major > 0) and (lcl_minor > 7) then
|
|
{$IFNDEF DARWIN}popup_hint.vNotifierForm.Scaled:=TRUE;{$ENDIF}
|
|
// ToDo: TApplication.HintPause:=2000;
|
|
// Defaults
|
|
slErrorList := TStringList.Create;
|
|
bForceSaveAs := True;
|
|
bShowPopupHints := True;
|
|
iNumLpkFilesVisible := 0;
|
|
edt_UpdateZipName.Text := rsMypackagenam;
|
|
edt_DownloadZipURL.Text := rsHttpWwwUpdat;
|
|
|
|
// Encourage the user to maintain an updates folder
|
|
sUpdateDirectory := ProgramDirectory + 'updates';
|
|
if not FileExistsUTF8(sUpdateDirectory) then
|
|
if not ForceDirectoriesUTF8(ProgramDirectory + 'updates') then
|
|
sUpdateDirectory := ProgramDirectory;
|
|
// Enable options persistence
|
|
// If program location is different, create a new CFG file
|
|
// Because each component's location might be different
|
|
iIniCount := 0;
|
|
// First time run anywhere on the system
|
|
INIFilePath := GetAppConfigFile(False) + '0';
|
|
if not FileExistsUTF8(INIFilePath) then
|
|
begin
|
|
CFG := TIniFile.Create(INIFilePath);
|
|
CFG.WriteString('Options', 'AppPath', ProgramDirectory);
|
|
end
|
|
else // Make a new INI if this is a new location
|
|
Try
|
|
CreateUniqueINI(iIniCount);
|
|
Except
|
|
On E:Exception do
|
|
begin
|
|
ShowMessageFmt('Unable to create a configuration file. Reason: %s',[E.Message]);
|
|
Application.Terminate;
|
|
end;
|
|
end;
|
|
CFG.UpdateFile;
|
|
if C_DEBUGMESSAGES = True then // Dev only
|
|
ShowMessageFmt('Inifile=%s, Count=%d', [INIFilePath, iIniCount]);
|
|
|
|
// Pop-up hints (show on first run, then not again unless the user chooses)
|
|
bIsVirgin := CFG.ReadBool('Options', 'Virgin', True);
|
|
bShowPopupHints := bIsVirgin;
|
|
mnu_helpShowHints.Checked := bShowPopupHints;
|
|
|
|
// On startup, default to FALSE
|
|
bAutoLoadLast:=CFG.ReadBool('Options', 'AutoLoadLastFile',FALSE);
|
|
mnu_helpAutoloadLastFile.Checked:=bAutoLoadLast;
|
|
sJSONFilePath:=CFG.ReadString('Options','LastSavedJSON','unknown');
|
|
if C_DEBUGMESSAGES = True then // Dev only
|
|
ShowMessage(sJSONFilePath);
|
|
// Override here if the user has re-enabled them
|
|
bShowPopupHints := CFG.ReadBool('Options', 'ShowPopupHints', bShowPopupHints);
|
|
mnu_helpShowHints.Checked := bShowPopupHints;
|
|
|
|
bDisableWarnings := CFG.ReadBool('Options', 'DiableWarnings', False);
|
|
mnu_helpDisableWarnings.Checked := bDisableWarnings;
|
|
CtrlSetUpPopupHandlers; // Set the Hint property of various controls to show a Popup
|
|
|
|
// Language translation
|
|
sLang := CFG.ReadString('Options', 'Language', 'en'); // First default is English
|
|
SetDefaultLang(sLang, 'locale', True);
|
|
// Add more translations here
|
|
if sLang = 'en' then
|
|
mnu_lang_en.Checked := True;
|
|
if sLang = 'es' then
|
|
mnu_lang_es.Checked := True;
|
|
bDirty := False; // No effect :(
|
|
end;
|
|
|
|
procedure TfrmMain.FormDestroy(Sender: TObject);
|
|
begin
|
|
// No memory leak!
|
|
DestroyControlArrays;
|
|
CFG.Free;
|
|
slErrorList.Free;
|
|
end;
|
|
|
|
procedure TfrmMain.FormShow(Sender: TObject);
|
|
begin
|
|
bDirty := False;
|
|
AddPackageFileToList;
|
|
If sJSONFilePath <> 'unknown' then
|
|
If (FileExistsUTF8(sJSONFilePath)) AND (bAutoLoadLast=TRUE) then
|
|
LoadJSONFromFile(sJSONFilePath);
|
|
|
|
end;
|
|
procedure TfrmMain.LoadJSONFromFile(sFileName:String);
|
|
var
|
|
i: integer;
|
|
Quad: TVersionQuad;
|
|
begin
|
|
ResetPackageFileControlsToOne; // So iNumLpkFilesVisible=1
|
|
JSONPackage := TUpdatePackage.Create;
|
|
try
|
|
if JSONPackage.LoadFromFile(sFileName) then
|
|
begin
|
|
edt_UpdateZipName.Text := JSONPackage.UpdatePackageData.Name;
|
|
edt_DownloadZipURL.Text := JSONPackage.UpdatePackageData.DownloadZipURL;
|
|
chk_DisableInOPM.Checked := JSONPackage.UpdatePackageData.DisableInOPM;
|
|
for i := 0 to JSONPackage.UpdatePackageFiles.Count - 1 do
|
|
begin
|
|
if (i > 0) then
|
|
AddPackageFileToList;
|
|
ArrayEdtPackageFileName[i].Text :=
|
|
JSONPackage.UpdatePackageFiles.Items[i].Name;
|
|
if fileinfo.TryStrToVersionQuad(
|
|
JSONPackage.UpdatePackageFiles.Items[i].Version, Quad) then
|
|
begin
|
|
ArraySpinEditV1[i].Value := Quad[1];
|
|
ArraySpinEditV2[i].Value := Quad[2];
|
|
ArraySpinEditV3[i].Value := Quad[3];
|
|
ArraySpinEditV4[i].Value := Quad[4];
|
|
end;
|
|
ArrayChkBoxForceNotify[i].Checked :=
|
|
JSONPackage.UpdatePackageFiles.Items[i].ForceNotify;
|
|
ArraySpinEditInternalVersion[i].Value :=
|
|
JSONPackage.UpdatePackageFiles.Items[i].InternalVersion;
|
|
end;
|
|
if ValidationFailed then
|
|
begin
|
|
if (slErrorList.Count > 1) then
|
|
ShowMessage(Format(rsUpdateJsonSF, [ExtractFileName(sJSONFilePath)]) +
|
|
LineEnding + LineEnding + rsOneOfTheReqn + LineEnding +
|
|
slErrorList.Text + LineEnding + rsFixThenTryAg)
|
|
else
|
|
ShowMessage(Format(rsUpdateJsonSF, [ExtractFileName(sJSONFilePath)]) +
|
|
LineEnding + LineEnding + rsOneOfTheReq1 + LineEnding +
|
|
slErrorList.Text + LineEnding + rsFixThenTryAg);
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
ShowMessageFmt(rsThereWasAPro,
|
|
[ExtractFilename(sFileName)]);
|
|
finally
|
|
JSONPackage.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.LoadItemClick(Sender: TObject);
|
|
begin
|
|
FileOpen1.Dialog.InitialDir :=
|
|
CFG.ReadString('Options', 'LastLoadedJSONPath', sUpdateDirectory);
|
|
FileOpen1.Dialog.Filter := 'JSON|*.json';
|
|
if FileOpen1.Dialog.Execute then
|
|
begin
|
|
sJSONFilePath := FileOpen1.Dialog.Filename;
|
|
CFG.WriteString('Options', 'LastLoadedJSONPath', ExtractFileDir(sJSONFilePath));
|
|
ResetPackageFileControlsToOne; // So iNumLpkFilesVisible=1
|
|
LoadJSONFromFile(sJSONFilePath);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_fileExitClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_fileNewClick(Sender: TObject);
|
|
begin
|
|
edt_UpdateZipName.Text := rsMypackagenam;
|
|
edt_DownloadZipURL.Text := rsHttpWwwUpdat;
|
|
sJSONFilePath := '';
|
|
sZipDirectory := '';
|
|
chk_DisableInOPM.Checked := False;
|
|
ResetPackageFileControlsToOne;
|
|
ArrayEdtPackageFileName[0].Text := rsMypackagelpk;
|
|
ArraySpinEditV1[0].Value := 0;
|
|
ArraySpinEditV2[0].Value := 0;
|
|
ArraySpinEditV3[0].Value := 0;
|
|
ArraySpinEditV4[0].Value := 0;
|
|
ArrayChkBoxForceNotify[0].Checked := False;
|
|
ArraySpinEditInternalVersion[0].Value := 0;
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_fileSaveClick(Sender: TObject);
|
|
begin
|
|
bForceSaveAs := False;
|
|
SaveAsItem.Click;
|
|
bForceSaveAs := True;
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_helpAboutClick(Sender: TObject);
|
|
var
|
|
s: string;
|
|
Quad: TVersionQuad;
|
|
VInfo: TFileVersionInfo;
|
|
EqualsPos: integer;
|
|
begin
|
|
s := Application.Title + LineEnding;
|
|
if GetProgramVersion(Quad) then
|
|
s += 'Version: ' + VersionQuadToStr(Quad) + LineEnding;
|
|
Vinfo := TFileVersionInfo.Create(Application);
|
|
try
|
|
Vinfo.Filter.Add('LegalCopyright'); // Set In Project/Options/Version Info
|
|
Vinfo.Filter.Add('FileDescription'); // Set In Project/Options/Version Info
|
|
Vinfo.ReadFileInfo;
|
|
if VInfo.VersionStrings.Count > 0 then
|
|
begin
|
|
EqualsPos := Pos('=', VInfo.VersionStrings[1]); // Copyright
|
|
if (EqualsPos > 0) then
|
|
s += RightStr(VInfo.VersionStrings[1], Length(VInfo.VersionStrings[1]) -
|
|
EqualsPos) + LineEnding;
|
|
end;
|
|
// Comment line below out for JEDI source prettification
|
|
s+=Format(rsCompiledWith2,
|
|
[{$I %FPCVERSION%},lcl_major,lcl_minor,LineEnding,{$I %FPCTARGETCPU%},{$I %FPCTARGETOS%},LineEnding,LineEnding]);
|
|
if VInfo.VersionStrings.Count > 1 then
|
|
begin
|
|
EqualsPos := Pos('=', VInfo.VersionStrings[0]); // File Deswcription
|
|
if (EqualsPos > 0) then
|
|
s += RightStr(VInfo.VersionStrings[0], Length(VInfo.VersionStrings[0]) -
|
|
EqualsPos) + LineEnding;
|
|
|
|
end;
|
|
finally
|
|
Vinfo.Free;
|
|
end;
|
|
MessageDlg(rsAbout + ' ' + Application.Title, s, mtInformation, [mbOK], 0);
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_helpAutoloadLastFileClick(Sender: TObject);
|
|
begin
|
|
bAutoLoadLast:= NOT bAutoLoadLast;
|
|
mnu_helpAutoloadLastFile.Checked:=bAutoLoadLast;
|
|
CFG.WriteBool('Options', 'AutoLoadLastFile',bAutoLoadLast);
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_helpDisableWarningsClick(Sender: TObject);
|
|
begin
|
|
bDisableWarnings := not bDisableWarnings;
|
|
mnu_helpDisableWarnings.Checked := bDisableWarnings;
|
|
CFG.WriteBool('Options', 'DiableWarnings', bDisableWarnings);
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_helpShowHintsClick(Sender: TObject);
|
|
begin
|
|
bShowPopupHints := mnu_helpShowHints.Checked;
|
|
CFG.WriteBool('Options', 'ShowPopupHints', bShowPopupHints);
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_lang_enClick(Sender: TObject);
|
|
begin
|
|
SetDefaultLang('en', 'locale', True);
|
|
if Length(GetDefaultLang) > 0 then
|
|
begin
|
|
if bIsVirgin then
|
|
ShowMessageFmt(rsLanguageChan + '%s' + rsYouMayNeedTo, [GetDefaultLang,LineEnding])
|
|
else
|
|
ShowMessageFmt(rsLanguageChan, [GetDefaultLang]);
|
|
|
|
CFG.WriteString('Options', 'Language', GetDefaultLang);
|
|
mnu_lang_en.Checked := True;
|
|
end
|
|
else
|
|
begin
|
|
mnu_lang_en.Checked := False;
|
|
// SetDefaultLang(''); // Back to default?
|
|
ShowMessage(rsSorryThisLan + LineEnding + rsYouMayNeedTo);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.mnu_lang_esClick(Sender: TObject);
|
|
begin
|
|
SetDefaultLang('es', 'locale', True);
|
|
if Length(GetDefaultLang) > 0 then
|
|
begin
|
|
if bIsVirgin then
|
|
ShowMessageFmt(rsLanguageChan + '%s' + rsYouMayNeedTo, [GetDefaultLang,LineEnding])
|
|
else
|
|
ShowMessageFmt(rsLanguageChan, [GetDefaultLang]);
|
|
CFG.WriteString('Options', 'Language', GetDefaultLang);
|
|
mnu_lang_es.Checked := True;
|
|
end
|
|
else
|
|
begin
|
|
mnu_lang_es.Checked := False;
|
|
SetDefaultLang(''); // Back to DefaultTranslator
|
|
ShowMessage(rsSorryThisLan);
|
|
end;
|
|
end;
|
|
|
|
function TfrmMain.ValidationFailed: boolean;
|
|
// Add checks as needed here
|
|
var
|
|
iCount: integer;
|
|
begin
|
|
Result := False;
|
|
// Check Zipname and URL http:// length
|
|
if (Length(edt_UpdateZipName.Text) < 5) then
|
|
begin
|
|
edt_UpdateZipName.Color := clYellow;
|
|
slErrorList.Add(rsUpdateZipNam);
|
|
Result := True;
|
|
end;
|
|
// URL implausable?
|
|
if (Length(edt_DownloadZipURL.Text) < 10) then
|
|
begin
|
|
slErrorList.Add(rsDownloadZipURLI);
|
|
edt_DownloadZipURL.Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
// Remembered to type 'zip'?
|
|
if (Length(edt_UpdateZipName.Text) > 4) then
|
|
if (RightStr(LowerCase(edt_UpdateZipName.Text), 4) <> '.zip') then
|
|
begin
|
|
slErrorList.Add(rsUpdateZipNam2);
|
|
edt_UpdateZipName.Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
// A full URL?
|
|
if ((Length(edt_DownloadZipURL.Text) > 0) and
|
|
(RightStr(edt_DownloadZipURL.Text, 1) = '/')) then
|
|
begin
|
|
slErrorList.Add(rsDownloadZipURLI2);
|
|
edt_DownloadZipURL.Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
// URL starts with 'http' ?
|
|
if ((Length(edt_DownloadZipURL.Text) > 4) and
|
|
(LeftStr(LowerCase(edt_DownloadZipURL.Text), 4) <> 'http')) then
|
|
begin
|
|
slErrorList.Add(rsDownloadZipURLS);
|
|
edt_DownloadZipURL.Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
// URL contains zipfile name?
|
|
if (Pos(Lowercase(edt_UpdateZipName.Text),
|
|
Lowercase(edt_DownloadZipURL.Text)) = 0) then
|
|
begin
|
|
slErrorList.Add(rsDownloadZipURLD);
|
|
edt_DownloadZipURL.Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
|
|
// Check package files entries
|
|
for iCount := 0 to High(ArrayGrpBox) do
|
|
begin
|
|
// Is package name empty?
|
|
if Length(ArrayEdtPackageFileName[iCount].Text) = 0 then
|
|
begin
|
|
slErrorList.Add(Format(rsTheLpkEntryD2, [Succ(iCount)]));
|
|
ArrayEdtPackageFileName[iCount].Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
// Does it end with 'lpk'
|
|
if (RightStr(LowerCase(ArrayEdtPackageFileName[iCount].Text), 4) <> '.lpk') then
|
|
begin
|
|
slErrorList.Add(Format(rsTheLpkEntryD, [Succ(iCount)]));
|
|
ArrayEdtPackageFileName[iCount].Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
// Is the version number zero
|
|
if (ArraySpinEditV1[iCount].Value = 0) and
|
|
(ArraySpinEditV2[iCount].Value = 0) and
|
|
(ArraySpinEditV3[iCount].Value = 0) and
|
|
(ArraySpinEditV4[iCount].Value = 0) then
|
|
begin
|
|
slErrorList.Add(Format(rsVersionForPa, [Succ(iCount)]));
|
|
ArraySpinEditV1[iCount].Color := clYellow;
|
|
ArraySpinEditV2[iCount].Color := clYellow;
|
|
ArraySpinEditV3[iCount].Color := clYellow;
|
|
ArraySpinEditV4[iCount].Color := clYellow;
|
|
Result := True;
|
|
end;
|
|
// Check Forcenotify version isn't zero
|
|
if ArrayChkBoxForceNotify[iCount].Checked = True then
|
|
if ArraySpinEditInternalVersion[iCount].Value = 0 then
|
|
begin
|
|
ArraySpinEditInternalVersion[iCount].Color := clYellow;
|
|
slErrorList.Add(Format(rsInternalVers2, [LineEnding]));
|
|
Result := True;
|
|
end;
|
|
// Check for duplicate .lpk entries
|
|
if FoundADuplicateLPK then
|
|
if slErrorList.IndexOf(Format(rsThereAreOneO, [LineEnding])) = -1 then
|
|
begin
|
|
ArrayEdtPackageFileName[iCount].Color := clYellow;
|
|
slErrorList.Add(Format(rsThereAreOneO, [LineEnding]));
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.SaveAsItemClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
Quad: TVersionQuad;
|
|
begin
|
|
if ValidationFailed then
|
|
begin
|
|
if (slErrorList.Count > 1) then
|
|
ShowMessage(rsOneOfTheReqn + LineEnding + slErrorList.Text +
|
|
LineEnding + rsFixThenTryAg)
|
|
else
|
|
ShowMessage(rsOneOfTheReq1 + LineEnding + slErrorList.Text +
|
|
LineEnding + rsFixThenTryAg);
|
|
Exit;
|
|
end;
|
|
if bForceSaveAs or (sJSONFilePath = 'unknown') then
|
|
begin
|
|
FileSaveAs1.Dialog.InitialDir := sUpdateDirectory;
|
|
FileSaveAs1.Dialog.FileName :=
|
|
'update_' + ExtractFilenameOnly(edt_UpdateZipName.Text) + '.json';
|
|
|
|
if FileSaveAs1.Dialog.Execute then
|
|
begin
|
|
sJSONFilePath := FileSaveAs1.Dialog.FileName;
|
|
end
|
|
else
|
|
Exit;
|
|
end;
|
|
|
|
JSONPackage := TUpdatePackage.Create;
|
|
try
|
|
JSONPackage.UpdatePackageData.Name := edt_UpdateZipName.Text;
|
|
JSONPackage.UpdatePackageData.DownloadZipURL := edt_DownloadZipURL.Text;
|
|
JSONPackage.UpdatePackageData.DisableInOPM := chk_DisableInOPM.Checked;
|
|
for i := 0 to High(ArrayGrpBox) do
|
|
begin
|
|
with JSONPackage.UpdatePackageFiles.Add do
|
|
begin
|
|
Name := ArrayEdtPackageFileName[i].Text;
|
|
Quad[1] := ArraySpinEditV1[i].Value;
|
|
Quad[2] := ArraySpinEditV2[i].Value;
|
|
Quad[3] := ArraySpinEditV3[i].Value;
|
|
Quad[4] := ArraySpinEditV4[i].Value;
|
|
Version := VersionQuadToStr(Quad);
|
|
ForceNotify := ArrayChkBoxForceNotify[i].Checked;
|
|
InternalVersion := ArraySpinEditInternalVersion[i].Value;
|
|
end;
|
|
end;
|
|
|
|
// Process Options before saving
|
|
if bIsVirgin then
|
|
if MessageDlg(Format(rsFileSCanBeAu,
|
|
[ExtractFileName(sJSONFilePath),Application.Title,LineEnding,LineEnding,mnu_helpAutoloadLastFile.Caption]),
|
|
mtInformation,[MBYES,MBNO],0,MBYES) = mrYes then
|
|
begin
|
|
mnu_helpAutoloadLastFile.Checked:=TRUE;
|
|
bAutoLoadLast:=TRUE;
|
|
CFG.WriteBool('Options', 'AutoLoadLastFile',bAutoLoadLast);
|
|
end;
|
|
|
|
|
|
if FileExistsUTF8(sJSONFilePath) and (bDisableWarnings = False) then
|
|
// Overwrite?
|
|
begin
|
|
if MessageDlg(rsOverwrite + ' ' + sJSONFilePath + '?', mtConfirmation,
|
|
[mbYes, mbNo], 0, mbYes) = mrYes then
|
|
if JSONPackage.SaveToFile(sJSONFilePath) then
|
|
begin
|
|
ShowMessage(sJSONFilePath + ' ' + rsSavedOK);
|
|
If (bAutoLoadLast = TRUE) then
|
|
CFG.WriteString('Options','LastSavedJSON',sJSONFilePath);
|
|
end;
|
|
end
|
|
else
|
|
// New file
|
|
if JSONPackage.SaveToFile(sJSONFilePath) then
|
|
begin
|
|
If (bDisableWarnings = True) then
|
|
begin
|
|
ShowMessage(sJSONFilePath + ' ' + rsSavedOK);
|
|
If (bAutoLoadLast = TRUE) then
|
|
CFG.WriteString('Options','LastSavedJSON',sJSONFilePath);
|
|
end
|
|
else
|
|
If (bAutoLoadLast = TRUE) then
|
|
if MessageDlg(sJSONFilePath + ' ' + rsSavedOK + LineEnding +
|
|
'Save this location for next Auto-Load?',
|
|
mtConfirmation,[MBYES,MBNO],0,MBYES) = mrYes then
|
|
CFG.WriteString('Options','LastSavedJSON',sJSONFilePath);
|
|
end
|
|
else
|
|
ShowMessage(rsSaveUnsucces);
|
|
bDirty := False;
|
|
finally
|
|
JSONPackage.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.sb_editNameClick(Sender: TObject);
|
|
var
|
|
s: string;
|
|
begin
|
|
FileOpen1.Dialog.InitialDir :=
|
|
CFG.ReadString('Options', 'LastLoadedZipPath', sZipDirectory);
|
|
FileOpen1.Dialog.Filter := rsUpdate + ' ZIP|*.zip';
|
|
if FileOpen1.Dialog.Execute then
|
|
begin
|
|
// Offer to copy to /updates?
|
|
sZipDirectory := ExtractFileDir(FileOpen1.Dialog.Filename);
|
|
CFG.WriteString('Options', 'LastLoadedZipPath', sZipDirectory);
|
|
s := ExtractFileName(FileOpen1.Dialog.Filename);
|
|
edt_UpdateZipName.Text := s;
|
|
if MessageDlg(Format(rsWouldYouLike, [s, sUpdateDirectory]),
|
|
mtConfirmation, [mbYes, mbNo], 0, mbYes) = mrYes then
|
|
begin
|
|
if CopyFile(FileOpen1.Dialog.Filename, sUpdateDirectory +
|
|
DirectorySeparator + s) then
|
|
ShowMessageFmt(rsSWasSuccessf, [s, sUpdateDirectory])
|
|
else
|
|
ShowMessage(rsSorryCopyOpe);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.spd_CheckURLClick(Sender: TObject);
|
|
// Show a popup notification because it takes time to open a browser window
|
|
var
|
|
bTemp: boolean;
|
|
sOldHint: string;
|
|
begin
|
|
if OpenURL(edt_DownloadZipURL.Text) then
|
|
begin
|
|
bTemp := bShowPopupHints;
|
|
sOldHint := spd_CheckURL.Hint;
|
|
spd_CheckURL.Hint := rsOpeningYourB;
|
|
bShowPopupHints := True;
|
|
CtrlShowPopup(spd_CheckURL);
|
|
spd_CheckURL.Hint := sOldHint;
|
|
bShowPopupHints := bTemp;
|
|
end;
|
|
end;
|
|
|
|
{ TPackage }
|
|
|
|
constructor TUpdatePackage.Create;
|
|
begin
|
|
FUpdatePackageData := TUpdatePackageData.Create;
|
|
FUpdatePackageFiles := TPackageFilesList.Create;
|
|
end;
|
|
|
|
destructor TUpdatePackage.Destroy;
|
|
var
|
|
c: TCollectionItem;
|
|
begin
|
|
FUpdatePackageData.Free;
|
|
for c in FUpdatePackageFiles do
|
|
c.Free;
|
|
FUpdatePackageFiles.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TUpdatePackage.LoadFromFile(AFileName: string): boolean;
|
|
var
|
|
DeStreamer: TJSONDeStreamer;
|
|
s: TStringList;
|
|
begin
|
|
Result := True;
|
|
s := TStringList.Create;
|
|
try
|
|
s.LoadFromFile(AFileName);
|
|
DeStreamer := TJSONDeStreamer.Create(nil);
|
|
try
|
|
DeStreamer.JSONToObject(s.Text, Self);
|
|
except
|
|
// Eat the exception
|
|
On E: Exception do
|
|
Result := False;
|
|
end;
|
|
finally
|
|
DeStreamer.Free;
|
|
s.Free;
|
|
end;
|
|
end;
|
|
|
|
function TUpdatePackage.SaveToFile(AFileName: string): boolean;
|
|
var
|
|
Streamer: TJSONStreamer;
|
|
s: TStringList;
|
|
begin
|
|
Result := True;
|
|
s := TStringList.Create;
|
|
try
|
|
Streamer := TJSONStreamer.Create(nil);
|
|
Streamer.Options := Streamer.Options + [jsoUseFormatString];
|
|
s.AddText(Streamer.ObjectToJSONString(Self));
|
|
try
|
|
s.SaveToFile(AFileName);
|
|
except
|
|
// Eat the exception
|
|
On E: Exception do
|
|
Result := False;
|
|
end;
|
|
finally
|
|
Streamer.Free;
|
|
s.Free;
|
|
end;
|
|
end;
|
|
|
|
// Use embedded .po resources if not distributed with executable
|
|
// Update for more languages
|
|
initialization
|
|
{$IFDEF PO_BUILTINRES}
|
|
sPoPath_en := ProgramDirectory + 'locale' + PathDelim + ExtractFilenameOnly(
|
|
Application.EXEName) + '.en.po';
|
|
sPoPath_es := ProgramDirectory + 'locale' + PathDelim + ExtractFilenameOnly(
|
|
Application.EXEName) + '.es.po';
|
|
//if (lcl_major > 0) and (lcl_minor > 6) then // Can't use a LazVersion $DEFINE :(
|
|
{$IFDEF LAZ17}
|
|
begin
|
|
// This uses a resource file added via Project/Options (Laz 1.7+)
|
|
if not FileExistsUTF8(sPoPath_en) then
|
|
begin
|
|
// create a resource stream which points to the po file
|
|
S := TResourceStream.Create(HInstance, 'JSONEDITOR.EN', MakeIntResource(10));
|
|
try
|
|
ForceDirectoriesUTF8(ProgramDirectory + 'locale');
|
|
F := TFileStream.Create(sPoPath_en, fmCreate);
|
|
try
|
|
F.CopyFrom(S, S.Size); // copy data from the resource stream to file stream
|
|
finally
|
|
F.Free; // destroy the file stream
|
|
end;
|
|
finally
|
|
S.Free; // destroy the resource stream
|
|
end;
|
|
end;
|
|
if not FileExistsUTF8(sPoPath_es) then
|
|
begin
|
|
S := TResourceStream.Create(HInstance, 'JSONEDITOR.ES', MakeIntResource(10));
|
|
try
|
|
ForceDirectoriesUTF8(ProgramDirectory + 'locale');
|
|
F := TFileStream.Create(sPoPath_es, fmCreate);
|
|
try
|
|
F.CopyFrom(S, S.Size);
|
|
finally
|
|
F.Free
|
|
end;
|
|
finally
|
|
S.Free;
|
|
end;
|
|
end;
|
|
end
|
|
{$ELSE}
|
|
//else
|
|
begin // Older version of laz
|
|
// This uses an lrs file generated from lazres
|
|
// Can't disable this with a LazVersion $DEFINE :(
|
|
{$I translate.lrs}
|
|
if not FileExistsUTF8(sPoPath_es) then
|
|
begin
|
|
aLRes := LazarusResources.Find('jsoneditor.es');
|
|
if assigned(aLRes) then
|
|
begin
|
|
ForceDirectory(ProgramDirectory + 'locale');
|
|
aSS := TStringListUTF8.Create;
|
|
try
|
|
Ass.Add(aLRes.Value);
|
|
aSS.SaveToFile(sPoPath_es);
|
|
finally
|
|
aSS.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
if not FileExistsUTF8(sPoPath_en) then
|
|
begin
|
|
aLRes := LazarusResources.Find('jsoneditor.en');
|
|
if assigned(aLRes) then
|
|
begin
|
|
ForceDirectory(ProgramDirectory + 'locale');
|
|
aSS := TStringListUTF8.Create;
|
|
try
|
|
Ass.Add(aLRes.Value);
|
|
aSS.SaveToFile(sPoPath_en);
|
|
finally
|
|
aSS.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end.
|