Savoir si un job d'impression est couleur ou monochrome

Résolu
L_art_ment Messages postés 302 Date d'inscription vendredi 21 septembre 2007 Statut Membre Dernière intervention 6 février 2013 - 6 févr. 2013 à 12:14
beckerich Messages postés 302 Date d'inscription jeudi 29 septembre 2005 Statut Membre Dernière intervention 17 septembre 2013 - 7 févr. 2013 à 18:58
Bonjour à tous !

Je viens vers vous pour avoir une petite aide, je vous explique mon soucis :

J'ai faits un petit utilitaire qui permet de lister les jobs des imprimantes locales et d'enregistrer le tout dans un fichier csv (avec le nom d'utilisateur, le poste à partir duquel l'impression a été lancée, nombre de pages...), que je lance tousles soirs sur mon serveur d'impression et qui me permet d'avoir des petites statistiques. Ceci fonctionne bien avec le code suivant (seule la partie interessante est mise) :

procedure GetPrinterListToList(var PrinterList: TStringList);
type 
  TPrinterInfos = array[0..0] of  _PRINTER_INFO_2;
type
  TJobs  = array [0..1000] of JOB_INFO_1;
  PJobs = ^TJobs;
var
  p    : pointer;
  pi  : _PRINTER_INFO_2;
  level: DWORD; 
  dwNeeded, dwReturned : DWORD; 
  bFlag : BOOLEAN; 
  i : dword;
  PtrName:PChar;     hPrinter: THandle;
  hGlobal, bytesNeeded, numJobs, j: Cardinal;
  pJ: PJobs;
  d,js:string;

begin 
  {$R-}
  try 
    level := 2; 
    bFlag := true;

    EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, 0, dwNeeded,dwReturned);
    if (dwNeeded = 0) then exit; 

    hGlobal := GlobalAlloc(GHND, dwneeded);
    p := GlobalLock(hGlobal); 
    if (p = nil) then exit; 


    bFlag := EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, dwneeded,dwNeeded, dwReturned);
    if (not bFlag) then exit; 


    Printerlist.Clear;

    for i := 0 to dwReturned-1 do
      begin
         Pi := TPrinterInfos(p^)[i];
         PtrName := PChar(pi.pPrinterName);

         if OpenPrinter(PtrName,hPrinter, nil) then
            begin
              try
                EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded,numJobs);
                pJ := AllocMem(bytesNeeded);
                if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded,bytesNeeded, numJobs) then
                    RaiseLastWin32Error;
                if numJobs <> 0 then
                  for j := 0 to Pred(numJobs) do
                  begin
                  d:='01/01/1901';
                  datetimetostring(d,'dd/mm/yyyy',SystemTimetoDateTime(pJ^[j].Submitted));
                  js:=pJ^[j].pPrinterName+';'+pJ^[j].pDocument+';'+pJ^[j].pUserName+';'+AnsiReplaceStr(pJ^[j].pMachineName,'\','')+';'+inttostr(pJ^[j].TotalPages)+';'+inttostr(pJ^[j].PagesPrinted)+';'+d;
                    Printerlist.Add(js);
                    setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_DELETE);
                    setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_CANCEL);
                  end;
              except end;

            ClosePrinter(hPrinter);
          end;

      end;

  finally 
    if (p <> nil) then GlobalUnlock(hGlobal); 
    if (hGlobal <> null) then GlobalFree(hGlobal);
  end; 
  {$R+} 
end;


Je souhaiterais maintenant savoir si chaque job d'impression est une impression couleur ou monochrome. La structure JOB_INFO_1 ne permet pas de récupérer cette info (de ce que j'ai compris de mes recherches), mais la structure JOB_INFO_2 le permettrai, j'ai donc tenté ce code là :

procedure GetPrinterListToList(var PrinterList: TStringList);
type 
  TPrinterInfos = array[0..0] of  _PRINTER_INFO_2;
type
  TJobs  = array [0..1000] of JOB_INFO_2;
  PJobs = ^TJobs;
var
  p    : pointer;
  pi  : _PRINTER_INFO_2;
  level: DWORD; 
  dwNeeded, dwReturned : DWORD; 
  bFlag : BOOLEAN; 
  i : dword;
  PtrName:PChar;     hPrinter: THandle;
  hGlobal, bytesNeeded, numJobs, j: Cardinal;
  pJ: PJobs;
  d,js,coul:string;

