AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi WebActionItems - oder kurz vor dem Durchdrehen
Thema durchsuchen
Ansicht
Themen-Optionen

WebActionItems - oder kurz vor dem Durchdrehen

Ein Thema von Delbor · begonnen am 22. Aug 2016 · letzter Beitrag vom 30. Aug 2016
 
Vorheriger Beitrag Vorheriger Beitrag   Nächster Beitrag Nächster Beitrag
Delbor

Registriert seit: 8. Okt 2006
Ort: St.Gallen/Schweiz
1.196 Beiträge
 
Delphi 11 Alexandria
 
#7

AW: WebActionItems - oder kurz vor dem Durchdrehen

  Alt 30. Aug 2016, 09:51
Hi Jumpy
Zitat:
Eigentlich sollte es so sein, das jeder Request für sich abgehandelt wird, ohne von vorhergehenden Request etwas wissen zu müssen
Das ist so.
Zitat:
PS: Ein Gedanke, bzw. einige nicht genügend beachtete Quelltextzeilen: Wenn der Browser im geladenen HTML ein src-Tag(..) findet, setzt er eine neue Anforderung ab. Hab ich übersehen, dass das Webmodul nach jeder Antwort deaktiviert und somit immer wieder neu aktiviert wird? Das würde bedeuten, dass auch eine Pageproducer.Content/Contentstream-Antwort eigentlich in einer Criticalsection abläüft...
Hatte ich beim schreiben dieser Zeilen nur mal eben diesen Gedanken, der mir zunächst als nicht mit letzter Sicherheit begründet erschien, so ist das inzwischen anders.
Zitat:
Ich würde einfach mal in jeder Webaction eine Dummy-Antwort zurückliefern lassen ala Response.Content='Webaction123', um zu sehen, ob wirklich die richtige Action feuert. Wenn das schon nicht klappt hast du ein Problem mit den Pathinfos oder im deinem Quellcode.
Das Problem ist nicht, das die falsche Seite (= falsche, aber existierende Pathinfo) angezeigt wird - je nach Pathinfo wird die überhaupt nicht angezeigt, und dann kann man sich den Seitenquelltext im Browser auch nicht über Rechtskllick->Seitenquelltext anzeigen lassen (Firefox - in anderen Browern lautet das entsprechende Item möglicherweise etwas anders).
Als nicht existierende Pathinfo verstehe ich eine solche, die theoretisch auf den ersten Blick korrekt erscheint, dies aber nicht ist, weil sie zuviele/zuwenige Zeichen enthält.

Im Quellcode, so wie er in der Webmodul1-Unit steht, dürfte kaum ein Fehler sein - die Codeschnipsel der für HTML-Seiten zuständigen WebactionItems sind alle gleich. Das war auch bisher der Grund, warum ich mit Code bisher eher zurückhaltend war.

zusammenfalten · markieren
Delphi-Quellcode:
var
  WebModuleClass: TComponentClass = TWebModule1;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}


{$R *.dfm}

uses ServerMethodsUnit1, Web.WebReq, DSServerMainUnit;

{-------------------------------OnAction-Events-------------------------------}
procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
if Request.PathInfo = '/' then
  WebModule1WebActHomeAction(Self,Request,Response,Handled);
if Request.PathInfo = '/html/DasWaldenburgerJuwel.html' then
  WebModule1WACWaldenburgerjuwelAction(Self,Request,Response,Handled);
end;

procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  var PathInformation: String;
begin
  PathInformation := Request.PathInfo;
  if Containstext(PathInformation, 'Images') then
  begin
    Self.ActionByName('WACImageItem').PathInfo := Request.PathInfo; // Hier wird ein WebactionItem aufgerufen,ddessen Pathinfoproperty
  end; // zur Entwurfszeit nicht belegt wurde und das jedes Bild - ob
  Handled := False; // Hintergrund oder Grafik - lädt.
end;

procedure TWebModule1.WebModule1WebActHomeAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := Self.PageProducerHome.Content;
  Response.SendResponse;
end;

