Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 26.07.2013, 19:06   #1
Кирилл12345
Пользователь
 
Регистрация: 06.07.2012
Сообщений: 12
Репутация: 10
По умолчанию Проблема с OnWork OnWorkBegin OnWorkEnd

Здравствуйте, при компиляции проекта, delphi xe 2 ругается на строки

http.OnWork:=Work;
http.OnWorkBegin:=WorkBegin;
http.OnWorkEnd:=WorkEnd;

Код:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, sButton, sSkinManager,
  Vcl.ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, acPNG, Vcl.OleCtrls, SHDocVw, ZipForge, ShellAPI,
  Vcl.Samples.Gauges, Math;

type
  TForm1 = class(TForm)
    Image1: TImage;
    sSkinManager1: TsSkinManager;
    sButton1: TsButton;
    IdHTTP1: TIdHTTP;
    WebBrowser1: TWebBrowser;
    sButton2: TsButton;
    ZipForge1: TZipForge;
    sButton3: TsButton;
    sButton4: TsButton;
    Label1: TLabel;
    Label2: TLabel;
    Gauge1: TGauge;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure sButton4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
TDownload = class(TThread)
 public
    procedure Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Int64);
    procedure WorkBegin(Sender: TObject; AWorkMode: TWorkMode;const AWorkCountMax: Int64);
    procedure WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
 protected
    procedure Execute;override;
 private
    size:integer;
    sizes: string;
end;
var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetInetFileSize(const FileUrl:string): integer;
var
   idHTTP: TidHTTP;
begin
   Result:=-1; //Ставим первоначальное значение -1, потом поймёте зачем
   idHTTP:=TIdHTTP.Create(nil);
   try
   idHTTP.Head(FileUrl); //Мы получаем только заголовок нашего файла, где хранится размер файла, код запроса и т.п.
   if IdHTTP.ResponseCode = 200 then //Если файл существует, то... (200 это успешный код: HTTP OK)
   Result:=idHTTP.Response.ContentLength; //В результат пихаем наш размер файла в байтах.
   except
   IdHTTP.Free;
   end;
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
Download:=TDownload.Create(false);
end;

procedure TForm1.sButton3Click(Sender: TObject);
begin
if DirectoryExists(ExtractFilePath(Application.ExeName)+'vkbot')=false then
CreateDir(ExtractFilePath(Application.ExeName)+'vkbot');
ZipForge1.FileName:='d3bot.zip';
 ZipForge1.OpenArchive;
 ZipForge1.BaseDir := 'vkbot\';
  ZipForge1.ExtractFiles('*');  // как тут можно добавить еще пару расширений?
  ZipForge1.CloseArchive;
  ShowMessage('Распаковка успешно завершена!');
end;

procedure TForm1.sButton4Click(Sender: TObject);
begin
ShellExecute(Handle, nil, PChar('vkbot\d3bot.exe'), nil, nil, SW_RESTORE);
end;

{ TDownload }

procedure TDownload.Execute;
const BufferSize = 1024;
var
 stream : TMemoryStream;
 FName:String;
 http: TidHTTP;
begin
 FName:='C:\test.rar';
 http:=tidhttp.Create(nil);
 http.OnWork:=Work;
 http.OnWorkBegin:=WorkBegin;
 http.OnWorkEnd:=WorkEnd;
 stream := TMemoryStream.Create;
 size:=GetInetFileSize('****'); //Узнаём размер файла
 if size > 0 then
 try
 sizes:=floattostr(RoundTo(size/(1024*1024) , -2)); //Переводим в МБ
 Form1.Label1.Caption:=sizes+' MB.';
 //sizes:=floattostr(RoundTo(size/(1024) , -2)); //Переводим в KB
 http.get('****', stream); //Начинаем скачивание
 stream.SaveToFile(FName); //Сохраняем
except
 FreeAndNil(http); //Завершаем HTTP
 FreeAndNil(stream); //Завершаем Stream
end
else Showmessage('Ошибка при скачивании файла!'); //Если размер файала меньше 0, то выводим сообщение.
end;


procedure TDownload.Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Int64);
begin
Form1.Gauge1.Progress:=AWorkCount; //Вбимаем кол-во скачанного
Form1.Label2.Caption:=floattostr(RoundTo(AWorkCount/(1024*1024) , -2))+' MB.';
end;


procedure TDownload.WorkBegin(Sender: TObject; AWorkMode: TWorkMode;const AWorkCountMax: Int64);
begin
Form1.Gauge1.MaxValue:=AWorkCountMax; //За макс. граничей прогресса, у нас будет размер файла
Form1.Label2.Caption:='Загружаем...';
end;


procedure TDownload.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
Form1.Gauge1.Progress:=0; //После завершения загрузки, прогресс = 0
Form1.Label2.Caption:='Готово!';
end;


end.

Кирилл12345 вне форума   Ответить с цитированием
Старый 26.07.2013, 20:06   #2
northener
Профессионал
 
Регистрация: 15.07.2013
Сообщений: 1,458
Репутация: 477
По умолчанию

Цитата:
Сообщение от Кирилл12345 Посмотреть сообщение
Здравствуйте, при компиляции проекта, delphi xe 2 ругается на строки

http.OnWork:=Work;
Ругается потому что не известен компилятору метод формы TForm1 с таким именем.
northener вне форума   Ответить с цитированием
Старый 26.07.2013, 23:39   #3
саша40
Профессионал
 
Регистрация: 12.09.2012
Сообщений: 1,030
Репутация: -22
По умолчанию

Может так лучше:
Код:

http1.onWork:=TDownLoad.Work;
http1.onWorkBegin:=TDownload.Workbegin;
http1.onWorkend:=TDownload.Workend;

А лучше их в классе формы описать
__________________
Что нужно программисту: Компьютер, Среда программирование, Воображение, Прямые руки, Мозги, Знания этой среды программирования.
Программист-это профессия, а программирование-это моё хобби.
саша40 вне форума   Ответить с цитированием
Старый 27.07.2013, 00:04   #4
northener
Профессионал
 
Регистрация: 15.07.2013
Сообщений: 1,458
Репутация: 477
По умолчанию

Цитата:
Сообщение от саша40 Посмотреть сообщение
Может так лучше:
Код:

http1.onWork:=TDownLoad.Work;
http1.onWorkBegin:=TDownload.Workbegin;
http1.onWorkend:=TDownload.Workend;

А сам так пробовал? Попробуй.
northener вне форума   Ответить с цитированием
Старый 27.07.2013, 15:14   #5
саша40
Профессионал
 
Регистрация: 12.09.2012
Сообщений: 1,030
Репутация: -22
По умолчанию

Цитата:
Сообщение от northener Посмотреть сообщение
А сам так пробовал? Попробуй.
Может тогда через переменую патока. Лучше бы он их в классе формы описал и всё.
__________________
Что нужно программисту: Компьютер, Среда программирование, Воображение, Прямые руки, Мозги, Знания этой среды программирования.
Программист-это профессия, а программирование-это моё хобби.
саша40 вне форума   Ответить с цитированием
Старый 27.07.2013, 15:41   #6
Stilet
Белик Виталий :)
Профессионал
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Адрес: Украина, Донецкая область, г. Краматорск
Сообщений: 57,842
Репутация: 6832
По умолчанию

Цитата:
delphi xe 2 ругается на строки
А почему ты их в отдельный класс вынес?
Не то чтобы придирнуться, просто интересно зачем такой геморрой делать?
__________________
I'm learning to live...
Stilet вне форума   Ответить с цитированием
Старый 02.08.2013, 08:47   #7
XerSon
Форумчанин
 
Аватар для XerSon
 
Регистрация: 21.01.2008
Сообщений: 208
Репутация: 62
По умолчанию

Просили, получите, D2010

Код:

unit Unit13;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Gauges, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, Math;

type
  TForm13 = class(TForm)
    ed: TEdit;
    gud: TGauge;
    bt: TButton;
    IdHTTP: TIdHTTP;
    lb: TLabel;
    lb2: TLabel;
    procedure btClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TDownload = class(TThread)
  public
    procedure OnWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure OnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  protected
    procedure Execute; override;
  private
    size: integer;
    sizes: string;
  end;