begin 
  {$R-}
  try 
    level := 2; 
    bFlag := true;

    EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, 0, dwNeeded,dwReturned);
    if (dwNeeded = 0) then exit; 

    hGlobal := GlobalAlloc(GHND, dwneeded);
    p := GlobalLock(hGlobal); 
    if (p = nil) then exit; 


    bFlag := EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, dwneeded,dwNeeded, dwReturned);
    if (not bFlag) then exit; 


    Printerlist.Clear;

    for i := 0 to dwReturned-1 do
      begin
         Pi := TPrinterInfos(p^)[i];
         PtrName := PChar(pi.pPrinterName);

         if OpenPrinter(PtrName,hPrinter, nil) then
            begin
              try
                EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded,numJobs);
                pJ := AllocMem(bytesNeeded);
                if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded,bytesNeeded, numJobs) then
                    RaiseLastWin32Error;
                if numJobs <> 0 then
                  for j := 0 to Pred(numJobs) do
                  begin
                  d:='01/01/1901';
                  datetimetostring(d,'dd/mm/yyyy',SystemTimetoDateTime(pJ^[j].Submitted));
                  coul:='nd';
                  if pJ^[j].pDevMode.dmColor=DMCOLOR_COLOR then coul:='couleur' else coul:='mono';
                  js:=pJ^[j].pPrinterName+';'+pJ^[j].pDocument+';'+pJ^[j].pUserName+';'+AnsiReplaceStr(pJ^[j].pMachineName,'\','')+';'+inttostr(pJ^[j].TotalPages)+';'+inttostr(pJ^[j].PagesPrinted)+';'+d+';'+coul;
                    Printerlist.Add(js);
                    setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_DELETE);
                    setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_CANCEL);
                  end;
              except end;

            ClosePrinter(hPrinter);
          end;

      end;

  finally 
    if (p <> nil) then GlobalUnlock(hGlobal); 
    if (hGlobal <> null) then GlobalFree(hGlobal);
  end; 
  {$R+} 
end;


Qui ne fonctionne pas et je ne vois pas trop pourquoi, je n'ai pas de message d'erreur, mais c'est comme si l'application planté. Je me demande si le fait que certaines imprimantes qui sont des imprimantes monochromes, ne possédent pas cette info dmColor et donc fait planter mon appli puisqu'elle n'arrive pas à la lire ? Enfin si vous avez une idée du problème, je suis tout ouie !

Merci par avance !

3 réponses

L_art_ment Messages postés 302 Date d'inscription vendredi 21 septembre 2007 Statut Membre Dernière intervention 6 février 2013
6 févr. 2013 à 16:36
Mon problème est résolu, il fallait pour les deux appels d'EnumJobs mettre le 4eme parametre à 2, et j'avais en plus un problème en amont.

voici le code final :

procedure GetPrinterListToList(var PrinterList: TStringList);
type 
  TPrinterInfos = array[0..0] of  _PRINTER_INFO_2;
type
  TJobs  = array [0..1000] of JOB_INFO_2;
  PJobs = ^TJobs;
var
  p    : pointer;
  pi  : _PRINTER_INFO_2;
  level: DWORD; 
  dwNeeded, dwReturned : DWORD; 
  bFlag : BOOLEAN; 
  i : dword;
  PtrName:PChar;     hPrinter: THandle;
  hGlobal, bytesNeeded, numJobs, j: Cardinal;
  pJ: PJobs;
  d,js,coul:string;

begin 
  {$R-}
  try 
    level := 2; 
    bFlag := true;

    EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, 0, dwNeeded,dwReturned);
    if (dwNeeded = 0) then exit; 

    hGlobal := GlobalAlloc(GHND, dwneeded);
    p := GlobalLock(hGlobal); 
    if (p = nil) then exit; 


    bFlag := EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, dwneeded,dwNeeded, dwReturned);
    if (not bFlag) then exit; 


    Printerlist.Clear;

    for i := 0 to dwReturned-1 do
      begin
         Pi := TPrinterInfos(p^)[i];
         PtrName := PChar(pi.pPrinterName);

         if OpenPrinter(PtrName,hPrinter, nil) then
            begin
              try
                EnumJobs(hPrinter, 0, 1000, 2, nil, 0, bytesNeeded,numJobs);
                pJ := AllocMem(bytesNeeded);
                if not EnumJobs(hPrinter, 0, 1000, 2, pJ, bytesNeeded,bytesNeeded, numJobs) then
                    RaiseLastWin32Error;
                if numJobs <> 0 then
                  for j := 0 to Pred(numJobs) do
                  begin
                  d:='01/01/1901';
                  datetimetostring(d,'dd/mm/yyyy',SystemTimetoDateTime(pJ^[j].Submitted));
                  coul:='nd';
                  pJ^[0].pDevMode^.dmFields:= pJ^[j].pDevMode^.dmFields or DM_COLOR;
                  if pJ^[j].pDevMode^.dmColor=DMCOLOR_COLOR then coul:='couleur' else coul:='mono';
                  js:=pJ^[j].pPrinterName+';'+pJ^[j].pDocument+';'+pJ^[j].pUserName+';'+AnsiReplaceStr(pJ^[j].pMachineName,'\','')+';'+inttostr(pJ^[j].TotalPages)+';'+inttostr(pJ^[j].PagesPrinted)+';'+coul+';'+d;
                  Printerlist.Add(js);
                  setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_DELETE);
                  setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_CANCEL);
                  end;
              except end;

            ClosePrinter(hPrinter);
          end;

      end;

  finally 
    if (p <> nil) then GlobalUnlock(hGlobal); 
    if (hGlobal <> null) then GlobalFree(hGlobal);
  end; 
  {$R+} 
