Gestionnaire des taches d'impression (imprimantes)

5/5 (11 avis)

Vue 19 816 fois - Téléchargée 2 071 fois

Télécharger le projet
Commenter

Description

Ce code permet d'obtenir la liste des fichiers en cours d'impression sur toutes les imprimantes installées sur le système.
Il permet de mettre en pause, de faire reprendre,d'annuler, de supprimer et redémarrer un travail d'impression
c'est un peu un clone du spooler windows :) lol

Source / Exemple : 


Option Explicit

Private Declare Function ClosePrinter Lib "winspool.drv" _
        (ByVal hPrinter As Long) As Long
        
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
        "OpenPrinterA" (ByVal pPrinterName As String, phPrinter _
        As Long, pDefault As Any) As Long
        
Private Declare Function EnumJobs Lib "winspool.drv" Alias _
        "EnumJobsA" (ByVal hPrinter As Long, ByVal FirstJob _
        As Long, ByVal NoJobs As Long, ByVal Level As Long, _
        pJob As Long, ByVal cdBuf As Long, pcbNeeded As _
        Long, pcReturned As Long) As Long
        
Private Declare Function SetJob Lib "winspool.drv" Alias _
        "SetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, _
        ByVal Level As Long, ByRef pJob As JOB_INFO_1, ByVal _
        Command As Long) As Long
        
Private Declare Function PtrToStr Lib "kernel32" Alias _
        "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As _
        Long) As Long
         
Private Declare Function StrLen Lib "kernel32" Alias _
        "lstrlenA" (ByVal Ptr As Long) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" _
        (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Public Type JOB_INFO_1
  JobId As Long
  pPrinterName As String
  pMachineName As String
  pUserName As String
  pDocument As String
  pDatatype As String
  pStatus As String
  Status As Long
  Priority As Long
  Position As Long
  TotalPages As Long
  PagesPrinted As Long
  Submitted As SYSTEMTIME
End Type
'Public Type JOB_INFO_2
'  JobId As Long
'  pPrinterName As String
'  pMachineName As String
'  pUserName As String
'  pDocument As String
'  pNotifyName As String
'  pDatatype As String
'  pPrintProcessor As String
'  pParameters As String
'  pDriverName As String
'  LPDEVMODE pDevMode
'  pStatus As String
''  PSECURITY_DESCRIPTOR pSecurityDescriptor
'  Status As Long
'  Priority As String
'  Position As String
'  StartTime As String
'  UntilTime As String
'  TotalPages As String
'  Size As String
'  Submitted As SYSTEMTIME
'  Time As Long
'  PagesPrinted As Long
'End Type
Public Const JOB_STATUS_PAUSED = &H1
Public Const JOB_STATUS_ERROR = &H2
Public Const JOB_STATUS_DELETING = &H4
Public Const JOB_STATUS_SPOOLING = &H8
Public Const JOB_STATUS_PRINTING = &H10
Public Const JOB_STATUS_OFFLINE = &H20
Public Const JOB_STATUS_PAPEROUT = &H40
Public Const JOB_STATUS_PRINTED = &H80
Public Const JOB_STATUS_USER_INTERVENTION = &H10000

Public Const MAX_PRIORITY = 99
Public Const MIN_PRIORITY = 1
Public Const DEF_PRIORITY = 1

Const JOB_CONTROL_PAUSE = 1
Const JOB_CONTROL_RESUME = 2
Const JOB_CONTROL_CANCEL = 3
Const JOB_CONTROL_RESTART = 4
Const JOB_CONTROL_DELETE = 5

Public Function DisplaySpoolerTask(PrinterName As String) As JOB_INFO_1()
  Dim Result As Long, Required As Long, BufLen As Long
  Dim Buffer() As Long, Entries As Long, LiMem, FTime As FILETIME
  Dim hPrinter As Long, PName As String, l As Long, X As Long, aa As String
  Dim Job() As JOB_INFO_1
  Const c As Long = 16

    BufLen = 1024
    ReDim Buffer(BufLen \ 4)
    
    'Ouvrir un acces à l'imprimante
    Result = OpenPrinter(ByVal PrinterName, ByVal VarPtr(hPrinter), ByVal 0)
    If Result <> 0 Then
      'Pas d'erreur
      'On cherche la taille du buffer
      Result = EnumJobs(hPrinter, 0, &HFFFFFFFF, 1, Buffer(0), _
                        BufLen, Required, Entries)
      
      If Result = 0 Or Required = 0 Then
        'une erreur s'est produite
        Call ClosePrinter(hPrinter)
        Exit Function
      Else
        'Est-ce que le buffer est assez gros ?
        If Required > BufLen Then
          'Buffer pas assez gros
          ReDim Buffer(Required \ 4)
          Result = EnumJobs(hPrinter, 0, &HFFFFFFFF, 1, Buffer(0), _
                            BufLen, Required, Entries)
          If Result = 0 Then
            'Erreur
            Call ClosePrinter(hPrinter)
            Exit Function
          End If
        End If
  
        'On ferme l'acces au printer
        Call ClosePrinter(hPrinter)
         
        'on prepare la variable local qui stocke les taches
        ReDim Job(0 To Entries - 1)
        For X = 0 To Entries - 1
        
          'JobID: Buffer(0)
          Job(X).JobId = Buffer(c * X + 0)
          
          'Nom de l'imprimante: Buffer(1) pointeur vers une chaine
          aa = Space$(StrLen(Buffer(c * X + 1)) + 1)
          Call PtrToStr(aa, Buffer(c * X + 1))
          aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
          Job(X).pPrinterName = aa
          
          'Nom de la machine: Buffer(2) pointeur vers une chaine
          aa = Space$(StrLen(Buffer(c * X + 2)) + 1)
          Call PtrToStr(aa, Buffer(c * X + 2))
          aa = Trim$(Left$(aa, InStr(aa, Chr$(0)) - 1))
          Job(X).pMachineName = aa
          
          'Nom de l'utilisateur: Buffer(3) pointeur vers une chaine
          aa = Space$(StrLen(Buffer(c * X + 3)) + 1)
          Call PtrToStr(aa, Buffer(c * X + 3))
          aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
          Job(X).pUserName = aa
  
          'Nom du document: Buffer(4) pointeur vers une chaine
          aa = Space$(StrLen(Buffer(c * X + 4)) + 1)
          Call PtrToStr(aa, Buffer(c * X + 4))
          aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
          Job(X).pDocument = aa
          
          'Type de date: Buffer(5) pointeur vers une chaine
          aa = Space$(StrLen(Buffer(c * X + 5)) + 1)
          Call PtrToStr(aa, Buffer(c * X + 5))
          aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
          Job(X).pDatatype = aa
          
          'Status de la tache: Buffer(6) pointeur vers une chaine
          aa = Space$(StrLen(Buffer(c * X + 6)) + 1)
          Call PtrToStr(aa, Buffer(c * X + 6))
          If InStr(aa, Chr$(0)) <> 0 Then
            aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
          Else
            aa = ""
          End If
          Job(X).pStatus = aa
                 
          'Parametre Status
          Job(X).Status = Buffer(c * X + 7)
          
          'Buffer(8) Priority.
          Job(X).Priority = Buffer(c * X + 8)
                   
          'Position de la tache dans la queue
          Job(X).Position = Buffer(c * X + 9)
   
          'Nombre de page de la tache
          Job(X).TotalPages = Buffer(c * X + 10)
         
          'Nombre de page déjà imprimée
          Job(X).PagesPrinted = Buffer(c * X + 11)
         
          'Date de soumission
          With Job(X).Submitted
            .wYear = Buffer(c * X + 12) Mod 65536
            .wMonth = Buffer(c * X + 12) \ 65536
            .wDayOfWeek = Buffer(c * X + 13) Mod 65536
            .wDay = Buffer(c * X + 13) \ 65536
            .wHour = Buffer(c * X + 14) Mod 65536
            .wMinute = Buffer(c * X + 14) \ 65536
            .wSecond = Buffer(c * X + 15) Mod 65536
            .wMilliseconds = Buffer(c * X + 15) \ 65536
          End With
          SystemTimeToFileTime Job(X).Submitted, FTime
          FileTimeToLocalFileTime FTime, FTime
          FileTimeToSystemTime FTime, Job(X).Submitted
        Next X
       End If
    End If
    DisplaySpoolerTask = Job
    Erase Job
End Function

Public Sub PauseJob(PrinterName As String, Job As JOB_INFO_1)
  Dim Result As Long, hPrinter As Long
    
    'Ouvrir un acces à l'imprimante
    Result = OpenPrinter(ByVal PrinterName, ByVal VarPtr(hPrinter), ByVal 0)
    If Result <> 0 Then
    'Pas d'erreur
      Call SetJob(hPrinter, Job.JobId, 1&, Job, JOB_CONTROL_PAUSE)
      Call ClosePrinter(hPrinter)
    End If
End Sub

Public Sub ResumeJob(PrinterName As String, Job As JOB_INFO_1)
  Dim Result As Long, hPrinter As Long
    
    'Ouvrir un acces à l'imprimante
    Result = OpenPrinter(ByVal PrinterName, ByVal VarPtr(hPrinter), ByVal 0)
    If Result <> 0 Then
    'Pas d'erreur
      Call SetJob(hPrinter, Job.JobId, 1&, Job, JOB_CONTROL_RESUME)
      Call ClosePrinter(hPrinter)
    End If
End Sub

Public Sub CancelJob(PrinterName As String, Job As JOB_INFO_1)
  Dim Result As Long, hPrinter As Long
    
    'Ouvrir un acces à l'imprimante
    Result = OpenPrinter(ByVal PrinterName, ByVal VarPtr(hPrinter), ByVal 0)
    If Result <> 0 Then
    'Pas d'erreur
      Call SetJob(hPrinter, Job.JobId, 1&, Job, JOB_CONTROL_CANCEL)
      Call ClosePrinter(hPrinter)
    End If
End Sub

Public Sub RestartJob(PrinterName As String, Job As JOB_INFO_1)
  Dim Result As Long, hPrinter As Long
    
    'Ouvrir un acces à l'imprimante
    Result = OpenPrinter(ByVal PrinterName, ByVal VarPtr(hPrinter), ByVal 0)
    If Result <> 0 Then
    'Pas d'erreur
      Call SetJob(hPrinter, Job.JobId, 1&, Job, JOB_CONTROL_RESTART)
      Call ClosePrinter(hPrinter)
    End If
End Sub

Public Sub DeleteJob(PrinterName As String, Job As JOB_INFO_1)
  Dim Result As Long, hPrinter As Long
    
    'Ouvrir un acces à l'imprimante
    Result = OpenPrinter(ByVal PrinterName, ByVal VarPtr(hPrinter), ByVal 0)
    If Result <> 0 Then
    'Pas d'erreur
      Call SetJob(hPrinter, Job.JobId, 1&, Job, JOB_CONTROL_DELETE)
      Call ClosePrinter(hPrinter)
    End If
End Sub

Public Function ConvertStatusToString(Flag As Long) As String
  Dim Temp As String
    
    If Flag And JOB_STATUS_PAUSED Then Temp = "Pause "
    If Flag And JOB_STATUS_ERROR Then Temp = Temp & "Erreur "
    If Flag And JOB_STATUS_DELETING Then Temp = Temp & "Suppression "
    If Flag And JOB_STATUS_SPOOLING Then Temp = Temp & "Spool "
    If Flag And JOB_STATUS_PRINTING Then Temp = Temp & "Impression "
    If Flag And JOB_STATUS_OFFLINE Then Temp = Temp & "Déconnectée "
    If Flag And JOB_STATUS_PAPEROUT Then Temp = Temp & "Plus de papier "
    If Flag And JOB_STATUS_PRINTED Then temp = temp & "Imprimé "
    If Flag And JOB_STATUS_USER_INTERVENTION Then Temp = Temp & "Intervention"
    ConvertStatusToString = Trim$(Temp)
End Function

Conclusion :


Marche sous XP au moins (je n'ai pas testé sur 9x/NT/2000)
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
derinhger Messages postés 1 Date d'inscription mardi 8 avril 2008 Statut Membre Dernière intervention 20 avril 2009
20 avril 2009 à 11:55
bonjour, pourrais tu fournir la version "compilé", car je n'est a ma disposition que le runtime de vb6.

Merci d'avance Derin
ShareVB Messages postés 2676 Date d'inscription vendredi 28 juin 2002 Statut Membre Dernière intervention 13 janvier 2016 26
8 août 2008 à 20:41
salut,

je pense que tu peux utiliser directement les modules .bas de VB6 dans un projet VBA. Cependant, certaines de ces apis peuvent nécessité des droits un peu plus important que simple utilisateur donc à voir s'il n'y a pas de "accès refusé".

ShareVB
sdfred Messages postés 7 Date d'inscription lundi 30 juin 2008 Statut Membre Dernière intervention 8 août 2008
8 août 2008 à 09:55
SAlut, je ne connais pas trop VBA.
Je me demandais si par hasard tu savais si on pouvais via le Winspool driver configurer l'imprimante?
J'utilise la fonction shellexecute pour imprimer des pdfs
J'aimerais via VBA configurer l'impression de ces pdfs automatiquement (A3/A4, recto ou RectoVErso, Nb de copies).
Cependant la configuration est propre à chaque imprimante, je me demande donc si c'est possible...
En te remerciant par avance.
Frédéric
cs_DARKSIDIOUS Messages postés 15814 Date d'inscription jeudi 8 août 2002 Statut Membre Dernière intervention 4 mars 2013 129
12 janv. 2005 à 19:54
Excellent cette source, ca m'enlève une épine du pied, merci beaucoup !

10/10

DarK Sidious
cs_fred3 Messages postés 3 Date d'inscription vendredi 4 juin 2004 Statut Membre Dernière intervention 6 décembre 2004
16 juin 2004 à 17:13
Super ce code, le seule problème , c'est que je developpe en vba et que je n'arrive pas a faire appel au fonctions deleteJob... car il bug sur le passage de paramètre du "job", il me dit type incompatible, est-ce que quelqu'un peut m'aider ?

Call DeleteJob(pNomImprimante, Job)

Merci
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (ShareVB)