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:
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:
with the following options:
- left or right click on the icon will show a popupmenu:
- Connect/Disconnect
- Reconnect on connection drop
- Notifications about connection state on/off
- Close the App for example:
The program cannot be closed by click against accidents you need to press STRG + ALT + X (global Hotkey)
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
if so please try it you will be flashed out 
