Embeddedform und Prozessbar

[waldforest]

Hallo,
Anbei der Code...

Ich denke das Problem liegt in der
function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText:
Solange ich nicht embedded bin, greife ich auf das aufgerufene Form zu.

Sobald ich in
procedure TGBD_update.Button2Click(Sender: TObject);
GBD_update:=self;
setzte werden auch im Embedded die Labels angezeigt.

Im Embedded ist wohl der Name GBDUpdate ein anderer.
Ich steh hier auf dem Schlauch diesen Fehler zu beseitigen.

Delphi-Quellcode:

unit F_GBDupdate;

interface

uses
  Windows, Messages, Classes,SysUtils,   Graphics, Controls, Forms,
  Dialogs, UrlMon, ActiveX, StdCtrls, ComCtrls, Gauges, iniFiles, ExtCtrls, ShellApi,
  ZLIB, Spin, WinInet, WinSock , Registry, JvComponentBase, JvEmbeddedForms;


type
  TGBD_update = class(TForm)
    Gauge1: TGauge;
    Button2: TButton;
    Panel1: TPanel;
    lcheck: TLabel;
    Label4: TLabel;
    Label2: TLabel;
    jvmbdfrmlnk_GDBUpdate: TJvEmbeddedFormLink;
    procedure CheckClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;
  function IsInternetConnected: Boolean;
  function LoadURL(URL: String): String;


  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;

  public
    { Public-Deklarationen }
  end;

   var
    GBD_update: TGBD_update;
    usercancel: Boolean = False;
    last_check : Integer;
    function DownloadURLToFile_NOCache(const FileURL, FileName: String): Cardinal;

implementation
  
//uses Liveupdate;
{$R *.dfm}
function cDownloadStatusCallback._AddRef: Integer;
begin
  Result := 0;
end;
function IsInternetConnected: Boolean;
var
  dwConnectionTypes: DWORD;
  wsadata : TWsaData;
  hostent : pHostent;
begin
   dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN +
   INTERNET_CONNECTION_PROXY+INTERNET_CONNECTION_MODEM_BUSY;

   if InternetGetConnectedState(@dwConnectionTypes, 0) then
     Result := True
   else
    // not connected
    // Versuch ne Verbindung aufzubauen

    if not InternetAutodial(INTERNET_AUTODIAL_FORCE_ONLINE or
      INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) then
      // Error
      Result := False

    else
      Result := InternetGetConnectedState(@dwConnectionTypes, 0);

    if(Result) then
    begin
      if(WsaStartup(MAKEWORD(1,0),wsadata) = 0) then
      begin
        hostent := GetHostByName('www.holfter.com');
        Result  := assigned(hostent);
      end;
      WsaCleanup;
    end;

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;

function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
var
  dwConnectionTypes: DWORD;
begin 
  case ulStatusCode of
    BINDSTATUS_FINDINGRESOURCE:
    begin
      GBD_update.Label4.Caption := 'Datei wurde gefunden...';
      if (usercancel) then
      begin
        Result := E_ABORT;
        exit; 
      end;
    end;
    BINDSTATUS_CONNECTING: 
    begin
      GBD_update.Label4.Caption := 'Es wird verbunden...';
      if (usercancel) then
      begin
        Result := E_ABORT;
        exit; 
      end; 
    end;
    BINDSTATUS_BEGINDOWNLOADDATA:
    begin
      GBD_Update.Gauge1.Progress := 0;
      GBD_update.Label4.Caption := 'Der Download wurde gestartet...';
      if (UserCancel) then 
      begin 
        Result := E_ABORT; 
        exit;
      end;
    end;
    BINDSTATUS_DOWNLOADINGDATA:
    begin
      GBD_UPDATE.Gauge1.Progress := MulDiv(ulProgress,100,ulProgressMax);
      GBD_update.Label4.Caption := 'Datei wird heruntergeladen...';
      if (UserCancel) then
      begin
        Result := E_ABORT; exit; 
      end; 
    end;
    BINDSTATUS_ENDDOWNLOADDATA:
    begin
      GBD_update.Label4.Caption := 'Download wurd beendet...';
      dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN +
      INTERNET_CONNECTION_PROXY;
      if InternetGetConnectedState(@dwConnectionTypes, 0) then
        // connected
        InternetAutodialHangup(0);
    end;
  end;
  Application.ProcessMessages;

  Result := S_OK;
