Gestion des imprimantes

Gestion des imprimantes

Messagepar Michael DELIQUE » 08 Oct 2012 à 16:07

Code : Tout sélectionner
Public Function PrinterColorGet(wPrinter As String) As String
   rem   renvois si l'imprimante est couleur o  Noir & blanc

   Dim vrPrinter As Variant
   Dim Printer As String
   Const Computer = "."
   
   On Error Goto CatchError
   PrinterColorGet  = ""
   
   If Trim(wPrinter) = "" Then
      Printer = Trim(PrinterDefautGet())
   Else
      Printer = Trim(wPrinter)
   End If   
   
   Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select Name,color from Win32_PrinterConfiguration Where Name = '}+Replace(Printer,"\","\\")+{'})
   
   Forall objPrinter In vrPrinter
      If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then            
         Select Case Trim(Cstr(objPrinter.color))
         Case "1"
            rem   Monochrome N&B
            PrinterColorGet  = "M"
         Case "2"
            rem   Couleur
            PrinterColorGet  = "C"
         End Select
         Exit Forall
      End If
   End Forall
   
   If Trim(PrinterColorGet) <> "" Then
      Set vrPrinter = Nothing
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select Name,color from Win32_PrinterConfiguration})
      Forall objPrinter In vrPrinter
         If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then
            Select Case Trim(Cstr(objPrinter.color))
            Case "1"
               rem   Monochrome N&B
               PrinterColorGet  = "M"
            Case "2"
               rem   Couleur
               PrinterColorGet  = "C"
            End Select
            Exit Forall
         End If
      End Forall
   End If

   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterColorGet  = ""
   Exit Function
End FunctionPublic Function PrinterDefautGet() As String
   rem   renvois le nom de l'imprimante par défaut

   Dim vrPrinter As Variant
   Const Computer = "."
   
   On Error Goto CatchError
   PrinterDefautGet = ""
   
   Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name from Win32_Printer Where Default = True")
   
   Forall objPrinter In vrPrinter
      PrinterDefautGet = Trim(Cstr(objPrinter.Name))
      Exit Forall
   End Forall
   
   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterDefautGet = ""
   Exit Function
End Function
Public Function PrinterDefautSet(wPrinter As String) As String
   
   rem   change l'imprimante par défaut
   
   Dim vrPrinter As Variant
   Const Computer = "."
   
   On Error Goto CatchError
   
   PrinterDefautSet = ""
   
   If Trim(wPrinter) = "" Then
      Error 9999,"wPrinter is empty"
      Exit Function
   End If
   
   Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select Name from Win32_Printer Where Name = '}+Trim(Replace(wPrinter,"\","\\"))+{'})
   
   Forall objPrinter In vrPrinter
      If Ucase(Trim(objPrinter.Name))=Ucase(Trim(wPrinter)) Then
         Call objPrinter.SetDefaultPrinter()
         PrinterDefautSet = Trim(objPrinter.Name)
         Exit Forall
      End If
   End Forall   
   
   If Trim(PrinterDefautSet) = "" Then
      'si jamais on ne trouve pas l'imprimante on passe toute les imprimante en revue
      Set vrPrinter = Nothing
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select * from Win32_Printer")      
      Forall objPrinter In vrPrinter
         If Ucase(Trim(objPrinter.Name))=Ucase(Trim(wPrinter)) Then
            Call objPrinter.SetDefaultPrinter()
            PrinterDefautSet = Trim(objPrinter.Name)
            Exit Forall
         End If
      End Forall
   End If
   
   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterDefautSet = ""
   Exit Function
End Function
Public Function PrinterDeviceNameLength(wPrinter As String) As Integer
   
   rem   détermine la taile e la propriété devicename pour la recherche via la requette
   
   Dim vrObject As Variant
   Dim vrPrinter As Variant
   Dim Printer As String
   Const Computer = "."
   Dim DeviceName As String
   
   On Error Goto CatchError
   
   PrinterDeviceNameLength = 0
   
   If Trim(wPrinter) = "" Then
      Printer = Trim(PrinterDefautGet())
   Else
      Printer = Trim(wPrinter)
   End If   
   
   DeviceName = Replace(Printer,"\","\\")
   
   Set vrObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2")
   While DeviceName <> ""      
      Set vrPrinter = Nothing
      Set vrPrinter =  vrObject.ExecQuery ({Select Name from Win32_PrinterConfiguration Where DeviceName = '}+DeviceName+{'})
      Forall objPrinter In vrPrinter
         If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then
            PrinterDeviceNameLength = Len(DeviceName)
            Set vrPrinter = Nothing
            Set vrObject = Nothing
            Exit Function
         End If
      End Forall
      If Len(DeviceName)>1 Then
         DeviceName = Left(DeviceName,Len(DeviceName)-1)
      Else
         DeviceName = ""
      End If
   Wend
   
   Set vrPrinter = Nothing
   Set vrObject = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterDeviceNameLength = 0
   Exit Function
End Function
Public Function PrinterList() As Variant
   
   rem   http://techsupt.winbatch.com/webcgi/webbatch.exe?techsupt/nftechsupt.web+Tutorials+Printing.txt
   rem   Liste toutes les imprimantes installé"
   Dim lstPrinter List As String
   Dim vrPrinter As Variant
   Dim i As Integer
   Dim objWMIService As Variant
   Const Computer = "."
   
   On Error Goto CatchError
   
   lstPrinter(0)=""

   Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name from Win32_Printer")
   i=0
   Forall objPrinter In vrPrinter
      lstPrinter(i)=objPrinter.Name
      i=i+1
   End Forall
   Set vrPrinter = Nothing
   PrinterList = lstPrinter
   Erase lstPrinter
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   Erase lstPrinter
   lstPrinter(0)=""
   PrinterList = lstPrinter
   Erase lstPrinter
   Exit Function
End Function
Public Function PrinterObject(wPrinter,wPrinterClass) As Variant
   
   rem   renvois l'objet correspondant a l'imprimante
   
   Dim vrPrinter As Variant
   Dim lstPrinter List As String
   Dim Printer As String
   Dim PrinterClass As String
   Const Computer = "."
   
   On Error Goto CatchError
   
   Set PrinterObject = Nothing
   
   If Trim(wPrinter) = "" Then
      Printer = Trim(PrinterDefautGet())
   Else
      Printer = Trim(wPrinter)
   End If   

   Select Case Ucase(Trim(wPrinterClass))
   Case "C","CONFIG","CONFIGURATION","WIN32_PRINTERCONFIGURATION"
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select * from Win32_PrinterConfiguration Where Name = '}+Replace(Printer,"\","\\")+{'})
      PrinterClass = "C"
   Case "P","PRINT","PRINTER","WIN32_PRINTER",""
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select * from Win32_Printer Where Name = '}+Replace(Printer,"\","\\")+{'})
      PrinterClass = "P"      
   Case Else
      Error 9999,"Bad PrinterClass : "+wPrinterClass
      Exit Function
   End Select
   
   Forall objPrinter In vrPrinter
      If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then
         Set PrinterObject = objPrinter
         Exit Forall
      End If
   End Forall
   
   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   Set PrinterObject = Nothing
End Function
Public Function PrinterOrientationGet(wPrinter As String) As String
   
   rem   récupere l'orientation de l'imprimante passé en parametre sinon renvois l'orientation de l'imprimante par défaut
   
   Dim vrPrinter As Variant
   Dim Printer As String
   Const Computer = "."
   
   On Error Goto CatchError
   PrinterOrientationGet  = ""
   
   If Trim(wPrinter) = "" Then
      Printer = Trim(PrinterDefautGet())
   Else
      Printer = Trim(wPrinter)
   End If   
   
   Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select Name,Orientation from Win32_PrinterConfiguration Where Name = '}+Replace(Printer,"\","\\")+{'})
   
   Forall objPrinter In vrPrinter
      If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then
         Select Case objPrinter.Orientation
         Case 1 'Portrait
            PrinterOrientationGet = "P"
         Case 2 'Paysage
            PrinterOrientationGet = "L"
         End Select
         
         Exit Forall
      End If
   End Forall
   
   If Trim(PrinterOrientationGet ) = "" Then
      rem   si jamais on ne trouve pas l'imprimante on passe toute les imprimante en revue
      Set vrPrinter = Nothing
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name,Orientation from Win32_PrinterConfiguration")      
      Forall objPrinter In vrPrinter
         If Ucase(Trim(objPrinter.Name))=Ucase(Printer) Then
            Select Case objPrinter.Orientation
            Case 1
               rem   Portrait
               PrinterOrientationGet = "P"
            Case 2
               rem   Paysage
               PrinterOrientationGet = "L"
            End Select
            Exit Forall
         End If
      End Forall
   End If
   
   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterOrientationGet  = ""
   Exit Function   
End Function
Public Function PrinterOrientationSet(wOrientation As String, wPrinter As String) As String
   REM change l'orientation de l'imprimante passé en parametre sinon change l'orientation de l'imprimante par défaut
   
   Dim vrPrinter As Variant
   Dim Printer As String
   Dim nbOrientation As Integer
   Const Computer = "."
   
   On Error Goto CatchError
   PrinterOrientationSet  = ""
   
   Select Case Ucase(Trim(wOrientation))
   Case "PORTRAIT","P","1"
      nbOrientation = 1
   Case "PAYSAGE","LANDSCAPE","L","2"
      nbOrientation = 2
   Case ""
      Error 9999,"wOrientation is Empty"
      Exit Function
   Case Else
      Error 9999,"Bad Orientation value : "+wOrientation
      Exit Function
   End Select
   
   If Trim(wPrinter) = "" Then
      Printer = Trim(PrinterDefautGet())
   Else
      Printer = Trim(wPrinter)
   End If   

   Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select Name,Orientation from Win32_PrinterConfiguration Where Name = '}+Replace(Printer,"\","\\")+{'})
   
   Forall objPrinter In vrPrinter
      If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then
         objPrinter.Orientation = nbOrientation
         If nbOrientation = 1 Then
            PrinterOrientationSet = "P"
            REM Portrait
         Else
            PrinterOrientationSet = "L"
            REM Paysage
         End If
         Exit Forall
      End If
   End Forall
   
   If Trim(PrinterOrientationSet) = "" Then
      REM si jamais on ne trouve pas l'imprimante on passe toute les imprimante en revue
      Set vrPrinter = Nothing
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name,Orientation from Win32_PrinterConfiguration")      
      Forall objPrinter In vrPrinter
         If Ucase(Trim(objPrinter.Name))=Ucase(Printer) Then
            objPrinter.Orientation = nbOrientation
            If nbOrientation = 1 Then
               PrinterOrientationSet = "P" 'Portrait
            Else
               PrinterOrientationSet = "L" ' Paysage
            End If
            Exit Forall
         End If
      End Forall
   End If
   
   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterOrientationSet  = ""
   Exit Function   
