Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Programmieren allgemein (https://www.delphipraxis.net/40-programmieren-allgemein/)
-   -   Delphi Pageproducer und IMG-Tag (https://www.delphipraxis.net/210300-pageproducer-und-img-tag.html)

DaCoda 1. Apr 2022 10:39

Pageproducer und IMG-Tag
 
Hallo,
ich habe folgende Testzeilen:

Code:
procedure TdmWebServer.HttpServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  AResponseInfo.ContentText := PageProducer.Content;
end;

procedure TdmWebServer.PageProducerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
  Loop: Integer;
begin
  for Loop := 1 to 10 do begin
    if TagString = 'LEDIMG' + IntToStr(Loop) then begin
      ReplaceText := 'images/led_yellow_on.png';
    end else if TagString = 'STRIMG' + IntToStr(Loop) then begin
      ReplaceText := 'images/led_blue_on.png';
    end;
  end;
end;
Warum werden die Bilder nicht angezeigt ? Wenn ich dieses HTML mal statisch mit diesen Bildern ausfülle, dann zeigt ein Browser das korrekt an, über PageProducer nicht...
Hat jemand einen tip, was ich falsch mache ?

Delphi.Narium 2. Apr 2022 15:43

AW: Pageproducer und IMG-Tag
 
Die Routine wird aufgerufen, wenn der Parser ein Tag entdeckt.

Wenn Du also 10 Bilder in der HTML-Datei hast, wird die Routine 10 mal aufgerufen und nicht einmal, um so "am Stück" alle 10 Tags zu ersetzen.

TagString kann immer nur einen Wert enthalten. Die Schleife ist da nicht wirklich zielführend. Klar kann man damit prüfen, ob das gelieferte Tag zufällig mit einem per Schleife durchprobierten Tag übereinstimmt. Aber das ist eigentlich nicht so wirklich der Sinn der Sache.

Zeig' uns bitte mal das zugrundeliegende HTML.

Ansonsten vergleiche bitte mal das statische und funktionierende HTML mit dem dynamisch per PageProducer erstellen HTML. Sind die identisch?

Eventuell kann es auch an den Pfadangaben zu den Bildern liegen.
Wird eine HTML-Datei im Browser geladen, dann werden die Pfade zu den Bildern ggfls. anders interpretiert, als bei einer dynamisch per Webserver zur Verfügung gestellten HTML-Seite.
Beim Laden einer Datei werden die Pfade ausgehend vom Pfad der Datei interpretiert, beim Laden über 'nen Webserver werden sie vom Webserver angefordert. Kann der Webserver die Dateien images/led_yellow_on.png und images/led_blue_on.png liefern? Wurde eine entsprechende Routine implementiert? Ggfls. muss HttpServerCommandGet entsprechend angepasst und ARequestInfo ausgewertet werden.

Momentan wird bei jeder Anforderung PageProducer.Content geliefert, auch bei den Bildern und die so erstellte HTML-Seite kann kein Browser als Bild darstellen.

Abgesehen davon:

Wenn nur zwei Bilder geliefert werden sollen, dann muss man die Tags nicht durchnummerieren. Der Name eines Tags kann mehrfach im HTML enthalten sein.
Delphi-Quellcode:
procedure TdmWebServer.PageProducerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
  if TagString = 'LEDIMG' then begin
    ReplaceText := 'images/led_yellow_on.png';
  end else if TagString = 'STRIMG' then begin
    ReplaceText := 'images/led_blue_on.png';
  end;
end;
Statt zehn Tags #LEDIMG1 .. #LEDIMG10 reicht es aus, wenn das Tag #LEDIMG zehn mal im HTML enthalten ist, kann aber auch beliebig weniger oder mehr sein. Bei Anpassungen im HTML muss man dann nicht an den Quelltext des Programmes ran. Jedes Tag #LEDIMG liefert dann images/led_yellow_on.png. Und wenn's mal 1000 werden, klappt das immer noch, bei der Schleifenvariante müsste man die Schleife dann ggfls. für dazugekommene Tags anpassen. Das ist nicht Sinn der Sache. Das gilt analog auch für das Tag #STRIMG.

DaCoda 2. Apr 2022 15:54

AW: Pageproducer und IMG-Tag
 
Vielen Dank für die Tips, das mit den 10 Durchläufen hat mich auch gestört. War der erste Ansatz...

Nun habe ich das mal so probiert, bin aber auch nicht zufrieden:
Code:
procedure TdmWebServer.HttpServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  Document: string;
  FileName: string;
  Ext: string;

  procedure LoadBinary(FileName, ContentType: string);
  begin
    if FileExists(FileName) then begin
      AResponseInfo.ContentType := ContentType;
      AResponseInfo.ContentStream := TFileStream.Create(FileName, fmOpenRead);
    end else
      AResponseInfo.ContentStream := nil;
  end;

  procedure LoadTextFile(FileName, ContentType: string);
  var
    SL: TStringList;
  begin
    if FileExists(FileName) then begin
      AResponseInfo.ContentType := ContentType;
      SL := TStringList.Create;
      try
        SL.LoadFromFile(FileName);
        AResponseInfo.ContentText := SL.Text;
      finally
        SL.Free;
      end;
    end else
      AResponseInfo.ContentText := '';
  end;

begin
  Document := ARequestInfo.Document;
  FileName := WWWRootPath + Document;
  AResponseInfo.ContentText := '';
  if Document = '/' then begin
    AResponseInfo.ContentType := 'text/html';
    AResponseInfo.ContentText := PageProducer.Content;
  end else if Document = '/style.css' then begin
    LoadTextFile(FileName, 'text/css');
  end else begin
    Ext := ExtractFileExt(Document).ToUpper;
    if Ext = '.ICO' then
      LoadBinary(FileName, 'image/ico')
    else if (Ext = '.JPG') or (Ext = '.JPEG') then
      LoadBinary(FileName, 'image/jpeg')
    else if Ext = '.PNG' then
      LoadBinary(FileName, 'image/png');
  end;

end;

procedure TdmWebServer.PageProducerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
  I: Integer;
begin
  if TagString.StartsWith('CVS_State_', True) then begin
    I := Copy(TagString, 11, 3).ToInteger;
    ReplaceText := 'CVS_State = ' + I.ToString;
  end else if TagString.StartsWith('Stacker_State_', True) then begin
    I := Copy(TagString, 15, 3).ToInteger;
    ReplaceText := 'Stacker_State = ' + I.ToString;
  end else if TagString.StartsWith('LSN', True) then begin
    I := Copy(TagString, 4, 3).ToInteger;
    ReplaceText := HtmlSpace4 + Format('[SERIAL %d]', [I]);
  end else if TagString.StartsWith('REC', True) then begin
    I := Copy(TagString, 4, 3).ToInteger;
    ReplaceText := HtmlSpace2 + Format('%d', [I]);
  end else if TagString.StartsWith('CNT', True) then begin
//    I := Copy(TagString, 4, 3).ToInteger;
    ReplaceText := HtmlSpace2 + Format('%d', [MaschinenDaten[Copy(TagString, 4, 3).ToInteger].Partial_Pcs]);
  end else if TagString.StartsWith('TPM', True) then begin
//    I := Copy(TagString, 4, 3).ToInteger;
    ReplaceText := HtmlSpace2 + Format('%d', [MaschinenDaten[Copy(TagString, 4, 3).ToInteger].Prod_Min]);
  end else if TagString.StartsWith('CVSIMG', True) then begin
    I := Copy(TagString, 7, 3).ToInteger;
    case MaschinenDaten[I].Prod_Status of
      psTotal: ReplaceText := HTMLImagePath + 'Led_white_off.png';
      psProducing: ReplaceText := HTMLImagePath + 'Led_green_on.png';
      psPause: ReplaceText := HTMLImagePath + 'Led_orange_on.png';
      psAlarm: ReplaceText := HTMLImagePath + 'Led_red_on.png';
      psMaintenance: ReplaceText := HTMLImagePath + 'Led_blue_on.png';
      psWaiting: ReplaceText := HTMLImagePath + 'Led_yellow_on.png';
      psOffLine: ReplaceText := HTMLImagePath + 'Led_yellow_on.png';
      psNoMaterial: ReplaceText := HTMLImagePath + 'Led_yellow_on.png';
      psNoPersonal: ReplaceText := HTMLImagePath + 'Led_yellow_on.png';
    else
      ReplaceText := HTMLImagePath + 'Led_white_off.png';
    end;
  end else if TagString.StartsWith('STRIMG', True) then begin
    I := Copy(TagString, 7, 3).ToInteger;
    ReplaceText := HTMLImagePath + 'Led_yellow_off.png';
  end;
Aber dieser Ansatz funktioniert schon mal (meistens), aber da die interne Abarbeitung im Thread läuft gibt es hierbei auch Überschneidungen
und dadurch entstehen falsche Anzeigen...

Delphi.Narium 2. Apr 2022 17:40

AW: Pageproducer und IMG-Tag
 
Du musst HttpServerCommandGet threadsicher implementieren.


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:58 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz