Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2007.12.23;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.04 c
2-1196253710
PASZLIB
2007-11-28 15:41
2007.12.23
Четность числа ?


2-1196405007
ardent
2007-11-30 09:43
2007.12.23
table order


2-1196157691
BattleCruser
2007-11-27 13:01
2007.12.23
Обработка сообщений в невизуалных класах.


15-1195657545
Synset
2007-11-21 18:05
2007.12.23
Компоненты


2-1196143990
dumka
2007-11-27 09:13
2007.12.23
Запросы





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский