mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 06:16:05 +02:00
Opkman: Submit packages to remote server.
git-svn-id: trunk@53885 -
This commit is contained in:
parent
27eb75ed6b
commit
dbe254e132
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -3316,6 +3316,7 @@ components/onlinepackagemanager/opkman_progressfrm.pas svneol=native#text/pascal
|
|||||||
components/onlinepackagemanager/opkman_serializablepackages.pas svneol=native#text/pascal
|
components/onlinepackagemanager/opkman_serializablepackages.pas svneol=native#text/pascal
|
||||||
components/onlinepackagemanager/opkman_timer.pas svneol=native#text/pascal
|
components/onlinepackagemanager/opkman_timer.pas svneol=native#text/pascal
|
||||||
components/onlinepackagemanager/opkman_updates.pas svneol=native#text/pascal
|
components/onlinepackagemanager/opkman_updates.pas svneol=native#text/pascal
|
||||||
|
components/onlinepackagemanager/opkman_uploader.pas svneol=native#text/pascal
|
||||||
components/onlinepackagemanager/opkman_visualtree.pas svneol=native#text/pascal
|
components/onlinepackagemanager/opkman_visualtree.pas svneol=native#text/pascal
|
||||||
components/onlinepackagemanager/opkman_zipper.pas svneol=native#text/pascal
|
components/onlinepackagemanager/opkman_zipper.pas svneol=native#text/pascal
|
||||||
components/onlinepackagemanager/vst/include/carbon/opkman_delphicompat.inc svneol=native#text/plain
|
components/onlinepackagemanager/vst/include/carbon/opkman_delphicompat.inc svneol=native#text/plain
|
||||||
|
@ -1,9 +1,9 @@
|
|||||||
object CreateRepositoryPackagefr: TCreateRepositoryPackagefr
|
object CreateRepositoryPackagefr: TCreateRepositoryPackagefr
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 450
|
Height = 506
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 750
|
Width = 750
|
||||||
ClientHeight = 450
|
ClientHeight = 506
|
||||||
ClientWidth = 750
|
ClientWidth = 750
|
||||||
Color = clBtnFace
|
Color = clBtnFace
|
||||||
ParentColor = False
|
ParentColor = False
|
||||||
@ -12,7 +12,7 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr
|
|||||||
DesignTop = 213
|
DesignTop = 213
|
||||||
object pnMessage: TPanel
|
object pnMessage: TPanel
|
||||||
Left = 247
|
Left = 247
|
||||||
Height = 340
|
Height = 400
|
||||||
Top = 65
|
Top = 65
|
||||||
Width = 503
|
Width = 503
|
||||||
Align = alClient
|
Align = alClient
|
||||||
@ -31,7 +31,7 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr
|
|||||||
end
|
end
|
||||||
object pnPackages: TPanel
|
object pnPackages: TPanel
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 340
|
Height = 400
|
||||||
Top = 65
|
Top = 65
|
||||||
Width = 245
|
Width = 245
|
||||||
Align = alLeft
|
Align = alLeft
|
||||||
@ -81,23 +81,23 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr
|
|||||||
end
|
end
|
||||||
object pnData: TPanel
|
object pnData: TPanel
|
||||||
Left = 247
|
Left = 247
|
||||||
Height = 340
|
Height = 400
|
||||||
Top = 65
|
Top = 65
|
||||||
Width = 503
|
Width = 503
|
||||||
Align = alClient
|
Align = alClient
|
||||||
BevelOuter = bvNone
|
BevelOuter = bvNone
|
||||||
ClientHeight = 340
|
ClientHeight = 400
|
||||||
ClientWidth = 503
|
ClientWidth = 503
|
||||||
TabOrder = 2
|
TabOrder = 2
|
||||||
object pnPackageData: TPanel
|
object pnPackageData: TPanel
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 151
|
Height = 211
|
||||||
Top = 189
|
Top = 189
|
||||||
Width = 503
|
Width = 503
|
||||||
Align = alClient
|
Align = alClient
|
||||||
BevelOuter = bvNone
|
BevelOuter = bvNone
|
||||||
BorderStyle = bsSingle
|
BorderStyle = bsSingle
|
||||||
ClientHeight = 147
|
ClientHeight = 207
|
||||||
ClientWidth = 499
|
ClientWidth = 499
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
Visible = False
|
Visible = False
|
||||||
@ -324,7 +324,7 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr
|
|||||||
end
|
end
|
||||||
object spMain: TSplitter
|
object spMain: TSplitter
|
||||||
Left = 245
|
Left = 245
|
||||||
Height = 340
|
Height = 400
|
||||||
Top = 65
|
Top = 65
|
||||||
Width = 2
|
Width = 2
|
||||||
AutoSnap = False
|
AutoSnap = False
|
||||||
@ -334,75 +334,105 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr
|
|||||||
end
|
end
|
||||||
object pnButtons: TPanel
|
object pnButtons: TPanel
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 45
|
Height = 41
|
||||||
Top = 405
|
Top = 465
|
||||||
Width = 750
|
Width = 750
|
||||||
Align = alBottom
|
Align = alBottom
|
||||||
BevelOuter = bvNone
|
BevelOuter = bvNone
|
||||||
BorderStyle = bsSingle
|
BorderStyle = bsSingle
|
||||||
ClientHeight = 41
|
ClientHeight = 37
|
||||||
ClientWidth = 746
|
ClientWidth = 746
|
||||||
TabOrder = 5
|
TabOrder = 5
|
||||||
object bCreate: TButton
|
|
||||||
Left = 584
|
|
||||||
Height = 26
|
|
||||||
Top = 8
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Create'
|
|
||||||
Enabled = False
|
|
||||||
OnClick = bCreateClick
|
|
||||||
TabOrder = 3
|
|
||||||
end
|
|
||||||
object bCancel: TButton
|
|
||||||
Left = 661
|
|
||||||
Height = 26
|
|
||||||
Top = 8
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Cancel'
|
|
||||||
Enabled = False
|
|
||||||
ModalResult = 2
|
|
||||||
OnClick = bCancelClick
|
|
||||||
TabOrder = 4
|
|
||||||
end
|
|
||||||
object cbOpen: TCheckBox
|
|
||||||
Left = 10
|
|
||||||
Height = 19
|
|
||||||
Top = 1
|
|
||||||
Width = 211
|
|
||||||
Caption = 'After create, open containing folder '
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object bOptions: TButton
|
|
||||||
Left = 507
|
|
||||||
Height = 26
|
|
||||||
Top = 8
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Options'
|
|
||||||
Enabled = False
|
|
||||||
OnClick = bOptionsClick
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
object bHelp: TButton
|
|
||||||
Left = 430
|
|
||||||
Height = 26
|
|
||||||
Top = 8
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Help'
|
|
||||||
Enabled = False
|
|
||||||
OnClick = bHelpClick
|
|
||||||
TabOrder = 5
|
|
||||||
end
|
|
||||||
object cbJSONForUpdates: TCheckBox
|
object cbJSONForUpdates: TCheckBox
|
||||||
Left = 10
|
Left = 10
|
||||||
Height = 19
|
Height = 19
|
||||||
Top = 21
|
Top = 9
|
||||||
Width = 148
|
Width = 148
|
||||||
Caption = 'Create JSON for updates'
|
Caption = 'Create JSON for updates'
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object pnB: TPanel
|
||||||
|
Left = 322
|
||||||
|
Height = 29
|
||||||
|
Top = 2
|
||||||
|
Width = 400
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
BorderSpacing.InnerBorder = 1
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 29
|
||||||
|
ClientWidth = 400
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
|
object bCancel: TButton
|
||||||
|
Left = 324
|
||||||
|
Height = 27
|
||||||
|
Top = 1
|
||||||
|
Width = 75
|
||||||
|
Align = alRight
|
||||||
|
BorderSpacing.Around = 1
|
||||||
|
Caption = 'Cancel'
|
||||||
|
Enabled = False
|
||||||
|
ModalResult = 2
|
||||||
|
OnClick = bCancelClick
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object bCreate: TButton
|
||||||
|
Left = 172
|
||||||
|
Height = 27
|
||||||
|
Top = 1
|
||||||
|
Width = 75
|
||||||
|
Align = alRight
|
||||||
|
BorderSpacing.Around = 1
|
||||||
|
Caption = 'Create'
|
||||||
|
Enabled = False
|
||||||
|
OnClick = bCreateClick
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object bSubmit: TButton
|
||||||
|
Left = 248
|
||||||
|
Height = 27
|
||||||
|
Top = 1
|
||||||
|
Width = 75
|
||||||
|
Align = alRight
|
||||||
|
BorderSpacing.Around = 1
|
||||||
|
Caption = 'Submit'
|
||||||
|
Enabled = False
|
||||||
|
OnClick = bSubmitClick
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object bOptions: TButton
|
||||||
|
Left = 96
|
||||||
|
Height = 27
|
||||||
|
Top = 1
|
||||||
|
Width = 75
|
||||||
|
Align = alRight
|
||||||
|
BorderSpacing.Around = 1
|
||||||
|
Caption = 'Options'
|
||||||
|
Enabled = False
|
||||||
|
OnClick = bOptionsClick
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object bHelp: TButton
|
||||||
|
Left = 20
|
||||||
|
Height = 27
|
||||||
|
Top = 1
|
||||||
|
Width = 75
|
||||||
|
Align = alRight
|
||||||
|
BorderSpacing.Around = 1
|
||||||
|
Caption = 'Help'
|
||||||
|
Enabled = False
|
||||||
|
OnClick = bHelpClick
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 4
|
||||||
|
end
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
object imTree: TImageList
|
object imTree: TImageList
|
||||||
|
@ -7,7 +7,8 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, Dialogs,
|
Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, Dialogs,
|
||||||
LazFileUtils, Graphics, Menus, Buttons, Laz2_XMLCfg, opkman_VirtualTrees,
|
LazFileUtils, Graphics, Menus, Buttons, Laz2_XMLCfg, opkman_VirtualTrees,
|
||||||
md5, fpjson, LCLIntf, EditBtn, opkman_serializablepackages, opkman_zipper;
|
md5, fpjson, LCLIntf, EditBtn, opkman_serializablepackages, opkman_zipper,
|
||||||
|
opkman_uploader;
|
||||||
|
|
||||||
type
|
type
|
||||||
PData = ^TData;
|
PData = ^TData;
|
||||||
@ -33,7 +34,7 @@ type
|
|||||||
FSVNURL: String;
|
FSVNURL: String;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
TPackageOperation = (poCreate, poSubmit);
|
||||||
{ TCreateRepositoryPackagefr }
|
{ TCreateRepositoryPackagefr }
|
||||||
|
|
||||||
TCreateRepositoryPackagefr = class(TFrame)
|
TCreateRepositoryPackagefr = class(TFrame)
|
||||||
@ -42,8 +43,8 @@ type
|
|||||||
Bevel1: TBevel;
|
Bevel1: TBevel;
|
||||||
bHelp: TButton;
|
bHelp: TButton;
|
||||||
bOptions: TButton;
|
bOptions: TButton;
|
||||||
|
bSubmit: TButton;
|
||||||
cbJSONForUpdates: TCheckBox;
|
cbJSONForUpdates: TCheckBox;
|
||||||
cbOpen: TCheckBox;
|
|
||||||
edCategories: TEdit;
|
edCategories: TEdit;
|
||||||
edPackageDir: TDirectoryEdit;
|
edPackageDir: TDirectoryEdit;
|
||||||
edDownloadURL: TEdit;
|
edDownloadURL: TEdit;
|
||||||
@ -67,6 +68,7 @@ type
|
|||||||
lbOF4: TLabel;
|
lbOF4: TLabel;
|
||||||
lbPackagedir: TLabel;
|
lbPackagedir: TLabel;
|
||||||
lbSupportedWidgetSet: TLabel;
|
lbSupportedWidgetSet: TLabel;
|
||||||
|
pnB: TPanel;
|
||||||
pnButtons: TPanel;
|
pnButtons: TPanel;
|
||||||
pnCategories: TPanel;
|
pnCategories: TPanel;
|
||||||
pnPackageData: TPanel;
|
pnPackageData: TPanel;
|
||||||
@ -82,6 +84,7 @@ type
|
|||||||
procedure bCreateClick(Sender: TObject);
|
procedure bCreateClick(Sender: TObject);
|
||||||
procedure bHelpClick(Sender: TObject);
|
procedure bHelpClick(Sender: TObject);
|
||||||
procedure bOptionsClick(Sender: TObject);
|
procedure bOptionsClick(Sender: TObject);
|
||||||
|
procedure bSubmitClick(Sender: TObject);
|
||||||
procedure edPackageDirAcceptDirectory(Sender: TObject; var Value: String);
|
procedure edPackageDirAcceptDirectory(Sender: TObject; var Value: String);
|
||||||
procedure edPackageDirButtonClick(Sender: TObject);
|
procedure edPackageDirButtonClick(Sender: TObject);
|
||||||
procedure pnBrowseResize(Sender: TObject);
|
procedure pnBrowseResize(Sender: TObject);
|
||||||
@ -89,12 +92,12 @@ type
|
|||||||
private
|
private
|
||||||
FVSTPackages: TVirtualStringTree;
|
FVSTPackages: TVirtualStringTree;
|
||||||
FVSTPackageData: TVirtualStringTree;
|
FVSTPackageData: TVirtualStringTree;
|
||||||
FCreatePressed: Boolean;
|
|
||||||
FPackageZipper: TPackageZipper;
|
FPackageZipper: TPackageZipper;
|
||||||
FPackageDir: String;
|
FPackageDir: String;
|
||||||
FPackageName: String;
|
FPackageName: String;
|
||||||
FPackageFile: String;
|
FPackageFile: String;
|
||||||
FDestDir: String;
|
FDestDir: String;
|
||||||
|
FPackageOperation: TPackageOperation;
|
||||||
procedure VSTPackagesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
procedure VSTPackagesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||||
Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
|
Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
|
||||||
procedure VSTPackagesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
procedure VSTPackagesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||||
@ -118,9 +121,14 @@ type
|
|||||||
procedure EnableDisableControls(const AEnable: Boolean);
|
procedure EnableDisableControls(const AEnable: Boolean);
|
||||||
procedure SaveExtraInfo(const ANode: PVirtualNode);
|
procedure SaveExtraInfo(const ANode: PVirtualNode);
|
||||||
function TranslateCategories(const AStr: String): String;
|
function TranslateCategories(const AStr: String): String;
|
||||||
procedure CreateJSONForUpdates;
|
function CanCreate: Boolean;
|
||||||
|
function CreateJSON(var AErrMsg: String): Boolean;
|
||||||
|
function CreateJSONForUpdates(var AErrMsg: String): Boolean;
|
||||||
|
procedure DoOnUploadProgress(Sender: TObject; AFileName: String);
|
||||||
|
procedure DoOnUploadError(Sender: TObject; AErrMsg: String);
|
||||||
|
procedure DoOnUploadCompleted(Sender: TObject);
|
||||||
public
|
public
|
||||||
procedure InitializeFrame;
|
procedure InitializeFrame(const ATyp: Integer = 0);
|
||||||
procedure FinalizeFrame;
|
procedure FinalizeFrame;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -131,11 +139,10 @@ uses opkman_const, opkman_common, opkman_options, opkman_categoriesfrm,
|
|||||||
|
|
||||||
{ TCreateRepositoryPackagefr }
|
{ TCreateRepositoryPackagefr }
|
||||||
|
|
||||||
procedure TCreateRepositoryPackagefr.InitializeFrame;
|
procedure TCreateRepositoryPackagefr.InitializeFrame(const ATyp: Integer = 0);
|
||||||
begin
|
begin
|
||||||
lbPackagedir.Caption := rsCreateRepositoryPackageFrm_lbPackageDir_Caption;
|
lbPackagedir.Caption := rsCreateRepositoryPackageFrm_lbPackageDir_Caption;
|
||||||
pnMessage.Caption := rsCreateRepositoryPackageFrm_pnMessage_Caption;
|
pnMessage.Caption := rsCreateRepositoryPackageFrm_pnMessage_Caption;
|
||||||
cbOpen.Caption := rsCreateRepositoryPackageFrm_cbOpen_Caption;
|
|
||||||
edCategories.Text := '';
|
edCategories.Text := '';
|
||||||
lbLazCompatibility.Caption := rsCreateRepositoryPackageFrm_lbLazCompatibility_Caption;
|
lbLazCompatibility.Caption := rsCreateRepositoryPackageFrm_lbLazCompatibility_Caption;
|
||||||
lbFPCCompatibility.Caption := rsCreateRepositoryPackageFrm_lbFPCCompatibility_Caption;
|
lbFPCCompatibility.Caption := rsCreateRepositoryPackageFrm_lbFPCCompatibility_Caption;
|
||||||
@ -146,9 +153,19 @@ begin
|
|||||||
lbDownloadURL.Caption := rsCreateRepositoryPackageFrm_lbDownloadURL_Caption;
|
lbDownloadURL.Caption := rsCreateRepositoryPackageFrm_lbDownloadURL_Caption;
|
||||||
lbSVNURL.Caption := rsCreateRepositoryPackageFrm_lbSVNURL_Caption;
|
lbSVNURL.Caption := rsCreateRepositoryPackageFrm_lbSVNURL_Caption;
|
||||||
bHelp.Caption := rsCreateRepositoryPackageFrm_bHelp_Caption;
|
bHelp.Caption := rsCreateRepositoryPackageFrm_bHelp_Caption;
|
||||||
|
bHelp.Hint := rsCreateRepositoryPackageFrm_bHelp_Hint;
|
||||||
bOptions.Caption := rsCreateRepositoryPackageFrm_bOptions_Caption;
|
bOptions.Caption := rsCreateRepositoryPackageFrm_bOptions_Caption;
|
||||||
|
bOptions.Hint := rsCreateRepositoryPackageFrm_bOptions_Hint;
|
||||||
bCreate.Caption := rsCreateRepositoryPackageFrm_bCreate_Caption;
|
bCreate.Caption := rsCreateRepositoryPackageFrm_bCreate_Caption;
|
||||||
|
bCreate.Hint := rsCreateRepositoryPackageFrm_bCreate_Hint;
|
||||||
|
bSubmit.Caption := rsCreateRepositoryPackageFrm_bSubmit_Caption;
|
||||||
|
bSubmit.Hint := rsCreateRepositoryPackageFrm_bSubmit_Hint;
|
||||||
bCancel.Caption := rsCreateRepositoryPackageFrm_bCancel_Caption;
|
bCancel.Caption := rsCreateRepositoryPackageFrm_bCancel_Caption;
|
||||||
|
bCancel.Hint := rsCreateRepositoryPackageFrm_bCancel_Hint;
|
||||||
|
bSubmit.Visible := ATyp = 0;
|
||||||
|
cbJSONForUpdates.Visible := ATyp = 0;
|
||||||
|
pnB.Height := bCreate.Height + 1;
|
||||||
|
pnB.Top := (pnButtons.Height - pnB.Height) div 2;
|
||||||
|
|
||||||
FVSTPackages := TVirtualStringTree.Create(nil);
|
FVSTPackages := TVirtualStringTree.Create(nil);
|
||||||
with FVSTPackages do
|
with FVSTPackages do
|
||||||
@ -230,6 +247,15 @@ end;
|
|||||||
|
|
||||||
procedure TCreateRepositoryPackagefr.FinalizeFrame;
|
procedure TCreateRepositoryPackagefr.FinalizeFrame;
|
||||||
begin
|
begin
|
||||||
|
if Uploader <> nil then
|
||||||
|
begin
|
||||||
|
pnMessage.Caption := rsCreateRepositoryPackageFrm_Message10;
|
||||||
|
pnMessage.Invalidate;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
Uploader.StopUpload;
|
||||||
|
Uploader.WaitFor;
|
||||||
|
Uploader := nil;
|
||||||
|
end;
|
||||||
FVSTPackages.Clear;
|
FVSTPackages.Clear;
|
||||||
FVSTPackages.Free;
|
FVSTPackages.Free;
|
||||||
FVSTPackageData.Clear;
|
FVSTPackageData.Clear;
|
||||||
@ -355,11 +381,11 @@ procedure TCreateRepositoryPackagefr.EnableDisableControls(
|
|||||||
const AEnable: Boolean);
|
const AEnable: Boolean);
|
||||||
begin
|
begin
|
||||||
pnBrowse.Enabled := AEnable;
|
pnBrowse.Enabled := AEnable;
|
||||||
cbOpen.Enabled := AEnable;
|
|
||||||
cbJSONForUpdates.Enabled := AEnable;
|
cbJSONForUpdates.Enabled := AEnable;
|
||||||
bHelp.Enabled := AEnable;
|
bHelp.Enabled := AEnable;
|
||||||
bOptions.Enabled := AEnable;
|
bOptions.Enabled := AEnable;
|
||||||
bCreate.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0);
|
bCreate.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0);
|
||||||
|
bSubmit.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0);
|
||||||
bCancel.Enabled := AEnable;
|
bCancel.Enabled := AEnable;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -467,7 +493,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCreateRepositoryPackagefr.bCreateClick(Sender: TObject);
|
function TCreateRepositoryPackagefr.CanCreate: Boolean;
|
||||||
|
|
||||||
procedure SelectAndFocusNode(const ANode: PVirtualNode);
|
procedure SelectAndFocusNode(const ANode: PVirtualNode);
|
||||||
begin
|
begin
|
||||||
@ -479,7 +505,7 @@ var
|
|||||||
Node: PVirtualNode;
|
Node: PVirtualNode;
|
||||||
Data: PData;
|
Data: PData;
|
||||||
begin
|
begin
|
||||||
FCreatePressed := True;
|
Result := False;
|
||||||
Node := FVSTPackages.GetFirstSelected;
|
Node := FVSTPackages.GetFirstSelected;
|
||||||
if Node <> nil then
|
if Node <> nil then
|
||||||
SaveExtraInfo(Node);
|
SaveExtraInfo(Node);
|
||||||
@ -525,21 +551,36 @@ begin
|
|||||||
end;
|
end;
|
||||||
Node := FVSTPackages.GetNext(Node);
|
Node := FVSTPackages.GetNext(Node);
|
||||||
end;
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCreateRepositoryPackagefr.bCreateClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
RootNode: PVirtualNode;
|
||||||
|
RootData: PData;
|
||||||
|
begin
|
||||||
|
if not CanCreate then
|
||||||
|
Exit;
|
||||||
SDD.Title := rsCreateRepositoryPackageFrm_SDDTitleDst;
|
SDD.Title := rsCreateRepositoryPackageFrm_SDDTitleDst;
|
||||||
SDD.InitialDir := Options.LastPackagedirDst;
|
SDD.InitialDir := Options.LastPackagedirDst;
|
||||||
EnableDisableControls(False);
|
EnableDisableControls(False);
|
||||||
if SDD.Execute then
|
if SDD.Execute then
|
||||||
begin
|
begin
|
||||||
|
FPackageOperation := poCreate;
|
||||||
Screen.Cursor := crHourGlass;
|
Screen.Cursor := crHourGlass;
|
||||||
ShowHideControls(1);
|
ShowHideControls(1);
|
||||||
fPackageZipper := TPackageZipper.Create;
|
FPackageZipper := TPackageZipper.Create;
|
||||||
fPackageZipper.OnZipError := @DoOnZippError;
|
FPackageZipper.OnZipError := @DoOnZippError;
|
||||||
fPackageZipper.OnZipCompleted := @DoOnZipCompleted;
|
FPackageZipper.OnZipCompleted := @DoOnZipCompleted;
|
||||||
FDestDir := AppendPathDelim(SDD.FileName);
|
FDestDir := AppendPathDelim(SDD.FileName);
|
||||||
Options.LastPackagedirDst := SDD.FileName;
|
Options.LastPackagedirDst := SDD.FileName;
|
||||||
Options.Changed := True;
|
Options.Changed := True;
|
||||||
FPackageName := StringReplace(FPackageName, ' ', '', [rfReplaceAll]);
|
RootNode := FVSTPackages.GetFirst;
|
||||||
|
RootData := FVSTPackages.GetNodeData(RootNode);
|
||||||
|
if RootData^.FDisplayName <> '' then
|
||||||
|
FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll])
|
||||||
|
else
|
||||||
|
FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]);
|
||||||
FPackageFile := FDestDir + FPackageName + '.zip';
|
FPackageFile := FDestDir + FPackageName + '.zip';
|
||||||
pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4;
|
pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4;
|
||||||
fPackageZipper.StartZip(FPackageDir, FPackageFile);
|
fPackageZipper.StartZip(FPackageDir, FPackageFile);
|
||||||
@ -548,6 +589,32 @@ begin
|
|||||||
EnableDisableControls(True);
|
EnableDisableControls(True);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCreateRepositoryPackagefr.bSubmitClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
RootNode: PVirtualNode;
|
||||||
|
RootData: PData;
|
||||||
|
begin
|
||||||
|
if not CanCreate then
|
||||||
|
Exit;
|
||||||
|
FPackageOperation := poSubmit;
|
||||||
|
EnableDisableControls(False);
|
||||||
|
ShowHideControls(1);
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
fPackageZipper := TPackageZipper.Create;
|
||||||
|
fPackageZipper.OnZipError := @DoOnZippError;
|
||||||
|
fPackageZipper.OnZipCompleted := @DoOnZipCompleted;
|
||||||
|
FDestDir := Options.LocalRepositoryUpdate;
|
||||||
|
RootNode := FVSTPackages.GetFirst;
|
||||||
|
RootData := FVSTPackages.GetNodeData(RootNode);
|
||||||
|
if RootData^.FDisplayName <> '' then
|
||||||
|
FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll])
|
||||||
|
else
|
||||||
|
FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]);
|
||||||
|
FPackageFile := FDestDir + FPackageName + '.zip';
|
||||||
|
pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4;
|
||||||
|
fPackageZipper.StartZip(FPackageDir, FPackageFile);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCreateRepositoryPackagefr.bHelpClick(Sender: TObject);
|
procedure TCreateRepositoryPackagefr.bHelpClick(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
OpenURL(cHelpPage_CreateRepositoryPackage);
|
OpenURL(cHelpPage_CreateRepositoryPackage);
|
||||||
@ -803,7 +870,7 @@ begin
|
|||||||
Result := AStr;
|
Result := AStr;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCreateRepositoryPackagefr.CreateJSONForUpdates;
|
function TCreateRepositoryPackagefr.CreateJSONForUpdates(var AErrMsg: String): Boolean;
|
||||||
var
|
var
|
||||||
RootNode, Node: PVirtualNode;
|
RootNode, Node: PVirtualNode;
|
||||||
RootData, Data: PData;
|
RootData, Data: PData;
|
||||||
@ -811,9 +878,12 @@ var
|
|||||||
Ms: TMemoryStream;
|
Ms: TMemoryStream;
|
||||||
UpdatePackage: TUpdatePackage;
|
UpdatePackage: TUpdatePackage;
|
||||||
UpdatePackageFiles: TUpdatePackageFiles;
|
UpdatePackageFiles: TUpdatePackageFiles;
|
||||||
FileName: String;
|
|
||||||
ErrMsg: String;
|
|
||||||
begin
|
begin
|
||||||
|
Result := False;
|
||||||
|
pnMessage.Caption := rsCreateRepositoryPackageFrm_Message6;
|
||||||
|
pnMessage.Invalidate;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
Sleep(2000);
|
||||||
UpdatePackage := TUpdatePackage.Create;
|
UpdatePackage := TUpdatePackage.Create;
|
||||||
try
|
try
|
||||||
RootNode := FVSTPackages.GetFirst;
|
RootNode := FVSTPackages.GetFirst;
|
||||||
@ -822,10 +892,6 @@ begin
|
|||||||
RootData := FVSTPackages.GetNodeData(RootNode);
|
RootData := FVSTPackages.GetNodeData(RootNode);
|
||||||
UpdatePackage.UpdatePackageData.Name := RootData^.FName;
|
UpdatePackage.UpdatePackageData.Name := RootData^.FName;
|
||||||
UpdatePackage.UpdatePackageData.DownloadZipURL := RootData^.FDownloadURL;
|
UpdatePackage.UpdatePackageData.DownloadZipURL := RootData^.FDownloadURL;
|
||||||
if RootData^.FDisplayName <> '' then
|
|
||||||
FileName := FDestDir + 'update_' + RootData^.FDisplayName + '.json'
|
|
||||||
else
|
|
||||||
FileName := FDestDir + 'update_' + RootData^.FName + '.json';
|
|
||||||
Node := FVSTPackages.GetFirstChild(RootNode);
|
Node := FVSTPackages.GetFirstChild(RootNode);
|
||||||
while Assigned(Node) do
|
while Assigned(Node) do
|
||||||
begin
|
begin
|
||||||
@ -849,23 +915,20 @@ begin
|
|||||||
try
|
try
|
||||||
Ms.Write(Pointer(JSON)^, Length(JSON));
|
Ms.Write(Pointer(JSON)^, Length(JSON));
|
||||||
Ms.Position := 0;
|
Ms.Position := 0;
|
||||||
Ms.SaveToFile(FileName);
|
Ms.SaveToFile(FDestDir + 'update_' + FPackageName + '.json');
|
||||||
finally
|
finally
|
||||||
MS.Free;
|
MS.Free;
|
||||||
end;
|
end;
|
||||||
MessageDlgEx(rsCreateJSONForUpdatesFrm_Message4, mtInformation, [mbOk], TForm(Self.Parent));
|
Result := True;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
AErrMsg := rsCreateJSONForUpdatesFrm_Error1 + sLineBreak + '"' + StringReplace(UpdatePackage.LastError, '"', '', [rfReplaceAll]) + '"';
|
||||||
ErrMsg := StringReplace(UpdatePackage.LastError, '"', '', [rfReplaceAll]);
|
|
||||||
MessageDlgEx(rsCreateJSONForUpdatesFrm_Error1 + sLineBreak + '"' + ErrMsg + '"', mtError, [mbOk], TForm(Self.Parent));
|
|
||||||
end;
|
|
||||||
finally
|
finally
|
||||||
UpdatePackage.Free;
|
UpdatePackage.Free;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCreateRepositoryPackagefr.DoOnZipCompleted(Sender: TObject);
|
function TCreateRepositoryPackagefr.CreateJSON(var AErrMsg: String): Boolean;
|
||||||
var
|
var
|
||||||
SerializablePackages: TSerializablePackages;
|
SerializablePackages: TSerializablePackages;
|
||||||
Package: TPackage;
|
Package: TPackage;
|
||||||
@ -874,13 +937,12 @@ var
|
|||||||
RootData, Data: PData;
|
RootData, Data: PData;
|
||||||
JSON: TJSONStringType;
|
JSON: TJSONStringType;
|
||||||
MS: TMemoryStream;
|
MS: TMemoryStream;
|
||||||
ErrMsg: String;
|
|
||||||
CanClose: Boolean;
|
|
||||||
begin
|
begin
|
||||||
CanClose := False;
|
Result := False;
|
||||||
pnMessage.Caption := rsCreateRepositoryPackageFrm_Message5;
|
pnMessage.Caption := rsCreateRepositoryPackageFrm_Message5;
|
||||||
pnMessage.Invalidate;
|
pnMessage.Invalidate;
|
||||||
Screen.Cursor := crDefault;
|
Application.ProcessMessages;
|
||||||
|
Sleep(2000);
|
||||||
SerializablePackages := TSerializablePackages.Create;
|
SerializablePackages := TSerializablePackages.Create;
|
||||||
try
|
try
|
||||||
RootNode := FVSTPackages.GetFirst;
|
RootNode := FVSTPackages.GetFirst;
|
||||||
@ -927,8 +989,6 @@ begin
|
|||||||
Node := FVSTPackages.GetNextSibling(Node);
|
Node := FVSTPackages.GetNextSibling(Node);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
ShowHideControls(2);
|
|
||||||
EnableDisableControls(True);
|
|
||||||
if SerializablePackages.Count > 0 then
|
if SerializablePackages.Count > 0 then
|
||||||
begin
|
begin
|
||||||
JSON := '';
|
JSON := '';
|
||||||
@ -939,32 +999,99 @@ begin
|
|||||||
MS.Write(Pointer(JSON)^, Length(JSON));
|
MS.Write(Pointer(JSON)^, Length(JSON));
|
||||||
MS.Position := 0;
|
MS.Position := 0;
|
||||||
MS.SaveToFile(FDestDir + FPackageName + '.json');
|
MS.SaveToFile(FDestDir + FPackageName + '.json');
|
||||||
MessageDlgEx(rsCreateRepositoryPackageFrm_Message6, mtInformation, [mbOk], TForm(Self.Parent));
|
Result := True;
|
||||||
CanClose := True;
|
|
||||||
finally
|
finally
|
||||||
MS.Free;
|
MS.Free;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
AErrMsg := rsCreateRepositoryPackageFrm_Error2 + sLineBreak + '"' + StringReplace(SerializablePackages.LastError, '"', '', [rfReplaceAll]) + '"'
|
||||||
ErrMsg := StringReplace(SerializablePackages.LastError, '"', '', [rfReplaceAll]);
|
|
||||||
MessageDlgEx(rsCreateRepositoryPackageFrm_Error2 + sLineBreak + '"' + ErrMsg + '"', mtError, [mbOk], TForm(Self.Parent));
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
finally
|
finally
|
||||||
SerializablePackages.Free;
|
SerializablePackages.Free;
|
||||||
end;
|
end;
|
||||||
if cbJSONForUpdates.Checked then
|
end;
|
||||||
CreateJSONForUpdates;
|
|
||||||
if CanClose then
|
procedure TCreateRepositoryPackagefr.DoOnZipCompleted(Sender: TObject);
|
||||||
|
var
|
||||||
|
ErrMsg: String;
|
||||||
|
begin
|
||||||
|
ErrMsg := '';
|
||||||
|
if not CreateJSON(ErrMsg) then
|
||||||
begin
|
begin
|
||||||
if cbOpen.Checked then
|
MessageDlgEx(ErrMsg, mtError, [mbOk], TForm(Self.Parent));
|
||||||
OpenDocument(FDestDir);
|
Exit;
|
||||||
TForm(Self.Parent).ModalResult := mrOk;
|
end;
|
||||||
TForm(Self.Parent).Close;
|
|
||||||
|
if cbJSONForUpdates.Checked then
|
||||||
|
begin
|
||||||
|
ErrMsg := '';
|
||||||
|
if not CreateJSONForUpdates(ErrMsg) then
|
||||||
|
begin
|
||||||
|
MessageDlgEx(ErrMsg, mtError, [mbOk], TForm(Self.Parent));
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case FPackageOperation of
|
||||||
|
poCreate:
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
ShowHideControls(2);
|
||||||
|
EnableDisableControls(True);
|
||||||
|
MessageDlgEx(rsCreateRepositoryPackageFrm_Message7, mtInformation, [mbOk], TForm(Self.Parent));
|
||||||
|
TForm(Self.Parent).ModalResult := mrOk;
|
||||||
|
TForm(Self.Parent).Close;
|
||||||
|
end;
|
||||||
|
poSubmit:
|
||||||
|
begin
|
||||||
|
Uploader := TUploader.Create;
|
||||||
|
Uploader.OnUploadProgress := @DoOnUploadProgress;
|
||||||
|
Uploader.OnUploadError := @DoOnUploadError;
|
||||||
|
Uploader.OnUploadCompleted := @DoOnUploadCompleted;
|
||||||
|
if cbJSONForUpdates.Checked then
|
||||||
|
Uploader.StartUpload(cSubmitURL_Zip, cSubmitURL_JSON, FPackageFile, FDestDir + FPackageName + '.json', FDestDir + 'update_' + FPackageName + '.json')
|
||||||
|
else
|
||||||
|
Uploader.StartUpload(cSubmitURL_Zip, cSubmitURL_JSON, FPackageFile, FDestDir + FPackageName + '.json', '')
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCreateRepositoryPackagefr.DoOnUploadProgress(Sender: TObject;
|
||||||
|
AFileName: String);
|
||||||
|
begin
|
||||||
|
pnMessage.Caption := Format(rsCreateRepositoryPackageFrm_Message8, [AFileName]);
|
||||||
|
pnMessage.Invalidate;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCreateRepositoryPackagefr.DoOnUploadError(Sender: TObject;
|
||||||
|
AErrMsg: String);
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
ShowHideControls(2);
|
||||||
|
EnableDisableControls(True);
|
||||||
|
MessageDlgEx(AErrMsg, mtError, [mbOk], TForm(Self.Parent));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCreateRepositoryPackagefr.DoOnUploadCompleted(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
ShowHideControls(2);
|
||||||
|
EnableDisableControls(True);
|
||||||
|
Uploader := nil;
|
||||||
|
if FileExistsUTF8(FPackageFile) then
|
||||||
|
DeleteFileUTF8(FPackageFile);
|
||||||
|
if FileExistsUTF8(FDestDir + FPackageName + '.json') then
|
||||||
|
DeleteFileUTF8(FDestDir + FPackageName + '.json');
|
||||||
|
if FileExistsUTF8(FDestDir + 'update_' + FPackageName + '.json') then
|
||||||
|
DeleteFileUTF8(FDestDir + 'update_' + FPackageName + '.json');
|
||||||
|
MessageDlgEx(rsCreateRepositoryPackageFrm_Message9, mtInformation, [mbOk], TForm(Self.Parent));
|
||||||
|
TForm(Self.Parent).ModalResult := mrOk;
|
||||||
|
TForm(Self.Parent).Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
@ -20,7 +20,7 @@
|
|||||||
<Description Value="Online package manger"/>
|
<Description Value="Online package manger"/>
|
||||||
<License Value="GPL"/>
|
<License Value="GPL"/>
|
||||||
<Version Major="1"/>
|
<Version Major="1"/>
|
||||||
<Files Count="19">
|
<Files Count="20">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="onlinepackagemanagerintf.pas"/>
|
<Filename Value="onlinepackagemanagerintf.pas"/>
|
||||||
<HasRegisterProc Value="True"/>
|
<HasRegisterProc Value="True"/>
|
||||||
@ -103,6 +103,10 @@
|
|||||||
<Filename Value="opkman_createjsonforupdates.pas"/>
|
<Filename Value="opkman_createjsonforupdates.pas"/>
|
||||||
<UnitName Value="opkman_createjsonforupdates"/>
|
<UnitName Value="opkman_createjsonforupdates"/>
|
||||||
</Item19>
|
</Item19>
|
||||||
|
<Item20>
|
||||||
|
<Filename Value="opkman_uploader.pas"/>
|
||||||
|
<UnitName Value="opkman_uploader"/>
|
||||||
|
</Item20>
|
||||||
</Files>
|
</Files>
|
||||||
<i18n>
|
<i18n>
|
||||||
<EnableI18N Value="True"/>
|
<EnableI18N Value="True"/>
|
||||||
|
@ -14,7 +14,7 @@ uses
|
|||||||
opkman_installer, opkman_packagelistfrm, opkman_options,
|
opkman_installer, opkman_packagelistfrm, opkman_options,
|
||||||
opkman_createrepositorypackage, opkman_categoriesfrm,
|
opkman_createrepositorypackage, opkman_categoriesfrm,
|
||||||
opkman_packagedetailsfrm, opkman_updates, opkman_createjsonforupdates,
|
opkman_packagedetailsfrm, opkman_updates, opkman_createjsonforupdates,
|
||||||
LazarusPackageIntf;
|
opkman_uploader, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
@ -53,6 +53,8 @@ const
|
|||||||
cOpenSSLURL = 'http://packages.lazarus-ide.org/openssl-1.0.2j-i386-win32.zip';
|
cOpenSSLURL = 'http://packages.lazarus-ide.org/openssl-1.0.2j-i386-win32.zip';
|
||||||
{$endif}
|
{$endif}
|
||||||
cExtractDir = 'ExtractDir';
|
cExtractDir = 'ExtractDir';
|
||||||
|
cSubmitURL_Zip = 'aHR0cDovL2xhemFydXNvcG0uMDAwd2ViaG9zdGFwcC5jb20vemlwLnBocA==';
|
||||||
|
cSubmitURL_JSON = 'aHR0cDovL2xhemFydXNvcG0uMDAwd2ViaG9zdGFwcC5jb20vanNvbi5waHA=';
|
||||||
|
|
||||||
resourcestring
|
resourcestring
|
||||||
//package manager
|
//package manager
|
||||||
@ -287,7 +289,6 @@ resourcestring
|
|||||||
//createrepositorypackage form
|
//createrepositorypackage form
|
||||||
rsCreateRepositoryPackageFrm_Caption = 'Create repository package';
|
rsCreateRepositoryPackageFrm_Caption = 'Create repository package';
|
||||||
rsCreateRepositoryPackageFrm_pnMessage_Caption = 'Please wait...';
|
rsCreateRepositoryPackageFrm_pnMessage_Caption = 'Please wait...';
|
||||||
rsCreateRepositoryPackageFrm_cbOpen_Caption = 'Open containing folder after creation';
|
|
||||||
rsCreateRepositoryPackageFrm_lbPackageDir_Caption = 'Package directory:';
|
rsCreateRepositoryPackageFrm_lbPackageDir_Caption = 'Package directory:';
|
||||||
rsCreateRepositoryPackageFrm_pnCaption_Caption0 = 'Available packages';
|
rsCreateRepositoryPackageFrm_pnCaption_Caption0 = 'Available packages';
|
||||||
rsCreateRepositoryPackageFrm_pnCaption_Caption1 = 'Description';
|
rsCreateRepositoryPackageFrm_pnCaption_Caption1 = 'Description';
|
||||||
@ -306,24 +307,34 @@ resourcestring
|
|||||||
rsCreateRepositoryPackageFrm_Error0 = 'Error reading package';
|
rsCreateRepositoryPackageFrm_Error0 = 'Error reading package';
|
||||||
rsCreateRepositoryPackageFrm_Error1 = 'Cannot create zip file:';
|
rsCreateRepositoryPackageFrm_Error1 = 'Cannot create zip file:';
|
||||||
rsCreateRepositoryPackageFrm_Error2 = 'Cannot create JSON file:';
|
rsCreateRepositoryPackageFrm_Error2 = 'Cannot create JSON file:';
|
||||||
|
rsCreateRepositoryPackageFrm_Error3 = 'Cannot send file: "%s"';
|
||||||
rsCreateRepositoryPackageFrm_Message0 = 'Please select a category for package:';
|
rsCreateRepositoryPackageFrm_Message0 = 'Please select a category for package:';
|
||||||
rsCreateRepositoryPackageFrm_Message1 = 'Please enter supported Lazarus versions for package:';
|
rsCreateRepositoryPackageFrm_Message1 = 'Please enter supported Lazarus versions for package:';
|
||||||
rsCreateRepositoryPackageFrm_Message2 = 'Please enter supported FPC versions for package:';
|
rsCreateRepositoryPackageFrm_Message2 = 'Please enter supported FPC versions for package:';
|
||||||
rsCreateRepositoryPackageFrm_Message3 = 'Please enter supported widgetsets for package:';
|
rsCreateRepositoryPackageFrm_Message3 = 'Please enter supported widgetsets for package:';
|
||||||
rsCreateRepositoryPackageFrm_Message4 = 'Compressing package. Please wait...';
|
rsCreateRepositoryPackageFrm_Message4 = 'Compressing package. Please wait...';
|
||||||
rsCreateRepositoryPackageFrm_Message5 = 'Creating JSON. Please wait...';
|
rsCreateRepositoryPackageFrm_Message5 = 'Creating JSON. Please wait...';
|
||||||
rsCreateRepositoryPackageFrm_Message6 = 'Repository package successfully created.';
|
rsCreateRepositoryPackageFrm_Message6 = 'Creating JSON for updates. Please wait...';
|
||||||
|
rsCreateRepositoryPackageFrm_Message7 = 'Repository package successfully created.';
|
||||||
|
rsCreateRepositoryPackageFrm_Message8 = 'Sending files("%s"). Please wait...';
|
||||||
|
rsCreateRepositoryPackageFrm_Message9 = 'Files successfully sent. Thank you for submitting packages!' + sLineBreak + 'Your request will be processed in 24 hours.';
|
||||||
|
rsCreateRepositoryPackageFrm_Message10 = 'Canceling upload. Please wait...';
|
||||||
rsCreateRepositoryPackageFrm_bHelp_Caption = 'Help';
|
rsCreateRepositoryPackageFrm_bHelp_Caption = 'Help';
|
||||||
|
rsCreateRepositoryPackageFrm_bHelp_Hint = 'Open help';
|
||||||
rsCreateRepositoryPackageFrm_bOptions_Caption = 'Options';
|
rsCreateRepositoryPackageFrm_bOptions_Caption = 'Options';
|
||||||
|
rsCreateRepositoryPackageFrm_bOptions_Hint = 'Open options dialog';
|
||||||
rsCreateRepositoryPackageFrm_bCreate_Caption = 'Create';
|
rsCreateRepositoryPackageFrm_bCreate_Caption = 'Create';
|
||||||
|
rsCreateRepositoryPackageFrm_bCreate_Hint = 'Create files locally';
|
||||||
|
rsCreateRepositoryPackageFrm_bSubmit_Caption = 'Submit';
|
||||||
|
rsCreateRepositoryPackageFrm_bSubmit_Hint = 'Submit files to remote server';
|
||||||
rsCreateRepositoryPackageFrm_bCancel_Caption = 'Cancel';
|
rsCreateRepositoryPackageFrm_bCancel_Caption = 'Cancel';
|
||||||
|
rsCreateRepositoryPackageFrm_bCancel_Hint = 'Close this dialog';
|
||||||
|
|
||||||
//createupdatejson
|
//createupdatejson
|
||||||
rsCreateJSONForUpdatesFrm_Caption = 'Create update JSON for package:';
|
rsCreateJSONForUpdatesFrm_Caption = 'Create update JSON for package:';
|
||||||
rsCreateJSONForUpdatesFrm_bHelp_Caption = 'Help';
|
rsCreateJSONForUpdatesFrm_bHelp_Caption = 'Help';
|
||||||
rsCreateJSONForUpdatesFrm_bCreate_Caption = 'Create';
|
rsCreateJSONForUpdatesFrm_bCreate_Caption = 'Create';
|
||||||
rsCreateJSONForUpdatesFrm_bClose_Caption = 'Cancel';
|
rsCreateJSONForUpdatesFrm_bClose_Caption = 'Cancel';
|
||||||
rsCreateJSONForUpdatesFrm_cbOpen_Caption = 'Open containing folder after creation';
|
|
||||||
rsCreateJSONForUpdatesFrm_lbLinkToZip_Caption = 'Link to the package zip file';
|
rsCreateJSONForUpdatesFrm_lbLinkToZip_Caption = 'Link to the package zip file';
|
||||||
rsCreateJSONForUpdatesFrm_bTest_Caption = 'Test';
|
rsCreateJSONForUpdatesFrm_bTest_Caption = 'Test';
|
||||||
rsCreateJSONForUpdatesFrm_Column0_Text = 'PackageFileName';
|
rsCreateJSONForUpdatesFrm_Column0_Text = 'PackageFileName';
|
||||||
|
@ -26,7 +26,7 @@ object CreateJSONForUpdatesFrm: TCreateJSONForUpdatesFrm
|
|||||||
ClientWidth = 580
|
ClientWidth = 580
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
object bCreate: TButton
|
object bCreate: TButton
|
||||||
Left = 414
|
Left = 415
|
||||||
Height = 26
|
Height = 26
|
||||||
Top = 8
|
Top = 8
|
||||||
Width = 75
|
Width = 75
|
||||||
@ -45,23 +45,15 @@ object CreateJSONForUpdatesFrm: TCreateJSONForUpdatesFrm
|
|||||||
ModalResult = 2
|
ModalResult = 2
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
end
|
end
|
||||||
object cbOpen: TCheckBox
|
|
||||||
Left = 15
|
|
||||||
Height = 19
|
|
||||||
Top = 12
|
|
||||||
Width = 211
|
|
||||||
Caption = 'After create, open containing folder '
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
object bHelp: TButton
|
object bHelp: TButton
|
||||||
Left = 336
|
Left = 339
|
||||||
Height = 26
|
Height = 26
|
||||||
Top = 8
|
Top = 8
|
||||||
Width = 75
|
Width = 75
|
||||||
Anchors = [akTop, akRight]
|
Anchors = [akTop, akRight]
|
||||||
Caption = 'Help'
|
Caption = 'Help'
|
||||||
OnClick = bHelpClick
|
OnClick = bHelpClick
|
||||||
TabOrder = 3
|
TabOrder = 2
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
object pnTop: TPanel
|
object pnTop: TPanel
|
||||||
|
@ -18,7 +18,6 @@ type
|
|||||||
bCreate: TButton;
|
bCreate: TButton;
|
||||||
bHelp: TButton;
|
bHelp: TButton;
|
||||||
bTest: TButton;
|
bTest: TButton;
|
||||||
cbOpen: TCheckBox;
|
|
||||||
edLinkToZip: TEdit;
|
edLinkToZip: TEdit;
|
||||||
imTree: TImageList;
|
imTree: TImageList;
|
||||||
lbLinkToZip: TLabel;
|
lbLinkToZip: TLabel;
|
||||||
@ -76,7 +75,6 @@ begin
|
|||||||
bCreate.Caption := rsCreateJSONForUpdatesFrm_bCreate_Caption;
|
bCreate.Caption := rsCreateJSONForUpdatesFrm_bCreate_Caption;
|
||||||
bHelp.Caption := rsCreateJSONForUpdatesFrm_bHelp_Caption;
|
bHelp.Caption := rsCreateJSONForUpdatesFrm_bHelp_Caption;
|
||||||
bClose.Caption := rsCreateJSONForUpdatesFrm_bClose_Caption;
|
bClose.Caption := rsCreateJSONForUpdatesFrm_bClose_Caption;
|
||||||
cbOpen.Caption := rsCreateJSONForUpdatesFrm_cbOpen_Caption;
|
|
||||||
|
|
||||||
FVST := TVirtualStringTree.Create(nil);
|
FVST := TVirtualStringTree.Create(nil);
|
||||||
with FVST do
|
with FVST do
|
||||||
@ -225,11 +223,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
if CanClose then
|
if CanClose then
|
||||||
begin
|
|
||||||
if cbOpen.Checked then
|
|
||||||
OpenDocument(ExtractFilePath(SD.FileName));
|
|
||||||
Close
|
Close
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCreateJSONForUpdatesFrm.bHelpClick(Sender: TObject);
|
procedure TCreateJSONForUpdatesFrm.bHelpClick(Sender: TObject);
|
||||||
|
@ -16,6 +16,28 @@ object CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm
|
|||||||
Position = poOwnerFormCenter
|
Position = poOwnerFormCenter
|
||||||
LCLVersion = '1.7'
|
LCLVersion = '1.7'
|
||||||
inline frCreateRep: TCreateRepositoryPackagefr
|
inline frCreateRep: TCreateRepositoryPackagefr
|
||||||
|
Height = 450
|
||||||
Align = alClient
|
Align = alClient
|
||||||
|
ClientHeight = 450
|
||||||
|
inherited pnMessage: TPanel
|
||||||
|
Height = 336
|
||||||
|
end
|
||||||
|
inherited pnPackages: TPanel
|
||||||
|
Height = 336
|
||||||
|
end
|
||||||
|
inherited pnData: TPanel
|
||||||
|
Height = 336
|
||||||
|
ClientHeight = 336
|
||||||
|
inherited pnPackageData: TPanel
|
||||||
|
Height = 147
|
||||||
|
ClientHeight = 143
|
||||||
|
end
|
||||||
|
end
|
||||||
|
inherited spMain: TSplitter
|
||||||
|
Height = 336
|
||||||
|
end
|
||||||
|
inherited pnButtons: TPanel
|
||||||
|
Top = 401
|
||||||
|
end
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
@ -30,9 +30,7 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, fpjson, opkman_httpclient, opkman_timer, opkman_common,
|
Classes, SysUtils, fpjson, opkman_httpclient, opkman_timer, opkman_common,
|
||||||
opkman_serializablepackages,
|
opkman_serializablepackages;
|
||||||
|
|
||||||
dialogs;
|
|
||||||
|
|
||||||
type
|
type
|
||||||
TDownloadType = (dtJSON, dtPackage, dtUpdate);
|
TDownloadType = (dtJSON, dtPackage, dtUpdate);
|
||||||
|
@ -116,7 +116,7 @@ begin
|
|||||||
FLocalUpdateDefault := LocalRepo + AppendPathDelim(cLocalRepositoryUpdate);
|
FLocalUpdateDefault := LocalRepo + AppendPathDelim(cLocalRepositoryUpdate);
|
||||||
|
|
||||||
FXML := TXMLConfig.Create(AFileName);
|
FXML := TXMLConfig.Create(AFileName);
|
||||||
if FileExists(AFileName) then
|
if FileExistsUTF8(AFileName) then
|
||||||
begin
|
begin
|
||||||
Load;
|
Load;
|
||||||
if FLocalRepositoryPackages = '' then
|
if FLocalRepositoryPackages = '' then
|
||||||
|
@ -1432,7 +1432,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
paUpdate:
|
paUpdate:
|
||||||
begin
|
begin
|
||||||
if FileExists(Options.LocalRepositoryUpdate + Items[I].RepositoryFileName) then
|
if FileExistsUTF8(Options.LocalRepositoryUpdate + Items[I].RepositoryFileName) then
|
||||||
DeleteFile(Options.LocalRepositoryUpdate + Items[I].RepositoryFileName)
|
DeleteFile(Options.LocalRepositoryUpdate + Items[I].RepositoryFileName)
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
218
components/onlinepackagemanager/opkman_uploader.pas
Normal file
218
components/onlinepackagemanager/opkman_uploader.pas
Normal file
@ -0,0 +1,218 @@
|
|||||||
|
{
|
||||||
|
***************************************************************************
|
||||||
|
* *
|
||||||
|
* 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. *
|
||||||
|
* *
|
||||||
|
***************************************************************************
|
||||||
|
|
||||||
|
Author: Balázs Székely
|
||||||
|
Abstract:
|
||||||
|
Implementation of the package uploader class.
|
||||||
|
}
|
||||||
|
unit opkman_uploader;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpjson, base64, LazFileUtils, opkman_httpclient,
|
||||||
|
|
||||||
|
dialogs;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOnUploadProgress = procedure(Sender: TObject; AFileName: String) of object;
|
||||||
|
TOnUploadError = procedure(Sender: TObject; AErrMsg: String) of object;
|
||||||
|
|
||||||
|
{ TUploader }
|
||||||
|
|
||||||
|
TUploader = class(TThread)
|
||||||
|
private
|
||||||
|
FOnUploadProgress: TOnUploadProgress;
|
||||||
|
FOnUploadError: TOnUploadError;
|
||||||
|
FOnUploadCompleted: TNotifyEvent;
|
||||||
|
FHTTPClient: TFPHTTPClient;
|
||||||
|
FNeedToBreak: Boolean;
|
||||||
|
FFileName: String;
|
||||||
|
FURLZip: String;
|
||||||
|
FURLJSON: String;
|
||||||
|
FZip: String;
|
||||||
|
FJSON: String;
|
||||||
|
FJSONUpdate: String;
|
||||||
|
procedure DoOnUploadProgress;
|
||||||
|
procedure DoOnUploadError;
|
||||||
|
procedure DoOnUploadCompleted;
|
||||||
|
function PostFile(const AURL, AFieldName, AFileName: String): Boolean;
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure StartUpload(AURLZip, AURLJSON, AZip, AJSON, AJSONUpdate: String);
|
||||||
|
procedure StopUpload;
|
||||||
|
published
|
||||||
|
property OnUploadProgress: TOnUploadProgress read FOnUploadProgress write FOnUploadProgress;
|
||||||
|
property OnUploadError: TOnUploadError read FOnUploadError write FOnUploadError;
|
||||||
|
property OnUploadCompleted: TNotifyEvent read FOnUploadCompleted write FOnUploadCompleted;
|
||||||
|
property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
Uploader: TUploader = nil;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses opkman_options, opkman_const;
|
||||||
|
|
||||||
|
{ TUploader }
|
||||||
|
|
||||||
|
procedure TUploader.DoOnUploadProgress;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnUploadProgress) then
|
||||||
|
FOnUploadProgress(Self, FFileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUploader.DoOnUploadError;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnUploadError) then
|
||||||
|
FOnUploadError(Self, Format(rsCreateRepositoryPackageFrm_Error3, [FFileName]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUploader.DoOnUploadCompleted;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnUploadCompleted) then
|
||||||
|
FOnUploadCompleted(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TUploader.PostFile(const AURL, AFieldName, AFileName: String): Boolean;
|
||||||
|
var
|
||||||
|
SS: TStringStream;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
SS := TStringStream.Create('');
|
||||||
|
try
|
||||||
|
FHTTPClient := TFPHTTPClient.Create(nil);
|
||||||
|
try
|
||||||
|
if Options.ProxyEnabled then
|
||||||
|
begin
|
||||||
|
FHTTPClient.Proxy.Host:= Options.ProxyServer;
|
||||||
|
FHTTPClient.Proxy.Port:= Options.ProxyPort;
|
||||||
|
FHTTPClient.Proxy.UserName:= Options.ProxyUser;
|
||||||
|
FHTTPClient.Proxy.Password:= Options.ProxyPassword;
|
||||||
|
end;
|
||||||
|
try
|
||||||
|
FHttpClient.FileFormPost(AURL, AFieldName, AFileName, SS);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
case AFieldName of
|
||||||
|
'zip' : Result := SS.DataString = 'zipok';
|
||||||
|
'json': Result := SS.DataString = 'jsonok';
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FHTTPClient.Free;
|
||||||
|
FHTTPClient := nil;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SS.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUploader.Execute;
|
||||||
|
var
|
||||||
|
CanGo: Boolean;
|
||||||
|
begin
|
||||||
|
FFileName := ExtractFileName(FZip);
|
||||||
|
CanGo := FileExistsUTF8(FZip);
|
||||||
|
if CanGo then
|
||||||
|
begin
|
||||||
|
Synchronize(@DoOnUploadProgress);
|
||||||
|
CanGo := PostFile(FURLZip, 'zip', FZip);
|
||||||
|
end;
|
||||||
|
if (not CanGo) and (not FNeedToBreak) then
|
||||||
|
begin
|
||||||
|
Synchronize(@DoOnUploadError);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if FNeedToBreak then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
FFileName := ExtractFileName(FJSON);
|
||||||
|
CanGo := FileExistsUTF8(FJSON);
|
||||||
|
if CanGo then
|
||||||
|
begin
|
||||||
|
Synchronize(@DoOnUploadProgress);
|
||||||
|
CanGo := PostFile(FURLJSON, 'json', FJSON);
|
||||||
|
Sleep(2000);
|
||||||
|
end;
|
||||||
|
if (not CanGo) and (not FNeedToBreak) then
|
||||||
|
begin
|
||||||
|
Synchronize(@DoOnUploadError);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if FNeedToBreak then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if FJSONUpdate <> '' then
|
||||||
|
begin
|
||||||
|
FFileName := ExtractFileName(FJSONUpdate);
|
||||||
|
CanGo := FileExistsUTF8(FJSONUpdate);
|
||||||
|
if CanGo then
|
||||||
|
begin
|
||||||
|
Synchronize(@DoOnUploadProgress);
|
||||||
|
CanGo := PostFile(FURLJSON, 'json', FJSONUpdate);
|
||||||
|
Sleep(2000);
|
||||||
|
end;
|
||||||
|
if (not CanGo) and (not FNeedToBreak) then
|
||||||
|
begin
|
||||||
|
Synchronize(@DoOnUploadError);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if not FNeedToBreak then
|
||||||
|
Synchronize(@DoOnUploadCompleted);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TUploader.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(True);
|
||||||
|
FreeOnTerminate := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TUploader.Destroy;
|
||||||
|
begin
|
||||||
|
//
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUploader.StartUpload(AURLZip, AURLJSON, AZip, AJSON, AJSONUpdate: String);
|
||||||
|
begin
|
||||||
|
FURLZip := DecodeStringBase64(AURLZip);
|
||||||
|
FURLJSON := DecodeStringBase64(AURLJSON);
|
||||||
|
FZip := AZip;
|
||||||
|
FJSON := AJSON;
|
||||||
|
FJSONUpdate := AJSONUpdate;
|
||||||
|
Start;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUploader.StopUpload;
|
||||||
|
begin
|
||||||
|
if Assigned(FHTTPClient) then
|
||||||
|
FHTTPClient.NeedToBreak := True;
|
||||||
|
FNeedToBreak := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user