Главная страница
    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.47 MB
Время: 0.047 c
2-1195710167
Costy
2007-11-22 08:42
2007.12.23
Ускорения tClientSocket (tserverSocket)


15-1195631021
nexo
2007-11-21 10:43
2007.12.23
числовые головоломки


15-1195587731
Черный Шаман
2007-11-20 22:42
2007.12.23
Ах вон он каков русский компьютер...


15-1195807851
toto
2007-11-23 11:50
2007.12.23
Письмо деду Морозу


2-1196011828
sdaf
2007-11-25 20:30
2007.12.23
проблемы с RxRichEdit





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский