Registriert seit: 9. Jun 2011
678 Beiträge
FreePascal / Lazarus
|
AW: Proxy-Einstellungen automatisch erkennen mit IDHttp
27. Mär 2013, 15:22
Ein Beispiel wofür?
FInternetHandle := InternetOpenA('MyAppUserAgent', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
Das Herunterladen mal grob skizziert:
Delphi-Quellcode:
function TpkInternetHTTP.Download(Server, Path: AnsiString; Stream: TStream): boolean;
var
hSession, hRequest: TInternetHandle;
dwConnIC, dwConnHOR, dwSize, dwIndex: DWord;
iEC: integer;
pc: PAnsiChar;
buf: string[32];
wPort: Word;
sPort: AnsiString;
begin
Result := false;
FCurrentBytes := 0;
FTotalBytes := 0;
FErrorCode := 0;
// InternetConnect
dwConnIC := 0;
wPort := INTERNET_DEFAULT_HTTP_PORT;
if Pos(':', Server) > 0 then begin
sPort := Server;
Delete(sPort, 1, Pos(':', sPort));
SetLength(Server, Length(Server) - Length(sPort) - 1);
wPort := StrToIntDef(sPort, INTERNET_DEFAULT_HTTP_PORT);
end;
hSession := InternetConnectA(FInternetHandle, PAnsiChar(Server), wPort, nil, nil, INTERNET_SERVICE_HTTP, 0, dwConnIC);
if hSession = 0 then begin
FErrorCode := GetLastError;
Exit;
end;
try
// HttpOpenRequest
dwConnHOR := 0;
hRequest := HttpOpenRequestA(hSession, nil, PAnsiChar(Path), nil, nil, nil, INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE, dwConnHOR);
if hRequest = 0 then begin
FErrorCode := GetLastError;
Exit;
end;
try
// HttpSendRequest
dwSize := 0;
if HttpSendRequestA(hRequest, nil, 0, nil, 0) then begin
// HttpQueryInfo - status
SetLength(buf, 32);
dwSize := Length(buf);
dwIndex := 0;
if HttpQueryInfoA(hRequest, HTTP_QUERY_STATUS_CODE, buf[1], dwSize, dwIndex) then begin
Val(Copy(buf, 1, dwSize), FStatusCode, iEC);
if iEC > 0 then begin
FStatusCode := 0;
// TODO : error handling
end;
end else begin
FStatusCode := 0;
// TODO : error handling
end;
if (FStatusCode = 404) then begin
FErrorCode := ERROR_NO_MORE_FILES;
Exit;
end;
// HttpQueryInfo - length
SetLength(buf, 32);
dwSize := Length(buf);
dwIndex := 0;
if HttpQueryInfoA(hRequest, HTTP_QUERY_CONTENT_LENGTH, buf[1], dwSize, dwIndex) then begin
Val(Copy(buf, 1, dwSize), FTotalBytes, iEC);
if iEC > 0 then begin
FTotalBytes := 0;
// TODO : error handling here
end;
end else begin
FTotalBytes := 0;
// TODO : error handling here
end;
GetMem(pc, FBlockSize + 1);
try
repeat
if InternetReadFile(hRequest, pc, FBlockSize, dwSize) then begin
Stream.WriteBuffer(pc^, dwSize);
Inc(FCurrentBytes, dwSize);
// FireProgress;
end
else dwSize := 0;
until dwSize = 0;
// FireProgress;
finally
FreeMem(pc);
end;
// FireProgress;
Result := true;
end else begin
FErrorCode := GetLastError;
end;
finally
InternetCloseHandle(hRequest);
end;
finally
InternetCloseHandle(hSession);
end;
Stream.Seek(0, soFromBeginning);
end;
|