procedure TWebModule1.WebModule1WACImageItemAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    var fs : tFileStream; sFile : String;
begin
  try
    sFile := 'E:\DelphiXE8 Corner\DelphiXE8VclCorner\DelborWebserverXE8\DelborDataSnapServer' + Request.PathInfo;
    fs := tFileStream.Create(sFile,fmOpenRead);
    try
      Response.ContentType := 'image/jpeg';
      Response.SendStream(fs);
      Response.SendResponse;
    except
      On e : Exception Do Response.Content := '<HTML><BODY>' + e.Message + '</BODY></HTML>';
    end;
  finally
    fs.Free;
  end;
end;

procedure TWebModule1.WebModule1WACWaldenburgerjuwelAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := PageProducerWaldenburg.Content;
  Response.SendResponse;
end;

procedure TWebModule1.WebModule1WebActRomanticeRoadAction(Sender: TObject; // 2. Act
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := PageProducerRomanticRR.Content;
  Response.SendResponse;
end;

procedure TWebModule1.WebModule1WACBischofzellerRosenwocheAction(
  Sender: TObject; Request: TWebRequest; Response: TWebResponse;
  var Handled: Boolean);
begin
  Response.Content := Self.PageProducerRosenwochen.Content;
  Response.SendResponse;
end;

procedure TWebModule1.WebModule1WACFrhlingserwachenAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := Self.PageProducerFruehlingserwachen.Content;
  Response.SendResponse;
end;

procedure TWebModule1.WebModule1WACDSC_4414Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    var fs : tFileStream; sFile : String;
begin
  if Request.PathInfo = '/Images/DVZO/jpeg 250/DSC_4414.jpg' then
  begin
    try
      sFile := 'E:\DelphiXE8 Corner\DelphiXE8VclCorner\DelborWebserverXE8\DelborDataSnapServer' + Request.PathInfo;
      fs := tFileStream.Create(sFile,fmOpenRead);
      try
        Response.ContentType := 'image/jpeg';
        Response.SendStream(fs);
        Response.SendResponse;
      except
        On e : Exception Do Response.Content := '<HTML><BODY>' + e.Message + '</BODY></HTML>';
      end;
    finally
      fs.Free;
    end;
  end;
end;

procedure TWebModule1.WebModule1WACDSC_4415Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    var fs : tFileStream; sFile : String;
begin
  if Request.PathInfo = '/Images/DVZO/jpeg 250/DSC_4415.jpg' then
  begin
    try
      sFile := 'E:\DelphiXE8 Corner\DelphiXE8VclCorner\DelborWebserverXE8\DelborDataSnapServer' + Request.PathInfo;
      fs := tFileStream.Create(sFile,fmOpenRead);
      try
        Response.ContentType := 'image/jpeg';
        Response.SendStream(fs);
        Response.SendResponse;
      except
        On e : Exception Do Response.Content := '<HTML><BODY>' + e.Message + '</BODY></HTML>';
      end;
    finally
      fs.Free;
    end;
  end;
end;

procedure TWebModule1.WebModule1WebActBackgroundItem2Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    var fs : tFileStream; sFile : String;
begin
  if Request.PathInfo = '/Images/background/bgblue.jpg' then
  begin
    try
      sFile := 'E:\DelphiXE8 Corner\DelphiXE8VclCorner\DelborWebserverXE8\DelborDataSnapServer' + Request.PathInfo;
      fs := tFileStream.Create(sFile,fmOpenRead);
      try
        Response.ContentType := 'image/jpeg';
        Response.SendStream(fs);
        Response.SendResponse;
      except
        On e : Exception Do Response.Content := '<HTML><BODY>' + e.Message + '</BODY></HTML>';
      end;
    finally
      fs.Free;
    end;
  end;
end; // 4 . Act

procedure TWebModule1.WebModule1WebActLogoitemAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    var fs : tFileStream; sFile, BGdPath : String;
begin
  try
    sFile := 'E:\DelphiXE8 Corner\DelphiXE8VclCorner\DelborWebserverXE8\DelborDataSnapServer' + Request.PathInfo;
    fs := tFileStream.Create(sFile,fmOpenRead);
    try
      Response.ContentType := 'image/jpeg';
      Response.SendStream(fs);
      Response.SendResponse;
    except
      On e : Exception Do Response.Content := '<HTML><BODY>' + e.Message + '</BODY></HTML>';
    end;
  finally
    fs.Free;
  end;
end;

procedure TWebModule1.PageProducerBahnhofsFestWattwilHTMLTag(Sender: TObject;
  Tag: TTag; const TagString: string; TagParams: TStrings;
  var ReplaceText: string);
begin
// Der hier fehlende Code fügt die CSS-Texte für das Seitenlayout und das Menue-CSS in dieSeiten ein
end;

procedure TWebModule1.PageProducerHomeHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
  if TagString = 'DELBORHOMECSS' then
    ReplaceText := PageProducerHomeCSS.Content;
  if Tagstring = 'MENUE' then
    ReplaceText := PageProducerMenueCSS.Content;
  if tagstring = 'Requestausgabe' then
    ReplaceText := PageproducerRequest.Content;
end;

procedure TWebModule1.PageProducerLogoHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: string; TagParams: TStrings; var ReplaceText: string);
    var fs : tFileStream; sFile, BGdPath : String;
begin
  try
    sFile := 'E:\DelphiXE8%20Corner\DelphiXE8VclCorner\DelborWebserverXE8\DelborDataSnapServer\Images\Logo\Delbor_9_5.jpg';
    fs := tFileStream.Create(sFile,fmOpenRead);
    try
      Response.ContentType := 'image/jpeg';
      Response.SendStream(fs);
      Response.SendResponse;
    except
      On e : Exception Do Response.Content := '<HTML><BODY>' + e.Message + '</BODY></HTML>';
    end;
  finally
    fs.Free;
  end;
end;

procedure TWebModule1.PageProducerRomanticRRHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
  if TagString = 'ROMANTICSPURCSS' then
    ReplaceText := Self.PageProducerFotoGaleryCSS.Content; //PageProducerRoundCol.Content;
  if Tagstring = 'MENUE' then
    ReplaceText := PageProducerMenueCSS.Content;
end;

procedure TWebModule1.PageProducerRosenwochenHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
  if TagString = 'DELBORHOMECSS' then
    ReplaceText := PageProducerHomeCSS.Content;
  if TagString = 'ROMANTICSPURCSS' then
    ReplaceText := PageProducerHomeCSS.Content;
  if Tagstring = 'MENUE' then
    ReplaceText := PageProducerMenueCSS.Content;
  if Tagstring = 'Picture' then
    ReplaceText := PageProducerFotoGaleryCSS.Content;
end;

procedure TWebModule1.PageProducerWaldenburgHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
  if TagString = 'DELBORHOMECSS' then
    ReplaceText := PageProducerHomeCSS.Content;
  if TagString = 'ROMANTICSPURCSS' then
    ReplaceText := PageProducerHomeCSS.Content;
  if Tagstring = 'MENUE' then
    ReplaceText := PageProducerMenueCSS.Content;
  if Tagstring = 'Picture' then
    ReplaceText := PageProducerFotoGaleryCSS.Content;
end;