end;

procedure TGBD_update.CheckClick(Sender: TObject);
var
  cDownStatus : cDownloadStatusCallback;
begin

If IsInternetConnected then
  begin
  cDownStatus := cDownloadStatusCallBack.Create;

  try
      Panel1.Visible := True;
      Label4.Caption :='Download, bitte jetzt starten';
   finally
   cDownStatus.Free;
  end;
 end
 else
     MessageDlg('Keine Internetverbindung, bitte herstellen und noch einmal versuchen',
     mtError, [mbOK], 0 ) ;
end;

procedure TGBD_update.Button2Click(Sender: TObject);
var
  cDownStatus : cDownloadStatusCallback;
  FilePath: String;
  
begin
  GBD_update:=self;
  
  cDownStatus := cDownloadStatusCallBack.Create;
  FilePath :=  ExtractFilePath(Application.ExeName);
  if not DirectoryExists(FilePath) then
    if not CreateDir(FilePath) then
    raise Exception.Create('Cannot create '+FilePath);
  try
   FilePath := ExtractFilePath(Application.ExeName)+'Daten.Dat';
 
// zuerst den Cache löschen !!!
   DeleteUrlCacheEntry('http://www.xyz.com/Daten.Dat');
   URLDownloadToFIle(nil,'http://www.xyz.com/Daten.Dat',
   PCHAR(FilePath),0,CDownStatus);
   if FileExists(FilePath) then
     DeCompress(FilePath,ExtractFilePath(Application.ExeName))
   else
         MessageDlg('Datenupdatedatei wurde nicht geladen, bitte später noch einmal versuchen',
         mtError, [mbOK], 0 ) ;
  finally
    cDownStatus.Free;
    GBD_update:=nil;

  end;
end;



function LoadURL(URL: String): String;
var
  IOpen, IURL: HINTERNET;
  Read: Cardinal;
  Msg: string;  // <==
begin
 Result := '';
  try
    IOpen := InternetOpen(
               'Mozilla 3.0 (compatible)',
               INTERNET_OPEN_TYPE_PRECONFIG, '', '',
               INTERNET_FLAG_NEED_FILE
             );
    if IOpen <> nil then
    try
      IURL := InternetOpenUrl(IOpen, PChar(URL), nil, 0,
                INTERNET_FLAG_NO_UI, 0);
      if IURL <> nil then
      try
        SetLength(Msg, 4096);  // <====
        repeat
           if InternetReadFile(IURL, @Msg[1], 4096, Read) then  // <===
            Result := Result + Copy(Msg, 1, Read) // <===
          else
            Break;
        until Read = 0;
      finally
        InternetCloseHandle(IURL);
      end;
    finally
      InternetCloseHandle(IOpen);
    end;
  except
  end;
end;

function DownloadURLToFile_NOCache(const FileURL, FileName: String): Cardinal;
var
  hSession, hFile: HInternet; 
  Buffer: array[1..1024] of Byte; 
  BufferLen, fSize: LongWord; 
  f: File; 
begin 
  Result := 0;
  hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hSession) then begin
    hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0, INTERNET_FLAG_RELOAD, 0); 
    if Assigned(hFile) then
    begin
      AssignFile(f, FileName); // Kann auch durch einen Filestream ersetzt werden
      Rewrite(f,1); 
      fSize := 0;
      repeat
        InternetReadFile(hFile, @Buffer, SizeOf(Buffer), BufferLen);
        BlockWrite(f, Buffer, BufferLen); 
        fSize := fSize + BufferLen;
      until (BufferLen = 0);
      CloseFile(f);
      Result := fSize;
      InternetCloseHandle(hFile);
    end;
    InternetCloseHandle(hSession);
  end;
end;

end.