unit AcLogon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, acBase, IniFiles;

type
  TLogonForm = class(TBaseForm)
    OkBtn: TButton;
    btnCancel: TButton;
    Label3: TLabel;
    Params: TRichEdit;
    btnCom: TButton;
    btnPipe: TButton;
    btnTCP: TButton;
    btnLocal: TButton;
    btnEPTS: TButton;
    lblSpecDll: TLabel;
    cbProfiles: TComboBox;
    btnTEAP: TButton;
    cbSoftConnect: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure OkBtnClick(Sender: TObject);
    procedure btnLocalClick(Sender: TObject);
    procedure btnComClick(Sender: TObject);
    procedure btnPipeClick(Sender: TObject);
    procedure btnTCPClick(Sender: TObject);
    procedure btnEPTSClick(Sender: TObject);
    procedure btnTEAPClick(Sender: TObject);
    procedure cbProfilesChange(Sender: TObject);
    procedure cbProfilesDrawItem(Control: TWinControl; AIndex: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ParamsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ParamsChange(Sender: TObject);
  private
    fIniFile: TIniFile;
    fChanging: Boolean;
    function CheckProfile: Boolean;
    procedure HighlightSyntax;
    procedure SetParams(const aText: string);
  public
    { Public declarations }
  end;

implementation

uses
  MTEApi, Winapi.RichEdit, Clipbrd, System.UITypes;

{$R *.DFM}

const
  SConnectParams = 'ConnectParams';
  SGeneral       = 'General';
  SNewProfile    = '< New profile >';
  SProfile       = 'Profile';
  sModuleName    = 'acLogon';

resourcestring
  rsOverwritePrompt = 'Вы пытаетесь изменить существующий профиль соединения, текущие настройки будут затерты. '^M^M +
    'Может быть вместо этого Вы желаете создать новый профиль и поместить туда новые настройки?';

type
  TToken = (toEOL, toPlain, toVar, toKeyword);

function IsKeyword(const S: string): Boolean;
const
  SKeywords: array [0..43] of string =
    ('HOST', 'SERVER', 'IFACENAME', 'SERVICE', 'PORT', 'PIPE', 'BAUDRATE',
     'TIMEOUT', 'SYNCTIME', 'LOGGING', 'PACKETSIZE', 'CRYPTOPROVIDER',
     'PROFILENAME', 'USERID', 'PASSWORD', 'BOARDS', 'SERVERKEY', 'KEY',
     'CONNECTTIME', 'MAXPROCESSINGTIME', 'EXTREFS', 'NOFILTER', 'CLIENTID',
     'EPTSMRLOG', 'NOKEYUNLOAD', 'INTERFACE', 'RETRIES', 'CONNECTTIMEOUT',
     'FEEDBACK', 'BROADCAST', 'PREFBROADCAST', 'COMPRESSION', 'LOGLEVEL',
     'IPSRCORDER', 'RESTRICTLIST', 'LANGUAGE', 'BUFSIZE', 'LOGFOLDER',
     'CACHEFOLDER', 'DIRECTCONNECT', 'VALIDATA.TYPE', 'VALIDATA.BASEPATH',
     'VALIDATA.LDAPPATH', 'LOGPREFIX');
var
  I: Integer;
  Keyword: string;
begin
  Result := True;
  Keyword := UpperCase(S);
  for I := Low(SKeywords) to High(SKeywords) do
    if SKeywords[I] = Keyword then Exit;
  Result := False;
end;

function GetToken(const Text: string; StartFrom: Integer; out Len: Integer): TToken;
var
  I, From: Integer;
  S: string;
begin
  if StartFrom > Length(Text) then
  begin
    Result := toEOL;
    Exit;
  end;

  if Text[StartFrom] = '{' then
  begin
    I := StartFrom + 1;
    while (I <= Length(Text)) and (Text[I] <> '}') do Inc(I);
    Len := I - StartFrom + 1;
    Result := toVar;
    Exit;
  end;

  I := StartFrom;
  repeat
    while (I <= Length(Text)) and not CharInSet(UpCase(Text[I]), ['A'..'Z', '_', '{']) do Inc(I);

    if Text[I] = '{' then
    begin
      Len := I - StartFrom;
      Result := toPlain;
      Exit;
    end;

    if CharInSet(UpCase(Text[I]), ['A'..'Z', '_']) then
    begin
      From := I;
      while (I <= Length(Text)) and CharInSet(UpCase(Text[I]), ['A'..'Z', '_', '0'..'9', '.']) do Inc(I);
      S := Copy(Text, From, I - From);
      if ((From = 1) or CharInSet(Text[From - 1], [#13, #10])) and IsKeyword(S) then
      begin
        if From = StartFrom then
        begin
          Result := toKeyword;
          Len := I - From;
        end
        else
        begin
          Result := toPlain;
          Len := From - StartFrom;
        end;
        Exit;
      end;
    end
    else
    begin
      Result := toPlain;
      Len := Length(Text) - StartFrom + 1;
      Exit;
    end;
  until False;
end;

function GetProfileCaption(const S: TStrings): string;
var
  P1, P2, User: string;
begin
  if (S.IndexOfName('SERVER') >= 0) and (S.IndexOfName('HOST') < 0) then
  begin
    P1 := S.Values['SERVER'];
    P2 := S.Values['SERVICE'];
  end
  else
    if S.IndexOfName('PORT') >= 0 then
    begin
      P1 := S.Values['PORT'];
      P2 := S.Values['BAUDRATE'];
    end
    else
      begin
        P1 := S.Values['HOST'];
        if S.IndexOfName('SERVICE') >= 0 then
          P2 := S.Values['SERVICE']
        else
          P2 := S.Values['PIPE'];
      end;
  if S.Values['USERID'] <> '' then User := ' ' + S.Values['USERID'];
  FmtStr(Result, '%s:%s%s', [P1, P2, User]);
end;

{ TLogonForm }

procedure TLogonForm.FormCreate(Sender: TObject);
var
  I: Integer;
  S: TStringList;
  ShowAllServerTypes: Boolean;
begin
  inherited;
  FIniFile := TIniFile.Create(LogonIniFileName);
  S := TStringList.Create;
  try
    S.Sorted := True;
    FIniFile.ReadSections(S);
    cbProfiles.Items.Assign(S);
  finally
    S.Free;
  end;
  cbProfiles.Items.Insert(0, SNewProfile);
  for I := 0 to cbProfiles.Items.Count - 1 do
    if cbProfiles.Items[I] = SGeneral then
    begin
      cbProfiles.Items.Delete(I);
      Break;
    end;
  cbProfiles.ItemIndex := cbProfiles.Items.IndexOf(FIniFile.ReadString(SGeneral, SProfile, ''));
  if cbProfiles.ItemIndex < 0 then cbProfiles.ItemIndex := 0;
  cbProfilesChange(cbProfiles);
  cbSoftConnect.Visible := msaSoftConnect in GetMTESrlAddons;

  ShowAllServerTypes := FindCmdLineSwitch('all', ['-', '/'], True);
  btnCom.Visible := ShowAllServerTypes;
  btnPipe.Visible := ShowAllServerTypes;
  btnTCP.Visible := ShowAllServerTypes;
//  lblSpecDll.Visible := ShowAllServerTypes;
//  btnLocal.Visible := ShowAllServerTypes;
  btnEpts.Visible := ShowAllServerTypes;
end;

procedure TLogonForm.FormDestroy(Sender: TObject);
begin
  inherited;
  FIniFile.Free;
end;

procedure TLogonForm.OkBtnClick(Sender: TObject);
var
  I: Integer;
  Section: string;
begin
  inherited;
  FIniFile.EraseSection(cbProfiles.Text);
  Section := GetProfileCaption(Params.Lines);
  with Params.Lines do
    for I := 0 to Count - 1 do
      if Trim(Params.Lines[i]) <> '' then
        FIniFile.WriteString(Section, Names[I], Values[Names[I]]);
  FIniFile.WriteString(SGeneral, SProfile, Section);
end;

function TLogonForm.CheckProfile: Boolean;
var
  RetVal: Integer;
begin
  Result := True;
  if cbProfiles.ItemIndex > 0 then
  begin
    RetVal := MessageDlg(rsOverwritePrompt, mtConfirmation, mbYesNoCancel, 0);
    Result := RetVal <> mrCancel;
    if RetVal = mrYes then
      cbProfiles.ItemIndex := 0;
  end
end;

procedure TLogonForm.SetParams(const aText: string);
begin
  if not CheckProfile then Exit;
  fChanging := True;
  try
    Params.Text := aText;
    HighlightSyntax;
  finally
    fChanging := False;
  end;
end;

procedure TLogonForm.btnLocalClick(Sender: TObject);
begin
  SetParams(
    'BROADCAST={ip-list}' + sLineBreak +
    'SERVER={trd_server}' + sLineBreak +
    'SERVICE={trd_service}' + sLineBreak +
    'USERID={userid}' + sLineBreak +
    'PASSWORD={password}' + sLineBreak +
    'IFACENAME={interface name}' + sLineBreak +
    'BOARDS={brd1,brd2,brd3,...}' + sLineBreak +
    'EXTREFS={extref_file_name}' + sLineBreak +
    'NOFILTER={table1,table2,...}' + sLineBreak +
    'TIMEOUT=0' + sLineBreak +
    'CONNECTTIME=0' + sLineBreak +
    'MAXPROCESSINGTIME=1000' + sLineBreak +
    'LOGGING=1');
end;

procedure TLogonForm.btnComClick(Sender: TObject);
begin
  SetParams(
    'PORT=COM1' + sLineBreak +
    'BAUDRATE=115200' + sLineBreak +
    'TIMEOUT=30000' + sLineBreak +
    'SYNCTIME=1' + sLineBreak +
    'LOGGING=1');
end;

procedure TLogonForm.btnPipeClick(Sender: TObject);
begin
  SetParams(
    'HOST={host_name}' + sLineBreak +
    'PIPE={pipe_name}' + sLineBreak +
    'TIMEOUT=30000' + sLineBreak +
    'SYNCTIME=1' + sLineBreak +
    'LOGGING=1');
end;

procedure TLogonForm.btnTCPClick(Sender: TObject);
begin
  SetParams(
    'HOST={host_name_or_ip}' + sLineBreak +
    'SERVICE={tcp_service}' + sLineBreak +
    'TIMEOUT=30000' + sLineBreak +
    'SERVERKEY={xxxxSSSSSS}' + sLineBreak +
    'KEY={xxxxSSSSSSnn}' + sLineBreak +
    'SYNCTIME=1' + sLineBreak +
    'LOGGING=1');
end;

procedure TLogonForm.btnEPTSClick(Sender: TObject);
begin
  SetParams(
    'HOST={host_ip}' + sLineBreak +
    'SERVICE={service_number}' + sLineBreak +
    'USERID={userid}' + sLineBreak +
    'PASSWORD={password}' + sLineBreak +
    'CLIENTID={client application}' + sLineBreak +
    'BOARDS={brd1,brd2,brd3,...}' + sLineBreak +
    'LOGGING=1' + sLineBreak +
    'PACKETSIZE=32000' + sLineBreak +
    'CRYPTOPROVIDER=Validata' + sLineBreak +
    'PROFILENAME={profilename}' + sLineBreak +
    'NOKEYUNLOAD=0');
end;

procedure TLogonForm.btnTEAPClick(Sender: TObject);
begin
  SetParams(
    'HOST={ip1:port1,ip2:port2,...}' + sLineBreak +
    'SERVER={te_access_point_id}' + sLineBreak +
    'USERID={te_userid}' + sLineBreak +
    'PASSWORD={te_password}' + sLineBreak +
    'INTERFACE={te_interface_id}' + sLineBreak +
    'FEEDBACK={contact_info}' + sLineBreak +
    '#BOARDS={brd1,brd2,brd3,...}' + sLineBreak +
    '#PROFILENAME={validata_profile_name}' + sLineBreak +
    '#LOGGING={0|1|2}' + sLineBreak +
    '#TIMEOUT={read_timeout_ms}' + sLineBreak +
    '#RETRIES={reconnect_retry_count}' + sLineBreak +
    '#CONNECTTIME={max_(re)connect_time_ms}');
end;

procedure TLogonForm.cbProfilesChange(Sender: TObject);
begin
  inherited;
  fChanging := True;
  try
    FIniFile.ReadSectionValues(cbProfiles.Text, Params.Lines);
    HighlightSyntax;
  finally
    fChanging := False;
  end;
end;

procedure TLogonForm.cbProfilesDrawItem(Control: TWinControl;
  AIndex: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  inherited;
  with cbProfiles, Canvas do
  begin
    if AIndex = 0 then Font.Style := [fsBold];
    TextRect(Rect, Rect.Left + 3, Rect.Top + 1, cbProfiles.Items[AIndex]);
  end;
end;

procedure TLogonForm.HighlightSyntax;
var
  OldSelStart, OldSelLength, StartPos, Len: Integer;
  S: string;
  Token: TToken;
begin
  with Params do begin
    Lines.BeginUpdate;
    try
      OldSelStart := SelStart;
      OldSelLength := SelLength;
      S := Lines.Text;
      // In Delphi 2010 and higher RichEdit uses #13 as string sepator internally,
      // so we must correct S to match RichEdit's positions
      S := StringReplace(S, sLineBreak, #13, [rfReplaceAll]);
      StartPos := 1;

      repeat
        Token := GetToken(S, StartPos, Len);
        SelStart := StartPos - 1;
        SelLength := Len;
        SelAttributes := DefAttributes;
        case Token of
          toKeyword:
            begin
              SelAttributes.Style := [fsBold];
              SelAttributes.Color := clNavy;
            end;
          toVar: SelAttributes.Color := clRed;
        end;
        Inc(StartPos, Len);
      until Token = toEOL;

      SelStart := OldSelStart;
      SelLength := OldSelLength;
    finally
      Lines.EndUpdate;
    end;
  end;
end;

procedure TLogonForm.ParamsChange(Sender: TObject);
begin
  inherited;
  if not fChanging then begin
    fChanging := True;
    try
      HighlightSyntax;
    finally
      fChanging := False;
    end;
  end;
end;

procedure TLogonForm.ParamsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = VK_ESCAPE then ModalResult := mrCancel;
  if ((ssCtrl in Shift) and (Key = Ord('V'))) or
     ((ssShift in Shift) and (Key = VK_INSERT)) then
  begin
    SendMessage(Params.Handle, EM_PASTESPECIAL, CF_TEXT, 0);
    Key := 0;
  end;
end;

end.
