GESTIONNAIRE DES TACHES D'IMPRESSION (IMPRIMANTES)

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