end;


Désolé du dérangement...
3
L_art_ment Messages postés 302 Date d'inscription vendredi 21 septembre 2007 Statut Membre Dernière intervention 6 février 2013
6 févr. 2013 à 14:34
Re-bonjour,

Alors j'avance un peu dans mes recherches et mon problème, j'ai trouvé sur le forum http://www.delphipages.com/forum/showthread.php?t=206523 un bout de code que j'ai testé et qui fonctionne, voici ce que j'ai essayé :
function GetCurrentPrinterHandle: THandle;
var
  Device, Driver, Port: array[0..255] of Char;
  hDeviceMode: THandle;
begin
  Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
  if not OpenPrinter(@Device, Result, nil) then
    RaiseLastWin32Error;
end;

procedure TForm1.Button1Click(Sender: TObject);
type
  TJobs  = array [0..1000] of JOB_INFO_2;
  PJobs = ^TJobs;
var
  hPrinter: THandle;
  bytesNeeded, numJobs, i: Cardinal;
  pJ: PJobs;
begin
  hPrinter := GetCurrentPrinterHandle;
  try
    EnumJobs(hPrinter, 0, 1000, 2, nil, 0, bytesNeeded,
      numJobs);
    pJ := AllocMem(bytesNeeded);
    if not EnumJobs(hPrinter, 0, 1000, 2, pJ, bytesNeeded,
      bytesNeeded, numJobs) then
      RaiseLastWin32Error;
    memo1.Clear;
    if numJobs = 0 then
      memo1.Lines.Add('No jobs in queue')
    else
      for i := 0 to Pred(numJobs) do begin
        memo1.Lines.Add('Printer: '+pJ^[i].pPrinterName);
        memo1.Lines.Add('Document: '+pJ^[i].pDocument);
        memo1.Lines.Add('Status: '+pJ^[i].pStatus);
        pJ^[0].pDevMode^.dmFields:= pJ^[i].pDevMode^.dmFields or DM_COLOR;
        memo1.Lines.Add('PaperSize: '+IntToStr(pJ^[i].pDevMode^.dmColor))
      end;
  finally
    ClosePrinter(hPrinter);
  end;
end;


Mais dés que je veux l'utiliser dans mon code (qui est une application console), ca ne fonctionne plus, voici mon code :
procedure GetPrinterListToList(var PrinterList: TStringList);
type 
  TPrinterInfos = array[0..0] of  _PRINTER_INFO_2;
type
  TJobs  = array [0..1000] of JOB_INFO_2;
  PJobs = ^TJobs;
var
  p    : pointer;
  pi  : _PRINTER_INFO_2;
  level: DWORD; 
  dwNeeded, dwReturned : DWORD; 
  bFlag : BOOLEAN; 
  i : dword;
  PtrName:PChar;     hPrinter: THandle;
  hGlobal, bytesNeeded, numJobs, j: Cardinal;
  pJ: PJobs;
  d,js,coul:string;

begin 
  {$R-}
  try 
    level := 2; 
    bFlag := true;

    EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, 0, dwNeeded,dwReturned);
    if (dwNeeded = 0) then exit; 

    hGlobal := GlobalAlloc(GHND, dwneeded);
    p := GlobalLock(hGlobal); 
    if (p = nil) then exit; 


    bFlag := EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, dwneeded,dwNeeded, dwReturned);
    if (not bFlag) then exit; 


    Printerlist.Clear;

    for i := 0 to dwReturned-1 do
      begin
         Pi := TPrinterInfos(p^)[i];
         PtrName := PChar(pi.pPrinterName);

         if OpenPrinter(PtrName,hPrinter, nil) then
            begin
              try
                EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded,numJobs);
                pJ := AllocMem(bytesNeeded);
                if not EnumJobs(hPrinter, 0, 1000, 2, pJ, bytesNeeded,bytesNeeded, numJobs) then
                    RaiseLastWin32Error;
                if numJobs <> 0 then
                  for j := 0 to Pred(numJobs) do
                  begin
                  pJ^[0].pDevMode^.dmFields:= pJ^[j].pDevMode^.dmFields or DM_COLOR;
                  js:=IntToStr(pJ^[j].pDevMode^.dmColor);
                  Printerlist.Add(js);
                    //setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_DELETE);
                    //setJob(hPrinter,pJ^[j].JobId,0,nil,JOB_CONTROL_CANCEL);
                  end;
              except end;

            ClosePrinter(hPrinter);
          end;

      end;

  finally 
    if (p <> nil) then GlobalUnlock(hGlobal); 
    if (hGlobal <> null) then GlobalFree(hGlobal);
  end; 
  {$R+} 
end;


Je n'ai pourtant pas l'impression de faire d'erreurs...
0
beckerich Messages postés 302 Date d'inscription jeudi 29 septembre 2005 Statut Membre Dernière intervention 17 septembre 2013 2
7 févr. 2013 à 18:58
Bonjour,

de rien, de rien.

merci de partager l'utilisation de cette api pas très accessible.

Luc.
0
Rejoignez-nous