Servicio con acceso a la red

[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!

[sanrp2004]

Lo tengo estube hasta tarde investigando del tema tambien tenia el mismo problema

para poder hacer el login en la red necesitas que la computadora donde esta el servicio instalado tener una cuenta de administrador ojo no la misma que por lo general en server 2003 y 2008 es Administrador, asi que creas una cuenta con la que se vaya a logear tu servicio.

despues te logeas en tu pc con esta cuenta y accedes al recurso de la red que deseas acceder por medio de tu servicio y guardas las credenciales y das logoff ojo te tienes que salir de la cuenta apagando el usuario.

despues vas al panel de servicos das click derecho luego propiedades y donde dice lo Log On das click en This account y en bowse buscas el usuario que creaste para este servicio y se pondar algo asi como ".\NAMEUSER" y abajo pones la contrasena y das click en aplicar si todo esta correcto inicas el servicio y listo ya puedes grabar en el directorio compartido de la red.

es un poco enredado pero es la unika manera k lo he podido solventar por el momento

saludos y espero te sirva.