big problem with services and opendatabase

Just starting out? Need help? Post your questions and find answers here.
supercdfr
User
User
Posts: 54
Joined: Tue Mar 16, 2010 9:28 pm

big problem with services and opendatabase

Post by supercdfr »

I need to make a service that will open a database.

here is the complete code that most have been found on the forum :

Code: Select all

EnableExplicit

Enumeration
  #database
EndEnumeration

Define result

DeclareModule Service
  Declare.b Install(ServiceName.s, DisplayName.s, Description.s)
  Declare.b Uninstall(ServiceName.s)
  Declare.b Run(ServiceName.s, *lpMainProc, *lpErrorProc)
  Declare.b IsRunning()
  Declare Logs(Message.s)
EndDeclareModule  
 
Module Service
  
  Structure SERVICE_PARAMS
    ServiceName.s
    *MainProc
    *ErrorProc
    CtrlStatus.l
  EndStructure  
  
  Enumeration
    #Log
  EndEnumeration
 
  Global ServiceParams.SERVICE_PARAMS
  Global ServiceStatus.SERVICE_STATUS
 
  Procedure Handler(fdwControl.l)
    Select fdwControl
      Case #SERVICE_CONTROL_INTERROGATE
      Case #SERVICE_CONTROL_STOP
        With ServiceStatus
          \dwWin32ExitCode = 0
          \dwCurrentState = #SERVICE_STOPPED
        EndWith
      Case #SERVICE_CONTROL_SHUTDOWN
        With ServiceStatus
          \dwWin32ExitCode = 0
          \dwCurrentState = #SERVICE_STOPPED
        EndWith
    EndSelect
    If (Not SetServiceStatus_(ServiceParams\CtrlStatus, @ServiceStatus))
      If (ServiceParams\ErrorProc)
        CallFunctionFast(ServiceParams\ErrorProc, GetLastError_())
      EndIf 
    EndIf  
  EndProcedure  
  
  Procedure Loop()
    
    ServiceParams\CtrlStatus = RegisterServiceCtrlHandler_(@ServiceParams\ServiceName, @Handler())
    If (Not ServiceParams\CtrlStatus)
      If (ServiceParams\ErrorProc)
        CallFunctionFast(ServiceParams\ErrorProc, GetLastError_())
      EndIf 
      ProcedureReturn
    EndIf
    
    ServiceStatus\dwCurrentState = #SERVICE_START_PENDING
    If (Not SetServiceStatus_(ServiceParams\CtrlStatus, @ServiceStatus))
      If (ServiceParams\ErrorProc)
        CallFunctionFast(ServiceParams\ErrorProc, GetLastError_())
      EndIf 
    EndIf  
    
    ServiceStatus\dwCurrentState = #SERVICE_RUNNING
    If (Not SetServiceStatus_(ServiceParams\CtrlStatus, @ServiceStatus))
      If (ServiceParams\ErrorProc)
        CallFunctionFast(ServiceParams\ErrorProc, GetLastError_())
      EndIf 
    EndIf  
    
    If (ServiceParams\MainProc)
      CallFunctionFast(ServiceParams\MainProc)
    EndIf 
 
    ServiceStatus\dwCurrentState = #SERVICE_STOP_PENDING
    If (Not SetServiceStatus_(ServiceParams\CtrlStatus, @ServiceStatus))
      If (ServiceParams\ErrorProc)
        CallFunctionFast(ServiceParams\ErrorProc, GetLastError_())
      EndIf 
    EndIf  
  
    ServiceStatus\dwCurrentState = #SERVICE_STOPPED
    If (Not SetServiceStatus_(ServiceParams\CtrlStatus, @ServiceStatus))
      If (ServiceParams\ErrorProc)
        CallFunctionFast(ServiceParams\ErrorProc, GetLastError_())
      EndIf 
    EndIf  
    
  EndProcedure  
  
  Procedure.b Install(ServiceName.s, DisplayName.s, Description.s)
    Protected Result.b, hManager.l, hService.l, tSd.SERVICE_DESCRIPTION, BytesNeeded.l
  
    hManager = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
    If hManager
      Define App.s = ProgramFilename()
      hService = CreateService_(hManager, @ServiceName, @DisplayName, #SERVICE_ALL_ACCESS, #SERVICE_WIN32_OWN_PROCESS|#SERVICE_INTERACTIVE_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, @App, #Null, #Null, #Null, #Null, #Null)
      If hService
        tSd\lpDescription = @Description
        If ChangeServiceConfig2_(hService, #SERVICE_CONFIG_DESCRIPTION, @tSd)
          Result = StartService_(hService, #Null, #Null)
          If (GetLastError_() = #ERROR_SERVICE_ALREADY_RUNNING)
            Result = 1
          EndIf
          If (Not Result)
            QueryServiceConfig_(hService, #Null, 0, @BytesNeeded)
            If (GetLastError_() = #ERROR_INSUFFICIENT_BUFFER)
              Define *ServiceConfig.QUERY_SERVICE_CONFIG = AllocateMemory(BytesNeeded)
              If *ServiceConfig
                If QueryServiceConfig_(hService, *ServiceConfig, BytesNeeded, @BytesNeeded)
                  Select *ServiceConfig\dwStartType
                    Case #SERVICE_AUTO_START, #SERVICE_DEMAND_START, #SERVICE_DISABLED
                      If ChangeServiceConfig_(hService, #SERVICE_NO_CHANGE, #SERVICE_DISABLED, #SERVICE_NO_CHANGE, #Null, #Null, #Null, #Null, #Null, #Null, #Null)
                        DeleteService_(hService)
                      EndIf  
                  EndSelect
                EndIf
                FreeMemory(*ServiceConfig)
              EndIf
            EndIf
          EndIf  
        EndIf  
        CloseServiceHandle_(hService)
      EndIf
      CloseServiceHandle_(hManager)
    EndIf
    
    ProcedureReturn Result
  
  EndProcedure
  
  Procedure.b Uninstall(ServiceName.s)
    Protected Result.b, hManager.l, hService.l, lpServiceStatus.SERVICE_STATUS, dService, ServicesReturned.l, BytesNeeded.l
  
    hManager = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
    If hManager
      hService = OpenService_(hManager, @ServiceName, #SERVICE_ALL_ACCESS)
      If hService
        
        ControlService_(hService, #SERVICE_CONTROL_STOP, @lpServiceStatus)
        
        Select GetLastError_()
          Case #ERROR_DEPENDENT_SERVICES_RUNNING
            EnumDependentServices_(hService, #SERVICE_ACTIVE, #Null, 0, @BytesNeeded, @ServicesReturned)
            If GetLastError_() = #ERROR_MORE_DATA
              Dim Services.ENUM_SERVICE_STATUS((BytesNeeded / SizeOf(ENUM_SERVICE_STATUS)) + 1)
              If EnumDependentServices_(hService, #SERVICE_ACTIVE, @Services(0), SizeOf(ENUM_SERVICE_STATUS) * ArraySize(Services()), @BytesNeeded, @ServicesReturned)
                While ServicesReturned
                  If Services(ServicesReturned - 1)\lpServiceName
                    dService = OpenService_(hManager, Services(ServicesReturned - 1)\lpServiceName, #SERVICE_ALL_ACCESS)
                    If dService
                      ControlService_(dService, #SERVICE_CONTROL_STOP, @lpServiceStatus)
                      CloseServiceHandle_(dService)
                    EndIf
                  EndIf
                  ServicesReturned - 1
                Wend
                Delay(1000)
                Result = ControlService_(hService, #SERVICE_CONTROL_STOP, @lpServiceStatus)
              EndIf
              FreeArray(Services()) 
            EndIf
        EndSelect
        
        QueryServiceConfig_(hService, #Null, 0, @BytesNeeded)
        
        If (GetLastError_() = #ERROR_INSUFFICIENT_BUFFER)
          Define *ServiceConfig.QUERY_SERVICE_CONFIG = AllocateMemory(BytesNeeded)
          If *ServiceConfig
            If QueryServiceConfig_(hService, *ServiceConfig, BytesNeeded, @BytesNeeded)
              Select *ServiceConfig\dwStartType
                Case #SERVICE_AUTO_START, #SERVICE_DEMAND_START, #SERVICE_DISABLED
                  Result = ChangeServiceConfig_(hService, #SERVICE_NO_CHANGE, #SERVICE_DISABLED, #SERVICE_NO_CHANGE, #Null, #Null, #Null, #Null, #Null, #Null, #Null)
              EndSelect
            EndIf
            FreeMemory(*ServiceConfig)
          EndIf
        EndIf
        
        Result = DeleteService_(hService)
        
        CloseServiceHandle_(hService)
      EndIf
      CloseServiceHandle_(hManager)
    EndIf
  
    ProcedureReturn Result
  
  EndProcedure
  
  Procedure.b Run(ServiceName.s, *lpMainProc, *lpErrorProc)
    
    Protected Result.b, Table.SERVICE_TABLE_ENTRY
    
    With ServiceParams
      \ServiceName = ServiceName
      \MainProc = *lpMainProc
      \ErrorProc = *lpErrorProc
    EndWith
    
    With Table
      \lpServiceName = @ServiceName
      \lpServiceProc = @Loop()
    EndWith
    
    With ServiceStatus
      \dwServiceType = #SERVICE_WIN32_OWN_PROCESS|#SERVICE_INTERACTIVE_PROCESS
      \dwControlsAccepted = #SERVICE_ACCEPT_STOP|#SERVICE_ACCEPT_SHUTDOWN
      \dwWin32ExitCode = 0
      \dwServiceSpecificExitCode = 0
      \dwCheckPoint = 0
      \dwWaitHint = 0
    EndWith
    
    Result = StartServiceCtrlDispatcher_(@Table)
    If (Result = #ERROR_SUCCESS)
      If (ServiceParams\ErrorProc)
        CallFunctionFast(ServiceParams\ErrorProc, GetLastError_())
      EndIf 
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  Procedure.b IsRunning()
    If (ServiceStatus\dwCurrentState = #SERVICE_RUNNING)
      ProcedureReturn #True
    EndIf
    ProcedureReturn #False
  EndProcedure 
 
  Procedure Logs(Message.s)
    If OpenFile(#Log, "c:\serv.log")
      FileSeek(#Log, Lof(#Log))
      WriteStringN(#Log, FormatDate("%yyyy/%mm/%dd %hh:%ii:%ss", Date()) + " [" + Str(GetCurrentProcessId_()) + "] >> " + Message)
      CloseFile(#Log)
    EndIf
  EndProcedure
 
EndModule
 
Global ServiceName.s = "pbService"
Global DisplayName.s = "pbService"
Global Description.s = "PureBasic"
 
Procedure ServiceMain()
  
  Define flag.b = #True
  Define result.l = 0
  
  result = OpenDatabase(#database, "test", "sa", "sa", #PB_Database_ODBC)
  Service::Logs(Str(result) )
  
  While Service::IsRunning() 
    Service::Logs("boucle")
    Delay(1000)
  Wend
 
EndProcedure
 
Procedure ServiceError(Code.l)
  Service::Logs("Error code service: " + StrU(Code, #PB_Word))
EndProcedure
 
Select ProgramParameter(0)
  Case "-i"
    If (Not Service::Install(ServiceName, DisplayName, Description))
      Service::Logs("Service error install")
    EndIf  
  Case "-d"
    If (Not Service::Uninstall(ServiceName))
      Service::Logs("Service error removed")
    EndIf  
  Default
    If (Not Service::Run(ServiceName, @ServiceMain(), @ServiceError()))
      Service::Logs("Service error started")
    EndIf  
EndSelect 
when i run this code, the database can't be open.

when i try only this

Code: Select all

EnableExplicit

Enumeration
  #database
EndEnumeration

Define result

UseODBCDatabase()
result = OpenDatabase(#database, "test", "sa", "sa", #PB_Database_ODBC)
Debug result
It works.

Is there a possibility to open a database in a service ?
supercdfr
User
User
Posts: 54
Joined: Tue Mar 16, 2010 9:28 pm

Re: big problem with services and opendatabase

Post by supercdfr »

i just try to run a exe that, alone, open the database, and i have the same result : impossible to open the database.
User avatar
HeX0R
Addict
Addict
Posts: 1205
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Re: big problem with services and opendatabase

Post by HeX0R »

I don't have PB here, but isn't there a UseODBCDatabase() missing?
supercdfr
User
User
Posts: 54
Joined: Tue Mar 16, 2010 9:28 pm

Re: big problem with services and opendatabase

Post by supercdfr »

i forgot to copy that on the first exemple, that's right.

But the problem is not from that.
supercdfr
User
User
Posts: 54
Joined: Tue Mar 16, 2010 9:28 pm

Re: big problem with services and opendatabase

Post by supercdfr »

i just try to make a service in C# that just run a exe in PB with this code :

Code: Select all

EnableExplicit

Enumeration
  #database
EndEnumeration

Define result

UseODBCDatabase()
result = OpenDatabase(#database, "test", "sa", "sa", #PB_Database_ODBC)
MessaeRequester("",str(result) )
All i obtain is that the database cannot be opened. If i run the exe alone, it works.
Something in "OpenDatabase" doesn't work with services.

I try with an old Pb version, it's the same.
I try with x86 version, as ODBC driver are X86.
Fred
Administrator
Administrator
Posts: 18249
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: big problem with services and opendatabase

Post by Fred »

Services runs as a special account, so I don't think it can access your DSN. May be you can try to create DSN on the fly (there is some example on this forum: http://www.purebasic.fr/english/viewtop ... t=odbc+DSN).
User avatar
mk-soft
Always Here
Always Here
Posts: 6253
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: big problem with services and opendatabase

Post by mk-soft »

My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
RichAlgeni
Addict
Addict
Posts: 935
Joined: Wed Sep 22, 2010 1:50 am
Location: Bradenton, FL

Re: big problem with services and opendatabase

Post by RichAlgeni »

First, you need to create a User Data Source. Go into Control Panel, Administrative Tools, Data Sources. You will need the server name, database name, user name, password and port.

From there, you will reference this data inside your service program. This is a snipet of code from a Microsoft SQL Server Service that I wrote.

Code: Select all

; **********************************************************************************
; process to handle database updates for ODBC
; **********************************************************************************

Procedure.i sendODBCSql(*dataBaseNumber, *pgSqlStatement, *databaseError)

    Protected logText.s
    Protected returnValue.i
    Protected dataBaseNumber.i = PeekI(*dataBaseNumber)
    Protected pgSqlStatement.s = PeekS(*pgSqlStatement)
    Protected processNum.i     = 8
    Protected debugThis.i      = processNum & debuggerLevel
    Protected logThis.i        = processNum & loggingLevel

; make sure the database is open, if not, re-open it

    If Not IsDatabase(dataBaseNumber)
        dataBaseNumber = OpenDatabase(#PB_Any, dataBaseName, userName, userPassword)
        If IsDatabase(dataBaseNumber)
            PokeI(*dataBaseNumber, dataBaseNumber)
        Else
            dataBaseNumber = 0
            PokeI(*dataBaseNumber, dataBaseNumber)
        EndIf
    EndIf

; now update the table with the sql command as needed

    If IsDatabase(dataBaseNumber)
        returnValue = DatabaseUpdate(dataBaseNumber, pgSqlStatement)
        If returnValue = 0
            PokeS(*databaseError, DatabaseError())
        EndIf
    Else
        logText = "sendODBCSql() > Error, unable to open database: " + dataBaseName + ", " + userName + ", " + userPassword
        WriteToLog(@logText)

; if the database is still not open, get the error, and exit the procedure

        returnValue = 0
        PokeS(*databaseError, DatabaseError())
    EndIf

    ProcedureReturn returnValue

EndProcedure
Post Reply