Thema: Delphi Pageproducer und IMG-Tag

Einzelnen Beitrag anzeigen

DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
143 Beiträge
 
Delphi 12 Athens
 
#3

AW: Pageproducer und IMG-Tag

  Alt 2. Apr 2022, 16:54
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...
Debuggers don’t remove bugs, they only show them in slow-motion.
  Mit Zitat antworten Zitat