Componentes.Terceros.RemObjects/internal/5.0.35.741/1/RemObjects SDK for Delphi/Samples/Message Envelopes/MessageEnvelopes_ServerMain.pas

unit MessageEnvelopes_ServerMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  uROClient, uROPoweredByRemObjectsButton, uROClientIntf, uROServer,
  uROBinMessage, uROIndyHTTPServer, uROIndyTCPServer, ActnList, CheckLst,
  ExtCtrls, uROEncryptionEnvelope;

const
  WM_LOG_MESSAGE = WM_APP + 1;
type
  TMessageEnvelopes_ServerMainForm = class(TForm)
    RoPoweredByRemObjectsButton1: TRoPoweredByRemObjectsButton;
    ROMessage: TROBinMessage;
    ROServer: TROIndyHTTPServer;
    Panel2: TPanel;
    bClearLog: TButton;
    Memo1: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    bMoveDown: TButton;
    bMoveUp: TButton;
    bDelete: TButton;
    bUpdate: TButton;
    bAdd: TButton;
    CheckListBox1: TCheckListBox;
    ActionList1: TActionList;
    aAdd: TAction;
    aUpdate: TAction;
    aDelete: TAction;
    aMoveUp: TAction;
    aMoveDown: TAction;
    aTest: TAction;
    procedure FormCreate(Sender: TObject);
    procedure aAddExecute(Sender: TObject);
    procedure aUpdateExecute(Sender: TObject);
    procedure aUpdateUpdate(Sender: TObject);
    procedure aDeleteExecute(Sender: TObject);
    procedure aMoveUpUpdate(Sender: TObject);
    procedure aMoveUpExecute(Sender: TObject);
    procedure aMoveDownUpdate(Sender: TObject);
    procedure aMoveDownExecute(Sender: TObject);
    procedure CheckListBox1ClickCheck(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure WMLog(var Message: TMessage); message WM_LOG_MESSAGE;
    procedure CreateAESEnvelope(AMarker, APass: String; AEnabled: Boolean);
    procedure DoBeforeEnvelopeProcessed(
      AMessageEnvelope: TROMessageEnvelope; AStream: TStream;
      aMode: TROMessageEnvelopeMode; AMessage: IROMessage);
    function GenerateString(AMessageEnvelope: TROAESEncryptionEnvelope): String;
  public
    { Public declarations }
    Procedure Log(Astr: string);
  end;

var
  MessageEnvelopes_ServerMainForm: TMessageEnvelopes_ServerMainForm;

implementation

uses
  MessageEnvelopes_AddEnvelope;
{$R *.dfm}

procedure TMessageEnvelopes_ServerMainForm.FormCreate(Sender: TObject);
begin
  ROServer.Active := true;
  CreateAESEnvelope('Marker A','Password A',True);
  CheckListBox1.ItemIndex := 0;
  CreateAESEnvelope('Marker B','Password B',False);
  CreateAESEnvelope('Marker C','Password C',False);
end;

procedure TMessageEnvelopes_ServerMainForm.aAddExecute(Sender: TObject);
var
  lMarker, lPassword: string;
begin
  lMarker := 'Marker '+ inttoStr(CheckListBox1.Count+1);
  lPassword := 'Password '+ inttoStr(CheckListBox1.Count+1);
  if AddAESEnvelope(lMarker,lPassword) then
    CreateAESEnvelope(lMarker,lPassword,True);
end;

procedure TMessageEnvelopes_ServerMainForm.aUpdateExecute(Sender: TObject);
var
  lEnv: TROAESEncryptionEnvelope;
  lMarker, lPassword: string;
begin
  lEnv := TROAESEncryptionEnvelope(CheckListBox1.Items.Objects[CheckListBox1.ItemIndex]);
  lMarker :=lEnv.EnvelopeMarker;
  lPassword := lEnv.Password;
  if UpdateAESEnvelope(lMarker,lPassword) then begin
    lEnv.EnvelopeMarker := lMarker;
    lEnv.Password := lPassword;
    CheckListBox1.Items[CheckListBox1.ItemIndex] := GenerateString(lEnv);
  end;
end;

procedure TMessageEnvelopes_ServerMainForm.aUpdateUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := CheckListBox1.ItemIndex <> -1;
end;

procedure TMessageEnvelopes_ServerMainForm.aDeleteExecute(Sender: TObject);
var
  lEnv: TROMessageEnvelope;
begin
  lEnv := TROMessageEnvelope(CheckListBox1.Items.Objects[CheckListBox1.ItemIndex]);
  CheckListBox1.Items.Delete(CheckListBox1.ItemIndex);
  ROMessage.Envelopes.Delete(ROMessage.Envelopes.ItemByEnvelope(lEnv).Index);
  lEnv.Free;
end;

procedure TMessageEnvelopes_ServerMainForm.aMoveUpUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (CheckListBox1.ItemIndex > 0);
end;

procedure TMessageEnvelopes_ServerMainForm.aMoveUpExecute(Sender: TObject);
var
  lEnv: TROMessageEnvelope;
begin
  lEnv := TROMessageEnvelope(CheckListBox1.Items.Objects[CheckListBox1.ItemIndex]);
  with ROMessage.Envelopes.ItemByEnvelope(lEnv) do
    Index := Index -1;
  CheckListBox1.Items.Exchange(CheckListBox1.ItemIndex, CheckListBox1.ItemIndex-1);
end;

procedure TMessageEnvelopes_ServerMainForm.aMoveDownUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (CheckListBox1.ItemIndex <> -1) and (CheckListBox1.ItemIndex <> CheckListBox1.Count-1);
end;

procedure TMessageEnvelopes_ServerMainForm.aMoveDownExecute(Sender: TObject);
var
  lEnv: TROMessageEnvelope;
begin
  lEnv := TROMessageEnvelope(CheckListBox1.Items.Objects[CheckListBox1.ItemIndex]);
  with ROMessage.Envelopes.ItemByEnvelope(lEnv) do
    Index := Index +1;
  CheckListBox1.Items.Exchange(CheckListBox1.ItemIndex, CheckListBox1.ItemIndex+1);
end;

procedure TMessageEnvelopes_ServerMainForm.Log(Astr: string);
var
  p: pChar;
begin
  if Application.Terminated then Exit;

  GetMem(p, (Length(Astr) + 1)*SizeOf(Char));
  Move(Astr[1], p^, (Length(Astr) + 1)*SizeOf(Char));
  PostMessage(Handle, WM_LOG_MESSAGE, 0, integer(p));

  { Access to the VCL may only happen from within the main thread. To allow
    Log to be called from within the Service implementattion, we must ensure
    it's threadsafe.

    So instread of just addint the log message to the Memo, we'l send a
    PostMessage to the window, which wil then later be handled within the
    main thread.

    As a side benefit, the secution of the Log doe snot need to wait for this
    logging to happen (as usage of, for example, Synchronize would require),
    which will in turn make the server more respinsible for a simultaneous
    calls. }
end;

procedure TMessageEnvelopes_ServerMainForm.WMLog(var Message: TMessage);
var
  p: pChar;
begin
  try
    p := pChar(Message.LParam);
    Memo1.Lines.Add(p);
    Freemem(p);
  except
    on E: Exception do
      Memo1.Lines.Add(E.Classname + ': ' + E.Message);
  end;
end;

procedure TMessageEnvelopes_ServerMainForm.CreateAESEnvelope(AMarker, APass: String;
  AEnabled: Boolean);
var
  lEnv: TROAESEncryptionEnvelope;
begin
  lEnv := TROAESEncryptionEnvelope.Create(nil);
  with lEnv do begin
    Password := APass;
    EnvelopeMarker := AMarker;
    BeforeEnvelopeProcessed := DoBeforeEnvelopeProcessed;
  end;
  with TROMessageEnvelopeItem(ROMessage.Envelopes.Add) do begin
    Envelope := lEnv;
    Enabled := AEnabled;
  end;
  CheckListBox1.AddItem(GenerateString(lEnv),lEnv);
  CheckListBox1.Checked[CheckListBox1.Count-1]:=AEnabled;
end;

procedure TMessageEnvelopes_ServerMainForm.DoBeforeEnvelopeProcessed(
  AMessageEnvelope: TROMessageEnvelope; AStream: TStream;
  aMode: TROMessageEnvelopeMode; AMessage: IROMessage);
begin
  case aMode of
    memIncoming: Log(AMessageEnvelope.EnvelopeMarker+' : processing incoming message');
    memOutgoing: Log(AMessageEnvelope.EnvelopeMarker+' : processing outgoing message');
  end;
end;

procedure TMessageEnvelopes_ServerMainForm.CheckListBox1ClickCheck(Sender: TObject);
var
  lEnv: TROMessageEnvelope;
begin
  lEnv := TROMessageEnvelope(CheckListBox1.Items.Objects[CheckListBox1.ItemIndex]);
  ROMessage.Envelopes.ItemByEnvelope(lEnv).Enabled := CheckListBox1.Checked[CheckListBox1.ItemIndex];
end;

function TMessageEnvelopes_ServerMainForm.GenerateString(
  AMessageEnvelope: TROAESEncryptionEnvelope): String;
begin
  Result := AMessageEnvelope.EnvelopeMarker + ' [ password = ''' + AMessageEnvelope.Password+''' ]'
end;

end.