Форум: "Основная";
Текущий архив: 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.045 c