AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Embeddedform und Prozessbar

Ein Thema von waldforest · begonnen am 5. Apr 2014 · letzter Beitrag vom 6. Apr 2014
Antwort Antwort
Seite 1 von 2  1 2      
waldforest

Registriert seit: 8. Mai 2005
366 Beiträge
 
Delphi XE3 Enterprise
 
#1

Embeddedform und Prozessbar

  Alt 5. Apr 2014, 13:58
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
mfg wf
  Mit Zitat antworten Zitat
Benutzerbild von sx2008
sx2008

Registriert seit: 15. Feb 2008
Ort: Baden-Württemberg
2.332 Beiträge
 
Delphi 2007 Professional
 
#2

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 14:17
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.
fork me on Github
  Mit Zitat antworten Zitat
waldforest

Registriert seit: 8. Mai 2005
366 Beiträge
 
Delphi XE3 Enterprise
 
#3

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 14:53
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
mfg wf

Geändert von waldforest ( 5. Apr 2014 um 14:59 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.116 Beiträge
 
Delphi 12 Athens
 
#4

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 15:53
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von sx2008
sx2008

Registriert seit: 15. Feb 2008
Ort: Baden-Württemberg
2.332 Beiträge
 
Delphi 2007 Professional
 
#5

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 16:11
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;
fork me on Github

Geändert von sx2008 ( 5. Apr 2014 um 16:21 Uhr)
  Mit Zitat antworten Zitat
waldforest

Registriert seit: 8. Mai 2005
366 Beiträge
 
Delphi XE3 Enterprise
 
#6

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 16:17
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.
mfg wf

Geändert von waldforest ( 6. Apr 2014 um 10:19 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von sx2008
sx2008

Registriert seit: 15. Feb 2008
Ort: Baden-Württemberg
2.332 Beiträge
 
Delphi 2007 Professional
 
#7

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 18:06
Es gilt weiterhin das was ich in Beitrag #5 geschrieben habe nur dass die globale Variable nicht Form1 sondern GBD_update heisst.
fork me on Github
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#8

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 20:09
@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?
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
waldforest

Registriert seit: 8. Mai 2005
366 Beiträge
 
Delphi XE3 Enterprise
 
#9

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 22:30
Hallo,
vielen Dank für die Hilfe, habe mal wieder etwas gelernt !!!

mfg
mfg wf
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#10

AW: Embeddedform und Prozessbar

  Alt 5. Apr 2014, 22:46
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)
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:38 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz