unit WebModuleUnit1;
interface
uses
System.SysUtils, System.Classes, Web.HTTPApp, Datasnap.DSHTTPCommon,
Datasnap.DSHTTPWebBroker, Datasnap.DSServer,
Web.WebFileDispatcher, Web.HTTPProd,
DataSnap.DSAuth,
Datasnap.DSProxyJavaScript, IPPeerServer, Datasnap.DSMetadata,
Datasnap.DSServerMetadata, Datasnap.DSClientMetadata, Datasnap.DSCommonServer,
Datasnap.DSHTTP;
type
TWebModule1 =
class(TWebModule)
DSHTTPWebDispatcher1: TDSHTTPWebDispatcher;
ServerFunctionInvoker: TPageProducer;
ReverseString: TPageProducer;
WebFileDispatcher1: TWebFileDispatcher;
DSProxyGenerator1: TDSProxyGenerator;
DSServerMetaDataProvider1: TDSServerMetaDataProvider;
procedure ServerFunctionInvokerHTMLTag(Sender: TObject; Tag: TTag;
const TagString:
string; TagParams: TStrings;
var ReplaceText:
string);
procedure WebModuleDefaultAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
procedure WebModuleBeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
procedure WebFileDispatcher1BeforeDispatch(Sender: TObject;
const AFileName:
string; Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
procedure WebModuleCreate(Sender: TObject);
procedure WebModule1WebhookAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
private
{ Private-Deklarationen }
FServerFunctionInvokerAction: TWebActionItem;
function AllowServerFunctionInvoker: Boolean;
public
{ Public-Deklarationen }
end;
var
WebModuleClass: TComponentClass = TWebModule1;
implementation
{$R *.dfm}
uses ServerMethodsUnit1, ServerContainerUnit1, Web.WebReq, uWebhookData;
procedure TWebModule1.ServerFunctionInvokerHTMLTag(Sender: TObject; Tag: TTag;
const TagString:
string; TagParams: TStrings;
var ReplaceText:
string);
begin
if SameText(TagString, '
urlpath')
then
ReplaceText :=
string(Request.InternalScriptName)
else if SameText(TagString, '
port')
then
ReplaceText := IntToStr(Request.ServerPort)
else if SameText(TagString, '
host')
then
ReplaceText :=
string(Request.Host)
else if SameText(TagString, '
classname')
then
ReplaceText := ServerMethodsUnit1.TServerMethods1.ClassName
else if SameText(TagString, '
loginrequired')
then
if DSHTTPWebDispatcher1.AuthenticationManager <>
nil then
ReplaceText := '
true'
else
ReplaceText := '
false'
else if SameText(TagString, '
serverfunctionsjs')
then
ReplaceText :=
string(Request.InternalScriptName) + '
/js/serverfunctions.js'
else if SameText(TagString, '
servertime')
then
ReplaceText := DateTimeToStr(Now)
else if SameText(TagString, '
serverfunctioninvoker')
then
if AllowServerFunctionInvoker
then
ReplaceText :=
'
<div><a href="' +
string(Request.InternalScriptName) +
'
/ServerFunctionInvoker" target="_blank">Server Functions</a></div>'
else
ReplaceText := '
';
end;
procedure TWebModule1.WebModuleDefaultAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
begin
if (Request.InternalPathInfo = '
')
or (Request.InternalPathInfo = '
/')
then
Response.Content := ReverseString.Content
else
Response.SendRedirect(Request.InternalScriptName + '
/');
end;
procedure TWebModule1.WebModule1WebhookAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
var
S:
String;
begin
S := Request.Content;
S := '
Empfangen: ' + S;
// Daten verarbeiten
fWebhook.mmo('
TWebModule1.WebModule1Webhook : ' + Request.Content );
Response.Content := S;
end;
procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
begin
if FServerFunctionInvokerAction <>
nil then
FServerFunctionInvokerAction.Enabled := AllowServerFunctionInvoker;
end;
function TWebModule1.AllowServerFunctionInvoker: Boolean;
begin
Result := (Request.RemoteAddr = '
127.0.0.1')
or
(Request.RemoteAddr = '
0:0:0:0:0:0:0:1')
or (Request.RemoteAddr = '
::1');
end;
procedure TWebModule1.WebFileDispatcher1BeforeDispatch(Sender: TObject;
const AFileName:
string; Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
var
D1, D2: TDateTime;
begin
Handled := False;
if SameFileName(ExtractFileName(AFileName), '
serverfunctions.js')
then
if not FileExists(AFileName)
or (FileAge(AFileName, D1)
and FileAge(WebApplicationFileName, D2)
and (D1 < D2))
then
begin
DSProxyGenerator1.TargetDirectory := ExtractFilePath(AFileName);
DSProxyGenerator1.TargetUnitName := ExtractFileName(AFileName);
DSProxyGenerator1.
Write;
end;
end;
procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
FServerFunctionInvokerAction := ActionByName('
ServerFunctionInvokerAction');
DSServerMetaDataProvider1.Server := DSServer;
DSHTTPWebDispatcher1.Server := DSServer;
if DSServer.Started
then
begin
DSHTTPWebDispatcher1.DbxContext := DSServer.DbxContext;
DSHTTPWebDispatcher1.Start;
end;
DSHTTPWebDispatcher1.AuthenticationManager := DSAuthenticationManager;
end;
initialization
finalization
Web.WebReq.FreeWebModules;
end.