source: cprs/branches/tmg-cprs/BDK32/Source/VCEdit.pas@ 1727

{ **************************************************************
        Package: XWB - Kernel RPCBroker
        Date Created: Sept 18, 1997 (Version 1.1)
        Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
        Developers: Danila Manapsal, Don Craven, Joel Ivey
        Description: Verify Code edit dialog.
        Current Release: Version 1.1 Patch 40 (January 7, 2005))
*************************************************************** }

unit VCEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons,
  {Broker units}
  Trpcb, Hash;

type
  TVCEdit = class(TComponent)
    private
      FRPCBroker : TRPCBroker;
      FOldVC     : string;
      FConfirmFailCnt : integer;  //counts failed confirms.
      FHelp      : string;
      FOldVCSet: Boolean;  // Shows whether old code was passed in, even if NULL
      procedure NoChange(reason : string);
    protected
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      function ChangeVCKnowOldVC(strOldVC : string) : Boolean;
      function ChangeVC : Boolean;
    published
      property RPCBroker : TRPCBroker read FRPCBroker write FRPCBroker;
  end;



  TfrmVCEdit = class(TForm)
    lblOldVC: TLabel;
    lblNewVC: TLabel;
    lblConfirmVC: TLabel;
    edtOldVC: TEdit;
    edtNewVC: TEdit;
    edtConfirmVC: TEdit;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    btnHelp: TBitBtn;
    procedure btnOKClick(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    procedure edtNewVCExit(Sender: TObject);
    procedure edtOldVCChange(Sender: TObject);
  protected
    { Private declarations }
    FVCEdit : TVCEdit;   //Links form to instance of VCEdit.
  public
    { Public declarations }
  end;

function ChangeVerify(RPCBroker: TRPCBroker): Boolean;
function SilentChangeVerify(RPCBroker: TRPCBroker; OldVerify, NewVerify1, NewVerify2: String; var Reason: String): Boolean;

var
  frmVCEdit: TfrmVCEdit;

const
  MAX_CONFIRM_FAIL : integer = 3;
  U = '^';

{procedure Register;}

implementation

{$R *.DFM}

function ChangeVerify(RPCBroker: TRPCBroker): Boolean;
var
  VCEdit1: TVCEdit;
begin
//  Str := '';
  VCEdit1 := TVCEdit.Create(Application);
  try
    VCEdit1.RPCBroker := RPCBroker;
    if VCEdit1.ChangeVC then  //invoke VCEdit form.                                              //VC changed.
      Result := True
    else
      Result := False;
  finally
    VCEdit1.Free;
  end;
end;

function SilentChangeVerify(RPCBroker: TRPCBroker; OldVerify, NewVerify1, NewVerify2: String; var Reason: String): Boolean;
var
  OrigContext: String;
begin
  Result := False;
  Reason := '';
  if UpperCase(OldVerify) = UpperCase(NewVerify1) then
    Reason := 'The new code is the same as the current one.'
  else
  if UpperCase(NewVerify1) <> UpperCase(NewVerify2) then
    Reason := 'The confirmation code does not match.';
  if Reason = '' then
  try
    with RPCBroker do
    begin
      OrigContext := CurrentContext;
      CreateContext('XUS SIGNON');
      RemoteProcedure := 'XUS CVC';
      Param[0].PType := literal;
      Param[0].Value := Encrypt(UpperCase(OldVerify))
                        + U + Encrypt(UpperCase(NewVerify1))
                        + U + Encrypt(UpperCase(NewVerify2)) ;
      Call;
      Reason := '';
      if Results[0] = '0' then
        Result := True
      else if Results.Count > 1 then
        Reason := Results[1];
      CreateContext(OrigContext);
    end;
  except
    on E: Exception do
    begin
      RPCBroker.RPCBError := E.Message;
      if Assigned(RPCBroker.OnRPCBFailure) then
        RPCBroker.OnRPCBFailure(RPCBroker)
      else if RPCBroker.ShowErrorMsgs = semRaise then
        Raise;
    end;
  end;
end;

{------------------TVCEdit component------------------------------------}

constructor TVCEDit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOldVCSet := False;
end;

destructor TVCEDit.Destroy;
begin
  inherited Destroy;
end;


function TVCEdit.ChangeVCKnowOldVC(strOldVC : string) : Boolean;
begin
  FOldVC := strOldVC;
  FOldVCSet := True;
  Result := ChangeVC;
  FOldVCSet := False;  // set it back to false in case we come in again
end;

{--------------------------ChangeVC function---------------------------}
function TVCEdit.ChangeVC : Boolean;
var
  OldHandle: THandle;
begin
  Result := False;
  try
    frmVCEDit := TfrmVCEDit.Create(application);
    with frmVCEDit do
    begin
      FVCEdit := Self;      //To link form to VCEdit instance.
      if FOldVCSet then      //If old VC known, stuff it & disable editing.
      begin
        edtOldVC.Color := clBtnFace;
        edtOldVC.Enabled := False;
        edtOldVC.Text := FOldVC;
      end{if};
//          ShowApplicationAndFocusOK(Application);
      OldHandle := GetForegroundWindow;
      SetForegroundWindow(frmVCEdit.Handle);
      if ShowModal = mrOK then    //outcome of form.
        Result := True;
      SetForegroundWindow(OldHandle);
    end{with};
  frmVCEDit.Free;
  except
    on E: Exception do
    begin
      FRPCBroker.RPCBError := E.Message;
      if Assigned(FRPCBroker.OnRPCBFailure) then
        FRPCBroker.OnRPCBFailure(FRPCBroker)
      else if FRPCBroker.ShowErrorMsgs = semRaise then
        Raise;
    end;
  end{except};
end;

{------------------TVCEdit.NoChange-------------------------------------
-----------Displays error messages when change fails.-------------------}
procedure TVCEdit.NoChange(reason : string);
begin
  ShowMessage('Your VERIFY code was not changed.' + #13 +
              reason + #13 );
end;


{-------------------------TfrmVCEdit methods-------------------------------}
procedure TfrmVCEdit.btnOKClick(Sender: TObject);
begin
  with FVCEdit do
  begin
    if edtOldVC.Text = edtNewVC.Text then
    begin
      NoChange('The new code is the same as the current one.');
      edtNewVC.Text := '';
      edtConfirmVC.Text := '';
      edtNewVC.SetFocus;
    end
    else
    if edtNewVC.Text <> edtConfirmVC.Text then
    begin
      inc(FConfirmFailCnt);
      if FConfirmFailCnt > MAX_CONFIRM_FAIL then
      begin
        edtNewVC.Text := '';
        edtConfirmVC.Text := '';
        NoChange('The confirmation code does not match.');
        edtNewVC.SetFocus;
      end
      else
      begin
        edtConfirmVC.text := '';
        NoChange('The confirmation code does not match.  Try again.');
        edtConfirmVC.SetFocus;
      end;
    end
    else
    with FRPCBroker do
    begin
      RemoteProcedure := 'XUS CVC';
      Param[0].PType := literal;
      Param[0].Value := Encrypt(UpperCase(edtOldVC.Text))
                        + U + Encrypt(UpperCase(edtNewVC.Text))
                        + U + Encrypt(UpperCase(edtConfirmVC.Text)) ;
      Call;
      if Results[0] = '0' then
      begin
        ShowMessage('Your VERIFY CODE has been changed');
        ModalResult := mrOK;  //Close form.
      end
      else
      begin
        if Results.Count > 1 then
          NoChange(Results[1])
        else
          NoChange('');
        edtNewVC.Text := '';
        edtConfirmVC.Text := '';
        edtNewVC.SetFocus;
      end;
    end;
  end{with};
end;

procedure TfrmVCEdit.btnHelpClick(Sender: TObject);
begin
  with FVCEdit do
  begin
    if FHelp = '' then
    begin
      with FRPCBroker do
      begin
        RemoteProcedure := 'XUS AV HELP';
        Call;
        if Results.Count > 0 then
          FHelp := Results[0];
        FHelp := 'Enter a new verify code and then confirm it.'
                 + #13#13 + FHelp;
        if FOldVC = '' then
          FHelp := 'Enter your current verify code first.' + #13#10 + FHelp;
      end{with};
    end{if};
    ShowMessage(FHelp);
  end{with};
end;

procedure TfrmVCEdit.edtNewVCExit(Sender: TObject);
begin
  if edtNewVC.Modified then
  begin
    FVCEdit.FConfirmFailCnt := 0;                //Reset counter.
    edtNewVC.Modified := False;
  end;
end;

procedure TfrmVCEdit.edtOldVCChange(Sender: TObject); //Also NewVC and ConfirmVC
begin
  btnOk.Default := ((edtNewVC.Text <> '') and        //Update status of OK btn.
                    (edtOldVC.Text <> '') and
                    (edtConfirmVC.Text <> '') );
end;

end.