Проблема с загрузкой файлов

  • Автор темы Artexoid
  • Дата начала
Статус
Закрыто для дальнейших ответов.
A

Artexoid

#1
Вот фигня какая-то у меня.
Загружаю я файлы вот этой маленькой процедуркой
Код:
function FtpDownloadFile(strHost, strUser, strPwd: string;
 Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar; LabelX: TLabel): Boolean;

 function FmtFileSize(Size: Integer): string;
 begin
   if Size >= $F4240 then
     Result := Format('%.2f', [Size / $F4240]) + ' Mb'
   else
   if Size < 1000 then
     Result := IntToStr(Size) + ' bytes'
   else
     Result := Format('%.2f', [Size / 1000]) + ' Kb';
 end;  

const
 READ_BUFFERSIZE = 4096;  // or 256, 512, ...
var
 hNet, hFTP, hFile: HINTERNET;
 buffer: array[0..READ_BUFFERSIZE - 1] of Char;
 bufsize, dwBytesRead, fileSize: DWORD;
 sRec: TWin32FindData;
 strStatus: string;
 LocalFile: file;
 bSuccess: Boolean;
begin
 Result := False;  

 { Open an internet session }  
 hNet := InternetOpen('Program_Name', // Agent
                       INTERNET_OPEN_TYPE_PRECONFIG, // AccessType  
                       nil,  // ProxyName  
                       nil, // ProxyBypass  
                       0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE

 {  
   Agent contains the name of the application or
   entity calling the Internet functions  
 }  


 { See if connection handle is valid }
 if hNet = nil then
 begin  
   ShowMessage('Unable to get access to WinInet.Dll');
   Exit;  
 end;  

 { Connect to the FTP Server }  
 hFTP := InternetConnect(hNet, // Handle from InternetOpen
                         PChar(strHost), // FTP server  
                         port, // (INTERNET_DEFAULT_FTP_PORT),  
                         PChar(StrUser), // username  
                         PChar(strPwd),  // password  
                         INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher?
                         0, // flag: 0 or INTERNET_FLAG_PASSIVE  
                         0);// User defined number for callback  

 if hFTP = nil then
 begin
   InternetCloseHandle(hNet);  
   messagebox(0,PChar(Format('Óäàëåííûé ñåðâåð "%s" íå íàéäåí. Âîçìîæíî îòñóòñòâóåò ñîåäèíåíèå ñ èíòåðíåòîì',[strHost])),
                'Îøèáêà',mb_ok or mb_iconerror);
   //ShowMessage(Format('Host "%s" is not available',[strHost]));
   form3.update.Interval:=2;
   form3.update.Enabled:=false;
   form3.update.Tag:=0;
   form3.Label15.Font.Color:=clMedGray;
   form3.proc1.Font.Color:=clMedGray;
   form3.Label17.Font.Color:=clMedGray;
   form3.proc2.Font.Color:=clMedGray;
   form3.Label18.Font.Color:=clMedGray;
   form3.proc3.Font.Color:=clMedGray;
   form3.Label22.Font.Color:=clMedGray;
   form3.procdownload.Font.Color:=clMedGray;
   form3.kolvo.Font.Color:=clMedGray;
   form3.SpeedButton1.Enabled:=true;
   form3.ProgressBar1.Position:=0;
   form3.ProgressBar2.Position:=0;
   form3.ProgressBar3.Position:=0;
   form3.ProgressBar4.Position:=0;
   form3.proc1.Caption:='0%';
   form3.proc2.Caption:='0 Kb of 0Kb / 0%';
   form3.proc3.Caption:='0%';
   form3.procdownload.Caption:='0 Kb of 0Kb / 0%';
   form3.kolvo.Caption:='0/0';
   loadlist.Destroy;
   spsfraz.Destroy;
   spsnewfraz.Destroy;
   form3.listtext.Update;
   Exit;
 end;

 { Change directory }
 bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir));

 if not bSuccess then
 begin
   InternetCloseHandle(hFTP);
   InternetCloseHandle(hNet);
   ShowMessage(Format('Cannot set directory to %s.',[ftpDir]));  
   Exit;
 end;

 { Read size of file }
 if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then
 begin  
   fileSize := sRec.nFileSizeLow;
   // fileLastWritetime := sRec.lastWriteTime  
 end else
 begin  
   //{îàçðûâ
   InternetCloseHandle(hFTP);
   InternetCloseHandle(hNet);
   messagebox(0,PChar(Format('Óäàëåííûé ñåðâåð "%s" íå îòâå÷àåò. Îøèáêà ñîåäèíåíèÿ FTP. Ïåðåçàïóñòèòå îáíîâëåíèå.',[strHost])),
                'Îøèáêà',mb_ok or mb_iconerror);
   form3.update.Enabled:=false;
   form3.update.Tag:=0;
   form3.Label15.Font.Color:=clMedGray;
   form3.proc1.Font.Color:=clMedGray;
   form3.Label17.Font.Color:=clMedGray;
   form3.proc2.Font.Color:=clMedGray;
   form3.Label18.Font.Color:=clMedGray;
   form3.proc3.Font.Color:=clMedGray;
   form3.Label22.Font.Color:=clMedGray;
   form3.procdownload.Font.Color:=clMedGray;
   form3.kolvo.Font.Color:=clMedGray;
   form3.SpeedButton1.Enabled:=true;
   form3.ProgressBar1.Position:=0;
   form3.ProgressBar2.Position:=0;
   form3.ProgressBar3.Position:=0;
   form3.ProgressBar4.Position:=0;
   form3.proc1.Caption:='0%';
   form3.proc2.Caption:='0 Kb of 0Kb / 0%';
   form3.proc3.Caption:='0%';
   form3.procdownload.Caption:='0 Kb of 0Kb / 0%';
   form3.kolvo.Caption:='0/0';
   Exit;
   //}
 end;

 { Open the file }
 hFile := FtpOpenFile(hFTP, // Handle to the ftp session
                      PChar(ftpFile), // filename
                      GENERIC_READ, // dwAccess
                      FTP_TRANSFER_TYPE_BINARY, // dwFlags
                      0); // This is the context used for callbacks.

 if hFile = nil then
 begin
   InternetCloseHandle(hFTP);
   InternetCloseHandle(hNet);
   Exit;
 end;

 { Create a new local file }
 AssignFile(LocalFile, TargetFile);
 {$i-}
 Rewrite(LocalFile, 1);
 {$i+}

 if IOResult <> 0 then
 begin  
   InternetCloseHandle(hFile);
   InternetCloseHandle(hFTP);
   InternetCloseHandle(hNet);
   Exit;  
 end;

 dwBytesRead := 0;
 bufsize := READ_BUFFERSIZE;  

 while (bufsize > 0) do
 begin
   Application.ProcessMessages;

   if not InternetReadFile(hFile,  
                           @buffer, // address of a buffer that receives the data
                           READ_BUFFERSIZE, // number of bytes to read from the file  
                           bufsize) then Break; // receives the actual number of bytes read

   if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then
     BlockWrite(LocalFile, buffer, bufsize);
   dwBytesRead := dwBytesRead + bufsize;

   { Show Progress }
   ProgressBar.Position := Round(dwBytesRead * 100 / fileSize);
   LabelX.Caption := Format('%s of %s / %d %%',[FmtFileSize(dwBytesRead),FmtFileSize(fileSize) ,ProgressBar.Position]);
 end;

 CloseFile(LocalFile);

 InternetCloseHandle(hFile);
 InternetCloseHandle(hFTP);
 InternetCloseHandle(hNet);
 Result := True;
