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 . 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; { 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.