Commit 1ae1c49a by Mac Stephens

updated client to sync with xdataemailservice server, configuring basic auth

parent 5273b770
......@@ -6,7 +6,7 @@
"configurations": [
{
"preLaunchTask": "Build",
"type": "msedge",
"type": "chrome",
"request": "launch",
"name": "Run",
"url": "http://localhost:${command:rad4.tms.web.port.debug}/${command:rad4.tms.getcurrentproject.html.file}",
......@@ -15,7 +15,7 @@
},
{
"preLaunchTask": "Build",
"type": "msedge",
"type": "chrome",
"request": "launch",
"name": "Run Without Debugging",
"url": "http://localhost:${command:rad4.tms.web.port.release}/${command:rad4.tms.getcurrentproject.html.file}",
......
{"tms":{"desktop":{"theme":"auto","layouts":{},"active":" "},"packages":{"installed":{"k0webcore":{"name":"TMS WEB Core","path":"core\\webcore.twcl","checked":true}}},"formDesigner":{"gridOptions":{"displayGrid":"true","useDesignerGuidelines":"true","snapToGrid":"true","gridSizeX":8,"gridSizeY":8},"options":{"showComponentCaptions":"true","showDesignerHints":"true","showExtendedControlHints":"true","showNonVisualComponents":"true","deleteEmptyEventHandlersOnSave":"true"}},"options":{"electron":{"debug":{"port":"9223","delay":"3","timeout":"10000"}},"automaticallyCopyFileExtensions":"","outputPath":".\\$(Platform)\\$(Config)","singleJavascriptFile":"","ecmaScript":""}},"omnipascal":{"delphiInstallationPath":"","freePascalSourcePath":"","defaultDevelopmentEnvironment":"Delphi","searchPath":"c:\\Users\\Admin\\.vscode\\extensions\\tmssoftware.tmswebcore-2.5.7377\\resources\\coresource\\*","msbuildPath":"","lazbuildPath":"","createBuildScripts":false,"symbolIndex":"workspace","usesListStyle":"multipleItemsPerLine","namingConventionString":"pascalCase"}}
\ No newline at end of file
{"tms":{"desktop":{"theme":"auto","layouts":{"Default Desktop":"{\"dockbox\":{\"id\":\"docklayoutbase\",\"size\":200,\"mode\":\"horizontal\",\"children\":[{\"id\":\"leftlayout\",\"size\":300,\"mode\":\"vertical\",\"children\":[{\"id\":\"+1\",\"size\":200,\"tabs\":[{\"id\":\"structure\"}],\"activeId\":\"structure\"},{\"id\":\"+2\",\"size\":200,\"tabs\":[{\"id\":\"objectinspector\"}],\"activeId\":\"objectinspector\"}]},{\"id\":\"+3\",\"size\":1000,\"tabs\":[{\"id\":\"documentgroup\"}],\"activeId\":\"documentgroup\"},{\"id\":\"rightlayout\",\"size\":250,\"tabs\":[{\"id\":\"toolpalette\"}],\"activeId\":\"toolpalette\"}]},\"floatbox\":{\"id\":\"+4\",\"size\":1,\"mode\":\"float\",\"children\":[]},\"maxbox\":{\"id\":\"+5\",\"size\":1,\"mode\":\"maximize\",\"children\":[]}}"},"active":"Default Desktop"},"packages":{"installed":{"k0webcore":{"name":"TMS WEB Core","path":"core\\webcore.twcl","checked":true}}},"formDesigner":{"gridOptions":{"displayGrid":"true","useDesignerGuidelines":"true","snapToGrid":"true","gridSizeX":8,"gridSizeY":8},"options":{"showComponentCaptions":"true","showDesignerHints":"true","showExtendedControlHints":"true","showNonVisualComponents":"true","deleteEmptyEventHandlersOnSave":"true"}},"options":{"electron":{"debug":{"port":"9223","delay":"3","timeout":"10000"}},"automaticallyCopyFileExtensions":"","outputPath":".\\$(Platform)\\$(Config)","singleJavascriptFile":"","ecmaScript":""}},"omnipascal":{"delphiInstallationPath":"","freePascalSourcePath":"","defaultDevelopmentEnvironment":"Delphi","searchPath":"c:\\Users\\Admin\\.vscode\\extensions\\tmssoftware.tmswebcore-2.5.7377\\resources\\coresource\\*","msbuildPath":"","lazbuildPath":"","createBuildScripts":false,"symbolIndex":"workspace","usesListStyle":"multipleItemsPerLine","namingConventionString":"pascalCase"}}
\ No newline at end of file
......@@ -5,8 +5,7 @@ uses
WEBLib.Forms,
View.Home in 'View.Home.pas' {FHome: TWebForm} {*.html},
View.Compliance in 'View.Compliance.pas' {FCompliance: TWebForm} {*.html},
View.ContactUs in 'View.ContactUs.pas' {FContactUs: TWebForm} {*.html},
uSmtpJsWrapper in 'uSmtpJsWrapper.pas';
View.ContactUs in 'View.ContactUs.pas' {FContactUs: TWebForm} {*.html};
{$R *.res}
......
......@@ -114,7 +114,6 @@
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="uSmtpJsWrapper.pas"/>
<None Include="TMSWebTemplate.html"/>
<None Include="css\App.css"/>
<None Include="images\bridgewoman.jpg">
......@@ -1004,4 +1003,4 @@
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>
</Project>
\ No newline at end of file
......@@ -11,6 +11,7 @@ object FContactUs: TFContactUs
FormStyle = fsNormal
Height = 1186
Left = 0
OnCreate = FContactUsCreate
TabOrder = 0
Top = 0
Width = 1138
......@@ -171,4 +172,19 @@ object FContactUs: TFContactUs
Top = 458
Width = 100
end
object XDataWebConnection1: TXDataWebConnection
OnConnect = XDataWebConnection1Connect
OnError = XDataWebConnection1Error
OnRequest = XDataWebConnection1Request
URL = 'http://localhost:2013/tms/email'
Left = 137
Top = 923
end
object XDataWebClient1: TXDataWebClient
Connection = XDataWebConnection1
OnError = XDataWebClient1Error
OnRequest = XDataWebClient1Request
Left = 300
Top = 926
end
end
unit View.ContactUs;
unit View.ContactUs;
interface
uses
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls, WebLib.RegularExpressions,
WEBLib.Forms, WEBLib.Dialogs, Vcl.StdCtrls, WEBLib.StdCtrls, Vcl.Controls, WEBLib.Menus;
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
WEBLib.Forms, WEBLib.Dialogs, XData.Web.Client, XData.Web.Connection, Data.DB,
XData.Web.JsonDataset, XData.Web.Dataset, Vcl.Controls, Vcl.Grids,
WEBLib.DBCtrls, WEBLib.DB, WEBLib.Grids, Vcl.StdCtrls, WEBLib.StdCtrls,
WEBLib.ExtCtrls, WEBLib.CDS, WEBLib.REST;
type
TFContactUs = class(TWebForm)
......@@ -16,13 +19,20 @@ type
edtEmail: TWebEdit;
memoMessage: TWebMemo;
edtSubject: TWebEdit;
XDataWebConnection1: TXDataWebConnection;
XDataWebClient1: TXDataWebClient;
procedure WebFormClose(Sender: TObject; var Action: TCloseAction);
procedure btnSubmitClick(Sender: TObject);
procedure XDataWebConnection1Request(Args: TXDataWebConnectionRequest);
procedure FContactUsCreate(Sender: TObject);
procedure XDataWebConnection1Connect(Sender: TObject);
procedure XDataWebClient1Error(error: TXDataClientError);
procedure XDataWebConnection1Error(error: TXDataWebConnectionError);
private
{ Private declarations }
function IsInputValid: Boolean;
function IsEmailValid(AEmail: String): Boolean;
procedure SendEmail;
[async] procedure SendEmail;
public
{ Public declarations }
end;
......@@ -34,7 +44,43 @@ implementation
{$R *.dfm}
uses uSmtpJsWrapper;
procedure TFContactUs.XDataWebConnection1Request(Args: TXDataWebConnectionRequest);
begin
// var
// basicAuthStr: string;
// begin
// asm
// var auth = 'admin:password';
// basicAuthStr = 'Basic ' + window.btoa(auth);
// end;
// Args.Request.Headers.SetValue('Authorization', basicAuthStr);
end;
procedure TFContactUs.XDataWebConnection1Error(error: TXDataWebConnectionError);
begin
ShowMessage('Unauthorized');
end;
procedure TFContactUs.XDataWebConnection1Connect(Sender: TObject);
begin
console.log('Connected to XData server');
end;
procedure TFContactUs.XDataWebClient1Error(Error: TXDataClientError);
begin
console.log('Error: ', Error.ErrorMessage, ' RequestId: ', Error.RequestId, ' Code: ', Error.ErrorCode, ' Request Url: ', Error.RequestUrl);
end;
procedure TFContactUs.FContactUsCreate(Sender: TObject);
begin
console.log('ContactUs form created');
XDataWebConnection1.Connected := True;
end;
procedure TFContactUs.btnSubmitClick(Sender: TObject);
begin
......@@ -48,16 +94,12 @@ begin
end;
end;
procedure TFContactUs.WebFormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
function TFContactUs.IsEmailValid(AEmail: String): Boolean;
const
CPattern = '^\w+([\.-]?w+)*@\w+([\.-]?\w+)*(\.\w{2,3})+$';
begin
Result := TRegEx.IsMatch( AEmail, CPattern );
asm
var regex = new RegExp('^\w+([\.-]?\w+)*@\w+([\.-]?\w+)*(\.\w{2,3})+$');
@Result = regex.test(AEmail);
end;
end;
function TFContactUs.IsInputValid: Boolean;
......@@ -77,14 +119,22 @@ begin
end;
procedure TFContactUs.SendEmail;
var
xdcResponse: TXDataClientResponse;
begin
TSmtpJsWrapper.Send(
'evtestskiclub@gmail.com',
edtName.Text,
edtEmail.Text,
edtSubject.Text,
memoMessage.Lines.Text
);
try
xdcResponse := await(XDataWebClient1.RawInvokeAsync('IEmailService.SendEmail',
[edtName.Text, edtEmail.Text, edtSubject.Text, memoMessage.Text]));
console.log('Email sent successfully');
except
on E: EXDataClientRequestException do
console.log('Error when attempting to send: ' + E.Message);
end;
end;
procedure TFContactUs.WebFormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
initialization
......
unit uSmtpJsWrapper;
interface
type
TSmtpJsWrapper = class
class procedure Send(const ARecipient, AName, ASender, ASubject, ABody: string);
end;
implementation
class procedure TSmtpJsWrapper.Send(const ARecipient, AName, ASender, ASubject, ABody: string);
var
LBody: string;
begin
LBody := AName + #10 + ABody;
// The PAS2JS compiler flag ignores the Delphi compliler, and uses the JavaScript compiler instead
// This allows for the code to run without errors
{$IFDEF PAS2JS}
asm
Email.send({
SecureToken : "...",
To : ARecipient,
From : ASender,
Subject : ASubject,
Body : LBody
}).then(
message => alert(message)
);
end;
{$ENDIF}
end;
end.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment