Datei Download mit SaveDialog

[Gehstock]

Delphi-Quellcode:

function TForm2.Download(URL : String):boolean ;
var
lStream: TFileStream;
begin
 if SaveDialog1.Execute  then
  begin
   try
    lStream:=TFileStream.Create(SaveDialog1.Filename, fmCreate or fmShareDenyNone);
   try
    idHTTP1.Get(URL, lStream);
   finally
    lStream.Free;
     end;
    finally
   end;
   end;
   end;

führt zu "Forbidden HTML irgendwas" der link (URL) funzt

[LDericher]

Delphi-Quellcode:

procedure TForm1.GoClick(Sender: TObject);
var lStream:TFileStream;
begin
if SaveTo.Execute then
  begin
  ShowMessage('Start...');
  lStream:=TFileStream.Create(SaveTo.FileName, fmCreate or fmShareDenyNone);
   try
     idHTTP1.Get(URL.Text, lStream);
   finally
     lStream.Free;
   end;
  ShowMessage('Done.');
  end;
end;

Hehe - Ich weiß nur, dass meines funzt :o

Edit: Sieht aus, als würdest du "EasyHelper" benutzen/zumindest kennen...

[Gehstock]

immernoch "HTTP1.1 403 Forbidden"

nein benutz ich nicht nur Google

Edit : die url ist per copy&Paste im IExplorer getestet

[Gehstock]

mache es nun mit

Delphi-Quellcode:

function TForm2.DownloadFile(Const Source : String; Const ToLabel: TLabel = Nil; Const PrgBar: TGauge = Nil): Boolean;
var
  NetHandle: HINTERNET;
  UrlHandle: HINTERNET;
  Buffer: Array[0..1024] Of Char;
  BytesRead, Reserved: dWord;
  ReadFile: String;
  NumByte: Integer;
  FileSize: dWord;
  s : TFilestream;
begin
if saveDialog1.Execute then
 begin
 saveDialog1.InitialDir := ExtractFilePath(Application.ExeName);
  ReadFile := '';
  ToLabel.Caption := 'Connecting...';
  Application.ProcessMessages;
 NetHandle := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  If Assigned(NetHandle) Then Begin
     UrlHandle := InternetOpenUrl(NetHandle, PChar(Source), Nil, 0, INTERNET_FLAG_RELOAD, 0);

     If Assigned(UrlHandle) Then Begin
        If (ToLabel <> Nil) Or (PrgBar <> Nil) Then Begin
           Buffer := '';
           FileSize := SizeOf(Buffer);
           Reserved := 0;
           If HttpQueryInfo(UrlHandle, HTTP_QUERY_CONTENT_LENGTH, @Buffer, FileSize, Reserved) Then
              FileSize := StrToIntDef(Buffer, -1);
        End;

        If ToLabel <> Nil Then
           ToLabel.Caption := '0 of 0 bytes';
        If Gauge1 <> Nil Then Begin
           Gauge1.MinValue := 0;
           Gauge1.MaxValue := FileSize;
           Gauge1.Progress := 0;
        End;

        FillChar(Buffer, SizeOf(Buffer), 0);
        Repeat
           FillChar(Buffer, SizeOf(Buffer), 0);
           InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
           For NumByte := 0 To BytesRead - 1 Do
              ReadFile := Concat(ReadFile, Buffer[NumByte]);

           If ToLabel <> Nil Then
              ToLabel.Caption := FormatFloat('0,000', Length(ReadFile)) + ' of ' + FormatFloat('0,000', FileSize) + ' bytes';
           If Gauge1 <> Nil Then
              Gauge1.Progress := Gauge1.Progress + StrToInt(IntToStr(BytesRead));
              if Gauge1.Progress = FileSize then exit;
           Application.ProcessMessages;
        Until BytesRead = 0;
        InternetCloseHandle(UrlHandle);
     End;
     InternetCloseHandle(NetHandle);
  End;

  ToLabel.Caption := '';
  Application.ProcessMessages;

  If Length(ReadFile) > 0 Then
     Begin
        If FileExists(saveDialog1.FileName) Then
           DeleteFile(PChar(saveDialog1.FileName));

        s := TFileStream.Create(saveDialog1.FileName, fmCreate);
        with s do
        begin
           Try
              Write(s, Length(ReadFile));
           Finally
              Free;
           End;
        end;

        Result := True;
     End
        Else
     Result := False;