А там фигня. Такая темя короче запускаю я загрузку, она загружает загружает, как 5 файлов загруэит пишет ошибку типо не может подключиться к серверу. Файлы я с народа качаю может проблемя в самом сервере ????? Помогите мне чем-нибудь я тут уже часа 3 голову ломаю, как я только не изменял это процедурку и все равно одно и тоже. Вот это ее исходный вариант.
 
B

Barmutik

#2
Тяжело по такому коду сказать что не работает ...

Я бы посоветовал использовать Indy компоненты для скачки с сервера .. всё точно будет работать .. если конечно не задания только на API написать...
 
A

Artexoid

#3
Да нет мне все равно как написать. Просто я с компонентом IdHTTP1 не могу разобраться. То что ты мне писал примет я ничего не понял, как-то странно ты его написал непонятно, ничего не работает :( :( :(
 
A

Artexoid

#4
Barmutik
Нопиши пример тока рабочий пожалуйста !! :(
Я тут закачку с нета уже 3 дня организовать пытаюсь, блин я уже из сил выбился, голова кругом идет :(, помоги !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
B

Barmutik

#5
Вот тебе весь модуль.. он скачивает заданный файл с инета:

На создание передаётся кого скачать и куда сохранить... В процессе работы потока вызываются функции для обновления MainForm. На ней лежит TGauge для показа прогресса, ProgressLabel -для отображения сколько из скольки скачано, с какой скоростью, сколько осталось и т.д...

Если что будет не понятно то спрашивай дальше ...

Код:
unit DownloadThreadUnit;

interface

uses
Classes, IdComponent, IdHTTP;

type
TDownloadThread = class(TThread)
private
 FUrl: string;
 FFileName: string;
 FPrevTime: TDateTime;
 FProgress: Integer;
 FMaxProgress: Integer;
 FSpeed: Real;
 FTime: Integer;

 procedure WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
 procedure Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
 procedure FSetMaxProgress;
 procedure FSetprogress;
protected
 procedure Execute; override;
public
 FDownloadHTTP: TIdHTTP;

 constructor Create(AUrl, AFileName: string);
 procedure StopDownload;
end;

implementation

uses
MainUnit, SysUtils, Windows, DateUtils, Math;

{ TDownloadThread }

constructor TDownloadThread.Create(AUrl, AFileName: string);
begin
FUrl := AUrl;
FFileName := AFileName;
FProgress := 0;
FMaxProgress := 0;
FPrevTime := Now;
inherited Create(False);
end;

procedure TDownloadThread.Execute;
var
Response: TFileStream;
begin
try
 Response := TFileStream.Create(FFileName, fmCreate);
 FDownloadHTTP := TIdHTTP.Create(nil);
 try
  FDownloadHTTP.Request.Referer := 'AdsCleaner Bundle';
  FDownloadHTTP.OnWorkBegin := WorkBegin;
  FDownloadHTTP.OnWork := Work;
  FDownloadHTTP.Get(FUrl, Response);
 finally
  FDownloadHTTP.Free;
  Response.Free;
 end;
except
 SysUtils.DeleteFile(FFileName);
 Halt(1);
end;
end;

procedure TDownloadThread.WorkBegin(Sender: TObject;
AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
FMaxProgress := AWorkCountMax;
Synchronize(FSetMaxProgress);
end;

procedure TDownloadThread.Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
FProgress := AWorkCount;
Synchronize(FSetProgress);
end;

procedure TDownloadThread.FSetMaxProgress;
begin
MainForm.Gauge.MaxValue := FMaxProgress;
end;

procedure TDownloadThread.FSetProgress;
var
ResultStr: string;
ATime: TDateTime;
ASecond: Real;
begin
ATime := Now;
ASecond := MilliSecondsBetween(Now, FPrevTime) / 1000;
FPrevTime := ATime;
if ASecond <> 0 then
begin
 FSpeed := (FDownloadHTTP.RecvBufferSize / ASecond) / 1024;
 FTime := Round(((FMaxProgress - FProgress) / 1024 )/ FSpeed);
 ResultStr := '';
 if FTime div 3600 = 0 then
  ResultStr := '00:'
 else
 begin
  ResultStr := IntToStr(FTime div 3600) + ':';
  FTime := FTime - FTime div 3600 * 3600;
 end;
 if FTime div 60 = 0 then
  ResultStr := ResultStr + '00:'
 else
 begin
  if FTime div 60 < 10 then
   ResultStr := ResultStr + '0' + IntToStr(FTime div 60) + ':'
  else
   ResultStr := ResultStr + IntToStr(FTime div 60) + ':';
  FTime := FTime - FTime div 60 * 60;
 end;
 if FTime = 0 then
  ResultStr := ResultStr + '00'
 else
 begin
  if FTime < 10 then
   ResultStr := ResultStr + '0' + IntToStr(FTime)
  else
  ResultStr := ResultStr + IntToStr(FTime);
 end;
 MainForm.ProgressLabel.Caption := FormatFloat('# ###', Max(1, MainForm.Gauge.Progress div 1024)) + ' from ' +
  FormatFloat('# ###', MainForm.Gauge.MaxValue div 1024) + 'Kb (' + FormatFloat('#.##', FSpeed) + 'Kb/s)' +
  ' - ' + ResultStr + ' remaining';
end;
MainForm.Gauge.Progress := FProgress;
MainForm.Update;
end;

procedure TDownloadThread.StopDownload;
begin
try
 FDownloadHTTP.Disconnect;
except
end; 
end;
 
A

Artexoid

#6
Barmutik
Спасибо за юнит!!
Это наверно глуповатый вопрос, но как его подключить ?? Как им пользоваться ?? :( :(
 
Z

zubr

#8
Artexoid
Здесь у тебя 2 ошибки:
1. Ты модуль, что тебе дал Barmutik - DownloadThreadUnit скопировал в модуль Unit1. Переименуй или DownloadThreadUnit в Unit1, или Unit1 в DownloadThreadUnit.
2. Нехватает модуля MainUnit. В нем находится интерфейс программы, как тебе Barmutik писал:
В процессе работы потока вызываются функции для обновления MainForm. На ней лежит TGauge для показа прогресса, ProgressLabel -для отображения сколько из скольки скачано, с какой скоростью, сколько осталось и т.д...
Тебе он не нужен, у тебя будет свой интерфейс.
 
A

Artexoid

#10
Во я себе какой аватар влипил )))))

zubr
Barmutik

Огромное вам спасибо !!!!!
zubr, Я все понял :( Спасибо!
Barmutik, этот твой модуль просто чудо ты не представляеш как я рад !!!!!!!!! СПАСИБО !!!!!!!!! :( :( :D
 
A

Artexoid

#11
Блин, просто суперски все работает, никак не нарадуюсь
 
B

Barmutik

#12
Ну просто счастье какое-то :)

Кстати ... аватара то не видно ;)
 
A

Artexoid

#13
Barmutik
Ага я знаю, блин что-то у форума с гифами туго )), или что-то я не так сделал !
Надо разобраться.
 

admin

Well-known member
08.08.2003
2 754
0
#14
Artexoid
это не у форума туго, а у твоего хостинга проблема.
 
A

Artexoid

#15
Серёга
Спасибо за подсказку :) ;) я не сомнивался что Народ.ру и Boom.ru гавно, не с того не с того аватор не прет.
Знаеш хороший хостинг ? Подскажи если не трудно, буду презнателен !
 
Статус
Закрыто для дальнейших ответов.