Why do I have this??

[Ian Branch 127]

Hi Team,

D11.3.

In my Log In form I have the fololowing code in the form Type section..

...
    //
  protected
    property Destroying: Boolean read FDestroying write FDestroying;
  end;

var
...

The form is called from the project file at startup..

...
  //
  if not TLogInForm.Execute('DBiBackup', %1001) then exit; // Bits 0 & 3
  //
...

I have long forgotten why it is there and obviously I didn't document it. 😞

Can someone enlighten me what it is there fore please??  Or, do I actually need it?? 

 

Regards & TIA,

Ian

orm 

[Anders Melander 1784]

You need to show us a bit more of your code.

How and when is the form created, how and when is it destroyed, where is Destroying set and read, etc., etc.?

[Ian Branch 127]

Hi Anders,

Created - The form is created with the   "if not TLogInForm.Execute('DBiBackup', %1001) then exit; // Bits 0 & 3"  in the dpr.

 

There is a private FDestroying in the Form Type..

  private
    { Private declarations }
    FDestroying: Boolean;

and a public class..

  public
    { Public declarations }
    class function Execute(const sApplication: string; const iBits: SmallInt): Boolean;

FMutex is a genaral Var.  FMutex            : THandle; // Mutex Handle

The Execute does this..

class function TLogInForm.Execute(const sApplication: string; const iBits: SmallInt): Boolean;
begin
  //
  sApp := sApplication;
  iBitsSet := iBits;
  //
  with TLogInForm.Create(nil) do
    try
      Result := ShowModal = mrOk;
    finally
      Free;
    end;
  //
end;

This is the FormCreate..

procedure TLogInForm.FormCreate(Sender: TObject);
var wApp            : array[0..11] of WideChar;
begin
  //
  if VirtualUI.Active then
  begin
    VirtualUI.ClientSettings.MouseMoveGestureStyle := MM_STYLE_ABSOLUTE;
    VirtualUI.ClientSettings.MouseMoveGestureAction := MM_ACTION_WHEEL;
    VirtualUI.ClientSettings.CursorVisible := True;
    VirtualUI.OnClose := BrowserClosed;
    // sUsersIP := VirtualUI.BrowserInfo.IPAddress;
    // if sUsersIP = '59.167.177.107' then
    // begin
    // ShowMessage('The Users IP is valid');
    // ModalResult := mrOK;
    // PostMessage(Handle, WM_CLOSE, 0, 0);
    // end;
  end;
  //
  if sApp <> 'DBManager' then TStyleManager.TrySetStyle('Windows11 Polar Light');
  //
  StringToWideChar(sApp, wApp, 12);
  //
  FMutex := CreateMutex(nil, False, wApp);
  //
  if WaitForSingleObject(FMutex, 0) = WAIT_TIMEOUT then Application.Terminate;
  //
  // if VirtualUI.Active then
  // begin
  // VirtualUI.ClientSettings.MouseMoveGestureStyle := MM_STYLE_ABSOLUTE;
  // VirtualUI.ClientSettings.MouseMoveGestureAction := MM_ACTION_WHEEL;
  // VirtualUI.ClientSettings.CursorVisible := True;
  // VirtualUI.OnClose := BrowserClosed;
  // sUsersIP := VirtualUI.BrowserInfo.IPAddress;
  // end;
  //
  DBE1.ConfigPath := DBiWIni.ReadString('DBiWorkflow', 'Directory', '');
  //
  iDatabaseType := DBiWIni.readInteger('DBiWorkflow', 'DatabaseType', 0);
  //
  DBSLogin.SessionDescription := sApp + ' Login Dialog.';
  DBSLogin.RemoteAddress := DBiWIni.ReadString('DBiWorkflow', 'ServerAddress', '0.0.0.0');
  DBSLogin.RemotePort := DBiWIni.readInteger('DBiWorkflow', 'ServerPort', 0);
  //
  try
    //
    DBC1.Open;
    //
  except
    on EDatabaseError do
    begin
      //
      TaskMessageDlg('Database Open Error!',
        'Please check that the database has been started and is available and that you have correctly configured the Data path with DBiConfig.' + sLineBreak +
        'The application will now close.', mtError, [mbOK], 0);
      DBE1.Close;
      Application.Terminate;
      Exit;
      //
    end;
    //
  end;
  //
end;

 

Destroyed -   The form normally closes with this..

procedure TLogInForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //
  DBC1.CloseDataSets;
  //
  DBC1.Close;
  DBSLogin.Close;
  DBE1.Close;
  //
  ReleaseMutex(FMutex);
  //
  Action := caFree;
  //
