Quick way to connect Windows 10 embedded VPN connections

x23piracy

Hi there,

in work we use a checkpoint firewall thats also giving us vpn access. Since Windows 10 is supporting Checkpoint VPN named “Capsule” on the store:

https://www.microsoft.com/de-de/store/p/check-point-capsule-vpn/9wzdncrdjxtj
It’s possible to use Windows 10 internal VPN instead of installing Checkpoints VPN Client.

Windows 10 from 1511 to 1607 just offered a real bad way to connect this VPN Connection by GUI, you had to click several times until the connection has been connected. A minimum is 5 clicks.

With 1703 this has changed and you can now access your VPN directly from Systray:

alt text

Applause Microsoft now i only need 3 Click up to a connection
I still hate it to need to click so often for a simple VPN Connection so i wrote myself something.

The program is called VPNTool, it’s a single exe binary that will place a systray icon:

alt text

with the following options:

left or right click on the icon will show a popupmenu:

alt text

Connect/Disconnect
Reconnect on connection drop
Notifications about connection state on/off
Close the App for example:

alt text

The program cannot be closed by click against accidents you need to press STRG + ALT + X (global Hotkey)

Every Action can additional to mouse done by global Hotkeys as seen on the Screenshot (open popup)
Doubleclick on the systray icon will dial or disconnect depending on connection state.

Now i just need a double click or 2 normal clicks or just need to press STRG + ALT + V to connect my VPN.

I will paste my source code here:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, CoolTrayIcon, Menus, StdCtrls, ImgList, TextTrayIcon, StrUtils,
  ExtCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    TextTrayIcon1: TTextTrayIcon;
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    VerbindenAuflegen1: TMenuItem;
    Beenden1: TMenuItem;
    Wiederverbinden1: TMenuItem;
    Timer2: TTimer;
    Benachrichtigungen1: TMenuItem;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure VerbindenAuflegen1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure Wiederverbinden1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure TextTrayIcon1DblClick(Sender: TObject);
    procedure Benachrichtigungen1Click(Sender: TObject);
  private
    id1, id2, id3, id4 : Integer;
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
    { Private declarations }
  public
    MinIcon : array[0..1] of TIcon;
    { Public declarations }
  end;

var
  Form1: TForm1;
  mHandle: THandle; // Mutexhandle

implementation

{$R *.dfm}

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  if Msg.HotKey = id1 then
    Form1.VerbindenAuflegen1.Click;
  if Msg.HotKey = id2 then
    Form1.Close;
  if Msg.HotKey = id3 then
    Form1.Wiederverbinden1.Click;
  if Msg.HotKey = id4 then
    Form1.Benachrichtigungen1.Click;
end;

function Konsole(const Command: String): String;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  OutputPipeRead, OutputPipeWrite: THandle;
  Res: Boolean;
  BufSize: Cardinal;
  Buffer: String;
  BytesRead: Cardinal;
begin
  //Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  //Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  //Pipe erzeugen
  CreatePipe(OutputPipeRead, OutputPipeWrite, @SecurityAttr, 0);

  //Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := OutputPipeWrite;
  StartupInfo.hStdError := OutputPipeWrite;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  //Prozess erzeugen
  Res := CreateProcess(nil, PChar(command), nil, nil, true,
                   CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or
                   NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);

  //OutputPipeWrite schließen
  CloseHandle(OutputPipeWrite);

  Result := '';

  if Res then
  begin
    //OutputPipeRead auslesen
    SetLength(Buffer, 5000);
    BufSize := Length(Buffer);
    repeat
      Res := ReadFile(OutputPipeRead, Buffer[1], BufSize, BytesRead, nil);
      Result := Result + Copy(Buffer, 1, BytesRead);
    until not Res;

    //auf Prozessende warten
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
  end;

  //OutputPipeRead schließen
  CloseHandle(OutputPipeRead);
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  MOD_ALT = 1;
  MOD_CONTROL = 2;
  VK_B = $42;
  VK_V = $56;
  VK_W = $57;
  VK_X = $58;
