Function outputs chinese characters
lazarus / 34-Windows

----------------------------------------------------------------------
d4nn13 · 2013-06-29 22:10

I found this function to add an exception to the windows firewall.

Code: [Select]procedure AddExceptionToFirewall(Const exCaption,
Executable: String);
const
NET_FW_PROFILE2_DOMAIN  = 1;
NET_FW_PROFILE2_PRIVATE = 2;
NET_FW_PROFILE2_PUBLIC  = 4;

NET_FW_IP_PROTOCOL_TCP = 6;
NET_FW_ACTION_ALLOW    = 1;
var
  fwPolicy2      : OleVariant;
  RulesObject    : OleVariant;
  Profile        : Integer;
  NewRule        : OleVariant;
begin
  Profile             := NET_FW_PROFILE2_PRIVATE OR
NET_FW_PROFILE2_PUBLIC;
  fwPolicy2           := CreateOleObject('HNetCfg.FwPolicy2');
  RulesObject         := fwPolicy2.Rules;
  NewRule             := CreateOleObject('HNetCfg.FWRule');
  NewRule.Name        := exCaption;
  NewRule.Description := exCaption;
  NewRule.Applicationname := Executable;
  NewRule.Protocol := NET_FW_IP_PROTOCOL_TCP;
  NewRule.Enabled := TRUE;
  NewRule.Profiles := Profile;
  NewRule.Action := NET_FW_ACTION_ALLOW;
  RulesObject.Add(NewRule);
end;  

However when i run it i get chinese characters in the firewall rule as
an result.
I am new to lazarus and never had that in Delphi before, hope someone
can explain what i'm doing wrong.

----------------------------------------------------------------------
Avishai · 2013-06-30 00:11

Try this.  It sounds like it needs to be converted to UTF8.

Code: [Select]NewRule.Description := AnsiToUTF8(exCaption);

----------------------------------------------------------------------
theo · 2013-06-30 10:18

Quote from: Avishai on June 30, 2013, 02:11:21 amTry this.  It sounds
like it needs to be converted to UTF8.

Code: [Select]NewRule.Description := AnsiToUTF8(exCaption);

Why do you think the input is Ansi and the output should be UTF-8 for
Windows?

I would try UTF8Decode, but I don't know where "exCaption" comes from.

----------------------------------------------------------------------
marcov · 2013-06-30 11:44

Quote from: theo on June 30, 2013, 12:18:31 pm
Why do you think the input is Ansi and the output should be UTF-8 for
Windows?

I would try UTF8Decode, but I don't know where "exCaption" comes from.

That would my guess too. COM works mostly with widestrings. 

Windows doesn't use utf8 for anything by default.

----------------------------------------------------------------------
d4nn13 · 2013-06-30 12:02

Widestring was the right tip !
I changed it to:

Code: [Select]procedure AddExceptionToFirewall(Const exCaption,
Executable: WideString);

And now its working as expected, thank's a lot !

----------------------------------------------------------------------
marcov · 2013-06-30 12:14

If you have a cleaned up version, I'd be happy to add it to the
winutils unit. (which has some misc winapi helpers/wrappers)

----------------------------------------------------------------------
d4nn13 · 2013-06-30 13:57

There u go:

Code: [Select]uses  ComObj, ActiveX;

...

const
  NET_FW_PROFILE2_DOMAIN  = 1;
  NET_FW_PROFILE2_PRIVATE = 2;
  NET_FW_PROFILE2_PUBLIC  = 4;
  NET_FW_IP_PROTOCOL_TCP = 6;
  NET_FW_IP_PROTOCOL_UDP = 17;
  NET_FW_ACTION_ALLOW    = 1; 
   
...

procedure AddProgramExceptionToFireWall(Const wsCaption,
wsDescription, wsExecutable: WideString; iProtocol, iProfile:Integer);
var
  fwPolicy2                :  OleVariant;
  RulesObject              :  OleVariant;
  NewRule                  :  OleVariant;
begin
  fwPolicy2                := CreateOleObject('HNetCfg.FwPolicy2');
  RulesObject              := fwPolicy2.Rules;
  NewRule                  := CreateOleObject('HNetCfg.FWRule');
  NewRule.Name             := wsCaption;
  NewRule.Description      := wsDescription;
  NewRule.Applicationname  := wsExecutable;
  NewRule.Protocol         := iProtocol;
  NewRule.Enabled          := TRUE;
  NewRule.Profiles         := iProfile;
  NewRule.Action           := NET_FW_ACTION_ALLOW;
  RulesObject.Add(NewRule);
end;

procedure RemoveExceptionFromFW(Const exCaption: WideString);
var
  fwPolicy2      : OleVariant;
begin
  fwPolicy2      := CreateOleObject('HNetCfg.FwPolicy2');
  fwPolicy2.Rules.Remove(exCaption);
end;  



sample call to add a rule for a programm for all networks:

Code: [Select]  AddProgramExceptionToFireWall(
Application.Title,Application.Title, Application.ExeName,
NET_FW_IP_PROTOCOL_TCP, NET_FW_PROFILE2_DOMAIN or
NET_FW_PROFILE2_PRIVATE or NET_FW_PROFILE2_PUBLIC);

to remove it:

Code: [Select]  RemoveExceptionFromFW(Application.Title);


Edit: Added Protocol

----------------------------------------------------------------------
marcov · 2013-06-30 16:19

Thanks, r25021 in FPC/trunk

----------------------------------------------------------------------
d4nn13 · 2013-07-01 21:41

BTW to check if the Windows Firewall is running or not i use:

Code: [Select]uses activex, comobj;

....

function WindowsFirewallActive:Boolean;
var
  fwMAnager:OleVariant;
begin
  fwManager := CreateOLEObject('hnetcfg.fwmgr');
  Result := fwManager.LocalPolicy.CurrentProfile.FirewallEnabled;
end;

----------------------------------------------------------------------
BigChimp · 2013-07-02 06:24

Hint:
http://wiki.lazarus.freepascal.org/Windows_Programming_Tips
might be a better place for these code snippets as it's easier to
search for them, edit them etc (IMO).

----------------------------------------------------------------------
CCRDude · 2016-09-28 11:47

Just found this in winutils.pp while working on a separate unit for
firewall access, and saw that it has the same issue as my code:

This would add another rule each time it's called, and there's no way
here to test if its listed, so if you've got this in program startup,
your firewall would be spammed with hundreds of entries.

Plus, the naming convention (once ending in ...Firewall, once in
...FW) looks like a very quick and dirty hack as well.

I would vote to remove this from the official FreePascal sources for
said reason, or for a good overhaul of the code.