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.