End Function
Public Function PrinterPropertyGet(wPrinter As String,wPrinterClass As String) As Variant
   rem   list toute les propriétées d'une imprimante
   rem   http://techsupt.winbatch.com/webcgi/webbatch.exe?techsupt/nftechsupt.web+Tutorials+Printing.txt

   Dim vrPrinter As Variant
   Dim lstPrinter List As String
   Dim Printer As String
   Dim PrinterClass As String
   Const Computer = "."
   
   On Error Goto CatchError
   
   lstPrinter("NAME")=""
   
   If Trim(wPrinter) = "" Then
      Printer = Trim(PrinterDefautGet())
   Else
      Printer = Trim(wPrinter)
   End If   
   
   Select Case Ucase(Trim(wPrinterClass))
   Case "C","CONFIG","CONFIGURATION","WIN32_PRINTERCONFIGURATION"
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select * from Win32_PrinterConfiguration Where Name = '}+Replace(Printer,"\","\\")+{'})
      PrinterClass = "C"
   Case "P","PRINT","PRINTER","WIN32_PRINTER",""
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select * from Win32_Printer Where Name = '}+Replace(Printer,"\","\\")+{'})
      PrinterClass = "P"      
   Case Else
      Error 9999,"Bad PrinterClass : "+wPrinterClass
      Exit Function
   End Select
   
   Forall objPrinter In vrPrinter
      If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then
         
         Select Case PrinterClass
         Case "C"            
            On Error Resume Next
            lstPrinter("WIN32") = "Win32_PrinterConfiguration"
            lstPrinter("BITSPERDEL") = Trim(Cstr(objPrinter.BitsPerPel))
            lstPrinter("CAPTION") = Trim(Cstr(objPrinter.Caption))
            lstPrinter("COLLATE") = Trim(Cstr(objPrinter.Collate))
            lstPrinter("COLOR") = Trim(Cstr(objPrinter.Color))
            lstPrinter("COPIES") = Trim(Cstr(objPrinter.Copies))
            lstPrinter("DESCRIPTION") = Trim(Cstr(objPrinter.Description))
            lstPrinter("DEVICENAME") = Trim(Cstr(objPrinter.DeviceName))
            lstPrinter("DISPLAYFLAGS") = Trim(Cstr(objPrinter.DisplayFlags))
            lstPrinter("DISPLAYFREQUENCY") = Trim(Cstr(objPrinter.DisplayFrequency))
            lstPrinter("DITHERTYPE") = Trim(Cstr(objPrinter.DitherType))
            lstPrinter("DRIVERVERSION") = Trim(Cstr(objPrinter.DriverVersion))
            lstPrinter("DUPLEX") = Trim(Cstr(objPrinter.Duplex))
            lstPrinter("FORMNAME") = Trim(Cstr(objPrinter.FormName))
            lstPrinter("HORIZONTALERESOLUTION") = Trim(Cstr(objPrinter.HorizontalResolution))
            lstPrinter("ICMINTENT") = Trim(Cstr(objPrinter.ICMIntent))         
            lstPrinter("ICMMETHOD") = Trim(Cstr(objPrinter.ICMMethod))
            lstPrinter("LOGPIXELS") = Trim(Cstr(objPrinter.LogPixels))   
            lstPrinter("MEDIATYPE") = Trim(Cstr(objPrinter.MediaType))
            lstPrinter("NAME") = Trim(Cstr(objPrinter.Name))
            lstPrinter("ORIENTATION") = Trim(Cstr(objPrinter.Orientation))
            lstPrinter("PAPERLENGTH") = Trim(Cstr(objPrinter.PaperLength))
            lstPrinter("PAPERSIZE") = Trim(Cstr(objPrinter.PaperSize))
            lstPrinter("PAPERWIDTH") = Trim(Cstr(objPrinter.PaperWidth))
            lstPrinter("PELSHEIGHT") = Trim(Cstr(objPrinter.PelsHeight))
            lstPrinter("PELSWIDTH") = Trim(Cstr(objPrinter.PelsWidth))
            lstPrinter("PRINTQUALITY") = Trim(Cstr(objPrinter.PrintQuality))
            lstPrinter("SCALE") = Trim(Cstr(objPrinter.Scale))
            lstPrinter("SETTINGID") = Trim(Cstr(objPrinter.SettingID))
            lstPrinter("SPECIFICATIONVERSION") = Trim(Cstr(objPrinter.SpecificationVersion))
            lstPrinter("TTOPTION") = Trim(Cstr(objPrinter.TTOption))
            lstPrinter("VERTICALRESOLUTION") = Trim(Cstr(objPrinter.VerticalResolution))
            lstPrinter("XRESOLUTION") = Trim(Cstr(objPrinter.XResolution))
            lstPrinter("YRESOLUTION") = Trim(Cstr(objPrinter.YResolution))
            On Error Goto CatchError
         Case "P"
            On Error Resume Next
            lstPrinter("WIN32") = " Win32_Printer"
            lstPrinter("ATTRIBUTES") = Trim(Cstr(objPrinter.Attributes))
            lstPrinter("AVAILABILITY") = Trim(Cstr(objPrinter.Availability))
            lstPrinter("AVAILABLEJABSHEETS") = Trim(Cstr(objPrinter.AvailableJobSheets))
            lstPrinter("AVERAGEPAGESPERMINUTE") = Trim(Cstr(objPrinter.AveragePagesPerMinute))
            lstPrinter("CAPABILITIES") = Trim(Cstr(objPrinter.Capabilities))
            lstPrinter("CAPABILITYDESCRIPTIONS") = Trim(Cstr(objPrinter.CapabilityDescriptions))
            lstPrinter("CAPTION") = Trim(Cstr(objPrinter.Caption))
            lstPrinter("CHARSETSSUPPORTED") = Trim(Cstr(objPrinter.CharSetsSupported))
            lstPrinter("COMMENT") = Trim(Cstr(objPrinter.Comment))
            lstPrinter("CONFIGMANAGERERRORCODE") = Trim(Cstr(objPrinter.ConfigManagerErrorCode))
            lstPrinter("CONFIGMANAGERUSERCONFIG") = Trim(Cstr(objPrinter.ConfigManagerUserConfig))
            lstPrinter("CREATIONCLASSNAME") = Trim(Cstr(objPrinter.CreationClassName))
            lstPrinter("CURRENTCAPABILITIES") = Trim(Cstr(objPrinter.CurrentCapabilities))
            lstPrinter("CURRENTCHARSET") = Trim(Cstr(objPrinter.CurrentCharSet))
            lstPrinter("CURRENTLANGUAGE") = Trim(Cstr(objPrinter.CurrentLanguage))
            lstPrinter("CURRENTMIMETYPE") = Trim(Cstr(objPrinter.CurrentMimeType))
            lstPrinter("CURRENTNATURALLANGUAGE") = Trim(Cstr(objPrinter.CurrentNaturalLanguage))
            lstPrinter("CURRENTPAGERTYPE") = Trim(Cstr(objPrinter.CurrentPaperType))
            lstPrinter("DEFAULT") = Trim(Cstr(objPrinter.Default))
            lstPrinter("DEFAULTCAPABILITIES") = Trim(Cstr(objPrinter.DefaultCapabilities))
            lstPrinter("DEFAULTCOPIES") = Trim(Cstr(objPrinter.DefaultCopies))
            lstPrinter("DEFAULTLANGUAGE") = Trim(Cstr(objPrinter.DefaultLanguage))
            lstPrinter("DEFAULTMIMETYPE") = Trim(Cstr(objPrinter.DefaultMimeType))
            lstPrinter("DEFAULTNUMBERUP") = Trim(Cstr(objPrinter.DefaultNumberUp))
            lstPrinter("DEFAULTPAPERTYPE") = Trim(Cstr(objPrinter.DefaultPaperType))
            lstPrinter("DEFAULTPRIORITY") = Trim(Cstr(objPrinter.DefaultPriority))
            lstPrinter("DESCRIPTION") = Trim(Cstr(objPrinter.Description))
            lstPrinter("DETECTEDERRORSTATE") = Trim(Cstr(objPrinter.DetectedErrorState))
            lstPrinter("DEVICEID") = Trim(Cstr(objPrinter.DeviceID))
            lstPrinter("DIRECT") = Trim(Cstr(objPrinter.Direct))
            lstPrinter("DOCOMPLETEFIRST") = Trim(Cstr(objPrinter.DoCompleteFirst))
            lstPrinter("DRIVERNAME") = Trim(Cstr(objPrinter.DriverName))
            lstPrinter("ENABLEBIDI") = Trim(Cstr(objPrinter.EnableBIDI))
            lstPrinter("ENBLEDEVQUERYPRINT") = Trim(Cstr(objPrinter.EnableDevQueryPrint))
            lstPrinter("ERRORCLEARED") = Trim(Cstr(objPrinter.ErrorCleared))
            lstPrinter("ERRORDESCRIPTION") = Trim(Cstr(objPrinter.ErrorDescription))
            lstPrinter("ERRORINFORMATION") = Trim(Cstr(objPrinter.ErrorInformation))
            lstPrinter("EXTENDEDDETECTEDERRORSTATE") = Trim(Cstr(objPrinter.ExtendedDetectedErrorState))
            lstPrinter("EXTENDEDPRINTERSTATUS") = Trim(Cstr(objPrinter.ExtendedPrinterStatus))
            lstPrinter("HIDDEN") = Trim(Cstr(objPrinter.Hidden))
            lstPrinter("HORIZONTALRESOLUTION") = Trim(Cstr(objPrinter.HorizontalResolution))
            lstPrinter("INSTALLDATE") = Trim(Cstr(objPrinter.InstallDate))
            lstPrinter("JOBCOUNTSINCELASTRESET") = Trim(Cstr(objPrinter.JobCountSinceLastReset))
            lstPrinter("KEEPPRINTEDJOBS") = Trim(Cstr(objPrinter.KeepPrintedJobs))
            lstPrinter("LANGUAGESUPPORTED") = Trim(Cstr(objPrinter.LanguagesSupported))
            lstPrinter("LASTERRORCODE") = Trim(Cstr(objPrinter.LastErrorCode))
            lstPrinter("LOCAL") = Trim(Cstr(objPrinter.Local))
            lstPrinter("LOCATION") = Trim(Cstr(objPrinter.Location))
            lstPrinter("MARKINGTECHNOLOGY") = Trim(Cstr(objPrinter.MarkingTechnology))
            lstPrinter("MAXCOPIES") = Trim(Cstr(objPrinter.MaxCopies))
            lstPrinter("MAXNUMBERUP") = Trim(Cstr(objPrinter.MaxNumberUp))
            lstPrinter("MAXSIZESUPPORTED") = Trim(Cstr(objPrinter.MaxSizeSupported))
            lstPrinter("MIMETYPESSUPPORTED") = Trim(Cstr(objPrinter.MimeTypesSupported))
            lstPrinter("NAME") = Trim(Cstr(objPrinter.Name))
            lstPrinter("NATURALLANGUAGESSUPPORTED") = Trim(Cstr(objPrinter.NaturalLanguagesSupported))
            lstPrinter("NETWORK") = Trim(Cstr(objPrinter.Network))
            lstPrinter("PAPERSIZESUPPORTED") = Trim(Cstr(objPrinter.PaperSizesSupported))
            lstPrinter("PAPERTYPEAVAILABLE") = Trim(Cstr(objPrinter.PaperTypesAvailable))
            lstPrinter("PARAMETERS") = Trim(Cstr(objPrinter.Parameters))
            lstPrinter("PNPDEVICEID") = Trim(Cstr(objPrinter.PNPDeviceID))
            lstPrinter("PORTNAME") = Trim(Cstr(objPrinter.PortName))
            lstPrinter("POWERMANAGEMENTCAPABILITIES") = Trim(Cstr(objPrinter.PowerManagementCapabilities))
            lstPrinter("POWERMANAGEMENTSUPPORTED") = Trim(Cstr(objPrinter.PowerManagementSupported))
            lstPrinter("PRINTERPAPERNAMES") = Trim(Cstr(objPrinter.PrinterPaperNames))
            lstPrinter("PRINTERSTATE") = Trim(Cstr(objPrinter.PrinterState))
            lstPrinter("PRINTERSTATUS") = Trim(Cstr(objPrinter.PrinterStatus))
            lstPrinter("PRINTERJOBDATATYPE") = Trim(Cstr(objPrinter.PrintJobDataType))
            lstPrinter("PRINTPROCESSOR") = Trim(Cstr(objPrinter.PrintProcessor))
            lstPrinter("PRIORITY") = Trim(Cstr(objPrinter.Priority))
            lstPrinter("PUBLISHED") = Trim(Cstr(objPrinter.Published))
            lstPrinter("QUEUED") = Trim(Cstr(objPrinter.Queued))
            lstPrinter("RAWONLY") = Trim(Cstr(objPrinter.RawOnly))
            lstPrinter("SEPARATORFILE") = Trim(Cstr(objPrinter.SeparatorFile))
            lstPrinter("SERVERNAME") = Trim(Cstr(objPrinter.ServerName))
            lstPrinter("SHARED") = Trim(Cstr(objPrinter.Shared))
            lstPrinter("SHARENAME") = Trim(Cstr(objPrinter.ShareName))
            lstPrinter("SPOOLENABLED") = Trim(Cstr(objPrinter.SpoolEnabled))
            lstPrinter("STARTTIME") = Trim(Cstr(objPrinter.StartTime))
            lstPrinter("STATUS") = Trim(Cstr(objPrinter.Status))
            lstPrinter("STATUSINFO") = Trim(Cstr(objPrinter.StatusInfo))
            lstPrinter("SYSTEMCREATIONCLASSNAME") = Trim(Cstr(objPrinter.SystemCreationClassName))
            lstPrinter("SYSTEMNAME") = Trim(Cstr(objPrinter.SystemName))
            lstPrinter("TIMEOFLASTRESET") = Trim(Cstr(objPrinter.TimeOfLastReset))
            lstPrinter("UNTILTIME") = Trim(Cstr(objPrinter.UntilTime))
            lstPrinter("VERTICALRESOLUTION") = Trim(Cstr(objPrinter.VerticalResolution))
            lstPrinter("WORKOFFLINE") = Trim(Cstr(objPrinter.WorkOffline))
            On Error Goto CatchError
            
         End Select         
         Exit Forall
      End If
   End Forall
   
   Set vrPrinter = Nothing
   PrinterPropertyGet = lstPrinter
   Erase lstPrinter
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   Erase lstPrinter
   lstPrinter("NAME")=""
   PrinterPropertyGet = lstPrinter
   Erase lstPrinter
   Exit Function
