Создание Программы Копирования С Выпадающими Списками И Прогрессбаром

Тема в разделе "Pascal and Delphi", создана пользователем IRBIS, 10 дек 2014.

  1. IRBIS

    IRBIS New Member

    Регистрация:
    10 дек 2014
    Сообщения:
    1
    Симпатии:
    0
    Помогите довести программу до ума. Есть программа копирования папок и отдельных файлов с указанием пути из внешнего жесткого диска на сервер. Писал благодаря урокам знающих людей. Учился понемножку. Но тут мозгов откровенно не хватает.

    Хотел бы, чтобы выбор каталога на сервере выбирался из выпадающих списков. На сервере располагаются папки с именами городов. В каждой такой папке по 3 каталога, переключение, допуски, тренировки.
    И выбирая из выпадающих списков город, во втором отображались папки этого города. и полный путь копирования, отображался в label...
    Если создавалась в городе еще папка помимо тех трех, то в списке выпадающем она отображалась тоже.

    При копировании, высвечивался прогрессбар в % соотношении файлов и сообщением копирование завершено.
    Заранее благодарен всем откликнувшимся. Я в долгу не останусь!!
    Вкладываю скриншот примера формы



    Код (Text):
    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, FileCtrl, CheckLst, StdCtrls, ComCtrls;

    type
    TForm1 = class(TForm)
    ListBox1: TListBox;
    CheckListBox1: TCheckListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Button4: TButton;
    Label3: TLabel;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);

    private
    { Private-Deklarationen }
    public
    { Public-Deklarationen }
    end;

    var
    Form1: TForm1;
    Path: String;
    S: String = '.avi';
    implementation

    {$R *.dfm}

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    SelectDirectory('Âûáîð äèðåêòîðèè', '', Path);
    Label1.Caption := Path;
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    var SR: TSearchRec;
    begin
    CheckListBox1.Clear;
    if FindFirst(Path+'\*'+S, faAnyFile, SR) = 0 then
    repeat
    CheckListBox1.Items.Add(SR.Name)
    until FindNext (SR) <> 0;
    end;

    procedure TForm1.Button3Click(Sender: TObject);
    var i: Integer;
    P: String;
    begin
    ListBox1.Clear;
    SelectDirectory('Âûáîð äèðåêòîðèè', 'file://10.107.21.22/temp$/', P);
    Label2.Caption := P;
    for i := 0 to CheckListBox1.Items.Count - 1 do
    if CheckListBox1.Checked[i] then
    { begin
    CopyFile(PChar(Path+'\'+CheckListBox1.Items[i]), PChar(P+'\'+CheckListBox1.Items[i]), True);
    ListBox1.Items.Add(P+'\'+CheckListBox1.Items[i])
    end;
    MessageBox(0, 'Ôàéëû ñêîïèðîâàíû', 'Êîïèðîâàíèå ôàéëîâ çàâåðøåíî', MB_OK); }
    end;

    procedure TForm1.Button4Click(Sender: TObject);
    begin
    S := InputBox('Âûáîð ðàñøèðåíèÿ', 'Çàïèøèòå ðàñøèðåíèå â ôîðìàòå ''.txt''', '.*');
    if (S[1] <> '.') or (S = '') then
    begin
    MessageDlg('Îøèáêà! Íå ñîîòâåòñòâèå ñ ìàñêîé, ïîïðîáóéòå åùå ðàç', mtError, [mbOK], 0);
    Exit;
    end;
    Label3.Caption := 'Ðàñøèðåíèå : ' + S;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    Label1.Caption := 'êîïèðîâàòü èç...';
    Label2.Caption := 'êîïèðîâàòü â...';
    Label3.Caption := 'Ðàñøèðåíèå : ' + S;
    Button1.Caption := 'Îòêðûòü êàòàëîã';
    Button2.Caption := 'Îòîáðàçèòü äåðåâî';
    Button3.Caption := 'Ñêîïèðîâàòü ôàéëû â...';
    Caption := 'Êîïèðîâàíèå ôàéëîâ';
    Button4.Caption := 'Âûáðàòü ðàñøèðåíèå';
    end;

    procedure TForm1.Button5Click(Sender: TObject);
    var i: Integer;
    P: String;
    begin
    CopyFile(PChar(Path+'\'+CheckListBox1.Items[i]), PChar(P+'\'+CheckListBox1.Items[i]), True);
    ListBox1.Items.Add(P+'\'+CheckListBox1.Items[i])
    end;
    MessageBox(0, 'Ôàéëû ñêîïèðîâàíû', 'Êîïèðîâàíèå ôàéëîâ çàâåðøåíî', MB_OK);
    end;

    end.
     

    Вложения:

Загрузка...

Поделиться этой страницей