![]() |
|
|
#1
|
|||
|
|||
|
Пишу программу которая должна скачать определенный файл из интернета.
И возникли 2 существенные проблемы: 1) при скачивании текстового файла напрочь теряются все ентеры, то есть то что было на разных строках сливается в одну длинющую, но при этом пробелы остаются. 2) при скачивании exe файла его не удается запустить, то есть он как бы запускается, но ничего не происходит Пробовал вот такие функции, но результат один и тот же Код:
function GetInetFile(const fileURL, FileName: string): boolean;
const
BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: file;
sAppName: string;
begin
Result := False;
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);
try
AssignFile(f, FileName);
Rewrite(f,1);
repeat
InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen);
until
BufferLen = 0;
CloseFile(f);
Result := True;
finally
InternetCloseHandle(hURL);
end;
finally
InternetCloseHandle(hSession);
end;
end; и Код:
procedure TForm1.Button1Click(Sender: TObject);
var
MS:TFileStream;
begin
try
MS:=TFileStream.Create('SUt.exe',fmOpenReadWrite);
except
MS:=TFileStream.Create('SUt.exe',fmCreate);
end;
try
try
idHttp1.Get(URL,MS);
finally
idHttp1.Free;
end;
finally
MS.Free;
end;
end;
Помогите пожалуйста, или хотя бы подскажите в чем ошибка |
|
#2
|
||||
|
||||
|
первый метод плох тем, что он качает только по прямой ссылке, т.е. ссылку типа site.com/index.php?get=4 он не скачает.
Второй метод у меня нормально работает. |
|
#3
|
||||
|
||||
|
Попробуйте эту функцию, она конечно тоже не лишена недостатков, но я ей пользуюсь, пока хватает:
Код:
type
TADCallBack = procedure(DonePercent: Integer; var Done: Boolean);
...
function ADGetUrl(fURL : WideString; fCallBack: TADCallBack = nil): AnsiString;
var
hInternet : pointer;
hConnect : pointer;
hRequest : pointer;
Size : cardinal;
B : boolean;
Buff : ANSIString;
ReadedSize : cardinal;
I, L : cardinal;
total: Cardinal;
done: Boolean;
str: String;
bl, rv: Cardinal;
function OpenInternet(Name: WideString): pointer;
begin
result := InternetOpenW(@Name[1], INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
end;
function Connect(hInternet : pointer): pointer;
var
SiteURL: String;
begin
result := nil;
SiteURL := ADExtractUrlHostName(fURL);
if hInternet = nil then exit;
result := InternetConnectW(hInternet, @SiteURL[1],
INTERNET_DEFAULT_HTTP_PORT,
'anonymous', nil, INTERNET_SERVICE_HTTP, 0, 0);
end;
function NewRequest(fURL : WideString; hConnect: pointer): pointer;
begin
result := nil;
if hConnect = nil then exit;
result := HTTPopenRequestW(hConnect, nil, @fURL[1],
nil, nil, nil, INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_RELOAD, 0);
end;
function SendRequest(hRequest: pointer): boolean;
begin
result := false;
if hRequest = nil then exit;
result := HTTPsendRequestW(hRequest, nil, 0, nil, 0);
end;
function DataAvailable(hRequest: pointer; out Size : cardinal): boolean;
begin
result := wininet.InternetQueryDataAvailable(hRequest, Size, 0, 0);
end;
function SizeQuery(hRequest: pointer; out Size : cardinal): boolean;
var
RSize,rv : cardinal;
p : pointer;
begin
RSize := 4;
result := HttpQueryInfoW(hRequest,
HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
@Size, RSize, rv);
if NOT result then Size := 0;
end;
begin
result := '';
SetLastError(0);
hInternet := OpenInternet('ADworldMiniDownloader');
hConnect := Connect(hInternet);
hRequest := NewRequest(ADExtractUrlFilePath(fURL), hConnect);
if NOT SendRequest(hRequest) then
begin
if hRequest <> nil then InternetCloseHandle(hRequest);
if hConnect <> nil then InternetCloseHandle(hConnect);
if hInternet <> nil then InternetCloseHandle(hInternet);
SetLastError(1);
exit;
end;
SizeQuery(hRequest, Size);
inc(Size);
SetLength(Buff, Size);
B := false;
HttpQueryInfoW(hRequest,
HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
@total, bl, rv);
I := 1;
while true do
begin
DataAvailable(hRequest, L);
if L = 0 then
break;
if (I + L) > Size then
SetLength(Buff, I + L);
B := InternetReadFile(hRequest, @Buff[i], L, ReadedSize);
if not B then
break;
inc(I, ReadedSize);
if(@fCallBack<>nil)and(Assigned(fCallBack))then
fCallBack(round(100/total*ReadedSize),done);
end;
if hRequest <> nil then InternetCloseHandle(hRequest);
if hConnect <> nil then InternetCloseHandle(hConnect);
if hInternet <> nil then InternetCloseHandle(hInternet);
Result := Buff;
end; |
|
#4
|
|||
|
|||
|
Цитата:
Что-то у меня не выходит этот способ: ругается на строки Код:
SiteURL := ADExtractUrlHostName(fURL); и hRequest := NewRequest(ADExtractUrlFilePath(fURL), hConnect); В частности на ADExtractUrlFilePath и ADExtractUrlHostName Цитата:
Зато у меня теперь какой-то Access violation вылазит и exe все равно не запускается ![]() Во вложении файл, который был скачан |
|
#5
|
||||
|
||||
|
это функции из моего пакета... допишите их до основной функции и будет работать
Код:
function ADExtractUrlHostName(const AUrl: String): String;
var
s: String;
begin
s := AUrl;
s := AnsiReplaceStr(s,'\','/');
if(Pos('//',s)<>0)then
s := AnsiMidStr(s,Pos('//',s)+2,Length(s));
if(Pos('/',s)<>0)then
s := AnsiMidStr(s,1,Pos('/',s)-1);
Result := s;
end;
function ADExtractUrlFilePath(const AUrl: String): String;
var
s: String;
begin
s := AUrl;
s := AnsiReplaceStr(s,'\','/');
if(Pos('//',s)<>0)then
s := AnsiMidStr(s,Pos('//',s)+2,Length(s));
if(Pos('/',s)<>0)and(Pos('//',AUrl)<>0)then
s := AnsiMidStr(s,Pos('/',s)+1,Length(s));
Result := s;
end; |
|
#6
|
|||
|
|||
|
все равно что-то не очень фурычит
|