End Function
Public Function PrinterTaskStop(wPrinter As String, nbAll As Integer) As Integer
   rem   stop la tache d'impression
   
   Dim vrPrinter As Variant
   Dim Printer As String
   Const Computer = "."
   
   On Error Goto CatchError
   
   PrinterTaskStop = False
   
   If nbAll = True Then
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name from Win32_Printer")
      Forall objPrinter In vrPrinter
         objPrinter.CancelAllJobs
         PrinterTaskStop = True
      End Forall
   Else
      If Trim(wPrinter) = "" Then
         Printer = Trim(PrinterDefautGet())
      Else
         Printer = Trim(wPrinter)
      End If   
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ({Select Name from Win32_Printer Where Name = '}+Replace(Printer,"\","\\")+{'})
      Forall objPrinter In vrPrinter
         If Ucase(Trim(objPrinter.Name)) = Ucase(Printer) Then
            objPrinter.CancelAllJobs
            PrinterTaskStop = True
         End If
         Exit Forall
      End Forall      
      
      If PrinterTaskStop = False Then
         rem   si jamais on ne trouve pas l'imprimante on passe toute les imprimante en revue
         Set vrPrinter = Nothing
         Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name from Win32_Printer")      
         Forall objPrinter In vrPrinter
            If Ucase(Trim(objPrinter.Name))=Ucase(Printer) Then
               objPrinter.CancelAllJobs
               PrinterTaskStop = True
               Exit Forall
            End If
         End Forall
      End If
   End If
   
   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterTaskStop = False
   Exit Function