begin
  mHandle := CreateMutex(nil,True,'VPNTool');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    Halt;
  end;
  MinIcon[0]:=TIcon.Create;
  MinIcon[1]:=TIcon.Create;
  MinIcon[0].Handle:=LoadIcon(hInstance,'lock');
  MinIcon[1].Handle:=LoadIcon(hInstance,'lock2');
  id1 := GlobalAddAtom('Hotkey1');
  RegisterHotKey(Handle, id1, MOD_CONTROL + MOD_Alt, VK_V);
  id2 := GlobalAddAtom('Hotkey2');
  RegisterHotKey(Handle, id2, MOD_CONTROL + MOD_Alt, VK_X);
  id3 := GlobalAddAtom('Hotkey3');
  RegisterHotKey(Handle, id3, MOD_CONTROL + MOD_Alt, VK_W);
  id4 := GlobalAddAtom('Hotkey4');
  RegisterHotKey(Handle, id4, MOD_CONTROL + MOD_Alt, VK_B);
  Self.Hide;
  WindowState := wsMinimized;
  ShowWindow(Application.Handle, SW_Hide);
  if AnsiContainsText(Konsole('cmd /c rasdial'),'hergestellt') then
  begin
    TextTrayIcon1.Icon := MinIcon[0];
    PopupMenu1.Items[0].Caption := 'Auflegen';
  end
  else
  begin
    TextTrayIcon1.Icon := MinIcon[1];
    PopupMenu1.Items[0].Caption := 'Verbinden';
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if AnsiContainsText(Konsole('cmd /c rasdial'),'hergestellt') then
  begin
    TextTrayIcon1.Icon := MinIcon[0];
    PopupMenu1.Items[0].Caption := 'Auflegen';
  end
  else
  begin
    TextTrayIcon1.Icon := MinIcon[1];
    PopupMenu1.Items[0].Caption := 'Verbinden';
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if AnsiContainsText(Konsole('cmd /c rasdial'),'Keine') then if PopupMenu1.Tag = 1 then Form1.VerbindenAuflegen1.Click;
end;

procedure TForm1.VerbindenAuflegen1Click(Sender: TObject);
begin
  //if AnsiContainsText(Konsole('ipconfig'),'VPN Haan')
  if AnsiContainsText(Konsole('cmd /c rasdial'),'hergestellt') then
  begin
    ShellExecute(handle,'open',PChar('rasdial'), PChar('"VPN Haan" /d'),'',SW_HIDE);
    if Form1.Tag = 1 then
    begin
      ListBox1.Items[2] := '$notificationTitle = "VPN Verbindung getrennt. " + [DateTime]::Now.ToShortTimeString()';
      ListBox1.Items.SaveToFile(SysUtils.GetEnvironmentVariable('temp') + '\VPNTool.ps1');
      ShellExecute(handle,'open',PChar('Powershell.exe'), PChar('-ExecutionPolicy Bypass -File ' + SysUtils.GetEnvironmentVariable('temp') + '\VPNTool.ps1'),'',SW_HIDE);
    end;
  end
  else
  begin
    ShellExecute(handle,'open',PChar('rasdial'), PChar('"VPN Haan"'),'',SW_HIDE);
    if Form1.Tag = 1 then
    begin
      ListBox1.Items[2] := '$notificationTitle = "VPN Verbindung hergestellt. " + [DateTime]::Now.ToShortTimeString()';
      ListBox1.Items.SaveToFile(SysUtils.GetEnvironmentVariable('temp') + '\VPNTool.ps1');
      ShellExecute(handle,'open',PChar('Powershell.exe'), PChar('-ExecutionPolicy Bypass -File ' + SysUtils.GetEnvironmentVariable('temp') + '\VPNTool.ps1'),'',SW_HIDE);
    end;
  end;
end;

procedure TForm1.Wiederverbinden1Click(Sender: TObject);
begin
  if PopupMenu1.Items[1].Checked = False then
  begin
    PopupMenu1.Tag := 0;
    Timer2.Enabled := False;
  end
    else
  begin
    PopupMenu1.Tag := 1;
    Timer2.Enabled := True;
  end;
end;

procedure TForm1.Benachrichtigungen1Click(Sender: TObject);
begin
  if PopupMenu1.Items[2].Checked = False then Form1.Tag := 0 else Form1.Tag := 1;
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
  if Form1.Tag = 1 then
  begin
    ListBox1.Items[2] := '$notificationTitle = "STRG + ALT + X zum beenden."';
    ListBox1.Items.SaveToFile(SysUtils.GetEnvironmentVariable('temp') + '\VPNTool.ps1');
    ShellExecute(handle,'open',PChar('Powershell.exe'), PChar('-ExecutionPolicy Bypass -File ' + SysUtils.GetEnvironmentVariable('temp') + '\VPNTool.ps1'),'',SW_HIDE);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(Handle, id1);
  GlobalDeleteAtom(id1);
  UnRegisterHotKey(Handle, id2);
  GlobalDeleteAtom(id2);
  UnRegisterHotKey(Handle, id3);
  GlobalDeleteAtom(id3);
  UnRegisterHotKey(Handle, id4);
  GlobalDeleteAtom(id4);
  if mHandle <> 0 then
  CloseHandle(mHandle)
end;

procedure TForm1.TextTrayIcon1DblClick(Sender: TObject);
begin
  Form1.VerbindenAuflegen1.Click;
end;

end.

Sorry i completely left it uncommented for now.
If anyone is interested i can also share binarys, actually all the strings are for german language but i can easily make it international.

At this time the VPN Name and a little more is hardcoded, but it would be no pain to make this adjustable with an ini file.

Also polling for the rasdial connection state while triggering cmd and reading its console returns is not really that what i would understand under best practice, so maybe someone has any ideas to solve this more system-orientated.

If anyone with development skills is really reading my source code, i know i am a bad ass and please forgive me i am not a developer just a stupid technician and i know delphi is dead but i can do with it.

Regards X23

Quick way to connect Windows 10 embedded VPN connections

177

11.6k

17.1k

154.6k