Print system functions

[Badara Thiam]

Hello Friends,

Here is the source code of the last update of some printers
functions i have created to solve problems encountered
in the past with printers. I give you to help. Thank you
to return me information about problem not solved.
I think this work under ALL Windows. Tell me if not :
this could be only because differents Windows registry
address than those tested.

To work with actual Reg32 Class under Vista (perhaps not only),
you must add a parameter ( nRegistreDroitsAcces )
into Reg32():New() function like this :

Code: Select all

//----------------------------------------------------------------------------//

CLASS TReg32

   DATA   cRegKey, nKey, nHandle, nError, lError

   METHOD New( nKey, cRegKey, lShowError, nRegistreDroitsAcces ) CONSTRUCTOR

   METHOD Create( nKey, cRegKey ) CONSTRUCTOR

   METHOD Get( cSubKey, uVar )

   METHOD Set( cSubKey, uVar )

   METHOD Close() INLINE If(::lError,,RegCloseKey( ::nHandle ))

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( nKey, cRegKey, lShowError, nRegistreDroitsAcces ) CLASS TReg32

   local nReturn, nHandle := 0

   DEFAULT cRegKey  := ""
   DEFAULT ::lError := .f.

   #ifdef __XPP__
      #undef New
   #endif

   #ifdef __CLIPPER__
      ::nError = RegOpenKeyEx( nKey, cRegKey,, IIF(nRegistreDroitsAcces = NIL, KEY_ALL_ACCESS, nRegistreDroitsAcces), @nHandle )
   #else
      ::nError = RegOpenKeyExA( nKey, cRegKey,, IIF(nRegistreDroitsAcces = NIL, KEY_ALL_ACCESS, nRegistreDroitsAcces), @nHandle )
   #endif

   ::cRegKey = cRegKey
   ::nHandle = nHandle

return Self

//----------------------------------------------------------------------------//

Code: Select all

#include  "fivewin.ch"

#IFNDEF __XPP__ 

    #define  HKEY_CLASSES_ROOT       2147483648        // 0x80000000
    #define  HKEY_CURRENT_USER       2147483649        // 0x80000001
    #define  HKEY_LOCAL_MACHINE      2147483650        // 0x80000002
    #define  HKEY_USERS              2147483651        // 0x80000003
    #define  HKEY_PERFORMANCE_DATA   2147483652        // 0x80000004
    #define  HKEY_CURRENT_CONFIG     2147483653        // 0x80000005
    #define  HKEY_DYN_DATA           2147483654        // 0x80000006

#ELSE 

   #define  HKEY_CLASSES_ROOT       1 
   #define  HKEY_CURRENT_USER       2 
   #define  HKEY_LOCAL_MACHINE      3 
   #define  HKEY_USERS              4 
   #define  HKEY_PERFORMANCE_DATA   5 
   #define  HKEY_CURRENT_CONFIG     6 
   #define  HKEY_DYN_DATA           7 

#ENDIF 

// Registry Specific Access Rights.

#define KEY_QUERY_VALUE         1    // 0x0001
#define KEY_SET_VALUE           2    // 0x0002
#define KEY_CREATE_SUB_KEY      4    // 0x0004
#define KEY_ENUMERATE_SUB_KEYS  8    // 0x0008
#define KEY_NOTIFY              16   // 0x0010
#define KEY_CREATE_LINK         32   // 0x0020


******************
FUNCTION WinGetPrn( lOrigine )
******************
* Recherche les imprimantes installées sous windows
* dans le registre de Windows (remplace le WIN.INI qui est obsolète sous Windows 2000 et suivants)
* Auteur Badara Thiam

LOCAL TIMP := {}
LOCAL nHandle
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL nok
LOCAL nLen
LOCAL cSubkeys
LOCAL aHKey := HKEY_LOCAL_MACHINE
LOCAL TSERVEURS := {}
LOCAL X
LOCAL oReg

* Recherche des imprimantes disponibles depuis le poste courant
cSubKeys := "System\CurrentControlSet\Control\Print\Printers"

