email server created with EM.ini in config folder, updated navbar to animate…

email server created with EM.ini in config folder, updated navbar to animate when scrolling, added footer links

EMSystemsEmailServer/Config/EM.ini

+[SMTP]
+Host=gator3304.hostgator.com
+Port=465
+Username=webmaster@efxcurrencyexchange.com
+Password=U51-M7KhiEMj
+FromEmail=webmaster@efxcurrencyexchange.com
+RecipientEmail=mac@em-sys.net
\ No newline at end of file

EMSystemsEmailServer/XDataEmailServer/Common.Logging.pas

+unit Common.Logging;
+
+interface
+
+uses
+  Generics.Collections;
+
+type
+  ILog = interface;
+  ILogAppender = interface;
+
+  ILogger = interface
+    ['{4D667DD2-BE11-496B-B92A-C47E03520BD6}']
+    procedure Log(logLevel: integer; Msg: string); overload;
+    procedure Log(logLevel: integer; Log: ILog); overload;
+    procedure AddAppender(ALogAppender: ILogAppender);
+    function Appenders: TArray<ILogAppender>;
+  end;
+
+  ILogAppender = interface
+    ['{A3B7D6FB-C75F-4BEF-8797-907B6FDAD5D2}']
+    procedure Send(logLevel: integer; Log: ILog);
+  end;
+
+  ILog = interface
+    ['{8E9C6580-C099-47C0-8B1B-6D7A28EC4FA3}']
+    function GetMessage: string;
+  end;
+
+  TLogger = class( TInterfacedObject, ILogger )
+  strict private
+    FAppenders: TList<ILogAppender>;
+  public
+    constructor Create; overload;
+    constructor Create(ALogger: ILogger); overload;
+    destructor Destroy; override;
+    procedure Log(logLevel: integer; Msg: string); overload;
+    procedure Log(logLevel: integer; Log: ILog); overload;
+    procedure AddAppender(ALogAppender: ILogAppender);
+    function Appenders: TArray<ILogAppender>;
+  end;
+
+  TLogMessage = class( TInterfacedObject, ILog )
+  private
+    FMsg: string;
+  public
+    constructor Create(AMsg: string);
+    function GetMessage: string;
+  end;
+
+  function Logger: ILogger;
+
+implementation
+
+var
+  _Logger: ILogger;
+
+function Logger: ILogger;
+begin
+  Result := _Logger;
+end;
+
+{ TLogMessage }
+
+constructor TLogMessage.Create(AMsg: string);
+begin
+  FMsg := AMsg;
+end;
+
+function TLogMessage.GetMessage: string;
+begin
+  Result := FMsg;
+end;
+
+{ TLogger }
+
+procedure TLogger.AddAppender(ALogAppender: ILogAppender);
+begin
+  FAppenders.Add(ALogAppender);
+end;
+
+function TLogger.Appenders: TArray<ILogAppender>;
+var
+  I: integer;
+begin
+  SetLength(Result, FAppenders.Count);
+  for I := 0 to FAppenders.Count - 1 do
+    Result[I] := FAppenders[I];
+end;
+
+constructor TLogger.Create(ALogger: ILogger);
+var
+  Appender: ILogAppender;
+begin
+  FAppenders := TList<ILogAppender>.Create;
+  if ALogger <> nil then
+    for Appender in ALogger.Appenders do
+      AddAppender(Appender);
+end;
+
+constructor TLogger.Create;
+begin
+  Create(nil);
+end;
+
+destructor TLogger.Destroy;
+begin
+  FAppenders.Free;
+  inherited;
+end;
+
+procedure TLogger.Log(logLevel: integer; Log: ILog);
+var
+  Appender: ILogAppender;
+begin
+  for Appender in FAppenders do
+    Appender.Send(logLevel, Log);
+end;
+
+procedure TLogger.Log(logLevel: integer; Msg: string);
+begin
+  Log(logLevel, TLogMessage.Create(Msg));
+end;
+
+initialization
+  _Logger := TLogger.Create;
+
+end.

EMSystemsEmailServer/XDataEmailServer/Data.pas

+unit Data;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, AdvUtil, Data.DB, Vcl.Grids, AdvObj,
+  BaseGrid, AdvGrid, DBAdvGrid, MemDS, DBAccess, Uni;
+
+type
+  TFData = class(TForm)
+    DBAdvGrid1: TDBAdvGrid;
+    DataSource1: TDataSource;
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  FData: TFData;
+
+implementation
+
+{$R *.dfm}
+
+end.

EMSystemsEmailServer/XDataEmailServer/Database.dfm

+object FDatabaseModule: TFDatabaseModule
+  Height = 480
+  Width = 640
+  object ucBooking: TUniConnection
+    ProviderName = 'PostgreSQL'
+    Username = 'admin'
+    Server = 'w11db03'
+    LoginPrompt = False
+    Left = 41
+    Top = 63
+    EncryptedPassword = '8FFF90FF8CFF8BFF98FF8DFF9AFFACFFAEFFB3FF'
+  end
+  object PostgreSQLUniProvider1: TPostgreSQLUniProvider
+    Left = 230
+    Top = 32
+  end
+  object UniQuery1: TUniQuery
+    Connection = ucBooking
+    Left = 363
+    Top = 138
+  end
+end

EMSystemsEmailServer/XDataEmailServer/Database.pas

+unit Database;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, Data.DB, MemDS, DBAccess, Uni, UniProvider,
+  PostgreSQLUniProvider;
+
+type
+  TFDatabaseModule = class(TDataModule)
+    ucBooking: TUniConnection;
+    PostgreSQLUniProvider1: TPostgreSQLUniProvider;
+    UniQuery1: TUniQuery;
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    class procedure ExecSQL(const SQL: string);
+  end;
+
+var
+  FDatabaseModule: TFDatabaseModule;
+
+implementation
+
+{%CLASSGROUP 'Vcl.Controls.TControl'}
+
+{$R *.dfm}
+
+class procedure TFDatabaseModule.ExecSQL(const SQL: string);
+var
+  DB: TFDatabaseModule;
+begin
+  DB := TFDatabaseModule.Create(nil);
+  try
+    DB.UniQuery1.SQL.Text := SQL;
+    DB.UniQuery1.ExecSQL;
+  finally
+    DB.Free;
+  end;
+end;
+
+end.

EMSystemsEmailServer/XDataEmailServer/Email.Service.pas

+unit Email.Service;
+
+interface
+
+uses
+  XData.Service.Common;
+
+type
+  [ServiceContract]
+  IEmailService = interface(IInvokable)
+  ['{46B3B095-5873-4452-B338-AEE009604DED}']
+    [HttpGet]
+    function SendEmail(Name, Email, Subject, Body: string): string;
+  end;
+
+implementation
+
+end.

EMSystemsEmailServer/XDataEmailServer/Email.ServiceImpl.pas

+unit Email.ServiceImpl;
+
+interface
+
+uses
+  XData.Server.Module,
+  XData.Service.Common,
+
+  IdSMTP, IdMessage, IdSSLOpenSSL, IdText, IdExplicitTLSClientServerBase,
+  IdIOHandlerSocket, IdException, IdSSL, IdSMTPBase, IdGlobal, IdStack, IdWinsock2,
+  IdStackConsts, IdIOHandler, IdIOHandlerStack, IdBaseComponent,
+  IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient,
+
+  Email.Service;
+
+type
+  [ServiceImplementation]
+  TEmailService = class(TInterfacedObject, IEmailService)
+  public
+    function SendEmail(Name, Email, Subject, Body: string): string;
+  end;
+
+implementation
+
+uses
+  System.SysUtils,
+  System.IniFiles,
+  Main;
+
+
+function TEmailService.SendEmail(Name, Email, Subject, Body: string): string;
+var
+  SMTP: TIdSMTP;
+  Message: TIdMessage;
+  SSL: TIdSSLIOHandlerSocketOpenSSL;
+  EMIni: TIniFile;
+begin
+  EMIni := TIniFile.Create('C:\Projects\emsystemsweb\EMSystemsEmailServer\Config\EM.ini');
+  try
+    SMTP := TIdSMTP.Create(nil);
+    try
+      Message := TIdMessage.Create(nil);
+      try
+        if not EMIni.SectionExists('SMTP') then
+          raise Exception.Create('Configuration section [SMTP] not found.');
+
+        SMTP.Host := EMIni.ReadString('SMTP', 'Host', '');
+        if SMTP.Host = '' then
+          raise Exception.Create('SMTP Host is not configured.');
+
+        SMTP.Port := EMIni.ReadInteger('SMTP', 'Port', 0);
+        if SMTP.Port = 0 then
+          raise Exception.Create('SMTP Port is not configured or invalid.');
+
+        SMTP.Username := EMIni.ReadString('SMTP', 'Username', '');
+        if SMTP.Username = '' then
+          raise Exception.Create('SMTP Username is not configured.');
+
+        SMTP.Password := EMIni.ReadString('SMTP', 'Password', '');
+        if SMTP.Password = '' then
+          raise Exception.Create('SMTP Password is not configured.');
+
+        Message.From.Address := EMIni.ReadString('SMTP', 'FromEmail', '');
+        if Message.From.Address = '' then
+          raise Exception.Create('SMTP From Email is not configured.');
+
+        Message.Recipients.EmailAddresses := EMIni.ReadString('SMTP', 'RecipientEmail', '');
+        if Message.Recipients.EmailAddresses = '' then
+          raise Exception.Create('SMTP Recipient Email is not configured.');
+
+        Message.Subject := Subject;
+        Message.Body.Text := Format(
+          '<html><body>' +
+          '<h4>Message from: %s (%s)</h4>' +
+          '<p>%s</p>' +
+          '</body></html>',
+          [Name, Email, Body.Replace(sLineBreak, '<br>')]);
+        Message.ContentType := 'text/html';
+
+        SSL := TIdSSLIOHandlerSocketOpenSSL.Create(SMTP);
+        SMTP.IOHandler := SSL;
+        SMTP.UseTLS := utUseImplicitTLS;
+
+        SMTP.Connect;
+        SMTP.Send(Message);
+        SMTP.Disconnect;
+
+        FMain.ContactFormData('Email Data:' + sLineBreak +
+                              'Name: ' + Name + sLineBreak +
+                              'Email: ' + Email + sLineBreak +
+                              'Subject: ' + Subject + sLineBreak +
+                              'Message: ' + Body);
+
+      finally
+        Message.Free;
+      end;
+    finally
+      SMTP.Free;
+    end;
+  finally
+    EMIni.Free;
+  end;
+  Result := 'Email sent successfully';
+end;
+
+
+
+
+initialization
+  RegisterServiceType(TEmailService);
+
+end.
+

EMSystemsEmailServer/XDataEmailServer/Main.dfm

+object FMain: TFMain
+  Left = 0
+  Top = 0
+  Caption = 'TMS XData Server'
+  ClientHeight = 583
+  ClientWidth = 764
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OnCreate = FormCreate
+  DesignSize = (
+    764
+    583)
+  TextHeight = 13
+  object memoInfo: TMemo
+    Left = 8
+    Top = 40
+    Width = 744
+    Height = 535
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    ReadOnly = True
+    TabOrder = 0
+  end
+  object btStart: TButton
+    Left = 8
+    Top = 8
+    Width = 75
+    Height = 25
+    Caption = 'Start'
+    TabOrder = 1
+    OnClick = btStartClick
+  end
+  object btStop: TButton
+    Left = 90
+    Top = 8
+    Width = 75
+    Height = 25
+    Caption = 'Stop'
+    TabOrder = 2
+    OnClick = btStopClick
+  end
+  object btnSwaggerUI: TButton
+    Left = 297
+    Top = 8
+    Width = 128
+    Height = 25
+    Caption = 'Launch SwaggerUI'
+    TabOrder = 3
+    OnClick = btnSwaggerUIClick
+  end
+  object btnData: TButton
+    Left = 525
+    Top = 8
+    Width = 75
+    Height = 25
+    Caption = 'Data'
+    TabOrder = 4
+    OnClick = btnDataClick
+  end
+  object btnExit: TButton
+    Left = 671
+    Top = 8
+    Width = 75
+    Height = 25
+    Caption = 'Exit'
+    TabOrder = 5
+    OnClick = btnExitClick
+  end
+  object Timer1: TTimer
+    Interval = 250
+    Left = 159
+    Top = 405
+  end
+end

