Servicio con acceso a la red
 

¡Buenas! Mi primer post, mi primera duda. Espero que me podáis ayudar.

Tengo un servicio escrito con Delphi que necesita tener acceso a las carpetas en red para realizar backups de firebird usando GBAK, pero por mucho que lo intento no soy capaz de encontrar la manera de hacerlo.
He probado ha ponerle "NT AUTHORITY\NetworkService" en el atributo de ServiceStartName, pero mas que elevar los permisos de la aplicación, hace que ni siquiera funcione en las carpetas locales.

Si alguien sabe como darle los permisos necesarios, o cualquier otra manera de hacerlo funcionar, le estaría eternamente agradecido.

¡Un saludo!

xFas,

¡¡Bienvenido al Club Delphi!!

Revisa este link, si es un problema de privilegios quizás se pueda usar en tu proyecto:
Revisa estos links relacionados con GBAK:
Espero sea útil :)

Nelson.

He intentado utilizar el "runas" al que me haces referencia, por desgracia sin ningún éxito.

Las otras referencias ya las había consultado, (es mas, ¡la pregunta en StackOverflow es mía!). La cosa es que el servicio funciona en las carpetas locales, pero no tiene acceso a las remotas.

Gracias por responder tan rápido :D

No entiendo qué quieres hacer, usar gbak, sí, pero ¿hacer un backup de una base de datos en un servidor, desde un cliente?, si es eso, no hace falta tener ningún privilegio ni permiso en el servidor.

No no, el servicio corre en el servidor.

La intención es hacer una copia de seguridad de la base de datos y guardarla en una unidad en red

Para eso sólo has de usar el parámetro adecuado en gbak
Enlace al documento


También puedes hacer una búsqueda por los foros, es un tema tratado en diversas ocasiones.

Pero para que funcione ese parámetro ¿no tiene que estar instalado firebird en el equipo remoto?

Yo lo que necesito es que el servidor haga un backup de su base de datos, y esta sea almacenada en un equipo de la red que no tiene porque tener firebird.

Muchas gracias por la ayuda!

Pero para eso sólo has de indicarle la ruta:

gbak -b -t -v -user sysdba -password masterkey localhost:/datos/tubasedatos.fdb 192.168.1.100:/home/backups/elbackupdetubd.fbk

gbak -b -t -v -user sysdba -password masterkey localhost:c:\datos\tubasedatos.fdb 192.168.1.100:c:\backups\elbackupdetubd.fbk

Lo que ha puesto Casimiro te sirve.

El servidor tendrá Firebird, por tanto ejecutará el gbak, hará la copia y lo enviará a otro ordenador remoto. En el remoto no tienes que instalar Firebird, bien puede ser una carpeta, otro ordenador, o un ftp.

Sigue sin funcionarme, os dejo código para que podáis ver lo que estoy intentando

Código Delphi [-]
try
  FillChar(SEInfo, SizeOf(SEInfo), 0);
  SEInfo.cbSize := SizeOf(TShellExecuteInfo);
  with SEInfo do begin
   fMask           := SEE_MASK_NOCLOSEPROCESS;
   Wnd             := 0;
   lpFile            := PWIDEChar(RegQueryStringValue('SOFTWARE\Firebird Project\Firebird Server\Instances', 'DefaultInstance')+'bin\gbak.exe');
   nShow          := SW_HIDE;
   lpParameters := PWIDEChar('-v -t -user SYSDBA -password "masterkey" LOCALHOST: DATABASE ' + 'REMOTE:/Programacion/Backup_Firebird');
  end;
  if ShellExecuteEx(@SEInfo) then begin
   repeat
    GetExitCodeProcess(SEInfo.hProcess, ExitCD);
   until (ExitCD <> STILL_ACTIVE) or (Terminated);
  end;

Los directorios que tengan espacios debes escribirlos entre comillas, ejemplo:

"c:\Archivos de programa\Firebird\bin\gbak" -b -t -v -user sysdba -password masterkey "localhost:c:\mis datos\basedatos.fdb" 192.168.1.100:c:\backups\elbackupdetubd.fbk

Lo se, he separado "LOCALHOST: DATABASE" para que no me saliese un :D , ¡perdón!

No, me refiero en la ruta: "c:\Archivos de programa\firebird...." debe ir entre comillas porque tiene espacios.
o sea, algo así como:

QuotedStr(la ruta)

