323 lines
9.0 KiB
Plaintext
323 lines
9.0 KiB
Plaintext
unit DMgWinFwMain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Buttons,
|
||
VirtualTrees, Vcl.StdCtrls, Tocsg.Firewall;
|
||
|
||
type
|
||
TDlgMgWinFwMain = class(TForm)
|
||
pnTop: TPanel;
|
||
pcMain: TPageControl;
|
||
tabInbound: TTabSheet;
|
||
tabOutbound: TTabSheet;
|
||
btnFwRules: TSpeedButton;
|
||
vtOut: TVirtualStringTree;
|
||
vtIn: TVirtualStringTree;
|
||
btnAddRule: TSpeedButton;
|
||
SpeedButton1: TSpeedButton;
|
||
SpeedButton2: TSpeedButton;
|
||
SpeedButton3: TSpeedButton;
|
||
SpeedButton4: TSpeedButton;
|
||
SpeedButton5: TSpeedButton;
|
||
SpeedButton6: TSpeedButton;
|
||
tabTheme: TTabSheet;
|
||
RadioButton1: TRadioButton;
|
||
cbStyles: TComboBox;
|
||
Memo1: TMemo;
|
||
Edit1: TEdit;
|
||
GroupBox1: TGroupBox;
|
||
CheckBox1: TCheckBox;
|
||
CheckBox2: TCheckBox;
|
||
ProgressBar1: TProgressBar;
|
||
RadioButton2: TRadioButton;
|
||
CheckBox3: TCheckBox;
|
||
ComboBox1: TComboBox; procedure btnFwRulesClick(Sender: TObject);
|
||
procedure vtInGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
procedure vtInFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||
procedure vtInGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
||
procedure vtInHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
|
||
procedure vtInCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||
procedure vtInGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
|
||
var HintText: string);
|
||
procedure btnAddRuleClick(Sender: TObject);
|
||
procedure SpeedButton1Click(Sender: TObject);
|
||
procedure SpeedButton2Click(Sender: TObject);
|
||
procedure SpeedButton3Click(Sender: TObject);
|
||
procedure SpeedButton4Click(Sender: TObject);
|
||
procedure SpeedButton5Click(Sender: TObject);
|
||
procedure SpeedButton6Click(Sender: TObject);
|
||
procedure cbStylesChange(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
ms_: TMemoryStream;
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
end;
|
||
|
||
var
|
||
DlgMgWinFwMain: TDlgMgWinFwMain;
|
||
|
||
implementation
|
||
|
||
uses
|
||
NetFwTypeLib_TLB, VirtualTrees.Types, Winapi.PsAPI, Winapi.ActiveX,
|
||
Tocsg.VirtualTreeViewUtil, System.Variants, Tocsg.Convert, Tocsg.Safe,
|
||
Vcl.Styles, Vcl.Themes;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TDlgMgWinFwMain.Create(aOwner: TComponent);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Inherited Create(aOwner);
|
||
ms_ := nil;
|
||
for i := Low(TStyleManager.StyleNames) to High(TStyleManager.StyleNames) do
|
||
cbStyles.Items.Add(TStyleManager.StyleNames[i]);
|
||
pcMain.ActivePage := tabInbound;
|
||
end;
|
||
|
||
Destructor TDlgMgWinFwMain.Destroy;
|
||
begin
|
||
if ms_ <> nil then
|
||
FreeAndNil(ms_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.SpeedButton1Click(Sender: TObject);
|
||
var
|
||
FwRule: TFwRule;
|
||
begin
|
||
ZeroMemory(@FwRule, SizeOf(FwRule));
|
||
FwRule.sName := '_22';
|
||
FwRule.sGroup := 'Tocsg Group';
|
||
FwRule.sDesc := 'Prevent default protocols over TCP/UDP';
|
||
FwRule.nProtocol := NET_FW_IP_PROTOCOL_ANY; // NET_FW_IP_PROTOCOL_TCP;
|
||
// FwRule.sLocalPorts := '*';
|
||
// FwRule.sRemotePorts := '20,21,23,25,69,110,119,123,143,989,990,2501,5001,9100,9101,9102,9600';
|
||
FwRule.sRemoteAddresses := '192.168.0.10,192.168.0.1-192.168.0.255';
|
||
FwRule.nAction := NET_FW_ACTION_BLOCK;
|
||
FwRule.nDirection := NET_FW_RULE_DIR_OUT;
|
||
FwRule.bEnabled := true;
|
||
|
||
if AddFwRule(FwRule) <> nil then
|
||
ShowMessage('<27><>Ģ <20>߰<EFBFBD> <20><><EFBFBD><EFBFBD>')
|
||
else
|
||
ShowMessage('<27><>Ģ <20>߰<EFBFBD> <20><><EFBFBD><EFBFBD>')
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.SpeedButton2Click(Sender: TObject);
|
||
var
|
||
fwPolicy2: INetFwPolicy2;
|
||
begin
|
||
fwPolicy2 := CoNetFwPolicy2.Create;
|
||
try
|
||
fwPolicy2.FirewallEnabled[fwPolicy2.CurrentProfileTypes] := false;
|
||
finally
|
||
fwPolicy2 := nil;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.SpeedButton3Click(Sender: TObject);
|
||
var
|
||
fwPolicy2: INetFwPolicy2;
|
||
begin
|
||
fwPolicy2 := CoNetFwPolicy2.Create;
|
||
try
|
||
fwPolicy2.FirewallEnabled[fwPolicy2.CurrentProfileTypes] := true;
|
||
finally
|
||
fwPolicy2 := nil;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.SpeedButton4Click(Sender: TObject);
|
||
var
|
||
fwPolicy2: INetFwPolicy2;
|
||
begin
|
||
fwPolicy2 := CoNetFwPolicy2.Create;
|
||
try
|
||
ShowMessage(BooleanToStr(fwPolicy2.FirewallEnabled[fwPolicy2.CurrentProfileTypes], '<27><><EFBFBD><EFBFBD>', '<27><><EFBFBD><EFBFBD>'));
|
||
finally
|
||
fwPolicy2 := nil;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.SpeedButton5Click(Sender: TObject);
|
||
begin
|
||
if RemoveFwRule('_11') then
|
||
ShowMessage('<27><>Ģ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>')
|
||
else
|
||
ShowMessage('<27><>Ģ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>');
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.SpeedButton6Click(Sender: TObject);
|
||
begin
|
||
begin
|
||
if RemoveFwRule('_22') then
|
||
ShowMessage('<27><>Ģ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>')
|
||
else
|
||
ShowMessage('<27><>Ģ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>');
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.btnAddRuleClick(Sender: TObject);
|
||
var
|
||
FwRule: TFwRule;
|
||
begin
|
||
ZeroMemory(@FwRule, SizeOf(FwRule));
|
||
FwRule.sName := '_11';
|
||
FwRule.sGroup := 'Tocsg Group';
|
||
FwRule.sDesc := 'Prevent Network Access';
|
||
FwRule.nProtocol := NET_FW_IP_PROTOCOL_TCP;
|
||
FwRule.sAppName := 'C:\Program Files\Google\Chrome\Application\chrome.exe';
|
||
FwRule.nAction := NET_FW_ACTION_BLOCK;
|
||
FwRule.nDirection := NET_FW_RULE_DIR_OUT;
|
||
FwRule.bEnabled := true;
|
||
|
||
if AddFwRule(FwRule) <> nil then
|
||
ShowMessage('<27><>Ģ <20>߰<EFBFBD> <20><><EFBFBD><EFBFBD>')
|
||
else
|
||
ShowMessage('<27><>Ģ <20>߰<EFBFBD> <20><><EFBFBD><EFBFBD>');
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.btnFwRulesClick(Sender: TObject);
|
||
var
|
||
FwRuleList: TFwRuleEntList;
|
||
i: Integer;
|
||
pData: PFwRuleEnt;
|
||
begin
|
||
vtIn.BeginUpdate;
|
||
vtOut.BeginUpdate;
|
||
try
|
||
VT_Clear(vtIn);
|
||
VT_Clear(vtOut);
|
||
pcMain.ActivePage := tabInbound;
|
||
|
||
Guard(FwRuleList, TFwRuleEntList.Create);
|
||
if GetFwRulesToList(FwRuleList) = 0 then
|
||
exit;
|
||
|
||
for i := 0 to FwRuleList.Count - 1 do
|
||
begin
|
||
if FwRuleList[i].nDirection = NET_FW_RULE_DIR_OUT then
|
||
pData := VT_AddChildData(vtOut)
|
||
else
|
||
pData := VT_AddChildData(vtIn);
|
||
pData^ := FwRuleList[i]^;
|
||
end;
|
||
finally
|
||
vtOut.EndUpdate;
|
||
vtIn.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.cbStylesChange(Sender: TObject);
|
||
begin
|
||
TStyleManager.TrySetStyle(cbStyles.Text);
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.vtInCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||
begin
|
||
Result := CompareText(TVirtualStringTree(Sender).Text[Node1, Column],
|
||
TVirtualStringTree(Sender).Text[Node2, Column]);
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.vtInFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
var
|
||
pData: PFwRuleEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
Finalize(pData^);
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.vtInGetHint(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex;
|
||
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
||
begin
|
||
HintText := TVirtualStringTree(Sender).Text[Node, Column];
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.vtInGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
begin
|
||
NodeDataSize := SizeOf(TFwRuleEnt);
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.vtInGetText(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||
var CellText: string);
|
||
var
|
||
pData: PFwRuleEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
|
||
case Column of
|
||
0 : CellText := IntToStr(Node.Index + 1);
|
||
1 : CellText := pData.sName;
|
||
2 : CellText := pData.sGroup;
|
||
3 : CellText := pData.sDesc;
|
||
4 : CellText := pData.sAppName;
|
||
5 : CellText := pData.sSvrName;
|
||
6 : CellText := pData.sLocalAddr;
|
||
7 : CellText := pData.sRemoteAddr;
|
||
8 : CellText := pData.sLocalPorts;
|
||
9 : CellText := pData.sRemotePorts;
|
||
10 : CellText := pData.sInterfaceType;
|
||
11 : CellText := pData.sIcmpTypesAndCodes;
|
||
12 : CellText := BooleanToStr(pData.bEnabled, 'Ȱ<><C8B0>', '<27><>Ȱ<EFBFBD><C8B0>');
|
||
13 : CellText := FwProfileToStr(pData.nProfiles);
|
||
14 : CellText := FwProtocolToStr(pData.nProtocol);
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgMgWinFwMain.vtInHeaderClick(Sender: TVTHeader;
|
||
HitInfo: TVTHeaderHitInfo);
|
||
begin
|
||
if HitInfo.Button = mbLeft then
|
||
begin
|
||
with Sender, Treeview, HitInfo do
|
||
begin
|
||
if HitInfo.Column < 0 then
|
||
exit;
|
||
|
||
if SortColumn > NoColumn then
|
||
Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
|
||
|
||
if HitInfo.Column = 0 then
|
||
SortColumn := NoColumn
|
||
else begin
|
||
if (SortColumn = NoColumn) or (SortColumn <> Column) then
|
||
begin
|
||
SortColumn := Column;
|
||
SortDirection := sdAscending;
|
||
end else
|
||
if SortDirection = sdAscending then
|
||
SortDirection := sdDescending
|
||
else
|
||
SortDirection := sdAscending;
|
||
|
||
Columns[SortColumn].Color := TVirtualStringTree(Treeview).Colors.BackGroundColor - 500;
|
||
TVirtualStringTree(Treeview).BeginUpdate;
|
||
try
|
||
TVirtualStringTree(Treeview).SortTree(SortColumn, SortDirection, False);
|
||
finally
|
||
TVirtualStringTree(Treeview).EndUpdate;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
end.
|