IF RegOpenKey( aHKey,  cSubKeys,  @nHandle ) == 0
    n1 := 0
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        IF ASCAN(TIMP, STRTRAN(cValue, "," , "\")) = 0
          SysRefresh()
          AADD(TIMP, STRTRAN(cValue, "," , "\"))
        ENDIF
      ELSE
        EXIT
      ENDIF
      n1 ++
    ENDDO
    SysRefresh()
    RegCloseKey( nHandle )
ENDIF

* Recherche des imprimantes réseau non répertoriées dans la clé précédente (ci-dessus)
* Ajouté le 20/10/2006
TSERVEURS := WinGetSerP()

IF !EMPTY(TSERVEURS)
  FOR X := 1 TO LEN(TSERVEURS)
    cSubKeys := TSERVEURS[X][2] + "\" + TSERVEURS[X][1] + "\Printers"

    IF RegOpenKey( TSERVEURS[X][3],  cSubKeys,  @nHandle ) == 0
      n1 := 0
      DO WHILE .T.
        cValue := ""
        n2 := RegEnumKey( nHandle, n1,  @cvalue  )
        SysRefresh()
        IF n2 = 0

          * Pour vista : le nom d'imprimante (sous précédents os) est le port, codé avec "{" et "}"
          IF EMPTY( lOrigine ) .AND. ( "{" $ cValue )
            oReg := TReg32():New( TSERVEURS[X][3], TSERVEURS[X][2] + "\" + TSERVEURS[X][1] + "\Printers" ;
            + "\" + cValue + "\PrinterDriverData", , KEY_QUERY_VALUE )
            IF oReg:nError = 0
              cValue := oReg:Get("Model", "")
            ENDIF
            oReg:Close()
          ENDIF
          IF ASCAN(TIMP, STRTRAN(cValue, "," , "\")) = 0
            IF "," $ cValue
              AADD(TIMP, STRTRAN(cValue, "," , "\"))
            ELSE
              AADD(TIMP, "\\" + TSERVEURS[X][1] + "\" + cValue)
            ENDIF
          ENDIF
          SysRefresh()
        ELSE
          EXIT
        ENDIF
        n1 ++
      ENDDO
      RegCloseKey( nHandle )
    ENDIF
    SysRefresh()
  NEXT X

ENDIF

RETURN ACLONE(TIMP)

*******************
FUNCTION WinGetSerP()
*******************
* Renvoie les noms des serveurs d'impression disponibles pour le poste courant
* Auteur Badara Thiam
LOCAL nHandle
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL cSubkeys
LOCAL aHKey
LOCAL TSERVEURS := {}
LOCAL nSubK := 0

DO WHILE .T.
  nSubK ++
  IF nSubK = 1
    aHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers"
  ELSEIF nSubK = 2
    * Sous Vista version premium familiale
    aHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\Client Side Rendering Print Provider\Servers"
  ELSE
    EXIT
  ENDIF
  IF RegOpenKey( aHKey,  cSubKeys,  @nHandle ) == 0

    * Recherche des serveurs accessibles
    n1 := 0
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        IF ASCAN(TSERVEURS, { |qelem| qelem[1] = cValue } ) = 0
          AADD(TSERVEURS, { cValue, cSubKeys, aHKey } )
        ENDIF
      ELSE
        EXIT
      ENDIF
      SysRefresh()
      n1 ++
    ENDDO

    RegCloseKey( nHandle )
  ENDIF
ENDDO
RETURN ACLONE(TSERVEURS)

*******************
FUNCTION WinGetPrnD(cNomDriver)
*******************
* Recherche le driver d'une imprimante installée sous windows
* dans le registre de Windows (remplace le WIN.INI qui est obsolète sous Windows 2000 et suivants)
* Auteur Badara THIAM

LOCAL nHandle
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL nok
LOCAL nLen
LOCAL cSubkeys
LOCAL cSubkeys2
LOCAL cSubkeys3
LOCAL X, X2
LOCAL XENV
LOCAL TENV := {}
LOCAL TVERDRIVER := {}
LOCAL oReg
LOCAL cDriver := ""

X := 0
DO WHILE EMPTY(cDriver)

  X ++
  TENV := {}
  TVERDRIVER := {}
  cDriver := ""
  nHandle := NIL

  IF X = 1
    cSubKeys := "System\CurrentControlSet\Control\Print\Environments"
  ELSEIF X = 2
    cSubKeys := "System\ControlSet001\Control\Print\Environments"
  ELSEIF X = 3
    cSubKeys := "System\ControlSet002\Control\Print\Environments"
  ELSE
    EXIT
  ENDIF

  IF RegOpenKey( HKEY_LOCAL_MACHINE,  cSubKeys,  @nHandle ) = 0
      * Stocke tous les sous chemins de ..\Environments
      * dans le tableau TENV, pour analyse le contenu de chaque "environment" 
      SysRefresh()
      n1 := 0
      DO WHILE .T.
        cValue := ""
        n2 := RegEnumKey( nHandle, n1,  @cvalue  )
        IF n2 = 0
          IF ASCAN(TENV, STRTRAN(cValue, "," , "\")) = 0
            AADD(TENV, STRTRAN(cValue, "," , "\"))
          ENDIF
        ELSE
          EXIT
        ENDIF
        n1 ++
        SysRefresh()
      ENDDO
      RegCloseKey( nHandle )
      SysRefresh()
  ENDIF

  FOR XENV := 1 TO LEN(TENV)
    cSubKeys2 := cSubKeys + "\" + TENV[XENV] + "\Drivers"
    cSubKeys3 := cSubKeys2 + "\" + cNomDriver

    oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys3, , KEY_QUERY_VALUE)

    IF oReg:nError = 0
    * Si le nom de l'imprimante est présent dans le chemin ..\Drivers
      cDriver := oReg:Get("Driver", "")
      oReg:Close()
      oReg := NIL

      IF !EMPTY(cDriver)
        cDriver := IIF("." $ cDriver, LEFT(cDriver, AT(".", cDriver) - 1), cDriver)
        EXIT
      ENDIF
    ELSE

      oReg:Close()
      oReg := NIL

      IF RegOpenKey( HKEY_LOCAL_MACHINE,  cSubKeys2,  @nHandle ) = 0

        n1 := 0
        TVERDRIVER := {}
        DO WHILE .T.
          cValue := ""
          n2 := RegEnumKey( nHandle, n1,  @cvalue  )
          IF n2 = 0
            IF ASCAN(TVERDRIVER, STRTRAN(cValue, "," , "\")) = 0
              AADD(TVERDRIVER, STRTRAN(cValue, "," , "\"))
            ENDIF
          ELSE
            EXIT
          ENDIF
          SysRefresh()
          n1 ++
        ENDDO

        RegCloseKey( nHandle )
        SysRefresh()

        FOR X2 := 1 TO LEN(TVERDRIVER)
          nHandle := NIL

          cSubKeys3 := cSubKeys2 + "\" + TVERDRIVER[X2] + "\" + cNomDriver

          oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys3, , KEY_QUERY_VALUE)

          IF oReg:nError = 0

            cDriver := oReg:Get("Driver", "")
            SysRefresh()
            oReg:Close()
            oReg := NIL
            IF !EMPTY(cDriver)
              cDriver := IIF("." $ cDriver, LEFT(cDriver, AT(".", cDriver) - 1), cDriver)
              EXIT
            ENDIF
          ELSE
            oReg:Close()
            oReg := NIL
          ENDIF
          SysRefresh()

        NEXT X2
        IF !EMPTY(cDriver)
          EXIT
        ENDIF
      ENDIF
    ENDIF
    SysRefresh()
  NEXT XENV

ENDDO

SysRefresh()
RETURN cDriver

*******************
FUNCTION WinGetPrnP(cNomImpr)
*******************
* Renvoie le (nom du fichier) Driver et le Port de l'imprimante dont le nom est le contenu de cNomImpr.
* Le Driver et le Port sont renvoyés dans une chaine, séparés par une virgule.
* Auteur Badara THIAM

LOCAL cDriver := ""
LOCAL cNomDriver := ""
LOCAL cPort := ""
LOCAL oReg
LOCAL X
LOCAL Y
LOCAL TIMP := WinGetPrn()
LOCAL TImpOrig := WinGetPrn(.T.)
LOCAL TSERVEURS := {}

* Recherche l'imprimante Windows ayant le même nom,
* en convertissant en minuscule et en supprimant les espaces
FOR X := 1 TO LEN(TIMP)
  IF MEMEIMPRIM(@cNomImpr, TIMP[X])
  * Si c'est la même imprimante
    EXIT
  ENDIF
NEXT X

IF X <= LEN(TIMP)

  IF "\" $ TIMP[X] .AND. TIMP[X] != TImpOrig[X]
  * Si imprimante réseau

    TSERVEURS := WinGetSerP()

    FOR Y := 1 TO LEN(TSERVEURS)
        oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
        + "\" + TSERVEURS[Y][1] + "\Printers\" + SUBSTR(TImpOrig[X], RAT("\",TImpOrig[X]) + 1) ;
        + "\DsSpooler", , KEY_QUERY_VALUE )
        IF oReg:nError = 0
          EXIT
        ENDIF
        oReg:Close()
        oReg := NIL
    NEXT Y

    IF oReg != NIL
      IF oReg:nError = 0
        cPort := oReg:Get("portName", "")
        cNomDriver := oReg:Get("driverName", "")
      ENDIF
      oReg:Close()
      oReg := NIL
    ENDIF

  ELSE
    oReg := TReg32():New(HKEY_LOCAL_MACHINE,;
   "System\CurrentControlSet\Control\Print\Printers\" + STRTRAN(TIMP[X],"\",","), , KEY_QUERY_VALUE)

    IF oReg:nError <> 0

      * Cherche si cette imprimante non répertoriée est en réseau (10/2006)
      oReg:Close()
      oReg := NIL
      TSERVEURS := WinGetSerP()

      FOR Y := 1 TO LEN(TSERVEURS)

        oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
        + "\" + TSERVEURS[Y][1] + "\Printers\" + STRTRAN(TIMP[X],"\",","), , KEY_QUERY_VALUE)

        IF oReg:nError = 0
          EXIT
        ELSEIF "\" $ TIMP[X]
          * Si "\" est présent dans le nom d'imprimante, c'est "peut-être" la fonction WinGetPrn()
          * qui a inséré le nom de serveur dans le nom d'imprimante. Pour le vérifier,
          * recherche également le nom de l'imprimante sans le nom de serveur
          oReg:Close()
          oReg := NIL
          oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
          + "\" + TSERVEURS[Y][1] + "\Printers\" + SUBSTR(TIMP[X], RAT("\",TIMP[X]) + 1 ), , KEY_QUERY_VALUE )
          IF oReg:nError = 0
            EXIT
          ENDIF
        ENDIF
        oReg:Close()
        oReg := NIL
      NEXT Y

    ENDIF

    IF oReg != NIL
      IF oReg:nError = 0
        cPort := oReg:Get("Port", "")
        cNomDriver := oReg:Get("Printer Driver", "")
      ENDIF
      oReg:Close()
      oReg := NIL
    ENDIF

  ENDIF

  IF cNomDriver != ""
    cDriver := WinGetPrnD( STRTRAN(cNomDriver, CHR(0), "") )
  ENDIF

ENDIF
RETURN cDriver + "," + cPort

******************
FUNCTION WinDefPrn()
******************
* Dernière modification le 17/11/2006
* Retourne le nom de l'imprimante par défaut en allant le chercher dans le registre Windows
* (regedit.exe)
LOCAL cDefPrn := ""
* Adresse dans le registre pour Windows 2000 et suivants
LOCAL oReg := TReg32():New(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", , KEY_QUERY_VALUE)
IF oReg:nError = 0
  cDefPrn := oReg:Get("Device", "")
  IF "," $ cDefPrn
    * Suppression du Pilote et du Port, non requis ici
    cDefPrn := LEFT(cDefPrn, AT(",",cDefPrn) -1)
  ENDIF
ELSE
  * Alternative pour Windows 9x et Millennium
  oReg:Close()
  oReg := NIL
  oReg := TReg32():New(HKEY_CURRENT_CONFIG, "System\CurrentControlSet\Control\Print\Printers", , KEY_QUERY_VALUE)
  IF oReg:nError = 0
    cDefPrn := oReg:Get("Default", "")
  ENDIF
ENDIF
oReg:Close()
oReg := NIL
RETURN cDefPrn

Regards.

[Badara Thiam]

Code: Select all

*******************
FUNCTION MEMEIMPRIM(cImp1, cImp2)
*******************
* Return .T. if the two printers names are the sames
* when we delete the spaces and upper <-> lower
* and changing "/" by "," if "/" is in the printer name

* Renvoie .T. si les deux noms d'imprimantes
* correspondent à la même imprimante,
* en ignorant les espaces et la casse
* et en remplaçant "/" par "," si présent dans le nom de l'imprimante

RETURN ( LOWER(STRTRAN(STRTRAN(cImp1, "", ","), " ", "")) == LOWER(STRTRAN(STRTRAN(cImp2, "", ","), " ","")) )

[anserkk]

Dear Badara

The updated function WinGetSerP() which you posed yesterday is giving error when used in Windows XP.

Old Function Working Fine

Code: Select all

*******************
FUNCTION WinGetSerP()
*******************
* Renvoie les noms des serveurs d'impression disponibles pour le poste courant
* Auteur Badara Thiam
LOCAL nHandle
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL cSubkeys
LOCAL aHKey := HKEY_LOCAL_MACHINE
LOCAL TSERVEURS := {}

cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers"
IF RegOpenKey( aHKey,  cSubKeys,  @nHandle ) == 0

    * Recherche des serveurs accessibles
    n1 := 0
    TSERVEURS := {}
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        AADD(TSERVEURS, cValue)
      ELSE
        EXIT
      ENDIF
      n1 ++
    ENDDO

    RegCloseKey( nHandle )
ENDIF
RETURN ACLONE(TSERVEURS) 

New Function Giving Error in XP Professional

Code: Select all

*******************
FUNCTION WinGetSerP()
*******************
* Returns the names of print servers available for the current post
* Author Badara Thiam
* Renvoie les noms des serveurs d'impression disponibles pour le poste courant
* Auteur Badara Thiam
LOCAL nHandle
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL cSubkeys
LOCAL aHKey
LOCAL TSERVEURS := {}
LOCAL nSubK := 0

DO WHILE .T.
  nSubK ++
  IF nSubK = 1
    aHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers"
  ELSEIF nSubK = 2
    * Sous Vista version premium familiale
    aHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\Client Side Rendering Print Provider\Servers"
  ELSE
    EXIT
  ENDIF
  IF RegOpenKey( aHKey,  cSubKeys,  @nHandle ) == 0

    * Recherche des serveurs accessibles
    n1 := 0
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        IF ASCAN(TSERVEURS, { |qelem| qelem[1] = cValue } ) = 0
          AADD(TSERVEURS, { cValue, cSubKeys, aHKey } )
        ENDIF
      ELSE
        EXIT
      ENDIF
      SysRefresh()
      n1 ++
    ENDDO

    RegCloseKey( nHandle )
  ENDIF
ENDDO
RETURN ACLONE(TSERVEURS) 

Application will quit abnormally
Error Screen snapshot



Regards

Anser

[Badara Thiam]

Anserkk,

I have tried today and it's ok here with XP Pro SP2.
I suspect the RegOpenKey() or RegEnumKey()
be the cause of this. I look to solve it now.

********** VERY IMPORTANT **************
These functions assume than SET EXACT is ON.
If NOT :

Put this at the START of each function...
LOCAL lSetExact := SET( _SET_EXACT, .T. )

...and put this at the END of each same function
SET( _SET_EXACT, lSetExact )
****************************************

Regards,

[anserkk]

I shall try and let u know

Regards

Anser

[Badara Thiam]

Here is the update of today. I have replaced all
RegOpenKey() with oReg32():New(), RegCloseKey() with oReg:Close()
and this work in the same way for me under Vista (Clipper & [x]Harbour).
I shall test under XP Pro SP2 after.

I have included also SET( _SET_EXACT ) into the functions.

Regards,

Code: Select all

#include  "fivewin.ch" 

#IFNDEF __XPP__ 

    #define  HKEY_CLASSES_ROOT       2147483648        // 0x80000000 
    #define  HKEY_CURRENT_USER       2147483649        // 0x80000001 
    #define  HKEY_LOCAL_MACHINE      2147483650        // 0x80000002 
    #define  HKEY_USERS              2147483651        // 0x80000003 
    #define  HKEY_PERFORMANCE_DATA   2147483652        // 0x80000004 
    #define  HKEY_CURRENT_CONFIG     2147483653        // 0x80000005 
    #define  HKEY_DYN_DATA           2147483654        // 0x80000006 

#ELSE 

   #define  HKEY_CLASSES_ROOT       1 
   #define  HKEY_CURRENT_USER       2 
   #define  HKEY_LOCAL_MACHINE      3 
   #define  HKEY_USERS              4 
   #define  HKEY_PERFORMANCE_DATA   5 
   #define  HKEY_CURRENT_CONFIG     6 
   #define  HKEY_DYN_DATA           7 

#ENDIF 

// Registry Specific Access Rights. 

#define KEY_QUERY_VALUE         1    // 0x0001 
#define KEY_SET_VALUE           2    // 0x0002 
#define KEY_CREATE_SUB_KEY      4    // 0x0004 
#define KEY_ENUMERATE_SUB_KEYS  8    // 0x0008 
#define KEY_NOTIFY              16   // 0x0010 
#define KEY_CREATE_LINK         32   // 0x0020 



******************
FUNCTION WinGetPrn( lOrigine )
******************
* Recherche les imprimantes installées sous windows
* dans le registre de Windows (remplace le WIN.INI qui est obsolète sous Windows 2000 et suivants)
* Auteur Badara Thiam

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL TIMP := {}
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL nok
LOCAL nLen
LOCAL cSubkeys
LOCAL aHKey := HKEY_LOCAL_MACHINE
LOCAL TSERVEURS := {}
LOCAL X
LOCAL oReg
LOCAL oRegSubK

* Recherche des imprimantes disponibles depuis le poste courant
cSubKeys := "System\CurrentControlSet\Control\Print\Printers"

oReg := TReg32():New( aHKey, cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
IF oReg:nError = 0
    n1 := 0
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        IF ASCAN(TIMP, STRTRAN(cValue, "," , "\")) = 0
          SysRefresh()
          AADD(TIMP, STRTRAN(cValue, "," , "\"))
        ENDIF
      ELSE
        EXIT
      ENDIF
      n1 ++
    ENDDO
    SysRefresh()
    oReg:Close()
ENDIF

* Recherche des imprimantes réseau non répertoriées dans la clé précédente (ci-dessus)
* Ajouté le 20/10/2006
TSERVEURS := WinGetSerP()

IF !EMPTY(TSERVEURS)
  FOR X := 1 TO LEN(TSERVEURS)
    cSubKeys := TSERVEURS[X][2] + "\" + TSERVEURS[X][1] + "\Printers"

    oRegSubK := TReg32():New( TSERVEURS[X][3], cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
    IF oRegSubK:nError = 0
      n1 := 0
      DO WHILE .T.
        cValue := ""
        n2 := RegEnumKey( oRegSubK:nHandle, n1,  @cvalue  )
        SysRefresh()
        IF n2 = 0

          * Pour vista : le nom d'imprimante (sous précédents os) est le port, codé avec "{" et "}"
          IF EMPTY( lOrigine ) .AND. ( "{" $ cValue )
            oReg := TReg32():New( TSERVEURS[X][3], TSERVEURS[X][2] + "\" + TSERVEURS[X][1] + "\Printers" ;
            + "\" + cValue + "\PrinterDriverData", , KEY_QUERY_VALUE )
            IF oReg:nError = 0
              cValue := oReg:Get("Model", "")
            ENDIF
            oReg:Close()
          ENDIF
          IF ASCAN(TIMP, STRTRAN(cValue, "," , "\")) = 0
            IF "," $ cValue
              AADD(TIMP, STRTRAN(cValue, "," , "\"))
            ELSE
              AADD(TIMP, "\\" + TSERVEURS[X][1] + "\" + cValue)
            ENDIF
          ENDIF
          SysRefresh()
        ELSE
          EXIT
        ENDIF
        n1 ++
      ENDDO
      oRegSubK:Close()

    ENDIF
    SysRefresh()
  NEXT X

ENDIF

SET( _SET_EXACT, lSetExact )
RETURN ACLONE(TIMP)

*******************
FUNCTION WinGetSerP()
*******************
* Renvoie les noms des serveurs d'impression disponibles pour le poste courant
* Auteur Badara Thiam

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL cSubkeys
LOCAL aHKey
LOCAL TSERVEURS := {}
LOCAL nSubK := 0
LOCAL oReg

DO WHILE .T.
  nSubK ++
  IF nSubK = 1
    aHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers"
  ELSEIF nSubK = 2
    * Sous Vista version premium familiale
    aHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\Client Side Rendering Print Provider\Servers"
  ELSE
    EXIT
  ENDIF

  oReg := TReg32():New( aHKey, cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
  IF oReg:nError = 0

    * Recherche des serveurs accessibles
    n1 := 0
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        IF ASCAN(TSERVEURS, { |qelem| qelem[1] = cValue } ) = 0
          AADD(TSERVEURS, { cValue, cSubKeys, aHKey } )
        ENDIF
      ELSE
        EXIT
      ENDIF
      SysRefresh()
      n1 ++
    ENDDO
    oReg:Close()
  ENDIF
ENDDO
SET( _SET_EXACT, lSetExact )
RETURN ACLONE(TSERVEURS)

*******************
FUNCTION WinGetPrnD(cNomDriver)
*******************
* Recherche le driver d'une imprimante installée sous windows
* dans le registre de Windows (remplace le WIN.INI qui est obsolète sous Windows 2000 et suivants)
* Auteur Badara THIAM

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL nok
LOCAL nLen
LOCAL cSubkeys
LOCAL cSubkeys2
LOCAL cSubkeys3
LOCAL X, X2
LOCAL XENV
LOCAL TENV := {}
LOCAL TVERDRIVER := {}
LOCAL oReg
LOCAL cDriver := ""

X := 0
DO WHILE EMPTY(cDriver)

  X ++
  TENV := {}
  TVERDRIVER := {}
  cDriver := ""

  IF X = 1
    cSubKeys := "System\CurrentControlSet\Control\Print\Environments"
  ELSEIF X = 2
    cSubKeys := "System\ControlSet001\Control\Print\Environments"
  ELSEIF X = 3
    cSubKeys := "System\ControlSet002\Control\Print\Environments"
  ELSE
    EXIT
  ENDIF

  oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
  IF oReg:nError = 0
      * Stocke tous les sous chemins de ..\Environments
      * dans le tableau TENV, pour analyse le contenu de chaque "environment" 
      SysRefresh()
      n1 := 0
      DO WHILE .T.
        cValue := ""
        n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
        IF n2 = 0
          IF ASCAN(TENV, STRTRAN(cValue, "," , "\")) = 0
            AADD(TENV, STRTRAN(cValue, "," , "\"))
          ENDIF
        ELSE
          EXIT
        ENDIF
        n1 ++
        SysRefresh()
      ENDDO
      oReg:Close()
      SysRefresh()
  ENDIF

  FOR XENV := 1 TO LEN(TENV)
    cSubKeys2 := cSubKeys + "\" + TENV[XENV] + "\Drivers"
    cSubKeys3 := cSubKeys2 + "\" + cNomDriver

    oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys3, , KEY_QUERY_VALUE)

    IF oReg:nError = 0
    * Si le nom de l'imprimante est présent dans le chemin ..\Drivers
      cDriver := oReg:Get("Driver", "")
      oReg:Close()
      oReg := NIL

      IF !EMPTY(cDriver)
        cDriver := IIF("." $ cDriver, LEFT(cDriver, AT(".", cDriver) - 1), cDriver)
        EXIT
      ENDIF
    ELSE

      oReg:Close()
      oReg := NIL

      oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys2, , KEY_ENUMERATE_SUB_KEYS )
      IF oReg:nError = 0

        n1 := 0
        TVERDRIVER := {}
        DO WHILE .T.
          cValue := ""
          n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
          IF n2 = 0
            IF ASCAN(TVERDRIVER, STRTRAN(cValue, "," , "\")) = 0
              AADD(TVERDRIVER, STRTRAN(cValue, "," , "\"))
            ENDIF
          ELSE
            EXIT
          ENDIF
          SysRefresh()
          n1 ++
        ENDDO
        oReg:Close()
        SysRefresh()

        FOR X2 := 1 TO LEN(TVERDRIVER)

          cSubKeys3 := cSubKeys2 + "\" + TVERDRIVER[X2] + "\" + cNomDriver

          oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys3, , KEY_QUERY_VALUE)

          IF oReg:nError = 0

            cDriver := oReg:Get("Driver", "")
            SysRefresh()
            oReg:Close()
            oReg := NIL
            IF !EMPTY(cDriver)
              cDriver := IIF("." $ cDriver, LEFT(cDriver, AT(".", cDriver) - 1), cDriver)
              EXIT
            ENDIF
          ELSE
            oReg:Close()
            oReg := NIL
          ENDIF
          SysRefresh()

        NEXT X2
        IF !EMPTY(cDriver)
          EXIT
        ENDIF
      ENDIF
    ENDIF
    SysRefresh()
  NEXT XENV

ENDDO

SysRefresh()
SET( _SET_EXACT, lSetExact )
RETURN cDriver

*******************
FUNCTION WinGetPrnP(cNomImpr)
*******************
* Renvoie le (nom du fichier) Driver et le Port de l'imprimante dont le nom est le contenu de cNomImpr.
* Le Driver et le Port sont renvoyés dans une chaine, séparés par une virgule.
* Auteur Badara THIAM

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL cDriver := ""
LOCAL cNomDriver := ""
LOCAL cPort := ""
LOCAL oReg
LOCAL X
LOCAL Y
LOCAL TIMP := WinGetPrn()
LOCAL TImpOrig := WinGetPrn(.T.)
LOCAL TSERVEURS := {}

* Recherche l'imprimante Windows ayant le même nom,
* en convertissant en minuscule et en supprimant les espaces
FOR X := 1 TO LEN(TIMP)
  IF MEMEIMPRIM(@cNomImpr, TIMP[X])
  * Si c'est la même imprimante
    EXIT
  ENDIF
NEXT X

IF X <= LEN(TIMP)

  IF "\" $ TIMP[X] .AND. TIMP[X] != TImpOrig[X]
  * Si imprimante réseau

    TSERVEURS := WinGetSerP()

    FOR Y := 1 TO LEN(TSERVEURS)
        oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
        + "\" + TSERVEURS[Y][1] + "\Printers\" + SUBSTR(TImpOrig[X], RAT("\",TImpOrig[X]) + 1) ;
        + "\DsSpooler", , KEY_QUERY_VALUE )
        IF oReg:nError = 0
          EXIT
        ENDIF
        oReg:Close()
        oReg := NIL
    NEXT Y

    IF oReg != NIL
      IF oReg:nError = 0
        cPort := oReg:Get("portName", "")
        cNomDriver := oReg:Get("driverName", "")
      ENDIF
      oReg:Close()
      oReg := NIL
    ENDIF

  ELSE
    oReg := TReg32():New(HKEY_LOCAL_MACHINE,;
   "System\CurrentControlSet\Control\Print\Printers\" + STRTRAN(TIMP[X],"\",","), , KEY_QUERY_VALUE)

    IF oReg:nError <> 0

      * Cherche si cette imprimante non répertoriée est en réseau (10/2006)
      oReg:Close()
      oReg := NIL
      TSERVEURS := WinGetSerP()

      FOR Y := 1 TO LEN(TSERVEURS)

        oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
        + "\" + TSERVEURS[Y][1] + "\Printers\" + STRTRAN(TIMP[X],"\",","), , KEY_QUERY_VALUE)

        IF oReg:nError = 0
          EXIT
        ELSEIF "\" $ TIMP[X]
          * Si "\" est présent dans le nom d'imprimante, c'est "peut-être" la fonction WinGetPrn()
          * qui a inséré le nom de serveur dans le nom d'imprimante. Pour le vérifier,
          * recherche également le nom de l'imprimante sans le nom de serveur
          oReg:Close()
          oReg := NIL
          oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
          + "\" + TSERVEURS[Y][1] + "\Printers\" + SUBSTR(TIMP[X], RAT("\",TIMP[X]) + 1 ), , KEY_QUERY_VALUE )
          IF oReg:nError = 0
            EXIT
          ENDIF
        ENDIF
        oReg:Close()
        oReg := NIL
      NEXT Y

    ENDIF

    IF oReg != NIL
      IF oReg:nError = 0
        cPort := oReg:Get("Port", "")
        cNomDriver := oReg:Get("Printer Driver", "")
      ENDIF
      oReg:Close()
      oReg := NIL
    ENDIF

  ENDIF

  IF cNomDriver != ""
    cDriver := WinGetPrnD( STRTRAN(cNomDriver, CHR(0), "") )
  ENDIF

ENDIF
SET( _SET_EXACT, lSetExact )
RETURN cDriver + "," + cPort

******************
FUNCTION WinDefPrn()
******************
* Dernière modification le 17/11/2006
* Retourne le nom de l'imprimante par défaut en allant le chercher dans le registre Windows
* (regedit.exe)
LOCAL cDefPrn := ""
* Adresse dans le registre pour Windows 2000 et suivants
LOCAL oReg := TReg32():New(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", , KEY_QUERY_VALUE)
IF oReg:nError = 0
  cDefPrn := oReg:Get("Device", "")
  IF "," $ cDefPrn
    * Suppression du Pilote et du Port, non requis ici
    cDefPrn := LEFT(cDefPrn, AT(",",cDefPrn) -1)
  ENDIF
ELSE
  * Alternative pour Windows 9x et Millennium
  oReg:Close()
  oReg := NIL
  oReg := TReg32():New(HKEY_CURRENT_CONFIG, "System\CurrentControlSet\Control\Print\Printers", , KEY_QUERY_VALUE)
  IF oReg:nError = 0
    cDefPrn := oReg:Get("Default", "")
  ENDIF
ENDIF
oReg:Close()
oReg := NIL
RETURN cDefPrn

[/list]

[anserkk]

Dear Badara,

I tested you function and is found to be working.

Your fuction WinGetSerP() is supposed to Return an array containing the name of the Print Servers

If I try MsgList(WinGetSerP()) will make my app quit abnormally with the error screen which I posted above

I also tried in different ways like

Code: Select all

aTestArr:=WinGetSerP()
MsgList(aTestArr)

but the problem is still there. I checked the VALTYPE(aTestArr) and I am getting the result as "A"

But if try your old function MsgList(WinGetSerP()) posten in the first page of this thread, it will display the array without any problem.

Regards

Anser

[Badara Thiam]

Dear Anserkk,

Try to change this line in WinGetSerP :

Code: Select all

 AADD(TSERVEURS, { cValue, cSubKeys, aHKey } )

replace it with :

Code: Select all

 AADD(TSERVEURS, ACLONE( { cValue, cSubKeys, aHKey } ) )

Perhaps this solve...

Regards,

[Badara Thiam]

Dear Anserkk,

Here and now the last update. The WinGetSerP()
is rewritted and return the sames values like the first WinGetSerP().

The previous WinGetSerP() (of yesterday) is renamed WinGetSP().

Thank you to help me to keep compatibility with my previous code...

Regards.

Code: Select all

******************
FUNCTION WinGetPrn( lOrigine )
******************
* Recherche les imprimantes installées sous windows
* dans le registre de Windows (remplace le WIN.INI qui est obsolète sous Windows 2000 et suivants)
* Auteur Badara Thiam

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL TIMP := {}
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL nok
LOCAL nLen
LOCAL cSubkeys
LOCAL nHKey := HKEY_LOCAL_MACHINE
LOCAL TSERVEURS := {}
LOCAL X
LOCAL oReg
LOCAL oRegSubK

* Recherche des imprimantes disponibles depuis le poste courant
cSubKeys := "System\CurrentControlSet\Control\Print\Printers"

oReg := TReg32():New( nHKey, cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
IF oReg:nError = 0
    n1 := 0
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        IF ASCAN(TIMP, STRTRAN(cValue, "," , "\")) = 0
          SysRefresh()
          AADD(TIMP, STRTRAN(cValue, "," , "\"))
        ENDIF
      ELSE
        EXIT
      ENDIF
      n1 ++
    ENDDO
    SysRefresh()
    oReg:Close()
ENDIF

* Recherche des imprimantes réseau non répertoriées dans la clé précédente (ci-dessus)
* Ajouté le 20/10/2006
TSERVEURS := WinGetSP()

IF !EMPTY(TSERVEURS)
  FOR X := 1 TO LEN(TSERVEURS)
    cSubKeys := TSERVEURS[X][2] + "\" + TSERVEURS[X][1] + "\Printers"

    oRegSubK := TReg32():New( TSERVEURS[X][3], cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
    IF oRegSubK:nError = 0
      n1 := 0
      DO WHILE .T.
        cValue := ""
        n2 := RegEnumKey( oRegSubK:nHandle, n1,  @cvalue  )
        SysRefresh()
        IF n2 = 0

          * Pour vista : le nom d'imprimante (sous précédents os) est le port, codé avec "{" et "}"
          IF EMPTY( lOrigine ) .AND. ( "{" $ cValue )
            oReg := TReg32():New( TSERVEURS[X][3], TSERVEURS[X][2] + "\" + TSERVEURS[X][1] + "\Printers" ;
            + "\" + cValue + "\PrinterDriverData", , KEY_QUERY_VALUE )
            IF oReg:nError = 0
              cValue := oReg:Get("Model", "")
            ENDIF
            oReg:Close()
          ENDIF
          IF ASCAN(TIMP, STRTRAN(cValue, "," , "\")) = 0
            IF "," $ cValue
              AADD(TIMP, STRTRAN(cValue, "," , "\"))
            ELSE
              AADD(TIMP, "\\" + TSERVEURS[X][1] + "\" + cValue)
            ENDIF
          ENDIF
          SysRefresh()
        ELSE
          EXIT
        ENDIF
        n1 ++
      ENDDO
      oRegSubK:Close()

    ENDIF
    SysRefresh()
  NEXT X

ENDIF

SET( _SET_EXACT, lSetExact )
RETURN ACLONE(TIMP)

Code: Select all

*****************
FUNCTION WinGetSP()
*****************
* Renvoie un tableau dont chaque élément est un tableau contenant
* 1 : les noms des serveurs d'impression disponibles pour le poste courant
* 2 : la sous-clé dans le registre Windows où est localisée l'information concernant le serveur
* 3 : clé dans le registre Windows où est localisée l'information concernant le serveur
* Auteur Badara Thiam

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL cSubkeys
LOCAL nHKey
LOCAL TSERVEURS := {}
LOCAL nSubK := 0
LOCAL oReg

DO WHILE .T.
  nSubK ++
  IF nSubK = 1
    nHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers"
  ELSEIF nSubK = 2
    * Sous Vista version premium familiale
    nHKey := HKEY_LOCAL_MACHINE
    cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\Client Side Rendering Print Provider\Servers"
  ELSE
    EXIT
  ENDIF

  oReg := TReg32():New( nHKey, cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
  IF oReg:nError = 0

    * Recherche des serveurs accessibles
    n1 := 0
    DO WHILE .T.
      cValue := ""
      n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
      SysRefresh()
      IF n2 = 0
        IF ASCAN(TSERVEURS, { |qelem| qelem[1] = cValue } ) = 0
          AADD(TSERVEURS, ACLONE( { cValue, cSubKeys, nHKey } ) )
        ENDIF
      ELSE
        EXIT
      ENDIF
      SysRefresh()
      n1 ++
    ENDDO
    oReg:Close()
  ENDIF
ENDDO
SET( _SET_EXACT, lSetExact )
RETURN ACLONE(TSERVEURS)

Code: Select all

*******************
FUNCTION WinGetSerP()
*******************
* Renvoie dans un tableau les noms des serveurs d'impression disponibles pour le poste courant
* Auteur Badara Thiam
LOCAL N
LOCAL TSERVEURS := WinGetSP()
LOCAL aServeurs := {}
FOR N := 1 TO LEN(TSERVEURS)
  AADD( aServeurs, TSERVEURS[N][1] )
NEXT N
RETURN ACLONE(aServeurs)

Code: Select all

*******************
FUNCTION WinGetPrnD(cNomDriver)
*******************
* Recherche le driver d'une imprimante installée sous windows
* dans le registre de Windows (remplace le WIN.INI qui est obsolète sous Windows 2000 et suivants)
* Auteur Badara THIAM

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL nok
LOCAL nLen
LOCAL cSubkeys
LOCAL cSubkeys2
LOCAL cSubkeys3
LOCAL X, X2
LOCAL XENV
LOCAL TENV := {}
LOCAL TVERDRIVER := {}
LOCAL oReg
LOCAL cDriver := ""

X := 0
DO WHILE EMPTY(cDriver)

  X ++
  TENV := {}
  TVERDRIVER := {}
  cDriver := ""

  IF X = 1
    cSubKeys := "System\CurrentControlSet\Control\Print\Environments"
  ELSEIF X = 2
    cSubKeys := "System\ControlSet001\Control\Print\Environments"
  ELSEIF X = 3
    cSubKeys := "System\ControlSet002\Control\Print\Environments"
  ELSE
    EXIT
  ENDIF

  oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys, , KEY_ENUMERATE_SUB_KEYS )
  IF oReg:nError = 0
      * Stocke tous les sous chemins de ..\Environments
      * dans le tableau TENV, pour analyse le contenu de chaque "environment" 
      SysRefresh()
      n1 := 0
      DO WHILE .T.
        cValue := ""
        n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
        IF n2 = 0
          IF ASCAN(TENV, STRTRAN(cValue, "," , "\")) = 0
            AADD(TENV, STRTRAN(cValue, "," , "\"))
          ENDIF
        ELSE
          EXIT
        ENDIF
        n1 ++
        SysRefresh()
      ENDDO
      oReg:Close()
      SysRefresh()
  ENDIF

  FOR XENV := 1 TO LEN(TENV)
    cSubKeys2 := cSubKeys + "\" + TENV[XENV] + "\Drivers"
    cSubKeys3 := cSubKeys2 + "\" + cNomDriver

    oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys3, , KEY_QUERY_VALUE)

    IF oReg:nError = 0
    * Si le nom de l'imprimante est présent dans le chemin ..\Drivers
      cDriver := oReg:Get("Driver", "")
      oReg:Close()
      oReg := NIL

      IF !EMPTY(cDriver)
        cDriver := IIF("." $ cDriver, LEFT(cDriver, AT(".", cDriver) - 1), cDriver)
        EXIT
      ENDIF
    ELSE

      oReg:Close()
      oReg := NIL

      oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys2, , KEY_ENUMERATE_SUB_KEYS )
      IF oReg:nError = 0

        n1 := 0
        TVERDRIVER := {}
        DO WHILE .T.
          cValue := ""
          n2 := RegEnumKey( oReg:nHandle, n1,  @cvalue  )
          IF n2 = 0
            IF ASCAN(TVERDRIVER, STRTRAN(cValue, "," , "\")) = 0
              AADD(TVERDRIVER, STRTRAN(cValue, "," , "\"))
            ENDIF
          ELSE
            EXIT
          ENDIF
          SysRefresh()
          n1 ++
        ENDDO
        oReg:Close()
        SysRefresh()

        FOR X2 := 1 TO LEN(TVERDRIVER)

          cSubKeys3 := cSubKeys2 + "\" + TVERDRIVER[X2] + "\" + cNomDriver

          oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys3, , KEY_QUERY_VALUE)

          IF oReg:nError = 0

            cDriver := oReg:Get("Driver", "")
            SysRefresh()
            oReg:Close()
            oReg := NIL
            IF !EMPTY(cDriver)
              cDriver := IIF("." $ cDriver, LEFT(cDriver, AT(".", cDriver) - 1), cDriver)
              EXIT
            ENDIF
          ELSE
            oReg:Close()
            oReg := NIL
          ENDIF
          SysRefresh()

        NEXT X2
        IF !EMPTY(cDriver)
          EXIT
        ENDIF
      ENDIF
    ENDIF
    SysRefresh()
  NEXT XENV

ENDDO

SysRefresh()
SET( _SET_EXACT, lSetExact )
RETURN cDriver

Code: Select all

*******************
FUNCTION WinGetPrnP(cNomImpr)
*******************
* Renvoie le (nom du fichier) Driver et le Port de l'imprimante dont le nom est le contenu de cNomImpr.
* Le Driver et le Port sont renvoyés dans une chaine, séparés par une virgule.
* Auteur Badara THIAM

LOCAL lSetExact := SET( _SET_EXACT, .T. )
LOCAL cDriver := ""
LOCAL cNomDriver := ""
LOCAL cPort := ""
LOCAL oReg
LOCAL X
LOCAL Y
LOCAL TIMP := WinGetPrn()
LOCAL TImpOrig := WinGetPrn(.T.)
LOCAL TSERVEURS := {}

* Recherche l'imprimante Windows ayant le même nom,
* en convertissant en minuscule et en supprimant les espaces
FOR X := 1 TO LEN(TIMP)
  IF MEMEIMPRIM(@cNomImpr, TIMP[X])
  * Si c'est la même imprimante
    EXIT
  ENDIF
NEXT X

IF X <= LEN(TIMP)

  IF "\" $ TIMP[X] .AND. TIMP[X] != TImpOrig[X]
  * Si imprimante réseau

    TSERVEURS := WinGetSP()

    FOR Y := 1 TO LEN(TSERVEURS)
        oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
        + "\" + TSERVEURS[Y][1] + "\Printers\" + SUBSTR(TImpOrig[X], RAT("\",TImpOrig[X]) + 1) ;
        + "\DsSpooler", , KEY_QUERY_VALUE )
        IF oReg:nError = 0
          EXIT
        ENDIF
        oReg:Close()
        oReg := NIL
    NEXT Y

    IF oReg != NIL
      IF oReg:nError = 0
        cPort := oReg:Get("portName", "")
        cNomDriver := oReg:Get("driverName", "")
      ENDIF
      oReg:Close()
      oReg := NIL
    ENDIF

  ELSE
    oReg := TReg32():New(HKEY_LOCAL_MACHINE,;
   "System\CurrentControlSet\Control\Print\Printers\" + STRTRAN(TIMP[X],"\",","), , KEY_QUERY_VALUE)

    IF oReg:nError <> 0

      * Cherche si cette imprimante non répertoriée est en réseau (10/2006)
      oReg:Close()
      oReg := NIL
      TSERVEURS := WinGetSP()

      FOR Y := 1 TO LEN(TSERVEURS)

        oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
        + "\" + TSERVEURS[Y][1] + "\Printers\" + STRTRAN(TIMP[X],"\",","), , KEY_QUERY_VALUE)

        IF oReg:nError = 0
          EXIT
        ELSEIF "\" $ TIMP[X]
          * Si "\" est présent dans le nom d'imprimante, c'est "peut-être" la fonction WinGetPrn()
          * qui a inséré le nom de serveur dans le nom d'imprimante. Pour le vérifier,
          * recherche également le nom de l'imprimante sans le nom de serveur
          oReg:Close()
          oReg := NIL
          oReg := TReg32():New( TSERVEURS[Y][3], TSERVEURS[Y][2] ;
          + "\" + TSERVEURS[Y][1] + "\Printers\" + SUBSTR(TIMP[X], RAT("\",TIMP[X]) + 1 ), , KEY_QUERY_VALUE )
          IF oReg:nError = 0
            EXIT
          ENDIF
        ENDIF
        oReg:Close()
        oReg := NIL
      NEXT Y

    ENDIF

    IF oReg != NIL
      IF oReg:nError = 0
        cPort := oReg:Get("Port", "")
        cNomDriver := oReg:Get("Printer Driver", "")
      ENDIF
      oReg:Close()
      oReg := NIL
    ENDIF

  ENDIF

  IF cNomDriver != ""
    cDriver := WinGetPrnD( STRTRAN(cNomDriver, CHR(0), "") )
  ENDIF

ENDIF
SET( _SET_EXACT, lSetExact )
RETURN cDriver + "," + cPort

Code: Select all

******************
FUNCTION WinDefPrn()
******************
* Dernière modification le 17/11/2006
* Retourne le nom de l'imprimante par défaut en allant le chercher dans le registre Windows
* (regedit.exe)
LOCAL cDefPrn := ""
* Adresse dans le registre pour Windows 2000 et suivants
LOCAL oReg := TReg32():New(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", , KEY_QUERY_VALUE)
IF oReg:nError = 0
  cDefPrn := oReg:Get("Device", "")
  IF "," $ cDefPrn
    * Suppression du Pilote et du Port, non requis ici
    cDefPrn := LEFT(cDefPrn, AT(",",cDefPrn) -1)
  ENDIF
ELSE
  * Alternative pour Windows 9x et Millennium
  oReg:Close()
  oReg := NIL
  oReg := TReg32():New(HKEY_CURRENT_CONFIG, "System\CurrentControlSet\Control\Print\Printers", , KEY_QUERY_VALUE)
  IF oReg:nError = 0
    cDefPrn := oReg:Get("Default", "")
  ENDIF
ENDIF
oReg:Close()
oReg := NIL
RETURN cDefPrn

[anserkk]

Thank you Badara,

I shall check and give u a feedback tomorrow. By the way any Idea about checking the online status of a network dot matrix printer (pserver). I have created a new post regarding the same on FWH english thread

Regards,

Anser

[anserkk]

Dear Badara,

It is Working fine.

Regards

Anser