Windows firewall rule for XP - windows

How to programmatically add an application or port to Windows Firewall on Windows XP?

Try this code extracted from our open source SQlite3UI.pas unit:
function GetXPFirewall(var fwMgr, profile: OleVariant): boolean;
begin
Result := (Win32Platform=VER_PLATFORM_WIN32_NT) and
(Win32MajorVersion>5) or ((Win32MajorVersion=5) and (Win32MinorVersion>0));
if result then // need Windows XP at least
try
fwMgr := CreateOleObject('HNetCfg.FwMgr');
profile := fwMgr.LocalPolicy.CurrentProfile;
except
on E: Exception do
result := false;
end;
end;
const
NET_FW_PROFILE_DOMAIN = 0;
NET_FW_PROFILE_STANDARD = 1;
NET_FW_IP_VERSION_ANY = 2;
NET_FW_IP_PROTOCOL_UDP = 17;
NET_FW_IP_PROTOCOL_TCP = 6;
NET_FW_SCOPE_ALL = 0;
NET_FW_SCOPE_LOCAL_SUBNET = 1;
procedure AddApplicationToXPFirewall(const EntryName, ApplicationPathAndExe: string);
var fwMgr, profile, app: OleVariant;
begin
if GetXPFirewall(fwMgr,profile) then
try
if profile.FirewallEnabled then begin
app := CreateOLEObject('HNetCfg.FwAuthorizedApplication');
try
app.ProcessImageFileName := ApplicationPathAndExe;
app.Name := EntryName;
app.Scope := NET_FW_SCOPE_ALL;
app.IpVersion := NET_FW_IP_VERSION_ANY;
app.Enabled :=true;
profile.AuthorizedApplications.Add(app);
finally
app := varNull;
end;
end;
finally
profile := varNull;
fwMgr := varNull;
end;
end;
procedure AddPortToXPFirewall(const EntryName: string; PortNumber: cardinal);
var fwMgr, profile, port: OleVariant;
begin
if GetXPFirewall(fwMgr,profile) then
try
if profile.FirewallEnabled then begin
port := CreateOLEObject('HNetCfg.FWOpenPort');
port.Name := EntryName;
port.Protocol := NET_FW_IP_PROTOCOL_TCP;
port.Port := PortNumber;
port.Scope := NET_FW_SCOPE_ALL;
port.Enabled := true;
profile.GloballyOpenPorts.Add(port);
end;
finally
port := varNull;
profile := varNull;
fwMgr := varNull;
end;
end;
It will allow you to add an application or a port to the XP firewall.
Should work from Delphi 6 up to XE.

Scripting the Windows Firewall is possible, see Scripting the Windows Firewall
And code examples for example here

Related

Indy IdHttp Digest Authentication - 401

When you try to take a picture from a camera, the authentication function does not work. I read all the other posts on the subject, but without success with this device.
Indy 10.6.2.0
Uses ..., IdAuthentication, IdAuthenticationDigest;
...
addr := 'cgi-bin/snapshot.cgi?1';
myADR := 'http://87.126.245.25:8181/' + addr;
rStream := TMemoryStream.Create;
try
H1 := TIdHttp.Create();
{$IFDEF DEBUG}
idLogFile := TIdLogFile.Create( H1 );
with idLogFile do begin
Filename := IncludeTrailingPathDelimiter( ExtractFileDir( Application.ExeName ) ) + 'indy_log.txt';
Active := true;
end;
{$ENDIF}
with H1 do begin
Response.KeepAlive := true;
ReadTimeout := selCAM.Timeout;
Request.BasicAuthentication := false;
Request.Username := selCAM.User;
Request.Password := selCAM.Pass;
Request.ContentType := 'image/jpeg';
Request.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) Chrome/97.0.4692.71';
Request.ContentVersion := '1.0';
Request.IPVersion := Id_IPv4;
Request.Host := 'http://' + addr;
HTTPOptions := [hoInProcessAuth, hoForceEncodeParams];
OnSelectAuthorization := IdHTTP_SelectAuthorization;
OnHeadersAvailable := IdHTTP_HeadersAvailable;
OnAuthorization := IdHTTP_Authorization;
{$IFDEF DEBUG} Intercept := idLogFile; {$ENDIF}
end;
try
H1.Get( myADR, rStream); except
on E: EIdHTTPProtocolException do begin SB1.Panels[0].Text := E.Message; er := true; end;
on E: EIdException do begin SB1.Panels[0].Text := E.Message; er := true; end;
on E: Exception do begin SB1.Panels[0].Text := E.Message; er := true; end;
end;
finally
H1.Free;
FreeAndNil(rStream);
end;
It works correctly through a browser
Attach wireshark from Browser, from Indy and Indy Log:
https://1drv.ms/u/s!AubiEh1vqvRLkr01GzXCf_T0yLgmfQ?e=69dqaD