end;

end;

bewegt zumindest erstmal den TGauge und das label zählz schön die bytes runter aber die Datei wird nicht erstellt (Systemweit gesucht)
hat jemand eine Idee?

[Dani]

Der Webserver könnte will evtl. den Referer oder einen UserAgent verlangen, außerdem solltest du Weiterleitungen behandeln... geht dieser Code?

Delphi-Quellcode:

function DownloadWithDialog(URL: String; SaveDialog: TSaveDialog): Boolean;
const
  UserAgentString: String = 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en;' +
                            ' rv:1.8.1.11) Gecko/20071127 Firefox/2.0.0.11';
  OkResponses: array[0..2] of Integer = (200, 301, 302);
  MinUrlLength: Integer = 8;
  RedirectMaximum: Integer = 5;
var
  HTTP: TIdHttp;
  Stream: TStream;
  I, Slashpos: Integer;
  ForgedReferer: String;
begin
  Result := false;
  if Length(URL) < MinUrlLength then Exit;

  if SaveDialog.Execute then begin
    Stream := TFileStream.Create(SaveDialog.FileName,
                                 fmCreate or fmShareDenyWrite);
    try
      HTTP := TIdHTTP.Create;
      try
        Slashpos := pos('/', copy(URL, MinUrlLength, MaxInt));
        if Slashpos > 0 then begin
          ForgedReferer := copy(URL, 1, MinUrlLength + Slashpos - 1);
        end else begin
          ForgedReferer := URL;
        end;

        HTTP.Request.Referer := ForgedReferer;
        HTTP.Request.UserAgent := UserAgentString;
        HTTP.HandleRedirects := true;
        HTTP.RedirectMaximum := RedirectMaximum;
        try
          HTTP.Get(URL, Stream);
          for I := Low(OkResponses) to High(OkResponses) do begin
            if HTTP.Response.ResponseCode = OkResponses[I] then begin
              Result := true;
              break;
            end;
          end;
        except
          on E: EIdException do begin
            Result := false;
          end;
        end;
      finally
        HTTP.Free;
      end;
    finally
      Stream.Free;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const URL = 'http://www.delphipraxis.net/forum22.html';
begin
 if  DownloadWithDialog(URL, SaveDialog1) then begin
   ShowMessage('Yay.');
 end else begin
   ShowMessage('Fail.');
 end;
end;

[seim]

Zitat:

Zitat von Gehstock

mache es nun mit

Delphi-Quellcode:

function TForm2.DownloadFile(Const Source : String; Const ToLabel: TLabel = Nil; Const PrgBar: TGauge = Nil): Boolean;
var
  NetHandle: HINTERNET;
  UrlHandle: HINTERNET;
  Buffer: Array[0..1024] Of Char;
  BytesRead, Reserved: dWord;
 [...]

Es gibt mit Microsoft Mitteln auch ne Möglichkeit.. allerdings hab ich die noch nicht hinbekommen.

Man müsste statt dem InternetOpenURL ein HttpOpenRequest verwenden da kann man den Referer setzen.

[himitsu]

Erstmal sollte der SaveDialog mit diesem Problem nichts zu tun haben, da diese Meldung auf ein Serverproblem hinweist, wie z.B. eine falsche URL.

Delphi-Quellcode:

uses UrlMon;

function TForm2.Download(const URL: String): Boolean;
begin
  Result := SaveDialog1.Execute and (URLDownloadToFile(nil,
    PChar(URL), PChar(SaveDialog1.Filename), 0, nil) = S_OK);
end;

PS: um welche Seite/URL handelt es sich denn?
womöglich verbietet der Anbieter das Aufrufen über Programme und erlaubt nur Browser (Headerprüfung)