procedure TWebModule1.WebModule1WebActionRequestAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  Var Page : TStringList;
begin
  Page := TStringList.Create;
  Try
    Page.Add('<html>');
    Page.Add('<head>');
    Page.Add('<title>');
    Page.Add('Testseite');
    Page.Add('</title>');
    Page.Add('</head>');
    Page.Add('<body>');
    Page.Add('<hr />');
    Page.Add('Request-Info<br /><br />');
    Page.Add('Request.Accept: ' + Request.Accept + '<br />');
    Page.Add('Request.Authorization: ' + Request.Authorization + '<br />');
    Page.Add('Request.CacheControl: ' + Request.CacheControl + '<br />');
    Page.Add('Request.Connection: ' + Request.Connection + '<br />');
    Page.Add('Request.Content: ' + Request.Content + '<br />');
    Page.Add('Request.ContentEncoding: ' + Request.ContentEncoding + '<br />');
    Page.Add('Request.ContentFields.Text: ' + Request.ContentFields.Text + '<br />');
    Page.Add('Request.ContentLength: ' + IntToStr(Request.ContentLength) + '<br />');
    Page.Add('Request.ContentType: ' + Request.ContentType + '<br />');
    Page.Add('Request.ContentVersion: ' + Request.ContentVersion + '<br />');
    Page.Add('Request.Cookie: ' + Request.Cookie + '<br />');
    Page.Add('Request.CookieFields.Text: ' + Request.CookieFields.Text + '<br />');
    Page.Add('Request.Date: ' + DateToStr(Request.Date) + '<br />');
    Page.Add('Request.DerivedFrom: ' + Request.DerivedFrom + '<br />');
    Page.Add('Request.Expires: ' + DateToStr(Request.Expires) + '<br />');
    Page.Add('Request.From: ' + Request.From + '<br />');
    Page.Add('Request.Host: ' + Request.Host + '<br />');
    Page.Add('Request.IfModifiedSince: ' + DateToStr(Request.IfModifiedSince) + '<br />');
    Page.Add('Request.InternalPathInfo: ' + Request.InternalPathInfo + '<br />');
    Page.Add('Request.InternalScriptName: ' + Request.InternalScriptName + '<br />');
    Page.Add('Request.Method: ' + Request.Method + '<br />');
    Page.Add('Request.PathInfo: ' + Request.PathInfo + '<br />');
    Page.Add('Request.PathTranslated: ' + Request.PathTranslated + '<br />');
    Page.Add('Request.ProtocolVersion: ' + Request.ProtocolVersion + '<br />');
    Page.Add('Request.Query: ' + Request.Query + '<br />');
    Page.Add('Request.QueryFields.Text: ' + Request.QueryFields.Text + '<br />');
    Page.Add('Request.Referer: ' + Request.Referer + '<br />');
    Page.Add('Request.RemoteAddr:' + Request.RemoteAddr + '<br />');
    Page.Add('Request.RemoteHost: ' + Request.RemoteHost + '<br />');
    Page.Add('Request.ScriptName: ' + Request.ScriptName + '<br />');
    Page.Add('Request.ServerPort: ' + IntToStr(Request.ServerPort) + '<br />');
    Page.Add('Request.URL: ' + Request.URL + '<br />');
    Page.Add('Request.UserAgent: ' + Request.UserAgent + '<br />');
    Page.Add('<hr>');
    Page.Add('</body>');
    Page.Add('</html>');
    Page.Add('');
    Page.Add('');
    Response.Content := Page.Text;
    Response.SendResponse;
  finally
    Page.Free;
  end;

end;

procedure TWebModule1.DSAuthenticationManager1UserAuthenticate(
  Sender: TObject; const Protocol, Context, User, Password: string;
  var valid: Boolean; UserRoles: TStrings);
begin
  valid := True;
end;

procedure TWebModule1.DSAuthenticationManager1UserAuthorize(
  Sender: TObject; EventObject: TDSAuthorizeEventObject;
  var valid: Boolean);
begin
  valid := True;
end;

procedure TWebModule1.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit1.TServerMethods1;
end;

initialization
finalization
  Web.WebReq.FreeWebModules;

end.
Soweit mal der Pascal-Quelltext. Die zuständigen PageProducer.HTMLFilepfade habe ich aus der Adresszeile des Explorers kopiert und um den Dateinamen ergänzt. Soweit ich das in Erinnerung habe, müssen dabei nicht mal die Backslashes ersetzt werden.
Für das beschriebene Phänomen scheint es also wirklich keinen Grund zu geben.

Gruss
Delbor
Roger
Man muss und kann nicht alles wissen - man muss nur wissen, wo es steht.
Frei nach Albert Einstein
http://roase.ch
  Mit Zitat antworten Zitat
 

« Vorheriges Thema | Nächstes Thema »

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 07:34 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