je ne trouve pas de sources plus récente que celle ci :https://f-lefevre.developpez.com/tutori ... e-windows/ que ce soit sur le forum ou sur Notre ami G00GL3, hors celle ci ne semble plus fonctionner avec la version actuel de PB, quelqu'un aurait le niveau pour la remettre au gout du jour ?Ceci devrait résoudre ton problème:caussatjerome a écrit :Hello ami(e)s codeurs !
Voila mon PB
ou une source plus récente et fonctionnel ?
Par avance merci !!
Code : Tout sélectionner
Define lnThread.i,*lnReturnPtr,*loVFP.KardAuth,lcCID.s,lnCID.i,lnETX.i,lnSTX.i,lcTxt.s,lnLen.i,ln.i,lcIPAddr.s
Code : Tout sélectionner
;#dCKardLivePort = 10005
#dCLogFile = "monlog.log" ;<<<<"KardLiveVFP05.log"
;#dCLogFileB = "KardLiveVFP05B.log"
#dCServiceName = "monservice" ;<<<<<< KardLiveVFP05"
#dCServiceAppName = "monservice.exe" ;<<<<<<KardLiveVFP05.exe"
#dCServiceDisplayName = "monservice" ;<<<<<<KardLiveVFP05"
;
; Use a structure when Windows API use an array of strings
;
Structure SrvParam
Param1.s
Param2.s
EndStructure
Declare Main()
Declare Service_Install(tcService.s)
Declare Service_Delete(tcService.s)
Declare Service_Debug()
Declare Service_Start(tcService.s)
Declare Service_Stop(tcService.s)
Declare Service_MainLoop(tnCount.i,*tcParam.SrvParam)
Declare Service_CtrlHandler(thCtrlRequest.l)
Declare WriteToLog(tcText.s)
Global gServiceStatus.SERVICE_STATUS,gcStartIn.s
Global ghStatus.i,gnLog.i,gnDebug.i
SetCurrentDirectory(GetPathPart(ProgramFilename()))
gcStartIn = GetCurrentDirectory()
If OpenFile(0,gcStartIn+#dCLogFile)
FileSeek(0, Lof(0))
EndIf
Main()
If IsFile(0)
CloseFile(0)
EndIf
;
; Main Function
;
Procedure Main()
WriteToLog(gcStartIn)
Select ProgramParameter(0)
Case "-i", "install"
Service_Install(#dCServiceName)
Case "-d", "delete", "-u", "uninstall"
Service_Delete(#dCServiceName)
Case "-k", "kill", "stop"
Service_Stop(#dCServiceName)
Case "debug"
gnLog = 1
gnDebug = 1
SetCurrentDirectory(ProgramParameter(1))
gcStartIn = GetCurrentDirectory()
WriteToLog(GetCurrentDirectory())
Service_MainLoop(0,0)
Case "-l", "log"
gnLog = 1
Service_Start(#dCServiceName)
Default
Service_Start(#dCServiceName)
EndSelect
EndProcedure
;
; Write New Log Entry
;
Procedure WriteToLog(tcText.s)
If IsFile(0)
WriteStringN(0, FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", Date())+" "+tcText)
FlushFileBuffers(0)
EndIf
EndProcedure
;
; Install a Service
;
Procedure Service_Install(tcService.s)
Protected lcDir.s, lhSCManager.l, lhService.l, SD.SERVICE_DESCRIPTION
WriteToLog("Service_Install() > Start")
lcDir = GetCurrentDirectory() + #dCServiceAppName
lhSCManager = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhService = CreateService_(lhSCManager, tcService, #dCServiceDisplayName, #SERVICE_ALL_ACCESS, #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, lcDir, #Null, #Null, #Null, #Null, #Null)
SD\lpDescription = @"mon service" ;<<<<<<<<<"KardPoll Live VFP Card Authorization"
ChangeServiceConfig2_(lhService, #SERVICE_CONFIG_DESCRIPTION, @SD)
CloseServiceHandle_(lhService)
CloseServiceHandle_(lhSCManager)
WriteToLog("Service_Install() > End")
EndProcedure
;
; Delete Service
;
Procedure Service_Delete(tcService.s)
Protected lhSCManager.l,lhServ.l
WriteToLog("Service_Delete() > Start")
lhSCManager.l = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhServ.l = OpenService_(lhSCManager, tcService, #SERVICE_ALL_ACCESS)
DeleteService_(lhServ)
CloseServiceHandle_(lhServ)
CloseServiceHandle_(lhSCManager)
WriteToLog("Service_Delete() > End")
EndProcedure
;
; Start Service
;
Procedure Service_Start(tcService.s)
Protected lnErr.l,Dim ServiceTable.SERVICE_TABLE_ENTRY(1)
WriteToLog("Service_Start() > Start")
With ServiceTable(0)
\lpServiceName = @tcService
\lpServiceProc = @Service_MainLoop()
EndWith
With ServiceTable(1)
\lpServiceName = #Null
\lpServiceProc = #Null
EndWith
If StartServiceCtrlDispatcher_(@ServiceTable()) = 0
lnErr.l=GetLastError_()
Select lnErr
Case #ERROR_FAILED_SERVICE_CONTROLLER_CONNECT
WriteToLog("Last Error FAILED_SERVICE_CONTROLLER_CONNECT")
Case #ERROR_INVALID_DATA
WriteToLog("Last Error INVALID_DATA")
Case #ERROR_SERVICE_ALREADY_RUNNING
WriteToLog("Last Error SERVICE ALREADY_RUNNING")
Default
WriteToLog("Last Error "+StrU(lnErr,#PB_Word))
EndSelect
EndIf
WriteToLog("Service_Start() > End")
EndProcedure
;
; Stop the Service
;
Procedure Service_Stop(tcService.s)
Protected lhSCManager.l,lhServ.l
WriteToLog("Service_Stop() > Start")
lhSCManager.l= OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhServ.l= OpenService_(lhSCManager, tcService, #SERVICE_ALL_ACCESS)
ControlService_(lhServ, #SERVICE_CONTROL_STOP, @gServiceStatus)
CloseServiceHandle_(lhServ)
CloseServiceHandle_(lhSCManager)
WriteToLog("Service_Stop() > End")
EndProcedure
;
; Update Service Status
;
Procedure Service_UpdateStatus(tcService.s)
Protected lhSCManager.l,lhServ.l
lhSCManager.l= OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhServ.l= OpenService_(lhSCManager, tcService, #SERVICE_ALL_ACCESS)
QueryServiceStatus_(lhServ,@gServiceStatus)
CloseServiceHandle_(lhServ)
CloseServiceHandle_(lhSCManager)
EndProcedure
;
; Main Service
;
Procedure Service_MainLoop(tnCount.i,*tcParam.SrvParam) ; Windows passes the number of parameter and a pointer to an array of parameter strings
;;<<<<<<<Define lnThread.i,*lnReturnPtr,*loVFP.KardAuth,lcCID.s,lnCID.i,lnETX.i,lnSTX.i,lcTxt.s,lnLen.i,ln.i,lcIPAddr.s
Define lnThread.i,*lnReturnPtr,lcCID.s,lnCID.i,lnETX.i,lnSTX.i,lcTxt.s,lnLen.i,ln.i,lcIPAddr.s
;<<<<<<<<<NewMap lmEventClnt.Client()
Dim laRcvd.s(1)
WriteToLog("Service_MainLoop() > Start")
If Not gnDebug
With gServiceStatus
\dwServiceType = #SERVICE_WIN32_OWN_PROCESS
\dwCurrentState = #SERVICE_START_PENDING
\dwControlsAccepted = #SERVICE_ACCEPT_STOP | #SERVICE_ACCEPT_SHUTDOWN
\dwWin32ExitCode = 0
\dwServiceSpecificExitCode = 0
\dwCheckPoint = 0
\dwWaitHint = 0
EndWith
ghStatus = RegisterServiceCtrlHandler_(#dCServiceName, @Service_CtrlHandler())
If ghStatus = 0
WriteToLog("Registering Control Handler failed")
ProcedureReturn
EndIf
SetServiceStatus_(ghStatus, @gServiceStatus)
EndIf
If Not gnDebug
gServiceStatus\dwCurrentState = #SERVICE_RUNNING
SetServiceStatus_(ghStatus, @gServiceStatus)
Else
OpenConsole()
Print("Press Escape to exit.")
EndIf
While (Not gnDebug And gServiceStatus\dwCurrentState = #SERVICE_RUNNING) Or (gnDebug And Inkey() <> Chr(27))
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Put your service code here
;
Wend
If gnDebug
CloseConsole()
EndIf
gServiceStatus\dwCurrentState = #SERVICE_STOPPED
SetServiceStatus_(ghStatus, @gServiceStatus)
WriteToLog("Service_MainLoop() > End")
EndProcedure
;
; Service Control Handler
;
Procedure Service_CtrlHandler(thCtrlRequest.l)
WriteToLog("Service_CtrlHandler() > Start")
Select thCtrlRequest
Case #SERVICE_CONTROL_INTERROGATE
WriteToLog("Service reported its current status to the SCM.")
Case #SERVICE_CONTROL_STOP
WriteToLog("Service stopped.")
With gServiceStatus
\dwWin32ExitCode = 0
\dwCurrentState = #SERVICE_STOP_PENDING
EndWith
Case #SERVICE_CONTROL_SHUTDOWN
WriteToLog("Service shutdown.")
With gServiceStatus
\dwWin32ExitCode = 0
\dwCurrentState = #SERVICE_STOP_PENDING
EndWith
Default
WriteToLog("CtrlRequest Unknown = "+Str(thCtrlRequest))
EndSelect
SetServiceStatus_(ghStatus, @gServiceStatus);
WriteToLog("Service_CtrlHandler() > End")
EndProcedure
Mercizaphod_b a écrit :Salut,
Dans le code il reste des traces du service de @swhite (authentification par carte).
C'est donc inutile.
J'ai enlevé les restes et ça compile.
Mais il faut coder le service le listing est une coquille vide.
J'espère que ca va aider.
cela m'a permis d'avancer déjà, voici le code modifier et franciser, mais j'ai encorezaphod_b
un soucis :
Code : Tout sélectionner
;#dCKardLivePort = 10005
#dCLogFile = "monlog.log" ;-<Nom du fichier de log
;#dCLogFileB = "KardLiveVFP05B.log" A quoi il sert lui ?
#dCServiceName = "monservice" ;-<=Nom du service (utiliser pour net start nomservice/net stop..)
#dCServiceAppName = "monservice.exe" ;-<= nom de l'executable avec son ext
#dCServiceDisplayName = "mon service nom complet" ;-<=Nom complet du service (utilise pour le visualiser depuis le gestionnaire de processus et services)
;
; Use a structure when Windows API use an array of strings
;
Structure SrvParam
Param1.s
Param2.s
EndStructure
Declare Main()
Declare Service_Install(tcService.s)
Declare Service_Delete(tcService.s)
Declare Service_Debug()
Declare Service_Start(tcService.s)
Declare Service_Stop(tcService.s)
Declare Service_MainLoop(tnCount.i,*tcParam.SrvParam)
Declare Service_CtrlHandler(thCtrlRequest.l)
Declare WriteToLog(tcText.s)
Global gServiceStatus.SERVICE_STATUS,gcStartIn.s
Global ghStatus.i,gnLog.i,gnDebug.i
SetCurrentDirectory(GetPathPart(ProgramFilename()))
gcStartIn = GetCurrentDirectory();-<écrit le fichier de log à l'emplace de l'executable
If OpenFile(0,gcStartIn+#dCLogFile);-<ici
FileSeek(0, Lof(0))
EndIf
Main()
If IsFile(0)
CloseFile(0)
EndIf
;
; Main Function
;
Procedure Main()
WriteToLog(gcStartIn)
Select ProgramParameter(0)
Case "-i", "install"
Service_Install(#dCServiceName)
Case "-d", "delete", "-u", "uninstall"
Service_Delete(#dCServiceName)
Case "-k", "kill", "stop"
Service_Stop(#dCServiceName)
Case "debug"
gnLog = 1
gnDebug = 1
SetCurrentDirectory(ProgramParameter(1))
gcStartIn = GetCurrentDirectory()
WriteToLog(GetCurrentDirectory())
Service_MainLoop(0,0)
Case "-l", "log"
gnLog = 1
Service_Start(#dCServiceName)
Default
Service_Start(#dCServiceName)
EndSelect
EndProcedure
;
; Write New Log Entry
;
Procedure WriteToLog(tcText.s)
If IsFile(0)
WriteStringN(0, FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", Date())+" "+tcText)
FlushFileBuffers(0)
EndIf
EndProcedure
;
; Install a Service
;
Procedure Service_Install(tcService.s)
Protected lcDir.s, lhSCManager.l, lhService.l, SD.SERVICE_DESCRIPTION
WriteToLog("Service_Install() > Start")
lcDir = GetCurrentDirectory() + #dCServiceAppName
lhSCManager = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhService = CreateService_(lhSCManager, tcService, #dCServiceDisplayName, #SERVICE_ALL_ACCESS, #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, lcDir, #Null, #Null, #Null, #Null, #Null)
SD\lpDescription = @"mon super service" ;-<= Description du service
ChangeServiceConfig2_(lhService, #SERVICE_CONFIG_DESCRIPTION, @SD)
CloseServiceHandle_(lhService)
CloseServiceHandle_(lhSCManager)
WriteToLog("Service_Install() > End")
EndProcedure
;
; Delete Service
;
Procedure Service_Delete(tcService.s)
Protected lhSCManager.l,lhServ.l
WriteToLog("Service_Delete() > Start")
lhSCManager.l = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhServ.l = OpenService_(lhSCManager, tcService, #SERVICE_ALL_ACCESS)
DeleteService_(lhServ)
CloseServiceHandle_(lhServ)
CloseServiceHandle_(lhSCManager)
WriteToLog("Service_Delete() > End")
EndProcedure
;
; Start Service
;
Procedure Service_Start(tcService.s)
Protected lnErr.l,Dim ServiceTable.SERVICE_TABLE_ENTRY(1)
WriteToLog("Service_Start() > Start")
With ServiceTable(0)
\lpServiceName = @tcService
\lpServiceProc = @Service_MainLoop()
EndWith
With ServiceTable(1)
\lpServiceName = #Null
\lpServiceProc = #Null
EndWith
If StartServiceCtrlDispatcher_(@ServiceTable()) = 0
lnErr.l=GetLastError_()
Select lnErr
Case #ERROR_FAILED_SERVICE_CONTROLLER_CONNECT
WriteToLog("Last Error FAILED_SERVICE_CONTROLLER_CONNECT")
Case #ERROR_INVALID_DATA
WriteToLog("Last Error INVALID_DATA")
Case #ERROR_SERVICE_ALREADY_RUNNING
WriteToLog("Last Error SERVICE ALREADY_RUNNING")
Default
WriteToLog("Last Error "+StrU(lnErr,#PB_Word))
EndSelect
EndIf
WriteToLog("Service_Start() > End")
EndProcedure
;
; Stop the Service
;
Procedure Service_Stop(tcService.s)
Protected lhSCManager.l,lhServ.l
WriteToLog("Service_Stop() > Start")
lhSCManager.l= OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhServ.l= OpenService_(lhSCManager, tcService, #SERVICE_ALL_ACCESS)
ControlService_(lhServ, #SERVICE_CONTROL_STOP, @gServiceStatus)
CloseServiceHandle_(lhServ)
CloseServiceHandle_(lhSCManager)
WriteToLog("Service_Stop() > End")
EndProcedure
;
; Update Service Status
;
Procedure Service_UpdateStatus(tcService.s)
Protected lhSCManager.l,lhServ.l
lhSCManager.l= OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
lhServ.l= OpenService_(lhSCManager, tcService, #SERVICE_ALL_ACCESS)
QueryServiceStatus_(lhServ,@gServiceStatus)
CloseServiceHandle_(lhServ)
CloseServiceHandle_(lhSCManager)
EndProcedure
;
; Main Service
;
Procedure Service_MainLoop(tnCount.i,*tcParam.SrvParam) ; Windows passes the number of parameter and a pointer to an array of parameter strings
;;<<<<<<<Define lnThread.i,*lnReturnPtr,*loVFP.KardAuth,lcCID.s,lnCID.i,lnETX.i,lnSTX.i,lcTxt.s,lnLen.i,ln.i,lcIPAddr.s
Define lnThread.i,*lnReturnPtr,lcCID.s,lnCID.i,lnETX.i,lnSTX.i,lcTxt.s,lnLen.i,ln.i,lcIPAddr.s
;<<<<<<<<<NewMap lmEventClnt.Client()
Dim laRcvd.s(1)
WriteToLog("Service_MainLoop() > Start")
If Not gnDebug
With gServiceStatus
\dwServiceType = #SERVICE_WIN32_OWN_PROCESS
\dwCurrentState = #SERVICE_START_PENDING
\dwControlsAccepted = #SERVICE_ACCEPT_STOP | #SERVICE_ACCEPT_SHUTDOWN
\dwWin32ExitCode = 0
\dwServiceSpecificExitCode = 0
\dwCheckPoint = 0
\dwWaitHint = 0
EndWith
ghStatus = RegisterServiceCtrlHandler_(#dCServiceName, @Service_CtrlHandler())
If ghStatus = 0
WriteToLog("Registering Control Handler failed")
ProcedureReturn
EndIf
SetServiceStatus_(ghStatus, @gServiceStatus)
EndIf
If Not gnDebug
gServiceStatus\dwCurrentState = #SERVICE_RUNNING
SetServiceStatus_(ghStatus, @gServiceStatus)
Else
OpenConsole()
Print("Press Escape to exit.")
EndIf
While (Not gnDebug And gServiceStatus\dwCurrentState = #SERVICE_RUNNING) Or (gnDebug And Inkey() <> Chr(27))
;
; -mettre le code dans cette boucle
; -(danger : il s'agit d'une boucle ! a ne pas bloquer sinon =
; -arret du service via --> gestionnaiire de processus --> afficher tous les processus --> nom du service.exe --> arreter le procesus)
;
If FileSize("c:\test.txt")<0;-vue que c'est une boucle cela peut faire le bordel si ça ouvre plein de fois notepad...
n.l=OpenFile(#PB_Any,"c:\test.txt")
If n.l
WriteStringN(n.l,"Session utilisé par le service : "+UserName())
Delay(300)
CloseFile(n.l)
RunProgram("notepad.exe")
;- BESOIN d'aide : n'affiche pas notepad (même si je met ma propre session dans les option du service, que ce soit compiler en admin ou nom)
;- Le logiciel est bien lancer mais pas afficher?..
EndIf
EndIf
Wend
If gnDebug
CloseConsole()
EndIf
gServiceStatus\dwCurrentState = #SERVICE_STOPPED
SetServiceStatus_(ghStatus, @gServiceStatus)
WriteToLog("Service_MainLoop() > End")
EndProcedure
;
; Service Control Handler
;
Procedure Service_CtrlHandler(thCtrlRequest.l)
WriteToLog("Service_CtrlHandler() > Start")
Select thCtrlRequest
Case #SERVICE_CONTROL_INTERROGATE
WriteToLog("Service reported its current status to the SCM.")
Case #SERVICE_CONTROL_STOP
WriteToLog("Service stopped.")
With gServiceStatus
\dwWin32ExitCode = 0
\dwCurrentState = #SERVICE_STOP_PENDING
EndWith
Case #SERVICE_CONTROL_SHUTDOWN
WriteToLog("Service shutdown.")
With gServiceStatus
\dwWin32ExitCode = 0
\dwCurrentState = #SERVICE_STOP_PENDING
EndWith
Default
WriteToLog("CtrlRequest Unknown = "+Str(thCtrlRequest))
EndSelect
SetServiceStatus_(ghStatus, @gServiceStatus);
WriteToLog("Service_CtrlHandler() > End")
EndProcedure
Merci, pour ces liens, hélas je ne suis pas super doué avec les api Windows, mais j'avais trouvé un "contournement" : le service à un thread serveur de contrôle et un logiciel est configuré pour démarrer avec les sessions utilisateurs en systray, et communique avec le serveurPierre Bellisle a écrit :Salut Jérôme,
Depuis Windows Vista, à la base, un service roule sous "session 0 "
et ne peut directement interagir avec le bureau de l'utilisateur en cours.
Pour ce faire tu devras te servir de quelques APIs,
qui devraient ultimement te permettre d'appeler CreateProcessAsUser().
Ce dernier pourra créer un processus GUI dans la session de l'utilisateur.
Voici trois articles intéressants...
Interactive Services
Launching UI Application from Windows Service
Subverting Vista UAC in Both 32 and 64 bit Architectures
Pierre
Donc si ton programme interagit avec un utilisateur, il suffit qu'il soit lancé au démarrage et tourne sur un compte dont les droits sont égaux ou supérieurs à ceux de l'utilisateur avec qui il communique.
Modifier la base de registre et chercher à outrepasser l'UAC, c'est le meilleur moyen de mettre le système hôte HS, sans oublier que les AV ne vont pas se laisser faire (et que la réputation de PB va encore en prendre un coup si tu diffuses ton programme sur le net) 