Startseite einer Website mit Synapse herunterladen

[creed steiger]

Ich glaube BeniBelas Internet Tools können sowas auch:
http://benibela.de/sources_en.html#internettools

das würde ich auch vorschlagen ... und Beni ist hier ja auch unterwegs

[Patrix2911]

Beim Aufruf dieser Website "http://www.cum-laude.info/" bleibt das Programm hängen. Innerhalb der IDE gibts nen ESocketError ... Hostname resolution for "" failed.....

[wp_xyz]

Ich weiß nicht, was du machst, aber bei mir funktioniert's (falls du nicht von den InternetTools redest - die habe ich nicht ausprobiert).

[Patrix2911]

Der fehler kommt bei mir beim einfachen Aufruf der genannten Website ...:/

Ich eben etwas seltsames festgestellt ...

Code: Alles auswählen

 
function DownloadHTTP(URL: String; AStream: TStream; out AErrMsg: String): Boolean;
begin
  AErrMsg := '';
  If Pos('HTTP',UpperCase(URL)) <> 1 then URL := 'http://' + Url;
  with TFPHTTPClient.Create(nil) do
    try
      AllowRedirect := true;
      try
        Get(URL, AStream);
        Result := (ResponseStatusCode = 200);
        if not Result then
          AErrMsg := ResponseStatusText;
      except
        Result := false;
        AErrMsg := 'Fehler, z.B. URL existiert nicht.';
      end;
    finally
      Free;
    end;
end;
 
procedure DownloadURL(URL: String; FN: String; Mode: Integer);
var
  stream: TMemoryStream;
  errmsg: String;
  i     : longint;
  s,s2,mail: string;
begin
  stream := TMemoryStream.Create;
  try
    Log('Lese Quelltext von "' + URL + '" ein:');
    Application.ProcessMessages;
    if DownloadHTTP(URL, stream, errmsg) then
    begin
      stream.SaveToFile(FN);
      Log('--> OK (' + IntToStr(stream.Size) + ' Bytes gelesen)');
    end else
      Log('--> Fehler: ' + errmsg);
  finally
    stream.Free;
  end;
 Log('Bereit.');
end;
 

http://www.cum-laude.info

Rufe ich die Website so auf:

Code: Alles auswählen

 
procedure GetSite;
var url,datei:string;
begin
 Url := 'http://www.cum-laude.info';
 datei:= 'Ausgabe.txt';
DownloadURL(url, datei, 0)
end;
 

kommt die besagte Fehlermeldung mit dem Socketfehler ...

rufe ich sie so auf:

Code: Alles auswählen

 
procedure GetSite;
var url,msg:string;
str : tstream;
begin
 Url := 'http://www.cum-laude.info';
 DownloadHTTP(Url,Str,Msg);
end;
 

und ändere in der DownLoadHTTP einfach diese Zeile:
Get(URL, AStream);
in diese
Get(URL, 'Ausgabe.txt');

Dann funktioniert der Download.... aber letzteendlich wird doch in der DownloadUrl auch nur die DownloadHTTP Funktion aufgerufen?

[wp_xyz]

Die zweite Variante kann nicht funktionieren, weil der Stream nicht erzeugt wird:

Code: Alles auswählen

procedure GetSite;
var 
  url,msg:string;
  str: tstream;
begin
  Url := 'http://www.cum-laude.info';
  str := TMemorystream.Create;
  try
    DownloadHTTP(Url,Str,Msg);
    // irgendetwas mit str machen, z.B. in ein Memo einlesen:
    // Memo1.Lines.LoadfromStream(str);  // evtl. vorher den Stream noch auf Anfang zurücksetzen: str.Position := 0
  finally
    str.Free;
  end;
end;

Ansonsten müsstest du ein kompilierbares Projekt hochladen, das ich selbst durch den Debugger jagen kann. Dazu bitte alles rausstreichen, was nicht reingehört - ich habe keine Lust, die fehlerhafte Funktion unter tausenden anderen Zeilen zu suchen.

[Patrix2911]

Ich habe Dir einen Downloadlink als PN geschickt. Danke für deine Hilfe.

[Patrix2911]

Mal noch des Rätsel-Lösungs, bzw. eine für mein Problem hinreichende Variante. Hierfür noch danke an wp_xyz...

Code: Alles auswählen

 
function DownloadHTTP(URL: String; AStream: TStream; out AErrMsg: String): Boolean;
begin
  Result := false;
  AErrMsg := '';
  If Pos('HTTP',UpperCase(URL)) <> 1 then URL := 'http://' + Url;
  with TFPHTTPClient.Create(nil) do
    try
      AllowRedirect := true;
      try
        HTTPMethod('GET', URL, AStream, [200, 400, 403, 404]); // lädt die Website herunter und verhindert das eine Exception ausgelöst wird sollte das Ergebnis einen der Fehlercodes 200, 400, ..... enthalten.
        Result := (ResponseStatusCode = 200);
        if not Result then
          AErrMsg := ResponseStatusText;
      except
        on E:Exception do begin
          Result := false;
          AErrMsg := 'Fehler: ' + E.Message;
        end;
      end;
    finally
      Free;
    end;
end;