var
  Form13: TForm13;

implementation

{$R *.dfm}

function ExtractUrlFileName(url: string): string;
var
  A: LongInt;
begin
  // извлекаем название файла из ссылки
  result := '';
  A := LastDelimiter('/', url);
  if (A > 0) and (url[A] = '/') then
    result := Copy(url, A + 1, Length(url) - A);
end;

function GetInetFileSize(const FileUrl: string): integer;
var
  IdHTTP: TIdHTTP;
begin
  result := -1; // Ставим первоначальное значение -1, потом поймёте зачем
  IdHTTP := TIdHTTP.Create(nil);
  try
    IdHTTP.Head(FileUrl); // Мы получаем только заголовок нашего файла, где хранится размер файла, код запроса и т.п.
    if IdHTTP.ResponseCode = 200 then // Если файл существует, то... (200 это успешный код: HTTP OK)
      result := IdHTTP.Response.ContentLength; // В результат пихаем наш размер файла в байтах.
  except
    IdHTTP.Free;
  end;
end;

procedure TDownload.Execute;
const
  BufferSize = 1024;
var
  stream: TMemoryStream;
  FName: String;
  http: TIdHTTP;
begin
  FName := 'C:\' + ExtractUrlFileName(Form13.ed.Text);
  http := TIdHTTP.Create(nil);
  http.OnWork := OnWork;
  http.OnWorkBegin := OnWorkBegin;
  http.OnWorkEnd := OnWorkEnd;
  stream := TMemoryStream.Create;
  size := GetInetFileSize(Form13.ed.Text); // Узнаём размер файла
  if size > 0 then
    try
      sizes := floattostr(RoundTo(size / (1024 * 1024), -2)); // Переводим в МБ
      Form13.lb2.Caption := 'Размер на сервере: ' + sizes + ' MB.';
      // sizes:=floattostr(RoundTo(size/(1024) , -2)); //Переводим в KB
      http.get(Form13.ed.Text, stream); // Начинаем скачивание
      stream.SaveToFile(FName); // Сохраняем
    except
      FreeAndNil(http); // Завершаем HTTP
      FreeAndNil(stream); // Завершаем Stream
    end
  else
    Showmessage('Ошибка при скачивании файла!'); // Если размер файала меньше 0, то выводим сообщение.
end;

procedure TDownload.OnWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
  Form13.gud.Progress := AWorkCount; // Вбимаем кол-во скачанного
  Form13.lb.Caption := 'Всего загружено: ' + floattostr
    (RoundTo(AWorkCount / (1024 * 1024), -2)) + ' MB.';
end;

procedure TDownload.OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  Form13.gud.MaxValue := AWorkCountMax; // За макс. граничей прогресса, у нас будет размер файла
  Form13.bt.Caption := 'Загружаем...';
end;

procedure TDownload.OnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  Form13.gud.Progress := 0; // После завершения загрузки, прогресс = 0
  Form13.bt.Caption := 'Готово!';
end;

procedure TForm13.btClick(Sender: TObject);
begin
  TDownload.Create(false);
end;

end.

Вложения
Тип файла: zip TDownload.zip (26.9 Кб, 19 просмотров)

Последний раз редактировалось XerSon; 02.08.2013 в 09:07.
XerSon вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Неблокирующий сокет Си проблема с закрытием, проблема с закрытием сокетов в цикле mnx_vol C/C++ Сетевое программирование 0 06.11.2012 13:57
Ошибка в строке HTTP.OnWork := onWork fezilk25 Работа с сетью в Delphi 3 07.02.2011 18:55
Indy 9, не работает onWork evgeny_sh Работа с сетью в Delphi 0 18.01.2011 16:39
idHTTP. Cобытие onWork. Там есть значение WorkCount. Можно ли увидеть сколько уже скачалось текстом и... TwiX Работа с сетью в Delphi 0 13.03.2010 23:48
Проблема с рамами/Проблема с ЖД DRAGGER Железо 6 05.01.2009 00:37


06:56.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru