{$I ..\UTIL\AFD_DEFS.INC}
unit Menu;
(*----------------------------------------------------------------------
 *  Application: Accounting For Delphi
 *    File Name: menu.pas
 *    Exec File: AFDMAIN.EXE
 *    Copyright: (c) 1993-2002 by ColumbuSoft
 *
 *   The original purchaser is granted permission to use and distribute
 *   these functions in executable form as long as this copyright notice
 *   is not removed from the source.
 *
 *----------------------------------------------------------------------
 *)

(*----------------------------------------------------------------------
 *  For step-by-step instructions on how to one of your own modules
 *  to the main menu, go to the end of this file.
 *----------------------------------------------------------------------
 *)

interface

uses
  SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,
  StdCtrls, MMSystem, Menus, DB, DBTables, Buttons, AFDUtil, StrTypes, WinTypes,
  WinProcs, tblSys, LForm, Global, IniFiles, checklst;

type
  TUserName = string[10];
  TPassword = string[15];

  TfrmMainMenu = class(TForm)
    tblNames_: TTable;
    fldUserName: TStringField;
    fldPassword: TStringField;
    fldAcLevel: TStringField;
    tblSys_: TTable;
    dbAFD: TDatabase;
    mmnMain: TMainMenu;
    mnuFile: TMenuItem;
    mnuLogOn: TMenuItem;
    mnuLogOff: TMenuItem;
    mnuChangePW: TMenuItem;
    mnuSep1: TMenuItem;
    mnuExit: TMenuItem;
    mnuModule: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpContents: TMenuItem;
    mnuHelpSearch: TMenuItem;
    mnuHelpHowTo: TMenuItem;
    mnuAbout: TMenuItem;
    tblNames_AD: TBooleanField;
    tblNames_GL: TBooleanField;
    tblNames_AP: TBooleanField;
    tblNames_AR: TBooleanField;
    tblNames_OE: TBooleanField;
    tblNames_IP: TBooleanField;
    tblNames_PR: TBooleanField;
    tblNames_FA: TBooleanField;
    tblNames_JC: TBooleanField;
    tblNames_CM: TBooleanField;
    tblNames_HR: TBooleanField;
    mnuChangeDataSet: TMenuItem;
    tblNames_ITEM9: TBooleanField;
    tblNames_PS: TBooleanField;
    tblNames_DI: TBooleanField;
    mnuArchiveDataFiles: TMenuItem;
    tblSys_DATASET: TStringField;
    tblNames_DSCHANGE: TBooleanField;
    tblNames_MODULES: TStringField;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    mModules: TMemo;
    mInits: TMemo;
    mForms: TMemo;
    lbFiles: TCheckListBox;
    Label6: TLabel;
    mnuSupport: TMenuItem;
    Panel1: TPanel;
    sbAD: TSpeedButton;
    sbGL: TSpeedButton;
    sbAP: TSpeedButton;
    sbAR: TSpeedButton;
    sbOE: TSpeedButton;
    sbIP: TSpeedButton;
    sbPR: TSpeedButton;
    sbFA: TSpeedButton;
    sbJC: TSpeedButton;
    sbCM: TSpeedButton;
    sbPS: TSpeedButton;
    sbDI: TSpeedButton;
    sb1: TSpeedButton;
    sb2: TSpeedButton;
    mButtons: TMemo;
    Label7: TLabel;
    Bevel1: TBevel;
    mnuCreateNewDataSet: TMenuItem;
    procedure mnuLogOnClick(Sender: TObject);
    procedure mnuChangePWClick(Sender: TObject);
    procedure mnuLogOffClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ModuleClick(Sender: TObject);
    procedure CheckModulesRunning(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure mnuHelpContentsClick(Sender: TObject);
    procedure mnuHelpSearchClick(Sender: TObject);
    procedure mnuHelpHowToClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuChangeDataSetClick(Sender: TObject);
    procedure mnuArchiveDataFilesClick(Sender: TObject);
    procedure tblNames_BeforeOpen(DataSet: TDataset);
    procedure mnuSupportClick(Sender: TObject);
    procedure mnuCreateNewDataSetClick(Sender: TObject);
  private
    { Private declarations }
    bShowNotice : boolean;
    UserName  : TUserName;
    UserLevel : char;
    bHasModule : array [TModule] of Boolean;
    sMainCaption : string255;
    bChangeDSEnabled : boolean;
    aButtons : array[0..11] of TSpeedButton;
    function GetLevel (const UserName : tUserName; const UserPW : tPassword) : char;
    function SetPW (const OldPW, NewPW : tPassword) : Boolean;
    procedure SetNewLevel(NewLevel : char);
    procedure ChangePassword;
    function KillIt(const which : string255) : integer;
    function ModuleHandle(const which : string255) : HWND;
    function bOpenNames : Boolean;
    procedure CheckReindex;
    procedure AFDShowMain(var Message: TMessage);
      message AFD_SHOWMAIN;
  public
    { Public declarations }
    procedure LogOn;
  end;

function IsRegistered : boolean;

var
  frmMainMenu: TfrmMainMenu;

implementation

{$R *.DFM}

uses
  {$IFDEF DEMO}
  Notice,
  {$ENDIF}
  About, LogDlg, Reindex2, StrUtil, ChgDs, Support, NewDS;

const
  DEVHELP = 'AFDTECH.HLP';
  EXE_DIR = '..\';
  cPASSWORD_CHAR = '*';
  iMIN_FORM_WIDTH = 210;

procedure TfrmMainMenu.FormCreate(Sender: TObject);
var
  Str : string255;
  modModule : TModule;
  i : integer;
  mItem : TMenuItem;
begin
  {add your button name below - reshuffle the order if you desire}
  aButtons[0] := sbAD;
  aButtons[1] := sbGL;
  aButtons[2] := sbAP;
  aButtons[3] := sbAR;
  aButtons[4] := sbOE;
  aButtons[5] := sbIP;
  aButtons[6] := sbPR;
  aButtons[7] := sbFA;
  aButtons[8] := sbJC;
  aButtons[9] := sbCM;
  aButtons[10] := sbPS;
  aButtons[11] := sbDI;

  bShowNotice := True;
  SetDataSet(dbAFD);
  Caption := GetLongCaption;
  sMainCaption := Caption;
  frmMainMenu.Caption := AllTrim(sMainCaption) +
    '  (DataSet: ' + dbAFD.AliasName + ')';
  mnuChangeDataSet.Enabled := bChangeDSEnabled;
  mnuCreateNewDataSet.Enabled := bChangeDSEnabled;
  for i := 0 to mModules.Lines.Count - 1 do
  begin
    aButtons[i].Tag := i;
    aButtons[i].OnClick := ModuleClick;
    aButtons[i].Hint := mModules.Lines[i];
    {$IFDEF FLAT_BUTTONS}
      aButtons[i].Flat := True;
    {$ENDIF}
    mItem := TMenuItem.Create(self);
    mItem.Tag := i;
    mItem.Caption := mModules.Lines[i];
    mItem.OnClick := ModuleClick;
    mnuModule.Insert(i, mItem);
    lbFiles.Checked[i] := FileExists(lbFiles.Items[i]) or
      FileExists(EXE_DIR + mInits.Lines[i] + '\' + lbFiles.Items[i]);
  end;
  SetNewLevel('X');
  CheckReindex;
  SetLTWH(self, 'MAIN');
  Height := 82;
  Width := 428;
end;

function TfrmMainMenu.bOpenNames;
{ This function tries to open tblSYS (SYSTEM.DBF) before opening tblNames. }
{ If it can't open tblSYS, it is because tblSys is open exclusively by     }
{ another module. Most other modules open tblSys at startup up, and they   }
{ can't be running when exclusive access to the tables is needed. This     }
{ module may be running when another module needs exclusive access.        }
begin
  result := False;
  try
    tblSys_.Open;
  except
    ;
  end;
  if tblSys_.Active then
  begin
    tblNames_.Open;
    result := True;
  end
  else
    ShowMessage('Accounting For Delphi In Exclusive Use By Another User');
end;

function TfrmMainMenu.GetLevel (const UserName : tUserName;
  const UserPW : tPassword) : char;
{input:  UserName, UserPW (password)      }
{output: user access level from NAMES.DBF }
{  '0'..'9' - valid access,               }
{  'X' - access denied                    }
begin
  Result := 'X';
  if not bOpenNames then exit;
  try
    with tblNames_ do
      if bLocate(fldUserName, UserName, True) and
        (EncryptPW(UserPW) = fldPASSWORD.Value) then
      begin
        Result := fldACLEVEL.Value[1];
        bChangeDSEnabled := tblNames_DSCHANGE.AsBoolean;
      end;
  finally
    tblSys_.Close;
  end;
end;

function TfrmMainMenu.SetPW (const OldPW, NewPW : tPassword) : Boolean;
{updates NAMES.DBF                 }
{input: UserName, NewPW (password) }
{output: True if change successful }
var
  EncPW : string255;
begin
  Result := False;
  if not bOpenNames then exit;
  try
    with tblNames_ do
    begin
      if bLocate(fldUserName, UserName, True) then
      begin
        if fldPASSWORD.Value = EncryptPW(OldPW) then
        begin
          Edit;
          fldPASSWORD.Value := EncryptPW(NewPW);
          Post;
          Result := True;
        end;
      end;
    end;
  finally
    tblNames_.Close;
    tblSys_.Close;
  end
end;

procedure TfrmMainMenu.LogOn;
var
  LogonName : tUserName;
  LogonPW : tPassword;
  LogonLevel : char;
begin
  {$IFDEF DEMO}
    if bShowNotice then
    begin
      frmNotice.ShowModal;
      bShowNotice := False;
    end;
  {$ENDIF}
  LogonName  := '';
  LogonPW    := '';
  with dlgLogon do
  begin
    Caption := 'System Logon';
    edtPW.CharCase := ecNormal;
    gbPrompt.Caption := 'Enter user name:';
    edtPW.PasswordChar := #0;
    {$IFNDEF DEMO}
      Height := 91;
      gbDemo.Visible := False;
    {$ENDIF}
  end;
  if dlgLogon.ShowModal = mrOK then
  begin
    LogonName := dlgLogon.edtPW.Text;
    dlgLogon.Release;
    Application.CreateForm(TdlgLogon, dlgLogon);
    with dlgLogon do
    begin
      Caption := 'System Logon';
      edtPW.charCase := ecUpperCase;
      gbPrompt.Caption := 'Enter password:';
      edtPW.PasswordChar := cPASSWORD_CHAR;
      {$IFNDEF DEMO}
        Height := 91;
        gbDemo.Visible := False;
      {$ENDIF}
    end;
    if dlgLogon.ShowModal = mrOK then
    begin
      LogonPW := dlgLogon.edtPW.Text;
      LogonLevel := GetLevel(LogonName, LogonPW);
      if (LogonLevel = 'X') then
      begin
        UserName := '';
        ShowMessage('Logon failed.');
      end
      else
      begin
        UserName := LogonName;
      end;
      SetNewLevel(LogonLevel);
    end;
  end;
end;

procedure TfrmMainMenu.SetNewLevel(NewLevel : char);
var
  s : string255;
  i, iLeft, iFormSize : integer;
begin
  iLeft := 0;
  iFormSize := 6;
  if NewLevel <> UserLevel then
  begin
    UserLevel := NewLevel;
    case UserLevel of
      'X' :
      {a level of 'X' means invalid logon (no access)}
      begin
        mnuModule.Enabled   := False;
        mnuLogOff.Enabled   := False;
        mnuChangePW.Enabled := False;
        for i := 0 to mModules.Lines.Count - 1 do
          aButtons[i].Visible := False;
      end;
      '0'..'9' :
      {All valid logons get access to all}
      {child programs. The child program is passed the access}
      {level on the command line and can restrict access itself.}
      begin
        mnuModule.Enabled   := True;
        mnuLogOff.Enabled   := True;
        mnuChangePW.Enabled := True;
        mnuChangeDataSet.Enabled := tblNames_DSCHANGE.AsBoolean;
        mnuCreateNewDataSet.Enabled := tblNames_DSCHANGE.AsBoolean;
        s := tblNames_MODULES.Value;
        for i := 0 to lbFiles.Items.Count - 1 do
        begin
          aButtons[i].Visible := lbFiles.Checked[i] and (Pos(mInits.Lines[i], s) > 0);
          mnuModule.Items[i].Visible := lbFiles.Checked[i] and (Pos(mInits.Lines[i], s) > 0);
          if aButtons[i].Visible then
          begin
            aButtons[i].Left := iLeft;
            inc(iLeft, aButtons[i].Width);
            Inc(iFormSize, aButtons[i].Width);
          end;
        end;
          if iMIN_FORM_WIDTH > iFormSize then
            frmMainMenu.Width := iMIN_FORM_WIDTH
          else
            frmMainMenu.Width := iFormSize;
      end;
    end;
  end;
  tblNames_.Close;
end;

procedure TfrmMainMenu.ChangePassword;
var
  OldPW, NewPW : tPassword;
  ok : Boolean;
begin
  with dlgLogon do
  begin
    Caption := 'Change Password';
    gbPrompt.Caption := 'Enter current password:';
    edtPW.PasswordChar := cPASSWORD_CHAR;
    {$IFNDEF DEMO}
      Height := 91;
      gbDemo.Visible := False;
    {$ENDIF}
  end;
  if dlgLogon.ShowModal = mrOK then
  begin
    oldPW := dlgLogon.edtPW.Text;
    dlgLogon.gbPrompt.Caption := 'Enter new password:';
    if dlgLogon.ShowModal = mrOK then
    begin
      NewPW := dlgLogon.edtPW.Text;
      dlgLogon.gbPrompt.Caption := 'Verify new password:';
      if dlgLogon.ShowModal = mrOK then
      begin
        ok := dlgLogon.edtPW.Text = NewPW;
        if ok then ok := frmMainMenu.SetPW(OldPW, NewPW);
        if ok
          then ShowMessage('Password change successful')
          else ShowMessage('Password change failed');
      end
    end
  end
end;

procedure TfrmMainMenu.mnuLogOnClick(Sender: TObject);
begin
  LogOn;
end;

procedure TfrmMainMenu.mnuChangePWClick(Sender: TObject);
begin
  ChangePassword;
end;

procedure TfrmMainMenu.mnuLogOffClick(Sender: TObject);
begin
  UserName := '';
  SetNewLevel('X');
end;

function TfrmMainMenu.ModuleHandle(const which : string255) : HWND;
var
  szModName : array [0..255] of char;
begin
  StrPCopy(szModName, which);
  Result := FindWindow('TApplication', szModName);
end;

procedure TfrmMainMenu.ModuleClick(Sender: TObject);
var
  which : TModule;
  cmdLine : string255;
  hwndTarget : HWND;
  szTemp, szClassName : array[0..255] of char;
  iTag : integer;
begin
  iTag := (Sender as TComponent).Tag;
  StrPCopy(szClassName, mForms.Lines[iTag]);
  hwndTarget := FindWindow(szClassName, nil);
  if (hwndTarget <> 0) then
  begin
    SendMessage(hwndTarget, AFD_RESTORE, 0, 0);
    SetForegroundWindow(hwndTarget);
  end
  else
  begin
    which := TModule((Sender as TComponent).Tag);
    begin
      cmdLine := lbFiles.Items[iTag] + ' ' + UserLevel + ' ' + UserName;
      StrPCopy(szTemp, cmdLine);
      if WinExec(Addr(szTemp), SW_SHOW) = 2 then { file not found }
      begin
        cmdLine := EXE_DIR + mInits.Lines[iTag] + '\' + lbFiles.Items[iTag] + ' ' + UserLevel + ' ' + UserName;
        StrPCopy(szTemp, cmdLine);
        WinExec(Addr(szTemp), SW_SHOW);
      end
    end
  end;
end;

{This procedure is called whenver the user clicks on the 'Module'}
{menu, but before the pull down is displayed. It is used to place}
{check marks beside the modules that are already active.}
procedure TfrmMainMenu.CheckModulesRunning(Sender: TObject);
var
  i : integer;
begin
  for i := 0 to mnuModule.Count - 1 do
    mnuModule.Items[i].Checked := ModuleHandle(mModules.Lines[i]) <> 0;
end;

procedure TfrmMainMenu.mnuAboutClick(Sender: TObject);
begin
  ShowAbout;
end;

procedure TfrmMainMenu.mnuHelpContentsClick(Sender: TObject);
begin
  Application.HelpCommand(HELP_CONTENTS, 0);
end;

procedure TfrmMainMenu.mnuHelpSearchClick(Sender: TObject);
const
  c : char = #0;
begin
  Application.HelpCommand(HELP_PARTIALKEY, longint(@c));
end;

procedure TfrmMainMenu.mnuHelpHowToClick(Sender: TObject);
begin
  Application.HelpCommand(HELP_HELPONHELP,0);
end;

procedure TfrmMainMenu.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  i, iCloseCount : integer;
begin
  iCloseCount := 0;
  for i := 0 to mForms.Lines.Count - 1 do
    iCloseCount := iCloseCount + KillIt(mForms.Lines[i]);
  if iCloseCount > 0 then
    Action := caNone
  else
  begin
    Action := caFree;
    SaveLTWH(self, 'MAIN');
  end;
end;

function TfrmMainMenu.KillIt(const which : string255) : integer;
var
  hwndTarget : HWND;
  szClassName : array [0..255] of char;
begin
  StrPCopy(szClassName, which);
  hwndTarget := FindWindow(szClassName, nil);
  if (hwndTarget <> 0) then
    Result := SendMessage(hwndTarget, AFD_CLOSE, 0, 0)
  else
    Result := 0;
end;

procedure TFrmMainMenu.CheckReindex;
const
  sCANT = 'Can''t Reopen SYS.DBF';
var
  modModule : TModule;
  bFound : Boolean;
  sPath : string255;
begin
  bFound := False;
  try
    tblSys_.Open;
    sPath := sGetDBPath(tblSys_.Database);
    tblSys_.Close;
    for modModule := AP_MOD to PS_MOD do
      bFound := bFound or FileExists(sPath + sKeyFileName[modModule] + '.MDX');
    if not bFound then ReindexAll(dbAFD);
  except
    {will be caught by exception handler in tblsys.pas}
  end;
end;

procedure TfrmMainMenu.mnuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMainMenu.mnuChangeDataSetClick(Sender: TObject);
const
  sMess = 'All Other AFD Modules Must Be Closed ' + #13 +
          'Before Performing This Operation.  Continue?';
begin
  if (Confirm(sMess, 0) = mrYes) then
  begin
    ChgDS.Run;
    frmMainMenu.Caption := AllTrim(sMainCaption) +
      '  (DataSet: ' + dbAFD.AliasName + ')';
  end;
end;

procedure TfrmMainMenu.mnuArchiveDataFilesClick(Sender: TObject);
const
  sFILE_PATH = EXE_DIR + 'zipper\zipper.exe';
var
  cmdLine : string255;
  szTemp : array[0..255] of char;
begin
  cmdLine := 'zipper.exe';
  StrPCopy(szTemp, cmdLine);
  if WinExec(Addr(szTemp), SW_SHOW) = 2 then { file not found }
  begin
    cmdLine := sFILE_PATH;
    StrPCopy(szTemp, cmdLine);
    WinExec(Addr(szTemp), SW_SHOW);
  end;
end;

procedure TfrmMainMenu.tblNames_BeforeOpen(DataSet: TDataset);
begin
  tblNames_.DatabaseName := sNAMES_ALIAS;
end;

procedure TfrmMainMenu.AFDShowMain(var Message: TMessage);
begin
  Application.Restore;
  Application.BringToFront;
  SetFocus;
end;

procedure TfrmMainMenu.mnuSupportClick(Sender: TObject);
begin
  Support.Run(UserName);
end;

function IsRegistered : boolean;
var
  f : TextFile;
  s1, s2, s3, sPath : string;
begin
  sPath := sGetDBPath(frmTblSys.tblSys_.Database);
  if FileExists(sPath + 'sys.mdx') then
  begin
    AssignFile(f, sPath + 'sys.mdx');
    Reset(f);
    Readln(f, s1);  // junk
    Readln(f, s1);
    Readln(f, s2);
    CloseFile(f);
    Result := (EncryptPW(frmTblSys.tblSys_COMPANY.Value) = s1) and
              (EncryptPW(frmTblSys.tblSys_ADDRESS1.Value) = s2);
  end
  else
    Result := False;
  if not Result then
    MessageDlg('A fatal error has occurred.' + #13 +
      'Please contact your reseller.', mtError, [mbOK], 0);
end;

procedure TfrmMainMenu.mnuCreateNewDataSetClick(Sender: TObject);
begin
  NewDS.Run;
end;

end.


{---------------------------------------------------------------------------------
How to add a new module to the AFD menu:

Let's assume the new module name is afddw.exe and it's located in
the \afd\dw directory.

on frmMainMenu, add items to the following:

(NOTE: you can juggle the order of the buttons and the modules,
 just keep everything in sync.)

(NOTE #2 - you don't have to delete buttons.  They won't be visible if the
 user doesn't have the EXE file.)

mModules TMemo component -
add the name of the module as it appears in the title field from the
Application page of the Options|Project menu.  If the two don't agree,
the main menu won't be able to determine that the child app is running.
This also appears as the hint for the toolbar button.

lbFiles TCheckListBox -
Add the name of the executable (i.e. afddw.exe)

mInits TMemo -
Add the two-letter code for this module (i.e. DW).  This is used to find
the proper directory while running in the Delphi IDE and also to determine
which modules the user has access to.  You should also add these initials to
the MODULES field in sys.dbf.

mForms TMemo -
Add the form class. (i.e. TfrmDWMain)

Add a button to the toolbar and give it a name - sbDW in this case.

Search for 'aButtons'.  You'll see the array declaration.  Change the
array size if necessary.

Search for 'aButtons[0] := sbAD;'  Add a line for your module.  Change the
array reference if you're changing the order.

That's all there is to it.

If you want to change the minimum form width, change the
iMIN_FORM_WIDTH constant at the top of the unit.  The form
width should probably be wide enough to show both the caption
and current dataset no matter how many buttons are visible.

Final Note: due to flakey behavior of TToolbar we had to switch back to
TPanel and TSpeedButtons.

Final Note #2: smaller glyphs are being prepared. 

---------------------------------------------------------------------------------}