{-------------------------------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;
//Wenn du hier die zur Request passende Action raussuchst und aufrufst, dann müssten da
//aber doch eigentlich auch ein paar mehr stehen, oder? Die Anderen Actions werden sonst
//doch gar nicht aufgerufen.
//Auch die Sache mit dem 'Image' im Pathinfo würde ich dann eher hier unterbringen
//Keine Ahnung ob das schon probiert hast, aber man könnte die Default-Handler Geschichte
//aber auch weglassen, so dass die Anwendung alleine über die Pathinfo die richtige Webaction
//(die wo halt die PathInfo passt) aufruft.
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
//So hier weist du der Action die zum Bild passende PathInfo zu, aber du ruft die Action nicht
//auf, d.h. hier fehlt mMn ein aufruf ala:
WebModule1WACImageItemAction(Self,Request,Response,Handled);
//Beachte aber auch den drunter stehenden Kommentar.
end;
// zur Entwurfszeit nicht belegt wurde und das jedes Bild - ob
Handled := False;
// Hintergrund oder Grafik - lädt.
end;
//BeforeDispatch ist mMn hierfür nicht das richtige Event (s.o.). Im Before-Dispatch
//könnte man den generierten Quellcode nochmal durchsuchen und Dinge darin ersetzen o.ä.
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);
//Hier nicht vllt. besser Response.ContenStream=fs
Response.SendResponse;
except
On e :
Exception Do Response.Content := '
<HTML><BODY>' + e.
Message + '
</BODY></HTML>';
//Ein Bild wird vom Browser angefordert, was aus irgendeinem Grund nicht klappt
//Da nützt es nix, HTML zu schicken, dass wird mMn nicht sinnvoll verarbeitet
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;
//Generell: Warum immer das Response.SendResponse?
//Das kann man doch weglassen. Man weist den Content zu, setzt ggf. noch Handled:=True und fertig.
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;
//Der nächste Block hier macht gar keinen Sinn. Da sollen im PageProducerContent Tags
//erstzt werden und keine Bilder verschickt werden. Ich denke das ist ein Relikt
//aus der Entwicklung. Weg damit:
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;
//Ich denke das ist eine Test-Rückgabe-Funktion???
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;
end.