Embeddedform und Prozessbar

[waldforest]

Hallo,
ich habe eine Anwendung mit Jedi EmbeddedInstanceFormPanel aufgebaut.
Solange es auf der eingebundenen Form keine Veränderungen in Form von Prozessbar gibt läuft alles wunderbar.
Sobald es aber Veränderungen auf dem Form, Anzeige von zusätzliche Labels oder eine Prozessbaranzeige gibt, wird die Form nicht aktualisiert.

Application.ProcessMessages, Repaint, und Refresh bringen mich nicht weiter.

Mir ist dies bisher nur durch

Code:

Procedure TForm1.ButtonClick(Sender: TObject)
begin
   Form1 := Self;
     // zeige den aktuellen Downloadstatus anhand von Labels, oder Progressbar an
   Form1 := Nil;
end;

gelungen, die Form zur Laufzeit zu aktualisieren.
Ein erneuter Aufruf dieser Form löst allerdings eine Zugriffsverletzung aus

Was mach ich falsch, was muss ich anders machen, damit die Form im Embedded aktualisiert wird. ?




mfg

[sx2008]

Du solltest die Deklaration der globalen Variablen Form1 auskommentieren; also so:

Delphi-Quellcode:

// var
//   Form1: TForm1;

Danach ist es nicht mehr möglich auf Form1 zuzugreifen und du bist gezwungen ohne die globale Variable auszukommen.
Wahrscheinlich lässt sich dein Code dann nicht mehr kompilieren, aber die Stellen an denen der Compiler meckert sind genau die Problemstellen die verbessert werden müssen.

[waldforest]

Hallo,
versteh ich nicht wirklich, denn dies sind genau die Stellen, wo z.B. im Label der aktuelle Status des Downloads angegeben wird.
Wie könnte man dies denn anders machen ?

Ich nutze hierzu folgenden Code, der alleine (also nicht als Embedded) einwandfrei funktioniert..
http://www.entwickler-ecke.de/topic_...ige_195,0.html

[himitsu]

Procedure TForm1.ButtonClick

Du bist schon in der Klasseninstanz, also hat man darin auch nicht Form1 zu verwenden.




Nja, es ist immer etwas blöd, wenn keiner DEN Code zeigt, welchen er wirklich verwendet.
Was außer raten sollen wir denn da machen?

Zitat:

Dann brauchen wir noch eine Variable:

Delphi-Quellcode:

var 
  Form1: TForm1;

Irgendwie hab ich grad die Befürchtung, als wenn da jemand eine neue/weitere Variable angelegt hat.

[sx2008]

Deine Klasse cDownloadStatusCallback greift bisher fest auf die globale Variable Form1 zu.
Das ist schlecht denn wenn du das Formular dynamisch erzeugst und in ein anderes Formular einbettest ist Form1 nicht korrekt belegt.
Oder stell dir vor du hättest 2 Downloads gleichzeitig laufen.
Also muss die globale Variable Form1 sterben.

cDownloadStatusCallback benötigt ein Label und ein Gauge. Die könntest du schon im Konstruktor übergeben:

Delphi-Quellcode:

type 
  cDownloadStatusCallback = class(TObject,IUnknown,IBindStatusCallback) 
  private
    FLabel: TLabel;  // neu
    FGauge: TGauge;  // neu
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;  
    ...
  public
    constructor Create(ALabel:TLabel; AGauge:TGauge);


constructor cDownloadStatusCallback.Create(ALabel:TLabel; AGauge:TGauge);
begin
  inherrited Create;
  FLabel := ALabel;
  FGauge := AGauge;
  Assert(Assigned(FLabel));  // Sicherheitsprüfung
  Assert(Assigned(FGauge));
end;

Statt Form1.Label1.Caption := 'Der Download wurde gestartet...'; schreibst du dann

Delphi-Quellcode:

  FLabel.Caption := 'Der Download wurde gestartet...';  
  FLabel.Refresh;

[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.

[sx2008]

Es gilt weiterhin das was ich in Beitrag #5 geschrieben habe nur dass die globale Variable nicht Form1 sondern GBD_update heisst.

[Sir Rufo]

@waldforest

Du bist nun schon so lange hier im Forum, da sollten dir die

Code:

[DELPHI][/DELPHI]

Tags bekannt sein, die man um den Delphi-Source setzt

Könntest du deinen Beitrag entsprechend ändern?

[waldforest]

Hallo,
vielen Dank für die Hilfe, habe mal wieder etwas gelernt !!!

mfg

[Sir Rufo]

Wofür hast du das (abenteuerlich benannte) cDownloadStatusCallback mit Interfaces implementiert?

Benutzt werden diese Interfaces ja nicht (zum Glück, sonst würde dir die Instanz sofort um die Ohren fliegen).
Wenn _Release eine 0 zurückliefert wird die Instanz freigegeben

Dein Geraffel kannst du dir sparen, wenn du von TInterfacedPersistent ableitest (dort erfolgt keine Referenz-Zählung)