Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.12.23;
Скачать: CL | DM;

Вниз

Небольшая проблема с менеджером загрузки файлов.   Найти похожие ветки 

 
Gulba   (2007-10-05 17:12) [0]

procedure TUrlLoader.execute;   //Реализует процесс закачки файла
var
 F: File;
 ResumePos, BufferLen, SumSize: DWORD;
 {hSession, }hURL: HInternet;
 Buffer: array[1..1024] of Byte;
 err: boolean;
 rsize:cardinal;
begin
repeat
SumSize := 0; ResumePos := 0;  //Инициализируемся
AssignFile(F, Path); //Свяжемся с файлом
Synchronize(Clear);
//hSession := InternetOpen("RNMC", PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);   //Открыли сессию
hURL := InternetOpenURL(Organizer_MainForm.hSession,PChar(URLadd),nil, 0, 0, 0);   //И наш УРЛ

Size:=0;
rsize:=4;
HttpQueryInfoW(hURL, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER, @Size, rsize, nil);   //Сколько там наш файл весит?
if size=0 then
 begin
  err:=false;
  errtext:="Устаревшая ссылка"
 end
else

begin

 IF FileExists(Path) then //Есть ли на диске этот файл
  begin
    Reset(f,1); //Откроем!
    ResumePos := FileSize(F); //Откуда докачать
    SumSize:=ResumePos;
    Seek(F, FileSize(F)); //А писать будем в конец
  end else
    begin
    {$I-}
      ReWrite(f,1); //А раз нет, так создадим
      sumsize:=0;
    {$I+}
   end;

   if IOResult <> 0 then
      begin
      // showmessage("Не правильное имя файла!!!");
      err:=false;
      errText:="Не правильное имя файла!!!";
      end
else
 begin
  if ResumePos>0 then //Если докачиваем,
       InternetSetFilePointer(hURL,ResumePos,nil,0,0); //То сместимся

  REPEAT //Качаем
    err:= InternetReadFile(hURL, @Buffer,SizeOf(Buffer),BufferLen); //Читаем буфер
    sumSize:=sumSize+BufferLen;
    progress:=round (sumSize/size*100);
    Synchronize(ShowProgress);
    IF err= false then  break;//Ошибка чтения

    BlockWrite(f, Buffer, BufferLen); //Пишем в файл
    sleep(130)
  UNTIL (BufferLen=0)or Terminated; //Качаем, пока не все или надо
close(F)
end;

есть вот такой вот поток реализующий закачку файлов. Далее объявляеться динамический массив таких потоков. И есть массив ожидающих закачки файлов. И проблема такая что одновременно могут закачиваться только два файла. остальные ожидают их завершения и после запускаються. Я первый раз работаю с потоками просьба сильно не материть.


 
Gulba   (2007-10-05 17:17) [1]

procedure TUrlLoader.execute;   //Реализует процесс закачки файла
var
 F: File;
 ResumePos, BufferLen, SumSize: DWORD;
 {hSession, }hURL: HInternet;
 Buffer: array[1..1024] of Byte;
 err: boolean;
 rsize:cardinal;
begin
repeat
SumSize := 0; ResumePos := 0;  //Инициализируемся
AssignFile(F, Path); //Свяжемся с файлом
Synchronize(Clear);
//hSession := InternetOpen("RNMC", PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);   //Открыли сессию
hURL := InternetOpenURL(Organizer_MainForm.hSession,PChar(URLadd),nil, 0, 0, 0);   //И наш УРЛ

Size:=0;
rsize:=4;
HttpQueryInfoW(hURL, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER, @Size, rsize, nil);   //Сколько там наш файл весит?
if size=0 then
 begin
  err:=false;
  errtext:="Устаревшая ссылка"
 end
else

begin

 IF FileExists(Path) then //Есть ли на диске этот файл
  begin
    Reset(f,1); //Откроем!
    ResumePos := FileSize(F); //Откуда докачать
    SumSize:=ResumePos;
    Seek(F, FileSize(F)); //А писать будем в конец
  end else
    begin
    {$I-}
      ReWrite(f,1); //А раз нет, так создадим
      sumsize:=0;
    {$I+}
   end;

   if IOResult <> 0 then
      begin
      // showmessage("Не правильное имя файла!!!");
      err:=false;
      errText:="Не правильное имя файла!!!";
      end
else
 begin
  if ResumePos>0 then //Если докачиваем,
       InternetSetFilePointer(hURL,ResumePos,nil,0,0); //То сместимся

  REPEAT //Качаем
    err:= InternetReadFile(hURL, @Buffer,SizeOf(Buffer),BufferLen); //Читаем буфер
    sumSize:=sumSize+BufferLen;
    progress:=round (sumSize/size*100);
    Synchronize(ShowProgress);
    IF err= false then  break;//Ошибка чтения

    BlockWrite(f, Buffer, BufferLen); //Пишем в файл
    sleep(130)
  UNTIL (BufferLen=0)or Terminated; //Качаем, пока не все или надо
close(F)
end;

if err then Synchronize(ShowWell)
else
  begin
    len:=1024;
    ZeroMemory(@errtext,SizeOf(errtext));
    if internetGetLastResponseInfo(ErCode,@errtext,len) then Synchronize(ShowError);
  end   // else

//   Synchronize(ShowError);//Показ результата

end;

InternetCloseHandle(hURL);
//InternetCloseHandle(hSession);

if (Organizer_MainForm.WaitingDownloadCount>0) then
 begin//Если список ожидающих не пуст
   EnterCriticalSection(Organizer_MainForm.CritSection);
      Name:=Organizer_MainForm.WaitingDownload[Organizer_MainForm.WaitingDownLoadCount -1].Name;
      URLadd:=Organizer_MainForm.WaitingDownload[Organizer_MainForm.WaitingDownLoadCou nt-1].URL;
      Path:="C:/"+name{Organizer_MainForm.WaitingDownload[Organizer_MainForm.WaitingDownLoadCount-1].Name}+".oms";
      Organizer_MainForm.WaitingDownload[Organizer_MainForm.WaitingDownLoadCount-1].Free;
      dec(Organizer_MainForm.WaitingDownLoadCount);
      SetLength(Organizer_MainForm.WaitingDownload,Organizer_MainForm.WaitingDownLoadC ount);
   LeaveCriticalSection(Organizer_MainForm.CritSection);
   Synchronize(NewDownload);
 end
else
 begin  //Иначе освоюождаем место
    EnterCriticalSection(Organizer_MainForm.CritSection);
      Organizer_MainForm.Indicator[number]:=true;
      dec(Organizer_MainForm.CurrentDownLoadCount);
    LeaveCriticalSection(Organizer_MainForm.CritSection);
    terminate;
 end;

until terminated;
end;



Страницы: 1 вся ветка

Текущий архив: 2007.12.23;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.015 c
4-1179815919
Magedon
2007-05-22 10:38
2007.12.23
Send To i n Vista


2-1196319865
Dennis I. Komarov
2007-11-29 10:04
2007.12.23
GetApplicationDataPath


15-1195808646
Ega23
2007-11-23 12:04
2007.12.23
Где сейчас можно купиь 5 лицензий на


15-1195783594
Forest
2007-11-23 05:06
2007.12.23
Двухядерные процессоры работают под Виндос МЕ или 9х серии ?


2-1196079946
webpauk
2007-11-26 15:25
2007.12.23
FindFirst, FindNext