Einzelnen Beitrag anzeigen

CCRDude

Registriert seit: 9. Jun 2011
661 Beiträge
 
FreePascal / Lazarus
 
#12

AW: Proxy-Einstellungen automatisch erkennen mit IDHttp

  Alt 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;
  Mit Zitat antworten Zitat