Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Conexión con bases de datos (https://www.clubdelphi.com/foros/forumdisplay.php?f=2)
-   -   Crear regla de entrada en Windows para Firebird 2.5 (https://www.clubdelphi.com/foros/showthread.php?t=96778)

pgranados 09-07-2024 00:15:03

Crear regla de entrada en Windows para Firebird 2.5
 
Hola, tengo una aplicación que utiliza Firebird 2.5 pero me he topado que con algunas computadoras tengo que crear una regla de entrada para el puerto 3050 para que funcione la base de datos.

Hay algun procedimiento o función en Delphi para crear esta regla en automatico (si es que no existe) en Windows?

Saludos

Casimiro Noteví 09-07-2024 10:17:05

¿Te refieres al firewall?
Algo así:
Código Delphi [-]
uses
  Winapi.Windows, Winapi.ShellAPI, System.SysUtils;

procedure AddFirewallRule;
var
  Command: string;
begin
  // Comando para agregar una regla al firewall de Windows
  Command := 'netsh advfirewall firewall add rule name="Firebird 3050" dir=in action=allow protocol=TCP localport=3050';

  // Ejecutar el comando usando ShellExecute
  ShellExecute(0, 'open', 'cmd.exe', PChar('/C ' + Command), nil, SW_HIDE);
end;

begin
  try
    AddFirewallRule;
    Writeln('Regla de firewall añadida.');
  except
    on E: Exception do
      Writeln('Error: ', E.Message);
  end;
end.

manelb 09-07-2024 10:42:14

Nosotros lo hacemos con un fichero .bat al realizar la instalación

Código:

netsh advfirewall firewall add rule name="Microdelta - Firebird (puerto)" dir=in action=allow protocol=TCP localport=3050
netsh advfirewall firewall add rule name="Microdelta - Firebird (fbguard)" dir=in action=allow program="C:\Program Files (x86)\Firebird\Firebird_2_1\bin\fbguard.exe" enable=yes
netsh advfirewall firewall add rule name="Microdelta - Firebird (fbserver)" dir=in action=allow program="C:\Program Files (x86)\Firebird\Firebird_2_1\bin\fbserver.exe" enable=yes


pgranados 18-07-2024 19:22:42

Gracias por sus aportes, al final utilice el procedimiento de Casimiro y con ayuda de GPT lo modifique un poco para que la regla se cree solo cuando no exista.

Código Delphi [-]

procedure AgregarFirewallFirebird;
var
  Command, CheckCommand: string;
  OutputLines: TStringList;
  ShellOutput: string;
  SecurityAttributes: TSecurityAttributes;
  StdOutRead, StdOutWrite: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  BytesRead: DWORD;
  Buffer: array[0..255] of AnsiChar;
  i:integer;
begin
  CheckCommand := 'netsh advfirewall firewall show rule name="REGLA 3050"';
  Command := 'netsh advfirewall firewall add rule name="REGLA 3050" dir=in action=allow protocol=TCP localport=3050';
  OutputLines := TStringList.Create;

  try
    ZeroMemory(@SecurityAttributes, SizeOf(SecurityAttributes));
    SecurityAttributes.nLength := SizeOf(SecurityAttributes);
    SecurityAttributes.bInheritHandle := TRUE;

    if not CreatePipe(StdOutRead, StdOutWrite, @SecurityAttributes, 0) then
      RaiseLastOSError;

    try
      ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
      StartupInfo.cb := SizeOf(StartupInfo);
      StartupInfo.hStdOutput := StdOutWrite;
      StartupInfo.hStdError := StdOutWrite;
      StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      StartupInfo.wShowWindow := SW_HIDE;

      ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));

      if CreateProcess(nil, PChar('cmd.exe /C ' + CheckCommand), nil, nil, TRUE, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
      begin
        CloseHandle(StdOutWrite);

        repeat
          BytesRead := 0;
          ReadFile(StdOutRead, Buffer, SizeOf(Buffer) - 1, BytesRead, nil);
          Buffer[BytesRead] := #0;
          ShellOutput := ShellOutput + String(Buffer);
        until BytesRead = 0;

        WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
        CloseHandle(ProcessInfo.hProcess);
        CloseHandle(ProcessInfo.hThread);
      end;

      OutputLines.Text := ShellOutput;

      i:= Pos('REGLA 3050', OutputLines.Text);
      if i = 0 then
        ShellExecute(0, 'open', 'cmd.exe', PChar('/C ' + Command), nil, SW_HIDE);

    finally
      CloseHandle(StdOutRead);
    end;

  finally
    OutputLines.Free;
  end;
end;


La franja horaria es GMT +2. Ahora son las 11:25:53.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi