Thema: Delphi Problem mit Download

Einzelnen Beitrag anzeigen

Benutzerbild von devnull
devnull

Registriert seit: 5. Okt 2003
362 Beiträge
 
Delphi 7 Personal
 
#1

Problem mit Download

  Alt 9. Jan 2004, 13:05
Hi,
also ich hab ne Unit zum Downloaden von Dateien kopiert ...

Das Problem ist, dass wenn ich auf download klicke und diesen thread aufrufe, mir das programm anzeigt, der download sei beendet obwohl es noch nicht mal angefangen hat !
Seltsamerweise läuft der Download derselben Datei manchmal (?) bis zu Ende.
Beim Ausführen der gedownloadeten Datei kommt dann die Meldung, dass die Datei nicht korrekt sei ...

Hier mal der Download-Thread:

Delphi-Quellcode:
unit ThreadUnit;

interface

uses ShellAPI, UrlMon, StdCtrls, ExtCtrls, Windows, SysUtils, Classes,
     ActiveX, Dialogs, Controls, DownloadServerLink;

type
  cDownloadStatusCallback = class(TObject,IUnknown,IBindStatusCallback)
  private
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
  end;

type
  TDownloadThread = class(TThread)
  private
       { Private declarations }
     procedure UpdateForm1;
  protected
     procedure Execute; override;
     procedure DownloadFiles;
  public
     { Public declarations }
     constructor Create(finfo, saveas,todownload : string); //stimmt das?
  end;

implementation

uses UInformationen;

var fileinfo, speichernals,runterladen : string;


function cDownloadStatusCallback._AddRef: Integer;
begin
  Result := 0;
end;

function cDownloadStatusCallback._Release: Integer;
begin
  Result := 0;
end;

function cDownloadStatusCallback.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if(GetInterface(IID,Obj)) then
  begin
    Result := 0
  end
  else
  begin
    Result := E_NOINTERFACE;
  end;
end;

function cDownloadStatusCallback.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

procedure dl;
var Handle : THandle;
begin
  MessageDlg ('Neuere Datenbank erfolgreich heruntergeladen !',mtInformation,[mbOk],0);
  PagesDlg2.CancelBtn.Enabled := true;
  PagesDlg2.OKBtn.Enabled := true;
  PagesDlg2.Button1.Enabled := true;
  if MessageDlg ('Programm beenden und Packet installieren ?',mtConfirmation,[mbYes,mbNo],0) = mrNo then exit;
  ShellExecute(Handle, NIL, pchar(speichernals),'','',SW_SHOWNORMAL);
  halt;
end;

function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  case ulStatusCode of
    BINDSTATUS_FINDINGRESOURCE : begin
        PagesDlg2.Label4.Caption := '"'+fileinfo+'" gefunden...';
    end;
    BINDSTATUS_CONNECTING : begin
        PagesDlg2.Label4.Caption := 'Verbindungsaufbau...';
    end;
    BINDSTATUS_BEGINDOWNLOADDATA : begin
        PagesDlg2.Label4.Caption := 'Download "'+fileinfo+'" beginnt ...';
    end;
    BINDSTATUS_DOWNLOADINGDATA : begin
        PagesDlg2.ProgressBar1.Position := MulDiv(ulProgress,100,ulProgressMax);
        PagesDlg2.Label4.Caption := 'Download "'+fileinfo+'" läuft ...';
    end;
    BINDSTATUS_ENDDOWNLOADDATA : begin
        PagesDlg2.Label4.Caption := 'Download "'+fileinfo+'" fertiggestellt ...';
        DownloadThread.UpdateForm1;
    end;
  end;

  Result := S_OK;
end;

procedure TDownloadThread.UpdateForm1;
begin
  PagesDlg2.Label4.Caption := 'Download "Programm Datenbank" fertiggestellt ...';
  MessageDlg ('Neuere Datenbank erfolgreich heruntergeladen !',mtInformation,[mbOk],0);
  PagesDlg2.CancelBtn.Enabled := true;
  PagesDlg2.OKBtn.Enabled := true;
  PagesDlg2.Button1.Enabled := true;
  if MessageDlg ('Programm beenden und Packet installieren ?',mtConfirmation,[mbYes,mbNo],0) = mrNo then exit;
  ShellExecute(Handle, NIL, pchar(speichernals),'','',SW_SHOWNORMAL);
  halt;
end;

procedure TDownloadThread.DownloadFiles;
var cDownStatus : cDownloadStatusCallback;
begin
  cDownStatus := cDownloadStatusCallBack.Create;
  try
   UrlDownloadtoFile(nil, PCHAR(runterladen), PCHAR(speichernals), 0, CDownStatus);
  finally
    cDownStatus.Free;
  end;
end;

constructor TDownloadThread.Create(finfo,saveas,todownload : string);
begin
  speichernals := saveas;
  runterladen := todownload;
  fileinfo := finfo;

  // Diese Variablen beinhalten Adresse zum Speichern und Downloaden der Zieldatei
  // Werte sind korrekt

  inherited Create(false);
  FreeOnTerminate := True;
end;

procedure TDownloadThread.Execute;

begin
  DownloadThread.DownloadFiles;
end;

end.
Code:
  // Aufruf des Threads (aus anderer Unit):
  pos := GetCurrentDir;
  DownloadThread := TDownloadThread.Create('Programm',pos+'\Programm_NewVersion.exe,server_adress+'\newprog.exe');
Hoffe ihr könnt mir da helfen (das ist der code aus der c.-lib)
devnull
-- Never change a running system --
  Mit Zitat antworten Zitat