VistA-cprs/BDK32/Source/Rpcconf1.pas

{ **************************************************************
	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, Raul Mendoza, Joel Ivey
	Description: Server selection dialog.
	Current Release: Version 1.1 Patch 40 (January 7, 2005))
*************************************************************** }

{**************************************************
 p13 - added an OnDestroy event to release the
        help file.  - REM (4/25/00)
**************************************************}
unit Rpcconf1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Xwbut1,
  WinSock, rpcnet, MFunStr;

type
  TrpcConfig = class(TForm)
    cboServer: TComboBox;
    Panel2: TPanel;
    Panel3: TPanel;
    pnlPort: TPanel;
    btnOk: TBitBtn;
    btnCancel: TBitBtn;
    Panel1: TPanel;
    Panel4: TPanel;
    btnHelp: TBitBtn;
    New: TButton;
    procedure cboServerClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure butOkClick(Sender: TObject);
    procedure butCancelClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cboServerExit(Sender: TObject);
    procedure NewClick(Sender: TObject);

  private
    { Private declarations }
    OrigHelp : String;   //Help filename of calling application.

  public
    { Public declarations }
    ServerPairs : TStringList;
  end;

function GetServerInfo(var Server,Port: string): integer;
function GetServerIP(ServerName: String): String;

var
  rpcConfig: TrpcConfig;
  ButtonStatus, Instance: integer;
  rServer, rPort: string;
  TaskInstance: integer;

implementation

uses AddServer;

{$R *.DFM}


function IsIPAddress(Val: String): Boolean;
var
  I: Integer;
  C: Char;
begin
  Result := True;
  for I := 1 to Length(Val) do    // Iterate
  begin
    C := Val[I];
    if not (C in ['0','1','2','3','4','5','6','7','8','9','.']) then
    begin
      Result := False;
      Break;
    end;
  end;    // for
end;

{: Library function to obtain an IP address, given a server name }
function GetServerIP(ServerName: String): String;
var
   host,outcome: PChar;
begin
  TaskInstance := LibOpen;
  if not IsIPAddress(ServerName) then
  begin
    outcome := StrAlloc(256);
    host := StrAlloc(length(ServerName) + 1);
    StrPCopy(host, ServerName);
    LibGetHostIP1(TaskInstance, host, outcome);
    Result := StrPas(outcome);
    StrDispose(outcome);
    StrDispose(host);
  end
  else
    Result := ServerName;
  LibClose(TaskInstance);
end;


procedure TrpcConfig.cboServerClick(Sender: TObject);
var
   index: integer;
begin
     {Based on selction, set port and server variable}
     index := cboServer.ItemIndex;
     rPort := Piece(ServerPairs[index], ',', 2);
     pnlPort.Caption := rPort;
     rServer := Piece(ServerPairs[index], ',', 1);
     btnOk.Enabled := True;

     {Based on Server, get IP addresss.}
     Panel4.Caption := GetServerIP(rServer);
end;

procedure TrpcConfig.FormCreate(Sender: TObject);
begin
  FormStyle := fsStayOnTop;
  OrigHelp := Application.HelpFile;             // Save original helpfile.
  Application.HelpFile := ReadRegData(HKLM, REG_BROKER, 'BrokerDr') +
                           '\clagent.hlp';      // Identify ConnectTo helpfile.
  ServerPairs := TStringList.Create;
end;

procedure TrpcConfig.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     cboServer.Clear;
     pnlPort.Caption := '';
     ServerPairs.Free;
     Application.HelpFile := OrigHelp;  // Restore helpfile.
end;

function GetServerInfo(var Server,Port: string): integer;
var
   index: integer;
   //tmp,fname,: string;  {P14}
   tmpServerPairs : TStringList;      //Format: SERVER,port#
   TextStr: String;

begin
     rpcconfig := Trpcconfig.Create(Application);
     TaskInstance := LibOpen;

     with rpcConfig do
     begin
       tmpServerPairs := TStringList.Create;
       ReadRegValueNames(HKLM, REG_SERVERS, tmpServerPairs);
       ServerPairs.Assign(tmpServerPairs);
       tmpServerPairs.Clear;
       ReadRegValueNames(HKCU, REG_SERVERS, tmpServerPairs);
       for index := 0 to (tmpServerPairs.Count-1) do
       begin
         TextStr := tmpServerPairs[index];
         if ServerPairs.IndexOf(TextStr) < 0 then
           ServerPairs.Add(TextStr);
       end;

       ButtonStatus := mrOk;

       if ServerPairs.Count < 1 then
       begin
         WriteRegData(HKLM, REG_SERVERS, 'BROKERSERVER,9200', '');
         ServerPairs.Add('BROKERSERVER,9200');
       end;


       if ServerPairs.Count > 1 then  // P31                     //need to show form
       begin
         //Initialize form.
         for index := 0 to (ServerPairs.Count -1) do     //Load combobox
           cboServer.Items.Add(ServerPairs[index]);
//           cboServer.Items.Add(Piece(ServerPairs[index], ',', 1));
         cboServer.ItemIndex := 0;
         rServer := Piece(ServerPairs[0], ',', 1);
         pnlPort.Caption := Piece(ServerPairs[0], ',', 2);
         rPort := Piece(ServerPairs[0], ',', 2);

         //Get and display IP address.
         panel4.Caption := GetServerIP(rServer);
         ShowModal;                           //Display form
       end
       else                //One choice: form not shown, value returned.
       begin
         rServer := Piece(ServerPairs[0], ',', 1);
         rPort   := Piece(ServerPairs[0], ',', 2);
     end;

       if ButtonStatus = mrOk then
          begin
            Server := rServer;
            Port := rPort;
       end;
       Result := ButtonStatus;

       tmpServerPairs.Free;
       libClose(TaskInstance);
       Release;
     end;
end;

procedure TrpcConfig.butOkClick(Sender: TObject);
begin
     ButtonStatus := mrOk;
     rServer := Piece(cboServer.Text,',',1);
     rPort := pnlPort.Caption;
     rpcConfig.close;
end;

procedure TrpcConfig.butCancelClick(Sender: TObject);
begin
     ButtonStatus := mrCancel;
     rServer := cboServer.Text;
     rPort := pnlPort.Caption;
     rpcConfig.close;
end;

procedure TrpcConfig.FormDestroy(Sender: TObject);
begin
        ServerPairs := TStringList.Create; // {p13 - REM}
        ServerPairs.Free;                  //   Release Help File.
        Application.HelpFile := OrigHelp;  //
end;

procedure TrpcConfig.cboServerExit(Sender: TObject);
begin
  //
end;

procedure TrpcConfig.NewClick(Sender: TObject);
var
  I: Integer;
  ServerForm: TfrmAddServer;
  strServer, strName, strPort: String;
begin
  ServerForm := TfrmAddServer.Create(Self);
  if ServerForm.ShowModal <> mrCancel then
  begin
    strServer := ServerForm.edtAddress.Text;
    strPort := ServerForm.edtPortNumber.Text;
    ServerForm.edtPortNumber.Text := strPort;
    strName := strServer + ',' + strPort;
    WriteRegData(HKCU, REG_SERVERS, strName, '');
    ServerPairs.Add(strName);
    strName := ServerPairs[ServerPairs.Count-1];
    cboServer.Items.Add(strName);
    for I := 0 to cboServer.Items.Count-1 do    // Iterate
    begin
      if cboServer.Items[I] = strName then
        cboServer.ItemIndex := I;
    end;    // for
//    cboServer.Text := strServer;
//    pnlPort.Caption := strPort;
    cboServerClick(Self);
  end;
  ServerForm.Free;
end;

end.