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

Тема в разделе "Delphi - Сети", создана пользователем Artexoid, 18 фев 2005.

Статус темы:
Закрыта.
  1. Artexoid

    Artexoid Гость

    Вот фигня какая-то у меня.
    Загружаю я файлы вот этой маленькой процедуркой
    Код (Text):
    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 голову ломаю, как я только не изменял это процедурку и все равно одно и тоже. Вот это ее исходный вариант.
     
  2. Barmutik

    Barmutik Гость

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

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

    Artexoid Гость

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

    Artexoid Гость

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

    Barmutik Гость

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

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

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

    Код (Text):
    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;
     
  6. Artexoid

    Artexoid Гость

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

    Artexoid Гость

    Barmutik
    Я не могу установить модуль, он пишет (Delphi 6) при инсталяции модуля вот такую ошибку: :(


    http://art-programs.narod.ru/aab.png

    Че мне делать помоги !!
     
  8. zubr

    zubr Гость

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

    Artexoid Гость

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

    Artexoid Гость

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

    zubr
    Barmutik

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

    Artexoid Гость

    Блин, просто суперски все работает, никак не нарадуюсь [​IMG]
     
  12. Barmutik

    Barmutik Гость

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

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

    Artexoid Гость

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

    admin Well-Known Member

    Регистрация:
    8 авг 2003
    Сообщения:
    2.811
    Симпатии:
    0
    Artexoid
    это не у форума туго, а у твоего хостинга проблема.
     
  15. Artexoid

    Artexoid Гость

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

    admin Well-Known Member

    Регистрация:
    8 авг 2003
    Сообщения:
    2.811
    Симпатии:
    0
    Artexoid
    аватар можно зааплоадить на форум :)
     
Загрузка...
Похожие Темы - Проблема загрузкой файлов
  1. BBDragon
    Ответов:
    15
    Просмотров:
    6.236
  2. Renat11111
    Ответов:
    5
    Просмотров:
    3.387
  3. c0de3r
    Ответов:
    5
    Просмотров:
    119
  4. DobermannTT
    Ответов:
    10
    Просмотров:
    133
  5. SoulPaladin
    Ответов:
    4
    Просмотров:
    126
Статус темы:
Закрыта.

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