|
#1
|
|||
|
|||
Скачивание EXE
Пишу программу которая должна скачать определенный файл из интернета.
И возникли 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; TAleD = class(TUser) public function HelpMe(ASubject, ARequest: String): String; function GiveMeExample(ASubject: String): TStringList; procedure WriteReview(APost: Integer; ADescription: TStringList); 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; TAleD = class(TUser) public function HelpMe(ASubject, ARequest: String): String; function GiveMeExample(ASubject: String): TStringList; procedure WriteReview(APost: Integer; ADescription: TStringList); end; |
#6
|
|||
|
|||
все равно что-то не очень фурычит
|