Why is my Delphi code not executing in order?

I am creating a program, and I need to display an image and then block input for a few seconds before allowing it again. The problem I am running into is that Delphi is not running the code in order and is executing the Sleep() command before the image command. I have run into this problem before when using Sleep() with a video before displaying a message.
The code looks as follows:
procedure TtForm.WindowsMediaPlayer2Click(ASender: TObject;
nButton, nShiftState: SmallInt; fX, fY: Integer);
Var
buttonSelected: Integer;
begin
buttonSelected := MessageDlg('Well done Monkey!-_-', mtError, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
Pages.Visible := False;
WindowsMediaPlayer2.Visible := False;
imgEroor.BringToFront;
BorderStyle := bsNone;
WindowState := wsMaximized;
imgEroor.Top := 0;
imgEroor.Left := 0;
imgEroor.Width := Screen.Width;
imgEroor.Height := Screen.Height;
imgEroor.BringToFront;
BlockInput(True);
Sleep(10000);
BlockInput(False);
end;
if buttonSelected = mrCancel then
begin
Pages.Visible := False;
WindowsMediaPlayer2.Visible := False;
imgEroor.BringToFront;
BorderStyle := bsNone;
WindowState := wsMaximized;
imgEroor.Top := 0;
imgEroor.Left := 0;
imgEroor.Width := Screen.Width;
imgEroor.Height := Screen.Height;
imgEroor.BringToFront;
BlockInput(True);
Sleep(10000);
BlockInput(False);
end;
end;

FireDAC under connecting freeze GUI

I'm facing with an issue, here is my code
constructor TORAThread.Create;
begin
inherited Create(True);
ORAFDcon_Ora := TFDConnection.Create(nil);
ORAFDPhysOracleDriverLink := TFDPhysOracleDriverLink.Create(nil);
ORAFDGUIxWaitCursor := TFDGUIxWaitCursor.Create(nil);
ORAStorPRoc := TFDStoredProc.Create(nil);
ORAFDcon_Ora.DriverName := 'ora';
ORAFDcon_Ora.LoginPrompt := False;
ORAFDcon_Ora.Params.LoadFromFile('ORAconfig.ini');
ORAFDcon_Ora.CheckConnectionDef;
ORAFDcon_Ora.ResourceOptions.AutoConnect := True;
ORAFDcon_Ora.ResourceOptions.AutoReconnect := True;
ORAFDcon_Ora.ResourceOptions.KeepConnection := True;
ORAFDcon_Ora.ResourceOptions.CmdExecMode := amNonBlocking;
procedure TORAThread.Execute;
begin
ORAFDcon_Ora.Connected := True;
while not terminated do
begin
//somejobs
end;
When I start the thread and VPN connection is not alive, my GUI freezes
Whats wrong?
Regards,

Localized string values for the size strings KB, MB, GB etc.?

Where is this strins resources is stored on the Windows?
I need to show size corectly on native language of installed Windows.
Strings are very specific to the application that is using it. There are no generic string resouce in windows that an application can use. Of course you can write a program to search the resource in the windows folder to see which resource dll has the string that you are looking for and then use that resource dll in your application, but that is unadvisable. The reason being that, any new update of the windows that brings in resource dll changes can break your application.
As the other poster advises, you are better of writing your own resource dll and localize it in the languages that you want to support your application.
This is possible with disk quota library which is available since Windows XP:
function FindStringResourceEx(AInstance: HINST; AStringID: UINT; ALangID: UINT): PWideChar;
var
Res: HRSRC;
LoadedRes: HGLOBAL;
I: Integer;
begin
Result := nil;
Res := FindResourceEx(AInstance, RT_STRING, MAKEINTRESOURCE(AStringID div 16 + 1), ALangID);
if Res <> 0 then begin
LoadedRes := LoadResource(AInstance, Res);
if LoadedRes <> 0 then
try
Result := PChar(LockResource(LoadedRes));
if Assigned(Result) then
try
for I := 0 to (AStringID and 15) - 1 do
Inc(Result, PWord(Result)^ + 1);
finally
UnlockResource(THandle(Result));
end;
finally
FreeResource(LoadedRes);
end;
end;
end;
function GetSizeStrings(out sBytes, sKB, sMB, sGB, sTB, sPB, sEB: string): Boolean;
var
hLib: HMODULE;
sRes: string;
I: Integer;
SL: TStringList;
begin
Result := False;
hLib := LoadLibrary('dskquoui.dll');
if hLib > 0 then
try
SL := TStringList.Create;
try
sRes := FindStringResourceEx(hLib, 14472, MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL));
Result := sRes <> '';
if Result then begin
sRes := sRes.Remove(0, 1);
I := sRes.IndexOf(#$B);
if I > -1 then
sRes := sRes.Remove(I);
SL.Delimiter := #2;
SL.DelimitedText := sRes;
sBytes := SL[0]; // bytes
sKB := SL[1]; // KB
sMB := SL[2]; // MB
sGB := SL[3]; // GB
sTB := SL[4]; // TB
sPB := SL[5]; // PB
sEB := SL[6]; // EB
end;
finally
SL.Free;
end;
finally
FreeLibrary(hLib);
end;
if not Result then begin
sBytes := 'bytes';
sKB := 'KB';
sMB := 'MB';
sGB := 'GB';
sTB := 'TB';
sPB := 'PB';
sEB := 'EB';
end;
end;

How to remove the bottom panel in inno set up..and replace it with a custom panel

i want to replace the bottom panel where we show Next,Back buttons with a custom panel which includes the installation progress bar..once the installation is completed,then page should automatically redirected to next page.
Below is mockup image,how i want to make this page.
Here is the script including also the main panel header from your previous question as well. Save it into your ..\InnoSetup\Examples\ folder as well as the following images which you need to convert to BMP files since I couldn't find any trusted file sharing site which wouldn't convert the images to PNG or JPG format:
this one convert to BMP and save as Logo.bmp
this one convert to BMP and save as InstallBackground.bmp
Here is the script (you should follow the commented version of this script first):
[Setup]
AppName=ERPBO
AppVersion=1.5
DefaultDirName={pf}\My Program
DefaultGroupName=My Program
UninstallDisplayIcon={app}\MyProg.exe
Compression=lzma2
SolidCompression=yes
OutputDir=userdocs:Inno Setup Examples Output
WizardSmallImageFile=Logo.bmp
[Files]
Source: "MyProg.exe"; DestDir: "{app}"
Source: "MyProg.chm"; DestDir: "{app}"
Source: "InstallBackground.bmp"; Flags: dontcopy
[Icons]
Name: "{group}\My Program"; Filename: "{app}\MyProg.exe"
[Run]
Filename: "{app}\MyProg.chm"; Check: JustBlockTheInstallPage
[Messages]
SetupWindowTitle=Installere - %1
WizardInstalling=Installasjon pågår...
[Code]
function JustBlockTheInstallPage: Boolean;
begin
Result := False;
WizardForm.StatusLabel.Caption := 'Pakker ut filer...';
WizardForm.FilenameLabel.Caption :='C:\dnpr\Crystal reports setup\WindowShoppingNet.msi';
MsgBox('Message just to see the install page :-)', mbInformation, MB_OK);
end;
var
InnerNotebookBounds: TRect;
OuterNotebookBounds: TRect;
InstallBottomPanel: TPanel;
InstallBackground: TBitmapImage;
function Rect(const ALeft, ATop, ARight, ABottom: Integer): TRect;
begin
Result.Left := ALeft;
Result.Top := ATop;
Result.Bottom := ABottom;
Result.Right := ARight;
end;
function GetBoundsRect(AControl: TControl): TRect;
begin
Result.Left := AControl.Left;
Result.Top := AControl.Top;
Result.Right := AControl.Left + AControl.Width;
Result.Bottom := AControl.Top + AControl.Height;
end;
procedure SetBoundsRect(AControl: TControl; const ARect: TRect);
begin
AControl.Left := ARect.Left;
AControl.Top := ARect.Top;
AControl.Width := ARect.Right - ARect.Left
AControl.Height := ARect.Bottom - ARect.Top;
end;
procedure CenterHorizontally(ASource, ATarget: TControl);
begin
ATarget.Left := (ASource.Width - ATarget.Width) div 2;
end;
procedure CenterVertically(ASource, ATarget: TControl);
begin
ATarget.Top := (ASource.Height - ATarget.Height) div 2;
end;
procedure InitializeWizard;
begin
WizardForm.PageDescriptionLabel.Visible := False;
WizardForm.PageNameLabel.Font.Size := 18;
WizardForm.PageNameLabel.Font.Name := 'Comic Sans MS';
WizardForm.PageNameLabel.AutoSize := True;
WizardForm.PageNameLabel.Left := 18;
CenterVertically(WizardForm.MainPanel, WizardForm.PageNameLabel);
WizardForm.WizardSmallBitmapImage.AutoSize := True;
WizardForm.WizardSmallBitmapImage.Left := WizardForm.ClientWidth - WizardForm.WizardSmallBitmapImage.Width - 18;
CenterVertically(WizardForm.MainPanel, WizardForm.WizardSmallBitmapImage);
WizardForm.InstallingPage.Color := clWhite;
InstallBottomPanel := TPanel.Create(WizardForm);
InstallBottomPanel.Parent := WizardForm.InstallingPage;
InstallBottomPanel.BevelOuter := bvNone;
InstallBottomPanel.Align := alBottom;
InstallBottomPanel.Caption := '';
InstallBottomPanel.Color := $00C7CFD3;
InstallBottomPanel.Height := 79;
InstallBottomPanel.ParentBackground := False;
ExtractTemporaryFile('InstallBackground.bmp');
InstallBackground := TBitmapImage.Create(WizardForm);
InstallBackground.Parent := WizardForm.InstallingPage;
InstallBackground.AutoSize := True;
InstallBackground.Bitmap.LoadFromFile(ExpandConstant('{tmp}\InstallBackground.bmp'));
WizardForm.StatusLabel.Parent := InstallBottomPanel;
WizardForm.StatusLabel.Left := 8;
WizardForm.StatusLabel.Top := 8;
WizardForm.FilenameLabel.Parent := InstallBottomPanel;
WizardForm.FilenameLabel.Left := 8;
WizardForm.FilenameLabel.Top := WizardForm.StatusLabel.Top + 16;
WizardForm.ProgressGauge.Parent := InstallBottomPanel;
WizardForm.ProgressGauge.Left := 8;
WizardForm.ProgressGauge.Top := WizardForm.FilenameLabel.Top + 26;
InnerNotebookBounds := GetBoundsRect(WizardForm.InnerNotebook);
OuterNotebookBounds := GetBoundsRect(WizardForm.OuterNotebook);
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = wpInstalling then
begin
SetBoundsRect(WizardForm.OuterNotebook, Rect(OuterNotebookBounds.Left,
OuterNotebookBounds.Top, OuterNotebookBounds.Right, WizardForm.ClientHeight));
SetBoundsRect(WizardForm.InnerNotebook, Rect(OuterNotebookBounds.Left,
WizardForm.Bevel1.Top + WizardForm.Bevel1.Height, OuterNotebookBounds.Right,
WizardForm.ClientHeight));
CenterHorizontally(WizardForm.InstallingPage, InstallBackground);
InstallBackground.Top := InstallBottomPanel.Top - InstallBackground.Height;
WizardForm.ProgressGauge.Width := InstallBottomPanel.Width - 16;
end
else
begin
SetBoundsRect(WizardForm.OuterNotebook, OuterNotebookBounds);
SetBoundsRect(WizardForm.InnerNotebook, InnerNotebookBounds);
end;
end;
And the result how the installation page looks like (and yes, I have used Comic Sans :-)

Resources