EMSystemsEmailServer/XDataEmailServer/Main.pas

+unit Main;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Winapi.ShellApi,
+  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
+  Vcl.StdCtrls, Server.Container, Vcl.ExtCtrls;
+
+type
+  TFMain = class(TForm)
+    memoInfo: TMemo;
+    btStart: TButton;
+    btStop: TButton;
+    btnSwaggerUI: TButton;
+    btnData: TButton;
+    btnExit: TButton;
+    Timer1: TTimer;
+    procedure btStartClick(ASender: TObject);
+    procedure btStopClick(ASender: TObject);
+    procedure FormCreate(ASender: TObject);
+    procedure btnSwaggerUIClick(Sender: TObject);
+    procedure btnDataClick(Sender: TObject);
+    procedure btnExitClick(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
+    procedure ContactFormData(AText: String);
+  strict private
+    procedure UpdateGUI;
+    function ServerUrl: string;
+  end;
+
+var
+  FMain: TFMain;
+
+implementation
+
+uses
+  Common.Logging,
+  Sparkle.Utils,
+  Data;
+
+
+
+{$R *.dfm}
+
+resourcestring
+  SServerStopped = 'Server stopped';
+  SServerStartedAt = 'Server started at ';
+
+{ TMainForm }
+
+procedure TFMain.ContactFormData(AText: String);
+begin
+  if memoInfo.CanFocus then
+    TThread.Queue(nil, procedure
+    begin
+      memoInfo.Lines.Add(AText);
+    end)
+  else
+    TThread.Synchronize(nil, procedure
+    begin
+      memoInfo.Lines.Add(AText);
+    end);
+end;
+
+procedure TFMain.btnDataClick(Sender: TObject);
+begin
+  FData := TFData.Create( self );
+  FData.ShowModal;
+  FData.Free;
+end;
+
+procedure TFMain.btnExitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TFMain.btnSwaggerUIClick(Sender: TObject);
+begin
+  ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(ServerUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL);
+end;
+
+procedure TFMain.btStartClick(ASender: TObject);
+begin
+  FServerContainer.SparkleHttpSysDispatcher.Start;
+  UpdateGUI;
+end;
+
+procedure TFMain.btStopClick(ASender: TObject);
+begin
+  FServerContainer.SparkleHttpSysDispatcher.Stop;
+  UpdateGUI;
+end;
+
+function TFMain.ServerUrl: string;
+const
+  cHttp = 'http://+';
+  cHttpLocalhost = 'http://localhost';
+begin
+  Result := StringReplace(FServerContainer.XDataServer.BaseUrl,
+    cHttp, cHttpLocalhost, [rfIgnoreCase]);
+end;
+
+procedure TFMain.Timer1Timer(Sender: TObject);
+begin
+  Timer1.Enabled := False;
+  Logger.Log( 3, 'Timer1Timer event' );
+  UpdateGUI;
+end;
+
+procedure TFMain.FormCreate(ASender: TObject);
+begin
+  UpdateGUI;
+end;
+
+procedure TFMain.UpdateGUI;
+const
+  cHttp = 'http://+';
+  cHttpLocalhost = 'http://localhost';
+begin
+  btStart.Enabled := not FServerContainer.SparkleHttpSysDispatcher.Active;
+  btStop.Enabled := not btStart.Enabled;
+  if FServerContainer.SparkleHttpSysDispatcher.Active then
+    memoInfo.Lines.Add(SServerStartedAt + StringReplace(
+      FServerContainer.XDataServer.BaseUrl,
+      cHttp, cHttpLocalhost, [rfIgnoreCase]))
+  else
+    memoInfo.Lines.Add(SServerStopped);
+end;
+
+end.

EMSystemsEmailServer/XDataEmailServer/Server.Container.dfm

+object FServerContainer: TFServerContainer
+  Height = 210
+  Width = 431
+  object SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher
+    Active = True
+    Left = 72
+    Top = 16
+  end
+  object XDataServer: TXDataServer
+    BaseUrl = 'http://+:2013/tms/email'
+    Dispatcher = SparkleHttpSysDispatcher
+    EntitySetPermissions = <>
+    SwaggerOptions.Enabled = True
+    SwaggerOptions.AuthMode = Jwt
+    SwaggerUIOptions.Enabled = True
+    SwaggerUIOptions.ShowFilter = True
+    SwaggerUIOptions.TryItOutEnabled = True
+    Left = 216
+    Top = 16
+    object XDataServerBasicauth: TSparkleBasicAuthMiddleware
+      Realm = 'TMS Sparkle Server'
+      OnAuthenticate = XDataServerBasicauthAuthenticate
+    end
+    object XDataServerCompress: TSparkleCompressMiddleware
+    end
+    object XDataServerCORS: TSparkleCorsMiddleware
+    end
+  end
+end

EMSystemsEmailServer/XDataEmailServer/Server.Container.pas

+unit Server.Container;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, Sparkle.HttpServer.Module,
+  Sparkle.HttpServer.Context, Sparkle.Comp.Server,
+  Sparkle.Comp.HttpSysDispatcher, Aurelius.Drivers.Interfaces,
+  Aurelius.Comp.Connection, XData.Comp.ConnectionPool, XData.Server.Module,
+  XData.Comp.Server, Sparkle.Comp.GenericMiddleware, Sparkle.Comp.JwtMiddleware,
+  Sparkle.Comp.BasicAuthMiddleware, Sparkle.Comp.CorsMiddleware,
+  Sparkle.Comp.CompressMiddleware, IdBaseComponent, IdComponent,
+  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient,
+  IdSMTPBase, IdSMTP, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL,
+  IdSSLOpenSSL;
+
+type
+  TFServerContainer = class(TDataModule)
+    SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher;
+    XDataServer: TXDataServer;
+    XDataServerBasicauth: TSparkleBasicAuthMiddleware;
+    XDataServerCompress: TSparkleCompressMiddleware;
+    XDataServerCORS: TSparkleCorsMiddleware;
+    XDataServerGeneric: TSparkleGenericMiddleware;
+    procedure XDataServerBasicauthAuthenticate(Sender: TObject; const UserName,
+      Password: string; var User: IUserIdentity);
+    procedure XDataServerGenericRequest(Sender: TObject;
+      Context: THttpServerContext; Next: THttpServerProc);
+  end;
+
+var
+  FServerContainer: TFServerContainer;
+
+implementation
+
+{%CLASSGROUP 'Vcl.Controls.TControl'}
+
+{$R *.dfm}
+
+
+procedure TFServerContainer.XDataServerBasicauthAuthenticate(Sender: TObject;
+  const UserName, Password: string; var User: IUserIdentity);
+begin
+  if (UserName = 'admin') and (Password = 'password') then
+  begin
+    User := TUserIdentity.Create;
+    User.Claims.AddOrSet('username', UserName);
+    User.Claims.AddOrSet('roles', 'admin'); // arbitrary info you might want to add
+  end;
+end;
+
+procedure TFServerContainer.XDataServerGenericRequest(Sender: TObject;
+  Context: THttpServerContext; Next: THttpServerProc);
+begin
+  // does not allow anonymous requests
+  if Context.Request.User = nil then
+    Context.Response.StatusCode := 401
+  else
+    Next(Context);
+end;
+
+end.