End Function
Public Function PrinterTestPage(wPrinter As String) As Integer
   rem   change l'imprimante par défaut
   
   Dim vrPrinter As Variant
   Dim Printer As String
   Const Computer = "."
   
   On Error Goto CatchError
   
   PrinterTestPage = False
   
   If Trim(wPrinter) = "" Then
      Printer = Trim(PrinterDefautGet())
   Else
      Printer = Trim(wPrinter)
   End If   

   Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name from Win32_Printer Where Name= '"+Replace(Printer,"\","\\")+"'")
   
   Forall objPrinter In vrPrinter
      If Ucase(Trim(objPrinter.Name))=Ucase(Printer) Then
         If Cint(objPrinter.PrintTestPage) = 0 Then
            PrinterTestPage = True
         End If         
         Exit Forall
      End If
   End Forall
   
   If PrinterTestPage = False Then
      rem   si jamais on ne trouve pas l'imprimante on passe toute les imprimante en revue
      Set vrPrinter = Nothing
      Set vrPrinter =  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" +Computer + "\root\cimv2").ExecQuery ("Select Name from Win32_Printer")      
      Forall objPrinter In vrPrinter
         If Ucase(Trim(objPrinter.Name))=Ucase(Printer) Then
            If Cint(objPrinter.PrintTestPage) = 0 Then
               PrinterTestPage = True
            End If   
            Exit Forall
         End If
      End Forall
   End If
   
   Set vrPrinter = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   PrinterTestPage = False
   Exit Function
End Function
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy

Retour vers Divers