Графический интерфейс в aria2c RPC http://blindage.org/?p=5385
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 

702 lines
20 KiB

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
StdCtrls, Menus, ActnList, ExtCtrls, PopupNotifier, Buttons, ValEdit,
HTTPSend, SynaUtil, XMLRead, DOM, XMLUtils, fpjson, jsonparser, inifiles,
vinfo, versiontypes;
type
{ TForm1 }
TForm1 = class(TForm)
action_check_upgrade: TAction;
action_update_server_list: TAction;
action_settings: TAction;
action_about: TAction;
action_servers: TAction;
action_quit: TAction;
action_pauseselected: TAction;
action_startall: TAction;
action_pauseall: TAction;
action_startselected: TAction;
action_deleteselected: TAction;
action_newdownload: TAction;
ActionList1: TActionList;
allimages: TImageList;
BitBtn1: TBitBtn;
ComboBox1: TComboBox;
Label2: TLabel;
ListView1: TListView;
Panel2: TPanel;
serv_images: TImageList;
items_images: TImageList;
Label1: TLabel;
ListView2: TListView;
MainMenu1: TMainMenu;
Memo1: TMemo;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem15: TMenuItem;
MenuItem16: TMenuItem;
MenuItem17: TMenuItem;
MenuItem18: TMenuItem;
MenuItem19: TMenuItem;
MenuItem2: TMenuItem;
MenuItem20: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
Panel1: TPanel;
PopupMenu1: TPopupMenu;
PopupNotifier1: TPopupNotifier;
PopupNotifierTimer: TTimer;
Splitter1: TSplitter;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton8: TToolButton;
UpdateListTimer: TTimer;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
TrayIcon1: TTrayIcon;
procedure action_check_upgradeExecute(Sender: TObject);
procedure action_update_server_listExecute(Sender: TObject);
procedure action_aboutExecute(Sender: TObject);
procedure action_deleteselectedExecute(Sender: TObject);
procedure action_newdownloadExecute(Sender: TObject);
procedure action_pauseselectedExecute(Sender: TObject);
procedure action_quitExecute(Sender: TObject);
procedure action_serversExecute(Sender: TObject);
procedure action_settingsExecute(Sender: TObject);
procedure action_startselectedExecute(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure PopupNotifierTimerTimer(Sender: TObject);
procedure TrayIcon1Click(Sender: TObject);
procedure UpdateListTimerTimer(Sender: TObject);
procedure show_baloon(bTitle, bText: string);
procedure UpdateAll;
function JSONQuery(query_array: TJSONObject): string;
procedure Minimize(Sender: TObject);
procedure ValueListEditor1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
close_to_tray, minimized: boolean;
implementation
uses unitSettings, unitServers, unitAdd, json, about, unitInfo;
{$R *.lfm}
{ TForm1 }
procedure tform1.show_baloon(bTitle, bText: string);
begin
with Form1 do
begin
PopupNotifier1.Title := bTitle;
PopupNotifier1.Text := bText;
PopupNotifier1.Show;
PopupNotifierTimer.Enabled := True;
end;
end;
function download_update(download: TStringList): boolean;
var
ItemIndex: integer;
myitem_details: TStringList;
begin
Result := False;
myitem_details := TStringList.Create;
with form1 do
for ItemIndex := 0 to ListView1.Items.Count - 1 do
begin
if ListView1.Items.Item[ItemIndex].Caption = download.Strings[0] then
begin
ListView1.Items.Item[ItemIndex].SubItems.Clear;
myitem_details.Add(download.Strings[1]); //state
myitem_details.Add(download.Strings[2]); //uri
myitem_details.Add(download.Strings[3]); //dest
myitem_details.Add(download.Strings[4]); //%
myitem_details.Add(download.Strings[5]); //threads
myitem_details.Add(download.Strings[6]); //speed
if download.Strings[1] = 'error' then
begin
ListView1.Items.Item[ItemIndex].ImageIndex := 2;
Result := True;
end;
if download.Strings[1] = 'complete' then
begin
ListView1.Items.Item[ItemIndex].ImageIndex := 1;
Result := True;
end;
if download.Strings[1] = 'active' then
ListView1.Items.Item[ItemIndex].ImageIndex := 0;
ListView1.Items.Item[ItemIndex].SubItems.AddStrings(myitem_details);
end;
end;
end;
procedure download_add(download: TStringList);
var
myitem: TListItem;
myitem_details: TStringList;
begin
with Form1 do
begin
//ListView1.Items.Clear;
myitem_details := TStringList.Create;
myitem := TListItem.Create(ListView1.Items);
myitem_details.Add(download.Strings[1]); //state
myitem_details.Add(download.Strings[2]); //uri
myitem_details.Add(download.Strings[3]); //dest
myitem_details.Add(download.Strings[4]); //%
myitem_details.Add(download.Strings[5]); //threads
myitem_details.Add(download.Strings[6]); //speed
if download.Strings[1] = 'error' then
myitem.ImageIndex := 2;
if download.Strings[1] = 'complete' then
myitem.ImageIndex := 1;
if download.Strings[1] = 'active' then
myitem.ImageIndex := 0;
if download.Strings[1] = 'paused' then
myitem.ImageIndex := 3;
if download.Strings[1] = 'removed' then
myitem.ImageIndex := 4;
if download.Strings[1] = 'waiting' then
myitem.ImageIndex := 5;
myitem.Caption := download.Strings[0]; //gid
myitem.SubItems.AddStrings(myitem_details);
ListView1.Items.AddItem(myitem);
//show_baloon('Aria2G', 'URL Added to queue');
end;
end;
function TForm1.JSONQuery(query_array: TJSONObject): string;
var
myHTTP: THTTPSend;
doc: TStringList;
begin
myHTTP := THTTPSend.Create;
doc := TStringList.Create;
try
WriteStrToStream(myHTTP.Document, query_array.FormatJSON);
myHTTP.MimeType := 'application/json-rpc';
if ComboBox1.Items.Count > 0 then
if myHTTP.HTTPMethod('POST', ComboBox1.Text + '/jsonrpc') then
begin
myHTTP.Document.Position := 0;
doc.LoadFromStream(myHTTP.Document);
Result := doc.Text;
end
else
begin
Result := 'nil';
Memo1.Lines.Insert(0, 'Cant connect to ' + ComboBox1.Text +
'. Temporary deleted from server list');
if ComboBox1.Items.Count > 0 then
ComboBox1.Items.Delete(ComboBox1.ItemIndex);
if ComboBox1.Items.Count > 0 then
ComboBox1.ItemIndex := 0;
UpdateAll;
end
else
Result := 'nil';
finally
myHTTP.Free;
doc.Free;
end;
end;
procedure TForm1.PopupNotifierTimerTimer(Sender: TObject);
begin
PopupNotifierTimer.Enabled := False;
PopupNotifier1.Hide;
end;
procedure TForm1.UpdateAll;
var
O, DownloadsActive, DownloadsStopped, DownloadsWaiting: TJSONObject;
AllDownloads, A, F, U: TJSONArray;
JS: TJSON;
download: TStringList;
ItemIndex, ResultIndex, percent, speed: integer;
total: int64;
json_result: string;
begin
DownloadsStopped := TJSONObject.Create(['methodName', 'aria2.tellStopped',
'params', TJSONArray.Create(
[0, 100, TJSONArray.Create(['gid', 'status', 'connections', 'dir',
'files', 'downloadSpeed', 'totalLength', 'completedLength'])])]);
DownloadsWaiting := TJSONObject.Create(['methodName', 'aria2.tellWaiting',
'params', TJSONArray.Create(
[0, 100, TJSONArray.Create(['gid', 'status', 'connections', 'dir',
'files', 'downloadSpeed', 'totalLength', 'completedLength'])])]);
DownloadsActive := TJSONObject.Create(['methodName', 'aria2.tellActive',
'params', TJSONArray.Create([TJSONArray.Create(
['gid', 'status', 'connections', 'dir', 'files', 'downloadSpeed',
'totalLength', 'completedLength'])])]);
O := TJSONObject.Create(['jsonrpc', '2.0', 'id', 'qwer', 'method',
'system.multicall', 'params', TJSONArray.Create(
[TJSONArray.Create([DownloadsActive, DownloadsWaiting, DownloadsStopped])])]);
download := TStringList.Create;
JS := TJSON.Create;
json_result := JSONQuery(O);
if json_result = 'nil' then
Memo1.Lines.Insert(0, 'Cant update list. Server connection error.')
else
begin
JS.Parse(json_result);
//Memo1.Lines.Text:=json_result;
AllDownloads := JS.Arrays['result'];
form1.ListView1.Clear;
for ResultIndex := 0 to AllDownloads.Count - 1 do
begin
A := AllDownloads.Arrays[ResultIndex].Arrays[0];
for ItemIndex := 0 to A.Count - 1 do
begin
download.Clear;
download.Add(A.Objects[ItemIndex].Extract('gid').AsString); //gid
download.Add(A.Objects[ItemIndex].Extract('status').AsString); //status
download.Add(A.Objects[ItemIndex].Arrays['files'].Objects[0].Extract(
'path').AsString); //uri torrent have no uri! and metalink i think too
download.Add(A.Objects[ItemIndex].Extract('dir').AsString); //dest
//%
total := A.Objects[ItemIndex].Extract('totalLength').AsInt64;
if total > 0 then
percent := (A.Objects[ItemIndex].Extract('completedLength').AsInt64 *
100) div total
else
percent := 0;
download.Add(IntToStr(percent));
download.Add(A.Objects[ItemIndex].Extract('connections').AsString); //threads
//speed
speed := A.Objects[ItemIndex].Extract('downloadSpeed').AsInteger;
if speed > 0 then
download.Add(IntToStr(speed div 1024) + ' KB/s')
else
download.Add('0 KB/s');
download_add(download);
end;
end;
end;
O.Free;
end;
procedure TForm1.UpdateListTimerTimer(Sender: TObject);
var
O, ActiveUpdate: TJSONObject;
AllDownloads, A, F, U: TJSONArray;
JS: TJSON;
doc: TStringList;
download: TStringList;
ItemIndex, ResultIndex, percent, speed: integer;
total: int64;
item: TListItem;
gid_array_len: integer;
json_array: TJSONArray;
json_result: string;
need_update_all: boolean;
begin
need_update_all := False;
//search active
//form1.Memo1.Lines.Add('update');
json_array := TJSONArray.Create;
json_array.Clear;
for ItemIndex := 0 to ListView1.Items.Count - 1 do
begin
gid_array_len := 0;
if ListView1.Items.Item[ItemIndex].SubItems.Strings[0] = 'active' then
begin
//showmessage(IntToStr(ItemIndex));
Inc(gid_array_len);
json_array.Insert(gid_array_len - 1,
TJSONObject.Create(['methodName', 'aria2.tellStatus', 'params',
TJSONArray.Create([ListView1.Items.Item[ItemIndex].Caption,
TJSONArray.Create(['gid', 'status', 'connections', 'dir',
'files', 'downloadSpeed', 'totalLength', 'completedLength'])])])
);
end;
end;
O := TJSONObject.Create(['jsonrpc', '2.0', 'id', 'qwer', 'method',
'system.multicall', 'params', TJSONArray.Create([json_array])]);
download := TStringList.Create;
JS := TJSON.Create;
json_result := JSONQuery(O);
if json_result = 'nil' then
//Memo1.Lines.Insert(0, 'Cant update list by timer')
else
begin
JS.Parse(json_result);
//Memo1.Lines.Insert(0, json_result);
AllDownloads := JS.Arrays['result'];
for ResultIndex := 0 to AllDownloads.Count - 1 do
begin
A := AllDownloads.Arrays[ResultIndex];
for ItemIndex := 0 to A.Count - 1 do
begin
download.Clear;
download.Add(A.Objects[ItemIndex].Extract('gid').AsString); //gid
download.Add(A.Objects[ItemIndex].Extract('status').AsString); //status
F := A.Objects[ItemIndex].Arrays['files'].Objects[0].Arrays['uris'];
//download.Add(F.Objects[0].Extract('uri').AsString); //uri
download.Add(A.Objects[ItemIndex].Arrays['files'].Objects[0].Extract(
'path').AsString); //uri torrent have no uri! and metalink i think too
download.Add(A.Objects[ItemIndex].Extract('dir').AsString); //dest
//%
total := A.Objects[ItemIndex].Extract('totalLength').AsInt64;
if total > 0 then
percent := (A.Objects[ItemIndex].Extract('completedLength').AsInt64 *
100) div total
else
percent := 0;
download.Add(IntToStr(percent));
download.Add(A.Objects[ItemIndex].Extract('connections').AsString); //threads
//speed
speed := A.Objects[ItemIndex].Extract('downloadSpeed').AsInteger;
if speed > 0 then
download.Add(IntToStr(speed div 1024) + ' KB/s')
else
download.Add('0 KB/s');
if need_update_all then
download_update(download)
else
need_update_all := download_update(download);
end;
end;
end;
O.Free;
download.Free;
if need_update_all then
UpdateAll;
end;
procedure TForm1.action_newdownloadExecute(Sender: TObject);
begin
with formAdd do
begin
ShowModal;
end;
end;
procedure TForm1.action_pauseselectedExecute(Sender: TObject);
var
gid_array_len, ItemIndex: integer;
json_array: TJSONArray;
JSONQueryObject: TJSONObject;
begin
//search selected
json_array := TJSONArray.Create;
json_array.Clear;
for ItemIndex := 0 to ListView1.Items.Count - 1 do
begin
gid_array_len := 0;
if ListView1.Items.Item[ItemIndex].Checked then
begin
//showmessage(IntToStr(ItemIndex));
Inc(gid_array_len);
json_array.Insert(gid_array_len - 1,
TJSONObject.Create(['methodName', 'aria2.pause', 'params',
TJSONArray.Create([ListView1.Items.Item[ItemIndex].Caption])])
);
end;
end;
JSONQueryObject := TJSONObject.Create(['jsonrpc', '2.0', 'id',
'qwer', 'method', 'system.multicall', 'params', TJSONArray.Create([json_array])]);
JSONQuery(JSONQueryObject);
UpdateAll;
end;
procedure TForm1.action_quitExecute(Sender: TObject);
begin
Close;
end;
procedure TForm1.action_serversExecute(Sender: TObject);
begin
formServers.ShowModal;
ComboBox1.Items := unitservers.formServers.ListBox1.Items;
ComboBox1.ItemIndex := 0;
end;
procedure TForm1.action_settingsExecute(Sender: TObject);
begin
formSettings.ShowModal;
end;
procedure TForm1.action_startselectedExecute(Sender: TObject);
var
gid_array_len, ItemIndex: integer;
json_array: TJSONArray;
JSONQueryObject: TJSONObject;
begin
//search selected
json_array := TJSONArray.Create;
json_array.Clear;
for ItemIndex := 0 to ListView1.Items.Count - 1 do
begin
gid_array_len := 0;
if ListView1.Items.Item[ItemIndex].Checked then
begin
//showmessage(IntToStr(ItemIndex));
Inc(gid_array_len);
json_array.Insert(gid_array_len - 1,
TJSONObject.Create(['methodName', 'aria2.unpause', 'params',
TJSONArray.Create([ListView1.Items.Item[ItemIndex].Caption])])
);
end;
end;
JSONQueryObject := TJSONObject.Create(['jsonrpc', '2.0', 'id',
'qwer', 'method', 'system.multicall', 'params', TJSONArray.Create([json_array])]);
JSONQuery(JSONQueryObject);
UpdateAll;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
UpdateListTimer.Enabled := False;
UpdateAll;
UpdateListTimer.Enabled := True;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
formServers.ListBox1.Items.SaveToFile('.aria2g.list');
end;
procedure TForm1.action_deleteselectedExecute(Sender: TObject);
var
gid_array_len, ItemIndex: integer;
json_array: TJSONArray;
JSONQueryObject: TJSONObject;
begin
//search selected
json_array := TJSONArray.Create;
json_array.Clear;
for ItemIndex := 0 to ListView1.Items.Count - 1 do
begin
gid_array_len := 0;
if ListView1.Items.Item[ItemIndex].Checked then
begin
//showmessage(IntToStr(ItemIndex));
Inc(gid_array_len);
json_array.Insert(gid_array_len - 1,
TJSONObject.Create(['methodName', 'aria2.remove', 'params',
TJSONArray.Create([ListView1.Items.Item[ItemIndex].Caption])])
);
end;
end;
JSONQueryObject := TJSONObject.Create(['jsonrpc', '2.0', 'id',
'qwer', 'method', 'system.multicall', 'params', TJSONArray.Create([json_array])]);
JSONQuery(JSONQueryObject);
UpdateAll;
end;
procedure TForm1.action_aboutExecute(Sender: TObject);
begin
form_about.ShowModal;
end;
procedure TForm1.action_update_server_listExecute(Sender: TObject);
begin
ComboBox1.Items := unitservers.formServers.ListBox1.Items;
ComboBox1.ItemIndex := 0;
UpdateAll;
end;
procedure TForm1.action_check_upgradeExecute(Sender: TObject);
var
update_page: TStringList;
HTTP: THTTPSend;
begin
//http://aria.blindage.org/builds/last_versions.txt
Memo1.Lines.Add('Checking for new version');
HTTP := THTTPSend.Create;
update_page := TStringList.Create;
try
HTTP.HTTPMethod('GET', 'http://aria.blindage.org/builds/last_versions.txt');
update_page.LoadFromStream(HTTP.Document);
ShowMessage('Installed: ' + about.form_about.Label5.Caption +
#13 + #13 + 'Downloadable:' + #13 + update_page.Text)
finally
HTTP.Free;
update_page.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.ListView1.SortColumn := 1;
end;
procedure TForm1.FormShow(Sender: TObject);
var
BuildNum, ver: string;
Info: TVersionInfo;
ini: TIniFile;
new_in_version: TStringList;
begin
ini := TIniFile.Create('.aria2g.ini');
//TrayIcon1.Visible := ini.ReadBool('APP', 'TRAY_ICON', True);
//close_to_tray := ini.ReadBool('APP', 'CLOSE_TO_TRAY_ICON', True);
UpdateListTimer.Interval := ini.ReadInteger('APP', 'LIST_UPDATE_DELAY_MS', 2000);
formSettings.Edit3.Text := IntToStr(ini.ReadInteger('APP',
'LIST_UPDATE_DELAY_MS', 2000));
formSettings.Edit2.Text := IntToStr(ini.ReadInteger('APP', 'THREADS_DEFAULT', 5));
formAdd.edit_threads.Text := IntToStr(ini.ReadInteger('APP', 'THREADS_DEFAULT', 5));
//minimized := False;
if close_to_tray then
begin
//Form1.OnClose := TrayIcon1Click(self);
//TrayIcon1.OnClick:=@TrayeIcon1Click;
//Form1.OnHide := @FormHide;
end;
ini.Free;
if FileExists('.aria2g.list') = True then
begin
formServers.ListBox1.Items.LoadFromFile('.aria2g.list');
ListView2.Items.Add;
end;
ComboBox1.Items := formServers.ListBox1.Items;
ComboBox1.ItemIndex := 0;
UpdateAll;
UpdateListTimer.Enabled := True;
Info := TVersionInfo.Create;
Info.Load(HINSTANCE);
// grab just the Build Number
ver := IntToStr(Info.FixedInfo.FileVersion[0]) + '.' +
IntToStr(Info.FixedInfo.FileVersion[1]) + '.' +
IntToStr(Info.FixedInfo.FileVersion[2]) + '.' +
IntToStr(Info.FixedInfo.FileVersion[3]);
Info.Free;
about.form_about.Label5.Caption := ver;
new_in_version := TStringList.Create;
new_in_version.LoadFromFile('last_changes.txt');
Memo1.Lines.Add('New in this version:');
Memo1.Lines.AddStrings(new_in_version);
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
begin
if ListView1.SelCount > 0 then
begin
UpdateListTimer.Enabled := False;
formInfo.memoInfo.Lines.Clear;
formInfo.memoInfo.Lines.Add('GID: ' + ListView1.Selected.Caption);
formInfo.memoInfo.Lines.Add('URL: ' + ListView1.Selected.SubItems.Strings[1]);
formInfo.memoInfo.Lines.Add('Target: ' + ListView1.Selected.SubItems.Strings[2]);
formInfo.memoInfo.Lines.Add('State: ' + ListView1.Selected.SubItems.Strings[0]);
formInfo.memoInfo.Lines.Add('Threads: ' + ListView1.Selected.SubItems.Strings[4]);
formInfo.memoInfo.Lines.Add('Progress: ' +
ListView1.Selected.SubItems.Strings[3] + '%');
formInfo.ProgressBar1.Position := StrToInt(ListView1.Selected.SubItems.Strings[3]);
formInfo.memoFiles.Clear;
formInfo.memoFiles.Lines.Add('Files:');
formInfo.ShowModal;
UpdateListTimer.Enabled := True;
end;
end;
procedure TForm1.FormHide(Sender: TObject);
begin
end;
procedure TForm1.Minimize(Sender: TObject);
begin
if close_to_tray then
begin
//TrayIcon1Click(self);
end;
end;
procedure TForm1.ValueListEditor1Click(Sender: TObject);
begin
end;
procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
if Form1.Visible = False then
begin
Visible := True;
end
else
begin
Visible := False;
end;
end;
end.