Добавил:

Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Белорусский государственный университет информатики и радиоэлектроники

Предмет:

[НЕСОРТИРОВАННОЕ]

Файл:

КСИС.docx

Скачиваний:

Добавлен:

01.07.2025

Размер:

3 Мб

Скачать

☆

<<< < Предыдущая 1 2 3 4 56 / 66

Заключение

1. В ходе данной курсовой работы был разработан менеджер закачек «Download the my» выполняющей следующие функции:

- приостановка загрузки файла;

- возобновление загрузки файла с последнего места его прерывания (т.н. «докачка»);

- удобная организация загрузок, хранение ссылок к загруженным файлам;

- расчёт времени на загрузку файла;

- хранение истории загузок;

- использование особых параметров входа на сервер;

- использование прокси-серверов;

- загрузка файлов по расписанию.

2. Для корректной работы программы необходимы следующие ресурсы:

- процессор: Pentium II и выше;

- объем оперативной памяти: 512 Мбайт и выше.

3. Оптимальные требования, которым должен соответствовать компьютер для того, чтобы на нем работала данная программа, а пользователь чувствовал себя комфортно, следующие:

- процессор AMD Duron(tm);

- 512 МБ оперативной памяти, из которых должно быть свободно около 150М;

- монитор жидкокристаллический для качественного и безопасного для зрения зрительного восприятия отображаемой информации;

- винчестер 20 ГБ;

- 255 МБ пространства на жестком или гибком диске для самой исполняемой программы;

- ОС Windows XP/7.

4. Программа реализованна в среде Borland Delphi 7.

5. Программа обладает удобным интуитивно понятным интерфейсом.

6. Программа протестированна – неполадок в работе не выявленно.

Таким образом программа готова к использованию.

Список литературы

mediaget - [Электронный ресурс] – Режим доступа -http://ru.vessoft.com/software/windows/download/mediaget
utorrent - [Электронный ресурс] – Режим доступа -http://ru.vessoft.com/software/windows/download/utorrent
fyds- [Электронный ресурс] – Режим доступа - http://ru.vessoft.com/software/windows/download/fyds
idm - [Электронный ресурс] – Режим доступа - http://ru.vessoft.com/software/windows/download/idm
freemakevd - [Электронный ресурс] – Режим доступа - http://ru.vessoft.com/software/windows/download/freemakevd
qbittorrent - [Электронный ресурс] – Режим доступа - http://ru.vessoft.com/software/windows/download/qbittorrent
Библиотека - [Электронный ресурс] – Режим доступа - http://5ka.su/ref/predprinimatelstvo/2_object72102.html
Библиотека - [Электронный ресурс] – Режим доступа - http://www.xserver.ru/user/isssl/2.shtml
Программы - [Электронный ресурс] – Режим доступа - http://lurkmore.to

Приложение А

(Обязательное)

Листинг программы

unit uMain;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ToolWin, ComCtrls, ImgList, StdActns, Menus, ExtCtrls, ActnList,

XPStyleActnCtrls, ActnMan, ActnCtrls, ActnMenus, StdCtrls, XPMan, Clipbrd,

DateUtils, ShellAPI;

type

TfMain = class(TForm) ilMenu: TImageList; ActionMainMenuBar1: TActionMainMenuBar; ActionManager1: TActionManager; actExit: TAction; actAdd: TAction; actOptions: TAction;

lvTasks: TListView; StatusBar: TStatusBar; actStatusBar: TAction; actInfo: TAction; Panel1: TPanel; Panel3: TPanel; Panel4: TPanel; Splitter1: TSplitter; tvFolders: TTreeView; Splitter2: TSplitter; Panel2: TPanel; lvParams: TListView; XPManifest1: TXPManifest; ilTasks: TImageList; actLoad: TAction; actDelete: TAction; ilTree: TImageList; actParams: TAction; actStop: TAction; ilTray: TImageList; actClearDel: TAction; actEdit: TAction; actAbout: TAction; actAddCategory: TAction; actDeleteCategory: TAction; actEditCategory: TAction; pmTasks: TPopupMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N5: TMenuItem; N7: TMenuItem; N8: TMenuItem; pmTree: TPopupMenu; N9: TMenuItem; N10: TMenuItem; N11: TMenuItem; N12: TMenuItem; N14: TMenuItem; tmUpdate: TTimer; N15: TMenuItem; N16: TMenuItem; ActionToolBar1: TActionToolBar; pmTray: TPopupMenu; N17: TMenuItem; N18: TMenuItem; N20: TMenuItem; N21: TMenuItem; N22: TMenuItem; N19: TMenuItem; N23: TMenuItem; N24: TMenuItem; actOpenFolder: TAction; N4: TMenuItem;N6: TMenuItem; actOpenFile: TAction;N13: TMenuItem; procedure FormCreate(Sender: TObject);procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure actExitExecute(Sender: TObject); procedure actAddExecute(Sender: TObject); procedure actOptionsExecute(Sender: TObject);

procedure actStatusBarExecute(Sender: TObject);

procedure actInfoExecute(Sender: TObject);

procedure actLoadExecute(Sender: TObject);

procedure actDeleteExecute(Sender: TObject);

procedure lvParamsCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

procedure actParamsExecute(Sender: TObject);

procedure lvTasksSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);

procedure tvFoldersChange(Sender: TObject; Node: TTreeNode);

procedure actStopExecute(Sender: TObject);

procedure TrayIconClick(Sender: TObject);

procedure lvTasksCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

procedure actClearDelExecute(Sender: TObject);

procedure actEditExecute(Sender: TObject);

procedure actAboutExecute(Sender: TObject);

procedure Panel2Resize(Sender: TObject);

procedure Panel1Resize(Sender: TObject);

procedure actAddCategoryExecute(Sender: TObject);

procedure lvTasksKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure actDeleteCategoryExecute(Sender: TObject);

procedure actEditCategoryExecute(Sender: TObject);

procedure tmUpdateTimer(Sender: TObject);

procedure N17Click(Sender: TObject);

procedure actOpenFolderExecute(Sender: TObject);

procedure actOpenFileExecute(Sender: TObject);

private

NextViewerHandle : THandle;

procedure OnDrawClipboard(var Message : TMessage); Message WM_DRAWCLIPBOARD;

procedure OnChangeCBCHain(var Message : TMessage); Message WM_CHANGECBCHAIN;

public

procedure InsertItem(P : Pointer);

procedure UpdateItems;

procedure RefreshTasks;

procedure SaveTreeNode(Node : TTreeNode);

end;

var

fMain: TfMain;

implementation

uses uAddTask, uObjects, uProcedures, uOptions, uLoading, uThreads, uEditTask, uAbout, uAddCategory, uEditCategory,

uDownload;

{$R *.dfm}

procedure TfMain.UpdateItems;

var Data: TTask; i: integer;

begin

for i:=0 to lvTasks.Items.Count-1 do

begin

Data := lvTasks.Items[i].Data;

if Data.Status=tsLoading then

begin

if Data.TotalSize>0

then lvTasks.Items[i].SubItems[1]:=BytesToText(Data.TotalSize)

else lvTasks.Items[i].SubItems[1]:='?';

lvTasks.Items[i].SubItems[2]:=BytesToText(Data.LoadSize);

if Data.TotalSize>0

then lvTasks.Items[i].SubItems[3]:=FloatToStrF((Data.LoadSize/Data.TotalSize)*100, ffFixed, 18, 0)

else lvTasks.Items[i].SubItems[3]:='?';

if Data.Speed>0

then lvTasks.Items[i].SubItems[4]:=BytesToText(Data.Speed)+'/с'

else lvTasks.Items[i].SubItems[4]:='?';

end;

procedure TfMain.FormCreate(Sender: TObject);

begin

Options:=TOptions.Create;

Options.Path:=ExtractFileDir(Application.ExeName);

Options.Version:=GetFileVersion(Application.ExeName);

Options.Name:='Download The My';

Options.Load;

NextViewerHandle:=SetClipboardViewer(Handle);

Application.Title:=Options.Name+' 0.2.1 '+Options.Version;

Caption:=Options.Name+' 0.2.1 '+Options.Version;

tvFolders.FullExpand;

actParams.Checked:=Panel2.Visible;

actStatusBar.Checked:=StatusBar.Visible;

tvFoldersChange(Self, tvFolders.Selected);

end;

procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);

begin

ChangeClipboardChain(Handle, NextViewerHandle);

Options.Save;

Options.Free;

end;

procedure TfMain.actExitExecute(Sender: TObject);

begin

Close;

end;

procedure TfMain.actAddExecute(Sender: TObject);

begin

fAddTask:=TfAddTask.Create(Application);

fAddTask.ShowModal;

end;

procedure TfMain.actOptionsExecute(Sender: TObject);

begin

fOptions:=TfOptions.Create(Application);

fOptions.ShowModal;

end;

procedure TfMain.actStatusBarExecute(Sender: TObject);

begin

StatusBar.Visible:=actStatusBar.Checked;

end;

procedure TfMain.actInfoExecute(Sender: TObject);

var

ThreadHttp: TGetOptionsHttp;

ThreadFtp: TGetOptionsFtp;

begin

if lvTasks.SelCount=0

then Exit;

if (TTask(lvTasks.Selected.Data).Protocol=ptHttp)

or (TTask(lvTasks.Selected.Data).Protocol=ptHttps)

then

begin

ThreadHttp:=TGetOptionsHttp.Create(true, lvTasks.Selected.Data);

ThreadHttp.Priority:=Options.Priority;

ThreadHttp.FreeOnTerminate:=true;

ThreadHttp.Resume;

end;

if TTask(lvTasks.Selected.Data).Protocol=ptFtp

then

begin

ThreadFtp:=TGetOptionsFtp.Create(true, lvTasks.Selected.Data);

ThreadFtp.Priority:=Options.Priority;

ThreadFtp.FreeOnTerminate:=true;

ThreadFtp.Resume;

end;

procedure TfMain.actLoadExecute(Sender: TObject);

var

LoadOne: TLoadOne;

begin

if lvTasks.SelCount=0

then Exit;

if Options.MinOnRun

then Application.Minimize;

if TTask(lvTasks.Selected.Data).Status=tsLoad

then

begin

if MessageBox(Application.Handle, PChar('Файл "'+TTask(lvTasks.Selected.Data).FileName + '" уже был загружен. Загрузить его снова?'), PChar(Options.Name), MB_YESNO or MB_ICONERROR)=IDYES

then

begin

TTask(lvTasks.Selected.Data).LoadSize:=0;

TTask(lvTasks.Selected.Data).Status:=tsReady;

end

else Exit;

end;

if Options.ShowLoadingForm

then

begin

fLoading:=TfLoading.Create(Application);

fLoading.Data:=lvTasks.Selected.Data;

fLoading.Show;

end;

LoadOne:=TLoadOne.Create(true, lvTasks.Selected.Data);

LoadOne.FreeOnTerminate:=true;

LoadOne.Resume;

end;

procedure TfMain.actDeleteExecute(Sender: TObject);

var

i: integer;

begin

if not Assigned(lvTasks.Selected)

then Exit;