end;

HTH.

 

Regards,

Ian

 

Edited April 1, 2023 by Ian Branch

[Remy Lebeau 1398]

All of that code is irrelevant.  You asked what the Destroying property is meant for.  But none of that code is setting or reading that property.  So, where is it ACTUALLY being used?  If you can't find that, then the property is likely no longer being used at all and could be removed so you don't have to worry about it anymore.

 

I question why it was ever needed in the first place, since the Form's ComponentState property has a csDestroying flag available.  Unless it is not the Form's destruction that you were keeping track of...

Edited April 1, 2023 by Remy Lebeau

[Ian Branch 127]

Tks Remy.

I sorta figured/hoped that was the case but I wasn't sure if there was any under-the-hood Delphi thing happening.

All gone now.

 

Regards,

Ian

 

[Ian Branch 127]

Ah Ha!

The login form is used for many Apps.  This code was further down..

procedure TLogInForm.DBSLoginRemoteReconnect(Sender: TObject; var Continue, StopAsking: Boolean);
begin
  //
  if FDestroying then
  begin
    Continue := False;
    StopAsking := True;
  end
  else
  begin
    Continue := True;
    MessageBeep(MB_ICONASTERISK);
    //
    tdRemRecon.Timer.Interval := 180000; // 3 minutes.
    //
    var iResponse := tdRemRecon.Execute;
    //
    case iResponse of
      200:
        begin
          Continue := True;
          iReconnectCounter := iReconnectCounter + 1;
        end;
      201:
        begin
          Continue := False;
          StopAsking := True;
        end;
      202: Continue := False;
    end;
    //
    if iReconnectCounter = 3 then Continue := False;
    //
    lConnected := False;
    //
    {$IFDEF SILogging}
    case iResponse of
      200: LogMessage('RemoteReconnect Result = mrYes - (Continue),  Continue = True StopAsking = False.');
      201: LogMessage('RemoteReconnect Result = mrCancel - (Ignore), Continue = False, StopAsking = True.');
      202: LogMessage('RemoteReconnect Result = mrNo - (Stop), Continue = False.');
    end;
    {$ENDIF}
    //
  end;
  //
end;

But still no sign of anything that actually sets FDestroying.

Is it possible that FDestroying should be set under specific conditions?  i.e.  during thr form OnDestroy event, or some other event/condition where the form is closed??

Fishing in unknown waters here.  I don't want to totally discount it until I have eliminated all the probabilities.

 

Regards,

Ian

 

[programmerdelphi2k 237]

Its intention, in fact, would be to allow only one instance of the application, and allow only "n" reconnection attempts to the DB when the connection fails?

CreateMutex is one of the easiest ways to do this, so maybe a "Singleton" class could help you here.

 

As for trying to reconnect to the DB, if using FireDAC, you can make use of the "OnLost, OnRecover, OnRestored" properties and events suitable for this type of situation, however, don't expect 100%... you will need to adapt it to your application in question!

 

unit uMySingleAppInstance;

interface

type
  IMyOneInstance = interface
    ['{----- GUID -------- Ctrl+G }']
    procedure MyAppInstanceFree;
    function MyAppIsRunning(AMutexName: string; out AMsg: string): boolean;
  end;

  TMyOneInstance = class(TInterfacedObject, IMyOneInstance)
  strict private
  class { class var'S ... }
    var
    FMyInstance    : IMyOneInstance;
    FMutexAppHandle: THandle;
    FMutexAppName  : string;
  private
    constructor Create;
    procedure MyAppInstanceFree;
  public
    destructor Destroy; override;
    //
    class function GetMyAppInstance: IMyOneInstance;
    //
    function MyAppIsRunning(AMutexName: string; out AMsg: string): boolean;
  end;

implementation

uses
  System.SysUtils,
  Winapi.Windows; // MSWindows tests...

{ TMyOneInstance }

constructor TMyOneInstance.Create;
begin
  // just for hide it from "public"
end;

destructor TMyOneInstance.Destroy;
begin
  CloseHandle(FMutexAppHandle);
  //
  inherited;
end;

class function TMyOneInstance.GetMyAppInstance: IMyOneInstance;
begin
  if (FMyInstance = nil) then
    FMyInstance := TMyOneInstance.Create;
  //
  result := FMyInstance;
end;

procedure TMyOneInstance.MyAppInstanceFree;
begin
  FMyInstance := nil;
end;

function TMyOneInstance.MyAppIsRunning(AMutexName: string; out AMsg: string): boolean;
var
  LOSLastError: cardinal;
begin
  result := true;
  //
  // an exclusive name...
  if FMutexAppName.IsEmpty then
    begin
      if AMutexName.Trim.IsEmpty then
        FMutexAppName := 'MyAppMutextNameExclusive'
      else
        FMutexAppName := AMutexName.Trim;
    end;
  //
  try
    FMutexAppHandle := CreateMutex(nil, false, PWideChar(FMutexAppName));
    //
    AMsg := 'Mutex: ' + FMutexAppName + '=' + FMutexAppHandle.ToString;
    //
    if (FMutexAppHandle = 0) then // Couldn't open handle at all
      RaiseLastOSError;
    //
    LOSLastError := GetLastError;
    //
    if not(LOSLastError = ERROR_ALREADY_EXISTS) then // We are not the first instance.
      result := false;
  except
    on E: Exception do // generic exception
      AMsg := 'Error: ' + E.Message;
  end;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

finalization

var
LAppInstanceToFree := TMyOneInstance.GetMyAppInstance;
//
if LAppInstanceToFree <> nil then
  LAppInstanceToFree.MyAppInstanceFree;

end.

 

unit uMyDBConnectionTry;

interface

uses
  FireDAC.Stan.Intf,
  FireDAC.Stan.Option,
  FireDAC.Stan.Error,
  FireDAC.UI.Intf,
  FireDAC.Phys.Intf,
  FireDAC.Stan.Def,
  FireDAC.Stan.Pool,
  FireDAC.Stan.Async,
  FireDAC.Phys,
  FireDAC.VCLUI.Wait,
  Data.DB,
  FireDAC.Comp.Client;

type
  TMyProcReference = reference to procedure(const AMsg: string);

function MyTryingDBConnect(const ADBConn: TFDConnection; out AMsg: string; { }
  const AProc: TMyProcReference; ATries: byte = 3; const AInterval: word = 2000): boolean;

implementation

uses
  System.SysUtils;

// it should be in a "THREAD" to release your UI... No need "Timers"
//
// if using FireDAC, you can use the "events" for Lost, Recover, Restore connection + properties!
// FireDAC try do it automatically!!!

function MyTryingDBConnect(const ADBConn: TFDConnection; out AMsg: string; { }
  const AProc: TMyProcReference; ATries: byte = 3; const AInterval: word = 2000): boolean;
var
  LCounter : word;
  LInterval: word;
begin
  result    := false;
  AMsg      := 'DB connected';
  LCounter  := 1;
  LInterval := AInterval;
  //
  if (ADBConn = nil) then
    begin
      AMsg := 'AConn = nil';
      exit; //
    end;
  //
  if not(ATries in [1 .. 5]) then
    ATries := 3;
  //
  if (AInterval < 1000) or (AInterval > 10000) then
    LInterval := 2000;
  //
  while (LCounter <= ATries) do
    begin
      if Assigned(AProc) then
        AProc('Try = ' + LCounter.ToString);
      //
      try
        ADBConn.Connected := true;
        result            := true;
        break;
      except
        on E: exception do
          AMsg := 'Try = [' + LCounter.ToString + ']' + slinebreak + E.Message;
      end;
      //
      LCounter := LCounter + 1;
      //
      sleep(LInterval); // waiting a while... dont abuse!
    end;
end;

end.

 

program Project1;

uses
  Vcl.Forms,
  uMainForm in 'uMainForm.pas' {FormMain},
  uFormPassWord in 'uFormPassWord.pas' {PasswordDlg},
  uMySingleAppInstance in 'uMySingleAppInstance.pas',
  uMyDBConnectionTry in 'uMyDBConnectionTry.pas';

{$R *.res}

var
  LText: string;

begin
  if TMyOneInstance.GetMyAppInstance.MyAppIsRunning('MyAppNameExclusive', LText) then
    exit;
  //
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormMain, FormMain);
  Application.Run;

end.

 

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses
  uMySingleAppInstance,
  uMyDBConnectionTry;

procedure MyProcForTest(const AMsg: string);
begin
  FormMain.Button1.Caption := AMsg;
end;

procedure TFormMain.Button1Click(Sender: TObject);
var
  LMsg: string;
begin
  if not MyTryingDBConnect(FDConnection1, LMsg, MyProcForTest, 3, 1500) then
    ShowMessage(LMsg);
end;

end.

 

[Ian Branch 127]

Hi Team,

Again, thank you all for your inputs.

I have eliminated FDestroying and related code altogether so issue resolved.

 

Regards,

Ian