Si le pongo el QuotedStr así

Código Delphi [-]
lpFile            := PWIDEChar(QuotedStr(RegQueryStringValue('SOFTWARE\Firebird Project\Firebird Server\Instances', 'DefaultInstance')+'bin\gbak.exe'));

no encuentra el archivo.

Ademas, estoy seguro de que el error no viene de por ahí, ya que si que hace los backups en carpetas locales. Solo da problemas con carpetas en red

Hola xFas.

Como te esta indicando Casimiro es la forma correcta de llamar a gbak, seguramente el problema este en la llamada a ShellExecute o exista alguna ruta incorrecta.

De este modo me funciona sin problemas:

Código Delphi [-]
...
uses ShellApi;

procedure MakeGbak(const Origen, Destino: string);
var
  lpDirectory,
  lpParameters: PChar;
begin
  lpDirectory := PChar(GetEnvironmentVariable('ProgramFiles') + '\Firebird\Firebird_2_5\bin');
  lpParameters:= PChar('-v -t -user SYSDBA -password "masterkey" ' + Origen + ' ' + Destino);
  ShellExecute(Form1.Handle,
               'open',
               'gbak.exe',
               lpParameters,
               lpDirectory,
               SW_HIDE);
end;

Tomá en cuenta que el ejemplo está basado en Firebird 2.5 para tomar la ubicación de gbak

Saludos. :)

Pues si tiene espacios es seguro que no funciona.

EDITO: ecfisa te ha puesto otro ejemplo.

He probado a hacerlo como me ha sugerido ecfisa, y tampoco. También he puesto las rutas absolutas entrecomilladas, y tampoco. Aun así, y a riesgo de parecer pesado, se que encuentra el archivo de GBAK porque me crea las copias de seguridad cuando le indico que quiero guardarlas en local.

¿Empiezo a pensar en tirar el ordenador por la ventana?

¡Gracias por el interés!

Puedes dar más información, por ejemplo: qué no te funciona, qué error sale, qué estás poniendo exactamente en los valores de las variables, etc...

xFas,

Pregunto:

1- ¿Puedes publicar el Print Screen del error al hacer el backup con GBAK?.

2- ¿Puedes publicar el código completo y las variables al momento del error?.

3- ¿Si haces el backup en una carpeta remota que no tenga espacios en blanco funciona?.

4- ¿Tienes los accesos requeridos para hacer backup en las carpetas remotas?.

5- ¿Si ejecutas el comando de GBAK manualmente a la carpeta remota funciona?.

Revisa estos links:
Espero sea útil :)

Nelson.

Vale, no se que es lo que he tocado, pero ahora funciona perfectamente en el modo debug de delphi. El problema da al ejecutarlo compilado como servicio, que no puede acceder a las carpetas de red, así que volvemos a la pregunta inicial. ¿Como le doy permisos al servicio para que pueda acceder a las carpetas de red? Os dejo todo el evento "OnExecute" para que le echéis un vistazo:

Código Delphi [-]
procedure TMYBackup.ServiceExecute(Sender: TService);
Resourcestring
  error_1 = 'Out of memory/resources';
  error_2 = 'GBAK not found';
  error_3 = 'Path not found';
  error_4 = 'Damaged or invalid exe';
  error_5 = 'Access denied';
  error_6 = 'Filename association invalid';
  error_7 = 'DDE error';
  error_8 = 'Sharing violation';
  error_9 = 'Unknown error';
  error_10= 'Destination directory not exists';
  error_11= 'New Backup created';
  error_12= 'Database retored';
var
  Nombre    : string;
  proceed   : boolean;
  SEInfo    : TShellExecuteInfo;
  ExitCD    : DWORD;
  Actual_Time:Extended;
begin
  while not terminated do begin
    IBDataSet1.Refresh;
    proceed:= false;
    Actual_time:=now;
    if IBDataSet1TYPE.asInteger = 0 then begin
      if (Pos(IntToStr(DayOfTheWeek(Today)),IBDataSet1DAYS.AsString) <> 0 ) and (formatdatetime('hhnnss',IBDataSet1HOUR.value) = formatdatetime('hhnnss',Actual_time)) then begin
        proceed := true;
      end;
    end
    else if HoursBetween(Now,Old_Time) = IBDataSet1TIMELAPSE.AsInteger then begin
      proceed := true;
      Old_Time := Now;
    end;
    if (proceed) or (Backup_now) then begin
      // Componer nombre de archivo ( yyyymmddhh.fbk )
      Nombre:=  'BACKUP - '+
                StringOfChar('0',4-Length(IntToStr(YearOf(Now))))+IntToStr(YearOf(Now)) +
                StringOfChar('0',2-Length(IntToStr(MonthOf(Now))))+IntToStr(MonthOf(Now)) +
                StringOfChar('0',2-Length(IntToStr(DayOf(Now))))+IntToStr(DayOf(Now))+
                StringOfChar('0',2-Length(IntToStr(HourOf(Now))))+IntToStr(HourOf(Now))+ '.FBK';
      if IBDataSet1LOCAL_FTP.Value = 0 then begin
        if not DirectoryExists( IBDataSet1LOCALDIR.AsString ) then begin
          InsertError( 'NoDir', error_10 );
          MYBackup.Status := csStopped;
          Exit;
        end;
        if not FileExists(IBDataSet1LOCALDIR.AsString +'\'+ Nombre) then begin
          try
            FillChar(SEInfo, SizeOf(SEInfo), 0);
            SEInfo.cbSize := SizeOf(TShellExecuteInfo);
            with SEInfo do begin
              fMask        := SEE_MASK_NOCLOSEPROCESS;
              Wnd          := 0;
              lpFile       := PWIDEChar(RegQueryStringValue('SOFTWARE\Firebird Project\Firebird Server\Instances', 'DefaultInstance')+'bin\gbak.exe');
              nShow        := SW_HIDE;
              lpParameters := PWIDEChar('-v -t -user SYSDBA -password "masterkey" DATABASE ' + '"' + IBDataSet1LOCALDIR.AsString +'\'+ Nombre + '"');
            end;
            if ShellExecuteEx(@SEInfo) then begin
              repeat
                GetExitCodeProcess(SEInfo.hProcess, ExitCD);
              until (ExitCD <> STILL_ACTIVE) or (Terminated);
            end;
            if (Backup_now) then UDPClient.Send('BACKUP_SUCCESS');
            InsertError( 'New', error_11);
          except
             on e : Exception do begin
                if GetLastError <= 32 then begin
                  case GetLastError of
                    0,se_err_OOM:
                      InsertError( 'OutMem', error_1 );
                    error_File_Not_Found:
                      InsertError( 'GMiss', error_2 );
                    error_Path_Not_Found:
                      InsertError( 'Path', error_3 );
                    error_Bad_Format:
                      InsertError( 'GBreak', error_4 );
                    se_err_AccessDenied:
                      InsertError( 'AccX', error_5);
                    se_err_NoAssoc,se_err_AssocIncomplete:
                      InsertError( 'BadFile', error_6);
                    se_err_DDEBusy,se_err_DDEFail,se_err_DDETimeOut:
                      InsertError( 'DDE', error_7 );
                    se_err_Share:
                      InsertError( 'Share', error_8);
                  else
                    InsertError( 'Unkn', error_9);
                  end;
                  MYBackup.Status := csStopped;
                  Exit;
                end
                else begin
                  InsertError( e.ClassName, e.Message );
                  MYBackup.Status := csStopped;
                  Exit;
                end;
             end;
          end;
        end;
      end
      else begin
        if not FileExists(GetEnvironmentVariable('ProgramData') +'\PROGRAMA\'+ Nombre) then
          try

            FillChar(SEInfo, SizeOf(SEInfo), 0);
            SEInfo.cbSize := SizeOf(TShellExecuteInfo);
            with SEInfo do begin
              fMask        := SEE_MASK_NOCLOSEPROCESS;
              Wnd          := 0;
              lpFile       := PWIDEChar(RegQueryStringValue('SOFTWARE\Firebird Project\Firebird Server\Instances', 'DefaultInstance')+'bin\gbak.exe');
              nShow        := SW_HIDE;
              lpParameters := PWIDEChar('-v -t -user SYSDBA -password "masterkey" DATABASE ' + '"' + GetEnvironmentVariable('ProgramData') + '\PROGRAMA\' + Nombre + '"');
            end;
            if ShellExecuteEx(@SEInfo) then begin
              repeat
                GetExitCodeProcess(SEInfo.hProcess, ExitCD);
              until (ExitCD <> STILL_ACTIVE) or (Terminated);
            end;

          except
             on e : Exception do begin
                if GetLastError <= 32 then begin
                  case GetLastError of
                    0,se_err_OOM:
                      InsertError( 'OutMem', error_1 );
                    error_File_Not_Found:
                      InsertError( 'GMiss', error_2 );
                    error_Path_Not_Found:
                      InsertError( 'Path', error_3 );
                    error_Bad_Format:
                      InsertError( 'GBreak', error_4 );
                    se_err_AccessDenied:
                      InsertError( 'AccX', error_5);
                    se_err_NoAssoc,se_err_AssocIncomplete:
                      InsertError( 'BadFile', error_6);
                    se_err_DDEBusy,se_err_DDEFail,se_err_DDETimeOut:
                      InsertError( 'DDE', error_7 );
                    se_err_Share:
                      InsertError( 'Share', error_8);
                  else
                    InsertError( 'Unkn', error_9);
                  end;
                  MYBackup.Status := csStopped;
                  Exit;
                end
                else begin
                  InsertError( e.ClassName, e.Message );
                  MYBackup.Status := csStopped;
                  Exit;
                end;
             end;
          end;
        with IdFTP1 do begin
          try
            Username := IBDataSet1FTPUSER.Value;
            Password := IBDataSet1FTPPASS.Value;
            Host     := IBDataSet1FTPSERVER.Value;
            Port     := IBDataSet1FTPPORT.Value;
            Connect;
            SendCmd('MKD MYBackup');
            SendCmd('CWD MYBackup');
            Put(GetEnvironmentVariable('ProgramData') +'\PROGRAMA\'+ Nombre, Nombre);
            if (Backup_now) then UDPClient.send('BACKUP_SUCCESS');
            DeleteFile(GetEnvironmentVariable('ProgramData') +'\PROGRAMA\'+ Nombre);
            InsertError( 'New', error_11);
          Except
            on e : Exception do begin
              InsertError( e.ClassName, e.Message );
              MYBackup.Status := csStopped;
              Exit;
            end;
          end;
          Disconnect;
        end;
      end;
      Backup_now := false;
    end;
    if Restore then begin
      Restore := false;

      FillChar(SEInfo, SizeOf(SEInfo), 0);
      SEInfo.cbSize := SizeOf(TShellExecuteInfo);
      with SEInfo do begin
        fMask        := SEE_MASK_NOCLOSEPROCESS;
        Wnd          := 0;
        lpFile       := PWIDEChar(RegQueryStringValue('SOFTWARE\Firebird Project\Firebird Server\Instances', 'DefaultInstance')+'bin\gbak.exe');
        nShow        := SW_HIDE;
        lpParameters := PWIDEChar('-replace_database -v -user SYSDBA -password "masterkey" '+DirecciondelFBKtransmitidaporUDP+' DATABASE');
      end;
      try
        if ShellExecuteEx(@SEInfo) then begin
          repeat
            GetExitCodeProcess(SEInfo.hProcess, ExitCD);
          until (ExitCD <> STILL_ACTIVE) or (Terminated);
        end;
        if ExitCD = 1 then UDPClient.Send('RESTORE_FAIL')
        else UDPClient.Send('RESTORE_FINISHED');
        IBDatabase1.Connected := True;
        InsertError( 'Res', error_12 );
      except
        on e : Exception do begin
          if GetLastError <= 32 then begin
            case GetLastError of
              0,se_err_OOM:
                InsertError( 'OutMem', error_1 );
              error_File_Not_Found:
                InsertError( 'GMiss', error_2);
              error_Path_Not_Found:
                InsertError( 'Path', error_3);
              error_Bad_Format:
                InsertError( 'GBreak', error_4 );
              se_err_AccessDenied:
                InsertError( 'AccX', error_5);
              se_err_NoAssoc,se_err_AssocIncomplete:
                InsertError( 'BadFile', error_6);
              se_err_DDEBusy,se_err_DDEFail,se_err_DDETimeOut:
                InsertError( 'DDE', error_7 );
              se_err_Share:
                InsertError( 'Share', error_8 );
            else
              InsertError( 'Unkn', error_9);
            end;
            MYBackup.Status := csStopped;
            Exit;
          end
          else begin
            InsertError( e.ClassName, e.Message );
            MYBackup.Status := csStopped;
            Exit;
          end;
        end;
      end;
    end;
    sleep(1000);
    ServiceThread.ProcessRequests(False);
  end;
end;

Muchas gracias por todas las respuestas!