Servicio con acceso a la red

[Casimiro Noteví]

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)

[xFas]

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

[ecfisa]

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.

[Casimiro Noteví]

Empezado por xFas

Ademas, estoy seguro de que el error no viene de por ahí

Pues si tiene espacios es seguro que no funciona.

EDITO: ecfisa te ha puesto otro ejemplo.

[xFas]

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!

[Casimiro Noteví]

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...

[[nlsgarcia]]

xFas,

Empezado por Casimiro Notevi

...Puedes dar más información...

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:

I want create a thread calling gbak.exe!! : http://www.delphipages.com/forum/sho...d.php?t=133353

How to backup the remote database to a local hard disk? : http://www.firebirdfaq.org/faq62/

Espero sea útil

Nelson.

[xFas]

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!