if MessageBox(Application.Handle, 'Удалить выделенные элементы?', PChar(Options.Name), MB_YESNO or MB_ICONWARNING)=IDYES

then

begin

for i:=0 to lvTasks.Items.Count-1 do

begin

if lvTasks.Items[i].Selected

then

begin

if TTask(lvTasks.Selected.Data).Status=tsDeleted

then TTask(lvTasks.Selected.Data).Status:=tsDelete

else TTask(lvTasks.Selected.Data).Status:=tsDeleted;

end;

lvTasks.Selected.Delete;

lvTasks.Repaint;

end;

procedure TfMain.lvParamsCustomDrawItem(Sender: TCustomListView;

Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

begin

if Item.Index mod 2=0

then

begin

Sender.Canvas.Font.Color:=clBlack;

Sender.Canvas.Brush.Color:=$F6F6F6;

end

else

begin

Sender.Canvas.Font.Color:=clBlack;

Sender.Canvas.Brush.Color:=clWhite;

end;

procedure TfMain.actParamsExecute(Sender: TObject);

begin

if ActParams.Checked

then

begin

Panel2.Height:=200;

Panel1.Height:=Panel4.Height-200;

Splitter2.Visible:=true;

end

else

begin

Panel2.Height:=0;

Panel1.Height:=Panel4.Height;

Splitter2.Visible:=false;

end;

procedure TfMain.lvTasksSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);

var

Data: TTask;

begin

if (lvParams.Items[0]=nil) or (Item<>lvTasks.Selected)

then Exit;

Data:=Item.Data;

lvParams.Items[0].SubItems[1]:=Data.LinkToFile;

lvParams.Items[1].SubItems[1]:=Data.Directory;

lvParams.Items[2].SubItems[1]:=Data.FileName;

if Data.TotalSize>0

then lvParams.Items[3].SubItems[1]:=IntToStr(Data.TotalSize)

else lvParams.Items[3].SubItems[1]:='?';

lvParams.Items[4].SubItems[1]:=IntToStr(Data.LoadSize);

if Data.LastModified<>0

then lvParams.Items[5].SubItems[1]:=FormatDateTime('dd.mm.yyyy hh:mm:ss', Data.LastModified)

else lvParams.Items[5].SubItems[1]:='?';

if Data.TotalSize>0

then lvParams.Items[6].SubItems[1]:='Да'

else lvParams.Items[6].SubItems[1]:='Нет';

if Data.TimeBegin<>0

then lvParams.Items[7].SubItems[1]:=FormatDateTime('dd.mm.yyyy hh:mm:ss', Data.TimeBegin)

else lvParams.Items[7].SubItems[1]:='?';

if Data.TimeEnd<>0

then lvParams.Items[8].SubItems[1]:=FormatDateTime('dd.mm.yyyy hh:mm:ss', Data.TimeEnd)

else lvParams.Items[8].SubItems[1]:='?';

if Data.TimeTotal<>0

then lvParams.Items[9].SubItems[1]:=FormatDateTime('hh:mm:ss', Data.TimeTotal)

else lvParams.Items[9].SubItems[1]:='?';

if Data.Speed>0

then lvParams.Items[10].SubItems[1]:=IntToStr(Data.Speed)

else lvParams.Items[10].SubItems[1]:='?';

lvParams.Items[11].SubItems[1]:=Data.ErrorText;

lvParams.Items[12 ].SubItems[1]:=Data.Description;

end;

procedure TfMain.tvFoldersChange(Sender: TObject; Node: TTreeNode);

var

i: integer;

Data: TTask;

SortStatus: TTaskStatus;

SortDate: TDate;

begin

if (Node.Level=0) or (Node<>tvFolders.Selected)

then Exit;

lvTasks.Items.Clear;

SortStatus:=tsReady;

SortDate:=0;

if (Node.Level=1) and (Node.Index=0)

then

begin

for i:=0 to Options.Task.Count-1 do

begin

Data:=Options.Task[i];

if Data.Status=tsLoad

then InsertItem(Data);

end;

if (Node.Level=1) and (Node.Index=1)

then

begin

for i:=0 to Options.Task.Count-1 do

begin

Data:=Options.Task[i];

if (Data.Status<>tsDelete) and (Data.Status<>tsDeleted)

then InsertItem(Data);

end;

if (Node.Parent.Level=1) and (Node.Parent.Index=1)

then

begin

case Node.Index of

0: SortStatus:=tsReady;

1: SortStatus:=tsLoad;

2: SortStatus:=tsLoading;

3: SortStatus:=tsStoped;

4: SortStatus:=tsError;

end;

for i:=0 to Options.Task.Count-1 do

begin

Data:=Options.Task[i];

if Data.Status=SortStatus

then InsertItem(Data);

end;

if (Node.Level=1) and (Node.Index=3)

then

begin

for i:=0 to Options.Task.Count-1 do

begin

Data:=Options.Task[i];

if Data.Status=tsDeleted

then InsertItem(Data);

end;

if (Node.Parent.Level=1) and (Node.Parent.Index=2)

then

begin

if (Node.Index=0) or (Node.Index=1)

then

begin

case Node.Index of

0: SortDate:=Date;

1: SortDate:=Date-1;

end;

for i:=0 to Options.Task.Count-1 do

begin

Data:=Options.Task[i];

if (SameDate(Data.TimeEnd, SortDate)) and (Data.Status=tsLoad)

then InsertItem(Data);

end;

if (Node.Index=2) or (Node.Index=3)

then

begin

case Node.Index of

2: SortDate:=Now-8;

3: SortDate:=Now-31;

end;

for i:=0 to Options.Task.Count-1 do

begin

Data:=Options.Task[i];

if (Data.TimeEnd>SortDate) and (Data.Status=tsLoad)

then InsertItem(Data);

end;

procedure TfMain.actStopExecute(Sender: TObject);

begin

if not Assigned(lvTasks.Selected)

then Exit;

if TTask(lvTasks.Selected.Data).Status=tsLoading

then TTask(lvTasks.Selected.Data).Status:=tsStoped;

end;

procedure TfMain.OnDrawClipboard(var Message : TMessage);

begin

if Options.HookClipboard

then

begin

if Clipboard.HasFormat(CF_TEXT)

then

begin

if (Pos('http://', Trim(Clipboard.AsText))=1)

or (Pos('https://', Trim(Clipboard.AsText))=1)

or (Pos('ftp://', Trim(Clipboard.AsText))=1)

then

begin

SetForegroundWindow(fMain.Handle);

fAddTask:=TfAddTask.Create(Application);

fAddTask.ShowModal;

end;

Message.Result:=SendMessage(WM_DRAWCLIPBOARD, NextViewerHandle, 0, 0);

end;

procedure TfMain.OnChangeCBCHain(var Message: TMessage);

begin

if Message.wParam=Integer(NextViewerHandle)

then

begin

NextViewerHandle:=Message.lParam;

Message.Result:=0;

end

else Message.Result:=SendMessage(NextViewerHandle, WM_CHANGECBCHAIN, Message.wParam, Message.lParam);

end;

procedure TfMain.TrayIconClick(Sender: TObject);

begin

SetForegroundWindow(Handle);

end;

procedure TfMain.lvTasksCustomDrawItem(Sender: TCustomListView;

Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

begin

if Item.Index mod 2=0

then

begin

Sender.Canvas.Font.Color:=clBlack;

Sender.Canvas.Brush.Color:=$F6F6F6;

end

else

begin

Sender.Canvas.Font.Color:=clBlack;

Sender.Canvas.Brush.Color:=clWhite;

end;

procedure TfMain.actClearDelExecute(Sender: TObject);

var

i: integer;

begin

if MessageBox(Application.Handle, 'Вы действительно хотите очистить папку "Удаленные"?', PChar(Options.Name), MB_OKCANCEL or MB_ICONWARNING)=ID_OK

then

begin

for i:=0 to Options.Task.Count-1 do

begin

if TTask(Options.Task[i]).Status=tsDeleted

then TTask(Options.Task[i]).Status:=tsDelete;

end;

lvTasks.Clear;

end;

procedure TfMain.InsertItem(P : Pointer);

var

ListItem: TListItem;

Data: TTask;

begin

Data:=P;

ListItem:=lvTasks.Items.Insert(0);

ListItem.SubItems.Add(Data.LinkToFile);

if Data.TotalSize>0

then ListItem.SubItems.Add(BytesToText(Data.TotalSize))

else ListItem.SubItems.Add('?');

ListItem.SubItems.Add(BytesToText(Data.LoadSize));

if Data.TotalSize>0

then ListItem.SubItems.Add(FloatToStrF((Data.LoadSize/Data.TotalSize)*100, ffFixed, 18, 0))

else ListItem.SubItems.Add('?');

if Data.Speed>0

then ListItem.SubItems.Add(BytesToText(Data.Speed)+'/c')

else ListItem.SubItems.Add('?');

ListItem.ImageIndex:=1;

ListItem.Data:=Data;

end;

procedure TfMain.actEditExecute(Sender: TObject);

begin

if lvTasks.SelCount=0

then Exit;

fEditTask:=TfEditTask.Create(Application);

fEditTask.Data:=lvTasks.Selected.Data;

fEditTask.ShowModal;

end;

procedure TfMain.actAboutExecute(Sender: TObject);

begin

fAbout:=TfAbout.Create(Application);

fAbout.ShowModal;

end;

procedure TfMain.Panel2Resize(Sender: TObject);

var

i: integer;

begin

if lvParams.Width>400

then

begin

if lvParams.Height<240

then i:=40

else i:=24;

lvParams.Columns[2].Width:=lvParams.Width-lvParams.Columns[1].Width-i;

end;

procedure TfMain.Panel1Resize(Sender: TObject);

var

i: integer;

begin

if lvTasks.Width>500

then

begin

if lvTasks.Height<lvTasks.Items.Count*16

then i:=40

else i:=24;

lvTasks.Columns[1].Width:=lvTasks.Width-lvTasks.Columns[2].Width - lvTasks.Columns[3].Width - lvTasks.Columns[4].Width-lvTasks.Columns[5].Width-i;

end;

procedure TfMain.actAddCategoryExecute(Sender: TObject);

begin

fAddCategory:=TfAddCategory.Create(Application);

fAddCategory.ShowModal;

end;

procedure TfMain.lvTasksKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if Key=VK_DELETE

then actDeleteExecute(nil);

end;

procedure TfMain.actDeleteCategoryExecute(Sender: TObject);

begin

if MessageBox(Application.Handle, PChar('Вы действительно хотите удалить папку "' + tvFolders.Selected.Text + '"?'), PChar(Options.Name), MB_OKCANCEL or MB_ICONWARNING)=ID_OK

then tvFolders.Selected.Delete;

end;

procedure TfMain.actEditCategoryExecute(Sender: TObject);

begin

fEditCategory:=TfEditCategory.Create(Application);

fEditCategory.ShowModal;

end;

procedure TfMain.tmUpdateTimer(Sender: TObject);

begin

UpdateItems;

end;

procedure TfMain.N17Click(Sender: TObject);

begin

SetForegroundWindow(Handle);

end;

procedure TfMain.RefreshTasks;

var

Data: TTask;

i: integer;

begin

for i:=0 to lvTasks.Items.Count-1 do

begin

Data:=lvTasks.Items[i].Data;

if Data.TotalSize>0

then lvTasks.Items[i].SubItems[1]:=BytesToText(Data.TotalSize)

else lvTasks.Items[i].SubItems[1]:='?';

lvTasks.Items[i].SubItems[2]:=BytesToText(Data.LoadSize);

if Data.TotalSize>0

then lvTasks.Items[i].SubItems[3]:=FloatToStrF((Data.LoadSize/Data.TotalSize)*100, ffFixed, 18, 0)

else lvTasks.Items[i].SubItems[3]:='?';

if Data.Speed>0

then lvTasks.Items[i].SubItems[4]:=BytesToText(Data.Speed)+'/с'

else lvTasks.Items[i].SubItems[4]:='?';

end;

procedure TfMain.SaveTreeNode(Node : TTreeNode);

var

i: integer;

begin

for i:=0 to Node.Count-1 do

begin

ShowMessage(Node.Item[i].Text);

SaveTreeNode(Node.Item[i]);

end;

procedure TfMain.actOpenFolderExecute(Sender: TObject);

begin

if not Assigned(lvTasks.Selected)

then Exit;

ShellExecute(0, 'open', PChar(TTask(lvTasks.Selected.Data).Directory), '', '', SW_SHOWNORMAL);

end;

procedure TfMain.actOpenFileExecute(Sender: TObject);

begin

if not Assigned(lvTasks.Selected)

then Exit;

ShellExecute(0, 'open', PChar(TTask(lvTasks.Selected.Data).Directory + '\' + TTask(lvTasks.Selected.Data).FileName), '', '', SW_SHOWNORMAL);

end;

end.

unit uObjects;

interface

uses

Classes, XMLDoc, XMLIntf, SysUtils, Windows, ComCtrls, Menus;

type

// Class TTaskStatus //

TTaskStatus = (tsReady, tsError, tsLoad, tsLoading, tsStoped, tsDelete, tsDeleted);

// Class THTTPVersion //

THTTPVersion = (hvHttp10, hvHttp11);

// Class TProtocol //

TProtocolType = (ptHttp, ptHttps, ptFtp);

// Class TCategory //

TCategory = record

Name : String;

Directory : String;

Extension : String;

end;

// Class TProxy //

TProxy = record

Host : String;

Port : Integer;

UserName : String;

Password : String;

UseProxy : Boolean;

end;

// Class TTask //

TTask = class(TObject)

public

LinkToFile : String; FileName : String;

Directory : String; TotalSize : Integer;

LoadSize : Integer; StartPosition : Integer;

EndPosition : Integer; Login : String;

Password : String; Port : Integer;

LastModified : TDateTime; TimeBegin : TDateTime;

TimeEnd : TDateTime; TimeTotal : TDateTime;

ScheduleOn : Boolean; Speed : Integer;

Status : TTaskStatus; Protocol : TProtocolType;

UseSpecial : Boolean; ErrorText : String;

Category : String; Description : String;

end;

// Class TOptions //

TOptions = class(TObject)

public

Name : String; Version : String;

Path : String; AgentName : String;

ShowLoadingForm : Boolean; AutoCloseLoadingForm : Boolean;

HookClipboard : Boolean; RunWithWindows : Boolean;

MinToTray : Boolean; MinOnRun : Boolean;

AlwaysInTray : Boolean; UseProxyLocal : Boolean;

ResumeLoad : Boolean; HTTPVersion : THTTPVersion;

Redirect : Boolean; Priority : TThreadPriority;

HotKey : TShortCut; HTTPProxy : TProxy;

FTPProxy : TProxy; Url : TStrings;

Directory : TStrings; Task : TList;

procedure Save; procedure Load;end;

var

Options : TOptions;

implementation

uses uMain;

procedure TOptions.Save;

var

Xml : TXMLDocument; Parent : IXMLNode; Child : IXMLNode;

Value : IXMLNode; i, n : Integer; Data : TTask;

begin

Xml := TXMLDocument.Create(nil);

Xml.Active := True;

if Xml.IsEmptyDoc then Xml.DocumentElement := Xml.CreateElement('XMLOptions', '');

Xml.DocumentElement.Attributes['Name'] := Options.Name;

Xml.DocumentElement.Attributes['Version'] := Options.Version;

Parent := Xml.DocumentElement.AddChild('Options');

Child := Parent.AddChild('AgentName');

Child.Text := AgentName;

Child := Parent.AddChild('ShowLoadingForm');

Child.Text := BoolToStr(ShowLoadingForm);

Child := Parent.AddChild('AutoCloseLoadingForm');

Child.Text := BoolToStr(AutoCloseLoadingForm);

Child := Parent.AddChild('HookClipboard');

Child.Text := BoolToStr(HookClipboard);

Child := Parent.AddChild('MinToTray');

Child.Text := BoolToStr(MinToTray);

Child := Parent.AddChild('AlwaysInTray');

Child.Text := BoolToStr(AlwaysInTray);

Child := Parent.AddChild('MinOnRun');

Child.Text := BoolToStr(MinOnRun);

Child := Parent.AddChild('RunWithWindows');

Child.Text := BoolToStr(RunWithWindows);

Child := Parent.AddChild('UseProxyLocal');

Child.Text := BoolToStr(UseProxyLocal);

Child := Parent.AddChild('Redirect');

Child.Text := BoolToStr(Redirect);

Child := Parent.AddChild('ThreadPriority');

Child.Text := IntToStr(Integer(Priority));

Child := Parent.AddChild('HotKey');

Child.Text := ShortCutToText(HotKey);

Child := Parent.AddChild('HTTPVersion');

Child.Text := IntToStr(Integer(HTTPVersion));

Child := Parent.AddChild('ResumeLoad');

Child.Text := BoolToStr(ResumeLoad);

Parent := Xml.DocumentElement.AddChild('MainForm');

Child := Parent.AddChild('MainWindowTop');

Child.Text := IntToStr(fMain.Top);

Child := Parent.AddChild('MainWindowLeft');

Child.Text := IntToStr(fMain.Left);

Child := Parent.AddChild('MainWindowHeight');

Child.Text := IntToStr(fMain.Height);

Child := Parent.AddChild('MainWindowWidth');

Child.Text := IntToStr(fMain.Width);

Child := Parent.AddChild('CategoryPanelWidth');

Child.Text := IntToStr(fMain.Panel3.Width);

Child := Parent.AddChild('TasksPanelHeight');

Child.Text := IntToStr(fMain.Panel1.Height);

Child := Parent.AddChild('ParamsVisible');

Child.Text := BoolToStr(fMain.actParams.Checked);

Child := Parent.AddChild('StatusBarVisible');

Child.Text := BoolToStr(fMain.actStatusBar.Checked);

Child := Parent.AddChild('TasksColumn1Width');

Child.Text := IntToStr(fMain.lvTasks.Columns[1].Width);

Child := Parent.AddChild('TasksColumn2Width');

Child.Text := IntToStr(fMain.lvTasks.Columns[2].Width);

Child := Parent.AddChild('TasksColumn3Width');

Child.Text := IntToStr(fMain.lvTasks.Columns[3].Width);

Child := Parent.AddChild('TasksColumn4Width');

Child.Text := IntToStr(fMain.lvTasks.Columns[4].Width);

Child := Parent.AddChild('TasksColumn5Width');

Child.Text := IntToStr(fMain.lvTasks.Columns[5].Width);

Child := Parent.AddChild('ParamsColumn1Width');

Child.Text := IntToStr(fMain.lvParams.Columns[1].Width);

Child := Parent.AddChild('ParamsColumn2Width');

Child.Text := IntToStr(fMain.lvParams.Columns[2].Width);

Child := Parent.AddChild('SelectedTreeItem');

if Assigned(fMain.tvFolders.Selected) then Child.Text := IntToStr(fMain.tvFolders.Selected.AbsoluteIndex) else Child.Text := '0';

Parent := Xml.DocumentElement.AddChild('Proxy');

Child := Parent.AddChild('HTTPProxy');

Value := Child.AddChild('Host');

Value.Text := HTTPProxy.Host;

Value := Child.AddChild('Port');

Value.Text := IntToStr(HTTPProxy.Port);

Value := Child.AddChild('User');

Value.Text := HTTPProxy.UserName;

Value := Child.AddChild('Password');

Value.Text := HTTPProxy.Password;

Value := Child.AddChild('UseProxy');

Value.Text := BoolToStr(HTTPProxy.UseProxy);

Child := Parent.AddChild('FTPProxy');

Value := Child.AddChild('Host');

Value.Text := FTPProxy.Host;

Value := Child.AddChild('Port');

Value.Text := IntToStr(FTPProxy.Port);

Value := Child.AddChild('User');

Value.Text := FTPProxy.UserName;

Value := Child.AddChild('Password');

Value.Text := FTPProxy.Password;

Value := Child.AddChild('UseProxy');

Value.Text := BoolToStr(FTPProxy.UseProxy);

if Url <> nil then

begin

Parent := Xml.DocumentElement.AddChild('Url');

if Url.Count > 15 then n := 15 else n := Url.Count - 1;

for i := 0 to n do

begin

Child := Parent.AddChild('Url');

Child.Text := Url.Strings[i];

end;

if Directory <> nil then

begin

Parent := Xml.DocumentElement.AddChild('Directory');

if Directory.Count > 15 then n := 15 else n := Directory.Count - 1;

for i := 0 to n do

begin

Child := Parent.AddChild('Directory');

Child.Text:= Directory.Strings[i];

end;

if Task <> nil then

begin

Parent := Xml.DocumentElement.AddChild('Tasks');

for i := 0 to Task.Count - 1 do

begin

Data := Task.Items[i];

if Data.Status <> tsDelete then

begin

Child := Parent.AddChild('Task');

Value := Child.AddChild('LinkToFile');

Value.Text := Data.LinkToFile;

Value := Child.AddChild('FileName');

Value.Text := Data.FileName;

Value := Child.AddChild('Directory');

Value.Text := Data.Directory;

Value := Child.AddChild('TotalSize');

Value.Text := IntToStr(Data.TotalSize);

Value := Child.AddChild('LoadSize');

Value.Text := IntToStr(Data.LoadSize);

Value := Child.AddChild('StartPosition');

Value.Text := IntToStr(Data.StartPosition);

Value := Child.AddChild('EndPosition');

Value.Text := IntToStr(Data.EndPosition);

Value := Child.AddChild('Login');

Value.Text := Data.Login;

Value := Child.AddChild('Password');

Value.Text := Data.Password;

Value := Child.AddChild('Port');

Value.Text := IntToStr(Data.Port);

Value := Child.AddChild('LastModified');

Value.Text := DateTimeToStr(Data.LastModified);

Value := Child.AddChild('TimeBegin');

Value.Text := DateTimeToStr(Data.TimeBegin);

Value := Child.AddChild('TimeEnd');

Value.Text := DateTimeToStr(Data.TimeEnd);

Value := Child.AddChild('TimeTotal');

Value.Text := DateTimeToStr(Data.TimeTotal);

Value := Child.AddChild('ScheduleOn');

Value.Text := BoolToStr(Data.ScheduleOn);

Value := Child.AddChild('Speed');

Value.Text := IntToStr(Data.Speed);

Value := Child.AddChild('Status');

Value.Text := IntToStr(Integer(Data.Status));

Value := Child.AddChild('Protocol');

Value.Text := IntToStr(Integer(Data.Protocol));

Value := Child.AddChild('UseSpecial');

Value.Text := BoolToStr(Data.UseSpecial);

Value := Child.AddChild('ErrorText');

Value.Text := Data.ErrorText;

Value := Child.AddChild('Category');

Value.Text := Data.Category;

Value := Child.AddChild('Description');

Value.Text := Data.Description;

end;

Xml.SaveToFile(Options.Path + '\' + Options.Name + '.xml');

Xml.Free;

end;

procedure TOptions.Load;

var

Xml : IXMLDocument; Parent : IXMLNode;

Child : IXMLNode; Value : IXMLNode;

i : Integer; Data : TTask;

begin

Url := TStringList.Create;

Directory := TStringList.Create;

Task := TList.Create;

if not FileExists(Options.Path + '\' + Options.Name + '.xml') then Exit;

Xml := TXMLDocument.Create(nil);

Xml.Active := True;

Xml.LoadFromFile(Options.Path + '\' + Options.Name + '.xml');

Parent := Xml.DocumentElement.ChildNodes['Options'];

Child := Parent.ChildNodes['AgentName'];

AgentName := Child.Text;

Child := Parent.ChildNodes['ShowLoadingForm'];

ShowLoadingForm := StrToBool(Child.Text);

Child := Parent.ChildNodes['AutoCloseLoadingForm'];

AutoCloseLoadingForm := StrToBool(Child.Text);

Child := Parent.ChildNodes['HookClipboard'];

HookClipboard := StrToBool(Child.Text);

Child := Parent.ChildNodes['MinToTray'];

MinToTray := StrToBool(Child.Text);

Child := Parent.ChildNodes['MinOnRun'];

MinOnRun := StrToBool(Child.Text);

Child := Parent.ChildNodes['AlwaysInTray'];

AlwaysInTray := StrToBool(Child.Text);

Child := Parent.ChildNodes['RunWithWindows'];

RunWithWindows := StrToBool(Child.Text);

Child := Parent.ChildNodes['UseProxyLocal'];

UseProxyLocal := StrToBool(Child.Text);

Child := Parent.ChildNodes['Redirect'];

Redirect := StrToBool(Child.Text);

Child := Parent.ChildNodes['HotKey'];

HotKey := TextToShortCut(Child.Text);

Child := Parent.ChildNodes['ThreadPriority'];

Priority := TThreadPriority(StrToInt(Child.Text));

Child := Parent.ChildNodes['HTTPVersion'];

HTTPVersion := THTTPVersion(StrToInt(Child.Text));

Child := Parent.ChildNodes['ResumeLoad'];

ResumeLoad := StrToBool(Child.Text);

Parent := Xml.DocumentElement.ChildNodes['MainForm'];

Child := Parent.ChildNodes['MainWindowTop'];

fMain.Top := StrToInt(Child.Text);

Child := Parent.ChildNodes['MainWindowLeft'];

fMain.Left := StrToInt(Child.Text);

Child := Parent.ChildNodes['MainWindowHeight'];

fMain.Height := StrToInt(Child.Text);

Child := Parent.ChildNodes['MainWindowWidth'];

fMain.Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['CategoryPanelWidth'];

fMain.Panel3.Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['TasksPanelHeight'];

fMain.Panel1.Height := StrToInt(Child.Text);

Child := Parent.ChildNodes['ParamsVisible'];

fMain.Panel3.Visible := StrToBool(Child.Text);

Child := Parent.ChildNodes['StatusBarVisible'];

fMain.StatusBar.Visible := StrToBool(Child.Text);

Child := Parent.ChildNodes['TasksColumn1Width'];

fMain.lvTasks.Columns[1].Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['TasksColumn2Width'];

fMain.lvTasks.Columns[2].Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['TasksColumn3Width'];

fMain.lvTasks.Columns[3].Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['TasksColumn4Width'];

fMain.lvTasks.Columns[4].Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['TasksColumn5Width'];

fMain.lvTasks.Columns[5].Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['ParamsColumn1Width'];

fMain.lvParams.Columns[1].Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['ParamsColumn2Width'];

fMain.lvParams.Columns[2].Width := StrToInt(Child.Text);

Child := Parent.ChildNodes['SelectedTreeItem'];

fMain.tvFolders.Items[StrToInt(Child.Text)].Selected := True;

Parent := Xml.DocumentElement.ChildNodes['Proxy'];

Child := Parent.ChildNodes[0];

Value := Child.ChildNodes['Host'];

HTTPProxy.Host := Value.Text;

Value := Child.ChildNodes['Port'];

HTTPProxy.Port := StrToInt(Value.Text);

Value := Child.ChildNodes['User'];

HTTPProxy.UserName := Value.Text;

Value := Child.ChildNodes['Password'];

HTTPProxy.Password := Value.Text;

Value := Child.ChildNodes['UseProxy'];

HTTPProxy.UseProxy := StrToBool(Value.Text);

Child := Parent.ChildNodes[1];

Value := Child.ChildNodes['Host'];

FTPProxy.Host := Value.Text;

Value := Child.ChildNodes['Port'];

FTPProxy.Port := StrToInt(Value.Text);

Value := Child.ChildNodes['User'];

FTPProxy.UserName := Value.Text;

Value := Child.ChildNodes['Password'];

FTPProxy.Password := Value.Text;

Value := Child.ChildNodes['UseProxy'];

FTPProxy.UseProxy := StrToBool(Value.Text);

Parent := Xml.DocumentElement.ChildNodes['Url'];

for i := 0 to Parent.ChildNodes.Count - 1 do

begin

Child := Parent.ChildNodes[i];

Url.Add(Child.Text);

end;

Parent := Xml.DocumentElement.ChildNodes['Directory'];

for i := 0 to Parent.ChildNodes.Count - 1 do

begin

Child := Parent.ChildNodes[i];

Directory.Add(Child.Text);

end;

Parent := Xml.DocumentElement.ChildNodes['Tasks'];

for i := 0 to Parent.ChildNodes.Count - 1 do

begin

Data := TTask.Create;

Child := Parent.ChildNodes[i];

Value := Child.ChildNodes['LinkToFile'];

Data.LinkToFile := Value.Text;

Value := Child.ChildNodes['FileName'];

Data.FileName := Value.Text;

Value := Child.ChildNodes['Directory'];

Data.Directory := Value.Text;

Value := Child.ChildNodes['TotalSize'];

Data.TotalSize := StrToInt(Value.Text);

Value := Child.ChildNodes['LoadSize'];

Data.LoadSize := StrToInt(Value.Text);

Value := Child.ChildNodes['StartPosition'];

Data.StartPosition := StrToInt(Value.Text);

Value := Child.ChildNodes['EndPosition'];

Data.EndPosition := StrToInt(Value.Text);

Value := Child.ChildNodes['Login'];

Data.Login := Value.Text;

Value := Child.ChildNodes['Password'];

Data.Password := Value.Text;

Value := Child.ChildNodes['Port'];

Data.Port := StrToInt(Value.Text);

Value := Child.ChildNodes['LastModified'];

Data.LastModified := StrToDateTime(Value.Text);

Value := Child.ChildNodes['TimeBegin'];

Data.TimeBegin := StrToDateTime(Value.Text);

Value := Child.ChildNodes['TimeEnd'];

Data.TimeEnd := StrToDateTime(Value.Text);

Value := Child.ChildNodes['TimeTotal'];

Data.TimeTotal := StrToDateTime(Value.Text);

Value := Child.ChildNodes['ScheduleOn'];

Data.ScheduleOn := StrToBool(Value.Text);

Value := Child.ChildNodes['Speed'];

Data.Speed := StrToInt(Value.Text);

Value := Child.ChildNodes['Status'];

Data.Status := TTaskStatus(StrToInt(Value.Text));

Value := Child.ChildNodes['Protocol'];

Data.Protocol := TProtocolType(StrToInt(Value.Text));

Value := Child.ChildNodes['UseSpecial'];

Data.UseSpecial := StrToBool(Value.Text);

Value := Child.ChildNodes['ErrorText'];

Data.ErrorText := Value.Text;

Value := Child.ChildNodes['Category'];

Data.Category := Value.Text;

Value := Child.ChildNodes['Description'];

Data.Description := Value.Text;

Task.Add(Data);

end;

Xml := nil;

end;

end.

unit uOptions;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, ExtCtrls, Spin, Registry;

type

TfOptions = class(TForm) btnOK: TButton;

btnCancel: TButton; PagControl1: TPageControl;

TabSheet1: TTabSheet; Label1: TLabel;

cbAgent: TComboBox; TabSheet3: TTabSheet;

cbxRunWithWindows: TCheckBox; cbxHookClipboard: TCheckBox;

cbxMinToTray: TCheckBox; Label23: TLabel;

mmExtention: TMemo; Label15: TLabel;

TrackBar: TTrackBar; Label16: TLabel;

CheckBox4: TCheckBox; CheckBox5: TCheckBox;

cbxAutoCloseLoadingForm: TCheckBox; cbxShowLoadingForm: TCheckBox;

cbxMinOnRun: TCheckBox; cbxRedirect: TCheckBox;

Label6: TLabel; hkApplication: THotKey;

Label7: TLabel; cbHttpVersion: TComboBox;

cbxResumeLoad: TCheckBox;

TabSheet2: TTabSheet; cbxUseProxyLocal: TCheckBox;

cbUseHTTPProxy: TCheckBox; GroupBox1: TGroupBox;

Label2: TLabel; Label3: TLabel; edHTTPProxyHost: TEdit;

edHTTPProxyPort: TEdit; Label4: TLabel; Label5: TLabel;

edHTTPProxyUser: TEdit; edHTTPProxyPass: TEdit;

GroupBox2: TGroupBox; Label8: TLabel;

Label9: TLabel; Label10: TLabel;

Label11: TLabel; edFTPProxyHost: TEdit;

edFTPProxyPort: TEdit; edFTPProxyUser: TEdit;

edFTPProxyPass: TEdit; cbUseFTPProxy: TCheckBox;

cbxAlwaysInTray: TCheckBox; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btnCancelClick(Sender: TObject);

procedure btnOKClick(Sender: TObject); procedure FormCreate(Sender: TObject);

procedure TrackBarChange(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fOptions: TfOptions;

implementation

uses uObjects, uMain;

{$R *.dfm}

procedure TfOptions.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TfOptions.btnCancelClick(Sender: TObject);

begin

Close;

end;

procedure TfOptions.btnOKClick(Sender: TObject);

var

Registry : TRegistry;

begin

Options.AgentName := Trim(cbAgent.Text);

Options.ShowLoadingForm := cbxShowLoadingForm.Checked;

Options.AutoCloseLoadingForm := cbxAutoCloseLoadingForm.Checked;

Options.HookClipboard := cbxHookClipboard.Checked;

Options.MinToTray := cbxMinToTray.Checked;

Options.MinOnRun := cbxMinOnRun.Checked;

Options.AlwaysInTray := cbxAlwaysInTray.Checked;

Options.RunWithWindows := cbxRunWithWindows.Checked;

Options.HotKey := hkApplication.HotKey;

Options.Redirect := cbxRedirect.Checked;

Options.UseProxyLocal := cbxUseProxyLocal.Checked;

Options.ResumeLoad := cbxResumeLoad.Checked;

Options.HTTPProxy.UseProxy := cbUseHTTPProxy.Checked;

Options.HTTPProxy.Host := Trim(edHTTPProxyHost.Text);

Options.HTTPProxy.Port := StrToInt(Trim(edHTTPProxyPort.Text));

Options.HTTPProxy.UserName := Trim(edHTTPProxyUser.Text);

Options.HTTPProxy.Password := Trim(edHTTPProxyPass.Text);

Options.FTPProxy.UseProxy := cbUseFTPProxy.Checked;

Options.FTPProxy.Host := Trim(edFTPProxyHost.Text);

Options.FTPProxy.Port := StrToInt(Trim(edFTPProxyPort.Text));

Options.FTPProxy.UserName := Trim(edFTPProxyUser.Text);

Options.FTPProxy.Password := Trim(edFTPProxyPass.Text);

if cbHttpVersion.Text = 'HTTP 1.0' then Options.HTTPVersion := hvHttp10 else Options.HTTPVersion := hvHttp11;

case TrackBar.Position of

0 : Options.Priority := tpIdle;

1 : Options.Priority := tpLowest;

2 : Options.Priority := tpLower;

3 : Options.Priority := tpNormal;

4 : Options.Priority := tpHigher;

5 : Options.Priority := tpHighest;

6 : Options.Priority := tpTimeCritical;

end;

Options.Save;

Registry := TRegistry.Create(KEY_ALL_ACCESS);

try

Registry.RootKey := HKEY_LOCAL_MACHINE;

Registry.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', True);

if cbxRunWithWindows.Checked then Registry.WriteString('Download', Application.ExeName)

else Registry.DeleteValue('Download');

Registry.CloseKey;

finally

Registry.Free;

end;

Close;

end;

procedure TfOptions.FormCreate(Sender: TObject);

begin

cbAgent.Text := Options.AgentName;

cbxShowLoadingForm.Checked := Options.ShowLoadingForm;

cbxAutoCloseLoadingForm.Checked := Options.AutoCloseLoadingForm;

cbxHookClipboard.Checked := Options.HookClipboard;

cbxMinToTray.Checked := Options.MinToTray;

cbxMinOnRun.Checked := Options.MinOnRun;

cbxAlwaysInTray.Checked := Options.AlwaysInTray;

cbxRunWithWindows.Checked := Options.RunWithWindows;

hkApplication.HotKey := Options.HotKey;

cbxRedirect.Checked := Options.Redirect;

cbxUseProxyLocal.Checked := Options.UseProxyLocal;

cbxResumeLoad.Checked := Options.ResumeLoad;

cbUseHTTPProxy.Checked := Options.HTTPProxy.UseProxy;

edHTTPProxyHost.Text := Options.HTTPProxy.Host;

edHTTPProxyPort.Text := IntToStr(Options.HTTPProxy.Port);

edHTTPProxyUser.Text := Options.HTTPProxy.UserName;

edHTTPProxyPass.Text := Options.HTTPProxy.Password;

cbUseFTPProxy.Checked := Options.FTPProxy.UseProxy;

edFTPProxyHost.Text := Options.FTPProxy.Host;

edFTPProxyPort.Text := IntToStr(Options.FTPProxy.Port);

edFTPProxyUser.Text := Options.FTPProxy.UserName;

edFTPProxyPass.Text := Options.FTPProxy.Password;

if Options.HTTPVersion = hvHttp10 then cbHttpVersion.ItemIndex := 0 else cbHttpVersion.ItemIndex := 1;

case Options.Priority of

tpIdle : begin TrackBar.Position := 0; Label16.Caption := 'Низкий'; end;

tpLowest : begin TrackBar.Position := 1; Label16.Caption := 'Ниже среднего'; end;

tpLower : begin TrackBar.Position := 2; Label16.Caption := 'Средний'; end;

tpNormal : begin TrackBar.Position := 3; Label16.Caption := 'Выше среднего'; end;

tpHigher : begin TrackBar.Position := 4; Label16.Caption := 'Высокий'; end;

tpHighest : begin TrackBar.Position := 5; Label16.Caption := 'Highest'; end;

tpTimeCritical : begin TrackBar.Position := 6; Label16.Caption := 'Реального времени'; end;

end;

procedure TfOptions.TrackBarChange(Sender: TObject);

begin

case TrackBar.Position of

0: Label16.Caption := 'Низкий';

1: Label16.Caption := 'Ниже среднего';

2: Label16.Caption := 'Средний';

3: Label16.Caption := 'Выше среднего';

4: Label16.Caption := 'Высокий';

5: Label16.Caption := 'Highest';

6: Label16.Caption := 'Реального времени';

end;

end.

unit uProcedures;

interface

uses

SysUtils, Windows, ShellAPI, ShlObj;

function BytesToText(Bytes : Integer) : String;

function GetFileVersion(FileName : String) : String;

function BrowserFolder(Owner : THandle) : String;

function CreateFileName(Url : String) : String;

function LocalAddress(Url : String) : Boolean;

function ExtractAddress(Url : String) : String;

function ExtractFileName(Url : String) : String;

function GetFreeSpace(Disk : String) : Int64;

function IsRun : Boolean;

function GetTimeStr(Secs : Integer) : String;

implementation

////////////////////////////////////////////////////////////////////////////////

function BytesToText(Bytes : integer) : String;

begin

if Bytes div 1000 < 1 then Result := IntToStr(Bytes) + ' байт';

if Bytes div 1000 >= 1 then Result := FloatToStrF(Bytes/1000, ffNumber, 18, 1) + ' Кб';

if Bytes div 1000 >= 1000 then Result := FloatToStrF(Bytes/1000000, ffNumber, 18, 1) + ' Мб';

end;

////////////////////////////////////////////////////////////////////////////////

function GetFileVersion(FileName : String) : String;

var

Data : Pointer;

DataSize, InfoSize : Dword;

Dummy : Cardinal;

Buffer: array [0..MAX_PATH] of Char;

Major1, Major2, Minor1, Minor2 : Integer;

FileInfo : PVSFixedFileInfo;

begin

StrCat(Buffer, PChar(FileName));

DataSize := GetFileVersionInfoSize(Buffer, Dummy);

if DataSize > 0 then

begin

GetMem(Data, DataSize);

GetFileVersionInfo(Buffer, 0, DataSize, Data);

VerQueryValue(Data, '\', Pointer(FileInfo), InfoSize);

Major1 := FileInfo.dwFileVersionMS shr 16;

Major2 := FileInfo.dwFileVersionMS and $FFFF;

Minor1 := FileInfo.dwFileVersionLS shr 16;

Minor2 := FileInfo.dwFileVersionLS and $FFFF;

Result := IntToStr(Major1) + '.' + IntToStr(Major2) + '.' + IntToStr(Minor1) + ' build ' + IntToStr(Minor2);

FreeMem(Data, DataSize);

end;

////////////////////////////////////////////////////////////////////////////////

function BrowserFolder(Owner : THandle) : String;

var

TitleName : String;

lpItemID : PItemIDList;

BrowseInfo : TBrowseInfo;

DisplayName : Array [0..MAX_PATH] of char;

TempPath : Array [0..MAX_PATH] of char;

begin

FillChar(BrowseInfo, SizeOf(TBrowseInfo), #0);

BrowseInfo.hwndOwner := Owner;

BrowseInfo.pszDisplayName := @DisplayName;

TitleName := 'Выберите директорию';

BrowseInfo.lpszTitle := PChar(TitleName);

BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;

lpItemID := SHBrowseForFolder(BrowseInfo);

if lpItemId <> nil then

begin

SHGetPathFromIDList(lpItemID, TempPath);

GlobalFreePtr(lpItemID);

Result := TempPath;

end else

begin

Result := '';

end;

////////////////////////////////////////////////////////////////////////////////

function CreateFileName(Url : String) : String;

var

i : Integer;

begin

Result := '';

if Pos('//', Url) > 0 then Delete(Url, 1, Pos('//', Url) + 1);

if Url = '' then Exit;

if Pos('/', Url) > 0 then Delete(Url, 1, Pos('/', Url))

else Delete(Url, 1, Length(Url));

if Url = '' then

begin

Result := 'index.html';

Exit;

end;

if Url[Length(Url)] <> '/' then

begin

i := Length(Url);

repeat

i := i - 1;

until Url[i] = '/';

Result := Copy(Url, i + 1, Length(Url) - i);

end else Result := 'index.html';

end;

////////////////////////////////////////////////////////////////////////////////

function LocalAddress(Url : String) : Boolean;

begin

Result := False;

if Pos('//', Url) > 0 then Delete(Url, 1, Pos('//', Url) + 1);

if Pos('/', Url) > 0 then Delete(Url, Pos('/', Url), Length(Url));

if LowerCase(Url) = 'localhost' then Result := True;

if LowerCase(Url) = '127.0.0.1' then Result := True;

end;

////////////////////////////////////////////////////////////////////////////////

function ExtractAddress(Url : String) : String;

begin

if Pos('//', Url) > 0 then Delete(Url, 1, Pos('//', Url) + 1);

if Pos('/', Url) > 0 then Delete(Url, Pos('/', Url), Length(Url));

Result := Url;

end;

////////////////////////////////////////////////////////////////////////////////

function ExtractFileName(Url : String) : String;

begin

if Pos('//', Url) > 0 then Delete(Url, 1, Pos('//', Url) + 1);

if Pos('/', Url) > 0 then Delete(Url, 1, Pos('/', Url));

Result := Url;

end;

////////////////////////////////////////////////////////////////////////////////

function GetFreeSpace(Disk : String) : Int64;

var

TotalBytes : Int64;

TotalFreeBytes : PLargeInteger;

FreeBytesCall : Int64;

begin

New(TotalFreeBytes);

try

GetDiskFreeSpaceEx(PChar(Disk), FreeBytesCall, TotalBytes, TotalFreeBytes);;

Result := TotalFreeBytes^;

finally

Dispose(TotalFreeBytes);

end;

////////////////////////////////////////////////////////////////////////////////

function IsRun : Boolean;

var

Mutex : integer;

begin

Result := False;

Mutex := CreateMutex(nil , True, 'BankClientServer');

if GetLastError <> 0 then

begin

CloseHandle(Mutex);

Result := True;

end;

////////////////////////////////////////////////////////////////////////////////

function GetTimeStr(Secs : Integer) : String;

function LeadingZero(N:Integer) : String;

begin

if N < 10 then Result := '0' + IntToStr(N) else Result := IntToStr(N);

end;

var

Hours, Mins : Integer;

begin

Hours := Secs div 3600;

Secs := Secs - Hours * 3600;

Mins := Secs div 60;

Secs := Secs - Mins * 60;

Result := LeadingZero(Hours) + ':' + LeadingZero(Mins) + ':' + LeadingZero(Secs);

end;

end.

unit uThreads;

interface

uses

Classes, IdHTTP, IdFTP, IdComponent, IdFTPCommon, Windows, SysUtils, uObjects, Forms;

type

// Class TGetFileHttp //

TGetFileHttp = class(TThread)

public

Item : Integer;

Reload : Boolean;

constructor Create(CreateSuspended : Boolean; P : Pointer);

private

Data : TTask;

Tick : Integer;

StartSize : Integer;

HTTP : TIdHTTP;

procedure OnWork(Sender : TObject; AWorkMode : TWorkMode; const AWorkCount : Integer);

procedure OnWorkBegin(Sender : TObject; AWorkMode : TWorkMode; const AWorkCountMax : Integer);

procedure OnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);

protected

procedure Execute; override;

end;

// Class TGetOptionsHttp //

TGetOptionsHttp = class(TThread)

public

constructor Create(CreateSuspended : Boolean; P : Pointer);

private

Data : TTask;

protected

procedure Execute; override;

end;

// Class TGetFileFtp //

TGetFileFtp = class(TThread)

public

Item : Integer;

Reload : Boolean;

constructor Create(CreateSuspended : Boolean; P : Pointer);

private

Data : TTask;

Tick : Integer;

FTP : TIdFTP;

procedure OnWork(Sender : TObject; AWorkMode : TWorkMode; const AWorkCount : Integer);

procedure OnWorkBegin(Sender : TObject; AWorkMode : TWorkMode; const AWorkCountMax : Integer);

procedure OnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);

protected

procedure Execute; override;

end;

// Class TGetOptionsFtp //

TGetOptionsFtp = class(TThread)

public

constructor Create(CreateSuspended : Boolean; P : Pointer);

private

Data : TTask;

protected

procedure Execute; override;

end;

implementation

uses uMain, uProcedures;

////////////////////////////////////////////////////////////////////////////////

// Class 'TGetFileHttp' //

////////////////////////////////////////////////////////////////////////////////

constructor TGetFileHttp.Create(CreateSuspended : Boolean; P : Pointer);

begin

Data := P;

inherited Create(CreateSuspended);

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileHttp.Execute;

var

FileStream : TFileStream;

begin

HTTP := TIdHTTP.Create(nil);

if FileExists(Data.Directory + '\' + Data.FileName) then

begin

FileStream := TFileStream.Create(Data.Directory + '\' + Data.FileName, fmOpenReadWrite);

FileStream.Position := FileStream.Size;

end else

begin

FileStream := TFileStream.Create(Data.Directory + '\' + Data.FileName, fmCreate);

end;

HTTP.OnWork := OnWork;

HTTP.OnWorkBegin := OnWorkBegin;

HTTP.OnWorkEnd := OnWorkEnd;

if Options.HTTPVersion = hvHttp10 then HTTP.ProtocolVersion := pv1_0 else HTTP.ProtocolVersion := pv1_1;

if (Options.HTTPProxy.UseProxy) and (LocalAddress(Data.LinkToFile) = False) then

begin

HTTP.ProxyParams.ProxyServer := Options.HTTPProxy.Host;

HTTP.ProxyParams.ProxyPort := Options.HTTPProxy.Port;

HTTP.ProxyParams.ProxyUsername := Options.HTTPProxy.UserName;

HTTP.ProxyParams.ProxyPassword := Options.HTTPProxy.Password;

end;

if Data.UseSpecial then

begin

HTTP.Port := Data.Port;

HTTP.Request.Username := Data.Login;

HTTP.Request.Password := Data.Password;

end;

HTTP.Request.ContentRangeStart := Data.LoadSize;

HTTP.Request.ContentRangeEnd := Data.TotalSize;

HTTP.HandleRedirects := Options.Redirect;

StartSize := Data.LoadSize;

try

HTTP.Get(Data.LinkToFile, FileStream);

except

on E : Exception do

begin

Data.Status := tsError;

Data.ErrorText := E.Message;

MessageBox(Application.Handle, PChar('Ошибка при загрузке файла.' + #13#10 + E.Message), PChar(Options.Name), MB_OK or MB_ICONERROR);

end;

HTTP.Free;

FileStream.Free;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileHttp.OnWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);

var

TickCount : Integer;

Count : Integer;

begin

if AWorkMode = wmRead then

begin

Data.LoadSize := StartSize + AWorkCount;

TickCount := GetTickCount;

Count := (TickCount - Tick) div 1000;

if (Data.LoadSize > 0) and (Count > 0) then Data.Speed := Data.LoadSize div Count;

end;

if Data.Status = tsStoped then HTTP.Disconnect;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileHttp.OnWorkBegin(Sender : TObject; AWorkMode : TWorkMode; const AWorkCountMax : Integer);

begin

Tick := GetTickCount;

Data.TimeBegin := Now;

Data.Status := tsLoading;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileHttp.OnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);

begin

Data.TimeEnd := Now;

Data.TimeTotal := Data.TimeBegin - Data.TimeEnd;

if Data.Status <> tsStoped then Data.Status := tsLoad;

end;

////////////////////////////////////////////////////////////////////////////////

// 'TGetOptionsHttp' //

////////////////////////////////////////////////////////////////////////////////

constructor TGetOptionsHttp.Create(CreateSuspended : Boolean; P : Pointer);

begin

Data := P;

inherited Create(CreateSuspended);

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetOptionsHttp.Execute;

var

HTTP : TIdHTTP;

begin

HTTP := TIdHTTP.Create(nil);

if (Options.HTTPProxy.UseProxy) and (LocalAddress(Data.LinkToFile) = False) then

begin

HTTP.ProxyParams.ProxyServer := Options.HTTPProxy.Host;

HTTP.ProxyParams.ProxyPort := Options.HTTPProxy.Port;

HTTP.ProxyParams.ProxyUsername := Options.HTTPProxy.UserName;

HTTP.ProxyParams.ProxyPassword := Options.HTTPProxy.Password;

end;

if Data.UseSpecial then

begin

HTTP.Port := Data.Port;

HTTP.Request.Username := Data.Login;

HTTP.Request.Password := Data.Password;

end;

HTTP.HandleRedirects := Options.Redirect;

if Options.HTTPVersion = hvHttp10 then HTTP.ProtocolVersion := pv1_0 else HTTP.ProtocolVersion := pv1_1;

try

HTTP.Head(Data.LinkToFile);

Data.Status := tsReady;

Data.ErrorText := 'Ошибок нет';

Data.TotalSize := HTTP.Response.ContentLength;

Data.LastModified := HTTP.Response.LastModified;

except

on E : Exception do

begin

Data.Status := tsError;

Data.ErrorText := E.Message;

Data.TotalSize := 0;

Data.LastModified := 0;

MessageBox(Application.Handle, PChar('Ошибка при загрузке файла.' + #13#10 + E.Message), PChar(Options.Name), MB_OK or MB_ICONERROR);

end;

HTTP.Free;

fMain.RefreshTasks;

end;

////////////////////////////////////////////////////////////////////////////////

// Class 'TGetFileFtp' //

////////////////////////////////////////////////////////////////////////////////

constructor TGetFileFtp.Create(CreateSuspended : Boolean; P : Pointer);

begin

Data := P;

inherited Create(CreateSuspended);

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileFtp.Execute;

begin

FTP := TIdFTP.Create(nil);

FTP.OnWork := OnWork;

FTP.OnWorkBegin := OnWorkBegin;

FTP.OnWorkEnd := OnWorkEnd;

if (Options.FTPProxy.UseProxy) and (LocalAddress(Data.LinkToFile) = False) then

begin

FTP.ProxySettings.Host := Options.FTPProxy.Host;

FTP.ProxySettings.Port := Options.FTPProxy.Port;

FTP.ProxySettings.Username := Options.FTPProxy.UserName;

FTP.ProxySettings.Password := Options.FTPProxy.Password;

end;

if Data.UseSpecial then

begin

FTP.Port := Data.Port;

FTP.Username := Data.Login;

FTP.Password := Data.Password;

end else FTP.Username := 'anonymous';

try

FTP.TransferType := ftBinary;

FTP.Host := ExtractAddress(Data.LinkToFile);

FTP.Connect;

FTP.Get(ExtractFileName(Data.LinkToFile), Data.Directory + '\' + Data.FileName, False, True);

FTP.Disconnect;

Data.Status := tsReady;

Data.ErrorText := 'Ошибок нет';

except

on E : Exception do

begin

Data.Status := tsError;

Data.ErrorText := E.Message;

MessageBox(Application.Handle, PChar('Ошибка при загрузке файла.' + #13#10 + E.Message), PChar(Options.Name), MB_OK or MB_ICONERROR);

end;

FTP.Free;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileFtp.OnWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);

var

TickCount : Integer;

Count : Integer;

begin

if AWorkMode = wmRead then

begin

Data.LoadSize := AWorkCount;

TickCount := GetTickCount;

Count := (TickCount - Tick) div 1000;

if (Data.LoadSize > 0) and (Count > 0) then Data.Speed := Data.LoadSize div Count;

end;

if Data.Status = tsStoped then FTP.Disconnect;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileFtp.OnWorkBegin(Sender : TObject; AWorkMode : TWorkMode; const AWorkCountMax : Integer);

begin

Tick := GetTickCount;

Data.TimeBegin := Now;

Data.Status := tsLoading;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetFileFtp.OnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);

begin

Data.TimeEnd := Now;

Data.TimeTotal := Data.TimeBegin - Data.TimeEnd;

if Data.Status <> tsStoped then Data.Status := tsLoad;

end;

////////////////////////////////////////////////////////////////////////////////

// 'TGetOptionsFtp' //

////////////////////////////////////////////////////////////////////////////////

constructor TGetOptionsFtp.Create(CreateSuspended : Boolean; P : Pointer);

begin

Data := P;

inherited Create(CreateSuspended);

end;

////////////////////////////////////////////////////////////////////////////////

procedure TGetOptionsFtp.Execute;

var

FTP : TIdFTP;

Details : TStrings;

begin

FTP := TIdFTP.Create(nil);

Details := TStringList.Create;

if (Options.FTPProxy.UseProxy) and (LocalAddress(Data.LinkToFile) = False) then

begin

FTP.ProxySettings.Host := Options.FTPProxy.Host;

FTP.ProxySettings.Port := Options.FTPProxy.Port;

FTP.ProxySettings.Username := Options.FTPProxy.UserName;

FTP.ProxySettings.Password := Options.FTPProxy.Password;

end;

if Data.UseSpecial then

begin

FTP.Port := Data.Port;

FTP.Username := Data.Login;

FTP.Password := Data.Password;

end else FTP.Username := 'anonymous';

try

FTP.TransferType := ftBinary;

FTP.Host := ExtractAddress(Data.LinkToFile);

FTP.Connect;

FTP.List(Details, ExtractFileName(Data.LinkToFile), True);

Data.TotalSize := FTP.DirectoryListing.Items[0].Size;

Data.LastModified := FTP.DirectoryListing.Items[0].ModifiedDate;

FTP.Disconnect;

Data.Status := tsReady;

Data.ErrorText := 'Ошибок нет';

except

on E : Exception do

begin

Data.Status := tsError;

Data.ErrorText := E.Message;

Data.TotalSize := 0;

Data.LastModified := 0;

MessageBox(Application.Handle, PChar('Ошибка при загрузке файла.' + #13#10 + E.Message), PChar(Options.Name), MB_OK or MB_ICONERROR);

end;

FTP.Free;

Details.Free;

fMain.RefreshTasks;

end;

end.

unit uAbout;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TfAbout = class(TForm)

Button1: TButton;

Label1: TLabel;

Label2: TLabel;

Image1: TImage;

Label3: TLabel;

procedure Button1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fAbout: TfAbout;

implementation

uses uObjects;

{$R *.dfm}

procedure TfAbout.Button1Click(Sender: TObject);

begin

Close;

end;

procedure TfAbout.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TfAbout.FormCreate(Sender: TObject);

begin

Label1.Caption:=Options.Name;

Label3.Caption:='Версия: 0.2.1'+Options.Version;

end;

end.

unit uAddCategory;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls;

type

TfAddCategory = class(TForm)

Label1: TLabel;

Label2: TLabel;

edName: TEdit;

edPath: TEdit;

Label3: TLabel;

Memo1: TMemo;

Button1: TButton;

Button2: TButton;

Button3: TButton;

procedure Button3Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

public

{ Public declarations }

end;

var

fAddCategory: TfAddCategory;

implementation

uses uProcedures, uMain, uObjects;

{$R *.dfm}

procedure TfAddCategory.Button3Click(Sender: TObject);

begin

Close;

end;

procedure TfAddCategory.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TfAddCategory.Button1Click(Sender: TObject);

begin

edPath.Text:=BrowserFolder(Handle);

end;

procedure TfAddCategory.Button2Click(Sender: TObject);

var

Node: TTreeNode;

begin

if Trim(edName.Text)=''

then

begin

MessageBox(Application.Handle, 'Не задано название категории!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if Trim(edPath.Text)=''

then

begin

MessageBox(Application.Handle, 'Не задано расположение папки!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if not DirectoryExists(Trim(edPath.Text))

then

begin

if MessageBox(Application.Handle, PChar('Папки "'+edPath.Text+'" не существует! Создать?'), PChar(Options.Name), MB_OKCANCEL or MB_ICONERROR)=ID_OK

then

begin

MkDir(Trim(edPath.Text));

end

else Exit;

end;

Node:=fMain.tvFolders.Items.AddChild(fMain.tvFolders.Selected, edName.Text);

Node.ImageIndex:=2;

Node.SelectedIndex:=2;

Close;

end;

end.

unit uAddTask;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

StdCtrls, Clipbrd, Mask, Spin, Dialogs;

type

TfAddTask = class(TForm)

Label1: TLabel;

Label2: TLabel;

btnOK: TButton;

btnCancel: TButton;

Label3: TLabel;

Label4: TLabel;

edLogin: TEdit;

edPassword: TEdit;

cbxSpecial: TCheckBox;

Label5: TLabel;

Label9: TLabel;

cbCategory: TComboBox;

cbDirectory: TComboBox;

Label10: TLabel;

edFileName: TEdit;

cbUrl: TComboBox;

Label8: TLabel;

edDescription: TEdit;

sePort: TSpinEdit;

GroupBox1: TGroupBox;

RadioButton1: TRadioButton;

RadioButton2: TRadioButton;

RadioButton3: TRadioButton;

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure btnCancelClick(Sender: TObject);

procedure cbxSpecialClick(Sender: TObject);

procedure cbDirectoryClick(Sender: TObject);

procedure cbDirectoryDropDown(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure cbUrlChange(Sender: TObject);

procedure btnOKClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fAddTask: TfAddTask;

implementation

uses uObjects, uMain, uProcedures;

{$R *.dfm}

procedure TfAddTask.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TfAddTask.btnCancelClick(Sender: TObject);

begin

Close;

end;

procedure TfAddTask.cbxSpecialClick(Sender: TObject);

begin

if cbxSpecial.Checked

then

begin

edLogin.Enabled:=true;

edPassword.Enabled:=true;

sePort.Enabled:=true;

end

else

begin

edLogin.Enabled:=false;

edPassword.Enabled:=false;

sePort.Enabled:=false;

end;

procedure TfAddTask.cbDirectoryClick(Sender: TObject);

begin

if cbDirectory.ItemIndex=0

then

begin

cbDirectory.Items.Strings[0]:=BrowserFolder(Handle);

cbDirectory.ItemIndex:=0;

end;

procedure TfAddTask.cbDirectoryDropDown(Sender: TObject);

begin

cbDirectory.Items.Strings[0]:='Обзор папок...';

end;

procedure TfAddTask.FormCreate(Sender: TObject);

var

ClipboardTemp: string;

i: Integer;

begin

if Clipboard.HasFormat(CF_TEXT)

then

begin

ClipboardTemp:=Trim(Clipboard.AsText);

if (Pos('http://', ClipboardTemp)=1)

or (Pos('https://', ClipboardTemp)=1)

or (Pos('ftp://', ClipboardTemp)=1)

then cbUrl.Text:=ClipboardTemp;

if Pos('www.', ClipboardTemp)=1

then cbUrl.Text:='http://'+ClipboardTemp;

if Pos('ftp.', ClipboardTemp)=1

then cbUrl.Text:='ftp://'+ClipboardTemp;

end;

edFileName.Text:=CreateFileName(cbUrl.Text);

cbUrl.Items:=Options.Url;

sePort.Enabled:=false;

for i:=0 to Options.Directory.Count-1 do

begin

cbDirectory.Items.Insert(1, Options.Directory.Strings[i]);

end;

procedure TfAddTask.cbUrlChange(Sender: TObject);

begin

edFileName.Text:=CreateFileName(cbUrl.Text);

end;

procedure TfAddTask.btnOKClick(Sender: TObject);

var

i, n: integer;

Data: TTask;

begin

if cbUrl.Text=''

then

begin

MessageBox(Application.Handle, 'Не указана ссылка!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if cbDirectory.Text=''

then

begin

MessageBox(Application.Handle, 'Не указан каталог для сохранения файла!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if edFileName.Text=''

then

begin

MessageBox(Application.Handle, 'Не указано имя файла!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if cbCategory.Text=''

then

begin

MessageBox(Application.Handle, 'Не указана категория!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if (Pos('http://', Trim(cbUrl.Text))=1)

or (Pos('https://', Trim(cbUrl.Text))=1)

or (Pos('ftp://', Trim(cbUrl.Text))=1)

then

else

begin

MessageBox(Application.Handle, 'Не указан протокол (http://, https://, ftp://)!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if not DirectoryExists(Trim(cbDirectory.Text))

then

begin

if MessageBox(Application.Handle, PChar('Папки "'+cbDirectory.Text + '" не существует! Создать?'), PChar(Options.Name), MB_OKCANCEL or MB_ICONERROR)=IDOK

then MkDir(Trim(cbDirectory.Text))

else Exit;

end;

if FileExists(Trim(cbDirectory.Text)+'\'+Trim(edFileName.Text))

then

begin

if MessageBox(Application.Handle, PChar('Файл "'+cbDirectory.Text + '\' + edFileName.Text + '" уже существует! Хотите перезаписать его?'), PChar(Options.Name), MB_OKCANCEL or MB_ICONERROR)=IDCANCEL

then Exit;

end;

n:=0;

for i:=0 to Options.Url.Count-1 do

begin

if Options.Url.Strings[I]=Trim(cbUrl.Text)

then n:=n+1;

end;

if n=0

then Options.Url.Insert(0, Trim(cbUrl.Text));

n:=0;

for i:=0 to Options.Directory.Count-1 do

begin

if Options.Directory.Strings[i]=Trim(cbDirectory.Text)

then n:=n+1;

end;

if n=0

then Options.Directory.Insert(0, Trim(cbDirectory.Text));

Data:=TTask.Create;

Data.LinkToFile:=Trim(cbUrl.Text);

Data.FileName:=Trim(edFileName.Text);

Data.Directory:=Trim(cbDirectory.Text);

Data.Login:=Trim(edLogin.Text);

Data.Password:=Trim(edPassword.Text);

Data.Port:=sePort.Value;

Data.UseSpecial:=cbxSpecial.Checked;

Data.Description:=Trim(edDescription.Text);

Data.Category:=Trim(edDescription.Text);

Data.Status:=tsReady;

Data.TotalSize:=0;

Data.LoadSize:=0;

Data.StartPosition:=0;

Data.EndPosition:=0;

Data.LastModified:=0;

Data.TimeBegin:=0;

Data.TimeEnd:=0;

Data.TimeTotal:=0;

Data.ErrorText:='';

if Pos('http://', Data.LinkToFile)=1

then Data.Protocol:=ptHttp;

if Pos('https://', Data.LinkToFile)=1

then Data.Protocol:=ptHttps;

if Pos('ftp://', Data.LinkToFile)=1

then Data.Protocol:=ptFtp;

Options.Task.Add(Data);

Close;

end;

end.

unit uDownload;

interface

uses

Classes, uThreads, uObjects, uProcedures;

type// Class TLoadOne //

TLoadOne = class(TThread)

public

constructor Create(CreateSuspended : Boolean; P : Pointer);

private

Data : TTask;

protected

procedure Execute; override;

end;

implementation

uses uMain;

constructor TLoadOne.Create(CreateSuspended : Boolean; P : Pointer);

begin

Data:=P;

inherited Create(CreateSuspended);

end;

procedure TLoadOne.Execute;

var

ThreadHttp: TGetFileHttp;

ThreadHttpOpt: TGetOptionsHttp;

ThreadFtp: TGetFileFtp;

ThreadFtpOpt: TGetOptionsFtp;

begin

if (Data.Protocol=ptHttp) or (Data.Protocol=ptHttps)

then

begin

ThreadHttpOpt:=TGetOptionsHttp.Create(True, Data);

ThreadHttpOpt.Priority:=Options.Priority;

ThreadHttpOpt.Resume;

ThreadHttpOpt.WaitFor;

ThreadHttpOpt.Free;

if Data.Status=tsError

then Exit;

if (Data.TotalSize<0) and not (Options.ResumeLoad)

then Exit;

if Data.TotalSize>0

then

begin

if Data.TotalSize>GetFreeSpace(Data.Directory)

then Exit;

end;

ThreadHttp:=TGetFileHttp.Create(true, Data);

ThreadHttp.Priority:=Options.Priority;

ThreadHttp.Resume;

ThreadHttp.WaitFor;

ThreadHttp.Free;

end;

if Data.Protocol=ptFtp

then

begin

ThreadFtpOpt:=TGetOptionsFtp.Create(True, Data);

ThreadFtpOpt.Priority:=Options.Priority;

ThreadFtpOpt.Resume;

ThreadFtpOpt.WaitFor;

ThreadFtpOpt.Free;

if Data.Status=tsError

then Exit;

if Data.TotalSize>0

then

begin

if Data.TotalSize>GetFreeSpace(Data.Directory)

then Exit;

end;

ThreadFtp:=TGetFileFtp.Create(True, Data);

ThreadFtp.Priority:=Options.Priority;

ThreadFtp.Resume;

ThreadFtp.WaitFor;

ThreadFtp.Free;

end;

fMain.tmUpdate.Enabled:=false;

fMain.RefreshTasks;

end;

end.

unit uEditCategory;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls;

type

TfEditCategory = class(TForm)

Label1: TLabel;

Label2: TLabel;

edName: TEdit;

edPath: TEdit;

Label3: TLabel;

Memo1: TMemo;

Button1: TButton;

Button2: TButton;

Button3: TButton;

procedure Button3Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

public

{ Public declarations }

end;

var

fEditCategory: TfEditCategory;

implementation

uses uProcedures, uMain, uObjects;

{$R *.dfm}

procedure TfEditCategory.Button3Click(Sender: TObject);

begin

Close;

end;

procedure TfEditCategory.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TfEditCategory.Button1Click(Sender: TObject);

begin

edPath.Text:=BrowserFolder(Handle);

end;

procedure TfEditCategory.Button2Click(Sender: TObject);

begin

if Trim(edName.Text)=''

then

begin

MessageBox(Application.Handle, 'Не задано название категории!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if Trim(edPath.Text)=''

then

begin

MessageBox(Application.Handle, 'Не задано расположение папки!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if not DirectoryExists(Trim(edPath.Text))

then

begin

if MessageBox(Application.Handle, PChar('Папки "' + edPath.Text + '" не существует! Создать?'), PChar(Options.Name), MB_OKCANCEL or MB_ICONERROR)=ID_OK

then

begin

MkDir(Trim(edPath.Text));

end

else Exit;

end;

fMain.tvFolders.Selected.Text := Trim(edName.Text);

Close;

end;

procedure TfEditCategory.FormCreate(Sender: TObject);

begin

edName.Text:=fMain.tvFolders.Selected.Text;

end;

end.

unit uEditTask;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

StdCtrls, Clipbrd, Mask, Spin, Dialogs, uObjects;

type

TfEditTask = class(TForm)

Label1: TLabel;

Label2: TLabel;

btnOK: TButton;

btnCancel: TButton;

Label3: TLabel;

Label4: TLabel;

edLogin: TEdit;

edPassword: TEdit;

cbxSpecial: TCheckBox;

Label5: TLabel;

Label9: TLabel;

cbCategory: TComboBox;

cbDirectory: TComboBox;

Label10: TLabel;

edFileName: TEdit;

cbUrl: TComboBox;

Label8: TLabel;

edDescription: TEdit;

sePort: TSpinEdit;

GroupBox1: TGroupBox;

RadioButton1: TRadioButton;

RadioButton2: TRadioButton;

rbSchedule: TRadioButton;

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure btnCancelClick(Sender: TObject);

procedure cbxSpecialClick(Sender: TObject);

procedure cbDirectoryClick(Sender: TObject);

procedure cbDirectoryDropDown(Sender: TObject);

procedure cbUrlChange(Sender: TObject);

procedure btnOKClick(Sender: TObject);

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

Data : TTask;

end;

var

fEditTask: TfEditTask;

implementation

uses uMain, uProcedures;

{$R *.dfm}

procedure TfEditTask.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TfEditTask.btnCancelClick(Sender: TObject);

begin

Close;

end;

procedure TfEditTask.cbxSpecialClick(Sender: TObject);

begin

if cbxSpecial.Checked

then

begin

edLogin.Enabled:=true;

edPassword.Enabled:=true;

sePort.Enabled:=true;

end

else

begin

edLogin.Enabled:=false;

edPassword.Enabled:=false;

sePort.Enabled:=false;

end;

procedure TfEditTask.cbDirectoryClick(Sender: TObject);

begin

if cbDirectory.ItemIndex=0

then

begin

cbDirectory.Items.Strings[0]:=BrowserFolder(Handle);

cbDirectory.ItemIndex:=0;

end;

procedure TfEditTask.cbDirectoryDropDown(Sender: TObject);

begin

cbDirectory.Items.Strings[0]:='Обзор папок...';

end;

procedure TfEditTask.cbUrlChange(Sender: TObject);

begin

edFileName.Text:=CreateFileName(cbUrl.Text);

end;

procedure TfEditTask.btnOKClick(Sender: TObject);

var

i, n: integer;

begin

if cbUrl.Text=''

then

begin

MessageBox(Application.Handle, 'Не указана ссылка!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if cbDirectory.Text = '' then

begin

MessageBox(Application.Handle, 'Не указан каталог для сохранения файла!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if edFileName.Text = '' then

begin

MessageBox(Application.Handle, 'Не указано имя файла!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if cbCategory.Text = '' then

begin

MessageBox(Application.Handle, 'Не указана категория!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if (Pos('http://', Trim(cbUrl.Text)) = 1)

or (Pos('https://', Trim(cbUrl.Text)) = 1)

or (Pos('ftp://', Trim(cbUrl.Text)) = 1)

then

else

begin

MessageBox(Application.Handle, 'Не указан протокол (http://, https://, ftp://)!', PChar(Options.Name), MB_OK or MB_ICONERROR);

Exit;

end;

if not DirectoryExists(Trim(cbDirectory.Text)) then

begin

if MessageBox(Application.Handle, PChar('Папки "' + cbDirectory.Text + '" не существует! Создать?'), PChar(Options.Name), MB_OKCANCEL or MB_ICONWARNING) = IDOK then MkDir(Trim(cbDirectory.Text)) else Exit;

end;

n := 0;

for i := 0 to Options.Url.Count - 1 do

begin

if Options.Url.Strings[I] = Trim(cbUrl.Text) then n := n + 1;

end;

if n = 0 then Options.Url.Insert(0, Trim(cbUrl.Text));

n := 0;

for i := 0 to Options.Directory.Count - 1 do

begin

if Options.Directory.Strings[i]=Trim(cbDirectory.Text) then n:=n+1;

end;

if n = 0 then Options.Directory.Insert(0, Trim(cbDirectory.Text));

Data.LinkToFile := Trim(cbUrl.Text);

Data.FileName := Trim(edFileName.Text);

Data.Directory := Trim(cbDirectory.Text);

Data.Login := Trim(edLogin.Text);

Data.Password := Trim(edPassword.Text);

Data.Port := sePort.Value;

Data.UseSpecial := cbxSpecial.Checked;

Data.Description := Trim(edDescription.Text);

if Pos('http://', Data.LinkToFile) = 1 then Data.Protocol := ptHttp;

if Pos('https://', Data.LinkToFile) = 1 then Data.Protocol := ptHttps;

if Pos('ftp://', Data.LinkToFile) = 1 then Data.Protocol := ptFtp;

Close;

end;

procedure TfEditTask.FormShow(Sender: TObject);

var

i : Integer;

begin

cbUrl.Text := Data.LinkToFile;

edFileName.Text := Data.FileName;

cbUrl.Items := Options.Url;

for i := 0 to Options.Directory.Count - 1 do

begin

cbDirectory.Items.Insert(1, Options.Directory.Strings[i]);

end;

cbDirectory.Text := Data.Directory;

cbCategory.Text := Data.Category;

edDescription.Text := Data.Description;

cbxSpecial.Checked := Data.UseSpecial;

if Data.UseSpecial

then

begin

edLogin.Enabled := True;

edPassword.Enabled := True;

sePort.Enabled := True;

end

else

begin

edLogin.Enabled := False;

edPassword.Enabled := False;

sePort.Enabled := False;

end;

edLogin.Text := Data.Login;

edPassword.Text := Data.Password;

sePort.Value := Data.Port;

if Data.ScheduleOn then rbSchedule.Checked:=true;

end;

end.

unit uLoading;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Gauges, ExtCtrls, uObjects, uProcedures;

type

TfLoading = class(TForm)

ProgressBar: TGauge;

Button1: TButton;

Button2: TButton;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label10: TLabel;

Label11: TLabel;

Label12: TLabel;

Label13: TLabel;

Timer: TTimer;

Label2: TLabel;

procedure Button1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure TimerTimer(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

Private declarations }

public

{ Public declarations }

Data : TTask;

end;

var

fLoading: TfLoading;

implementation

procedure TfLoading.Button1Click(Sender: TObject);

begin

Close;

end;

procedure TfLoading.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action := caFree;

end;

procedure TfLoading.TimerTimer(Sender: TObject);

var

TimeRemind : Integer;

begin

Label11.Caption := FormatDateTime('hh:mm:ss', Data.TimeBegin - Now);

if Data.TotalSize > 0 then

begin

Label7.Caption := BytesToText(Data.LoadSize) + ' из ' + BytesToText(Data.TotalSize);

ProgressBar.MinValue := 0;

ProgressBar.MaxValue := Data.TotalSize;

ProgressBar.Progress := Data.LoadSize;

if Data.Speed > 0 then

begin

TimeRemind := (Data.TotalSize - Data.LoadSize) div Data.Speed;

Label13.Caption := GetTimeStr(TimeRemind);

end;

end

else

begin

ProgressBar.MinValue := 0;

ProgressBar.MaxValue := 8;

ProgressBar.AddProgress(1);

if ProgressBar.Progress = 8 then ProgressBar.Progress := 0;

Label7.Caption := BytesToText(Data.LoadSize);

end;

Label9.Caption := BytesToText(Data.Speed) + '/с';

if (Data.Status = tsLoad) then

begin

Timer.Enabled := False;

ProgressBar.Progress := ProgressBar.MaxValue;

if Options.AutoCloseLoadingForm then Close;

end;

if (Data.Status = tsError) then

begin

Timer.Enabled := False;

ProgressBar.BackColor := clRed;

if Options.AutoCloseLoadingForm then Close;

end;

procedure TfLoading.FormShow(Sender: TObject);

begin

Timer.Enabled := True;

Label2.Caption := Data.LinkToFile;

end;

procedure TfLoading.Button2Click(Sender: TObject);

begin

Data.Status := tsStoped;

Close;

end;

end.

<<< < Предыдущая 1 2 3 4 56 / 66

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]

#
28.10.2018233 Кб20Краткий конспект.doc
#
11.05.2015155 Кб9кристине физика.doc
#
11.05.201533 Кб20Кристинке.doc
#
21.12.20187 Мб40крэс ответы.docx
#
01.07.202511 Мб1КС_2015_МЕТОДИЧЕСКИЕ УКАЗАНИЯ ПО КУРСОВОМУ ПРОЕКТУ.doc
#
01.07.20253 Мб0КСИС.docx
#
01.07.202513 Мб0КУБИКИ СОМА.doc
#
01.07.202510 Мб3Кузьменок_N содержащие.doc
#
01.07.202589 Кб0КУЛЬТУРА УПОТРЕБЛЕНИЯ ПИТЬЕВОЙ ВОДЫ - молодость...doc
#
01.07.2025439 Кб1Культурология УММ (Пс Юр) 29.11.07.doc
#
01.07.20251 Мб1курс вар 1.docx