Hello,
I have rewritted the functions WinGetPrn() and WinGetPrnP()
because there are some shared printers who are not registered
in the same path in the Windows registry, under NT, XP, and
i think also under 2000, 2003, Vista.
Theses functions must work under all Windows since 95,
else i have something to change.
Thank you to say me any problem found.
Regards,
- Code: Select all Expand view RUN
******************
FUNCTION WinGetPrn()
******************
* 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
* 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
AADD(TIMP, STRTRAN(cValue, "," , "\"))
ENDIF
ELSE
EXIT
ENDIF
n1 ++
ENDDO
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 := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers" ;
+ "\" + TSERVEURS[X] + "\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
AADD(TIMP, STRTRAN(cValue, "," , "\"))
ENDIF
ELSE
EXIT
ENDIF
n1 ++
ENDDO
RegCloseKey( nHandle )
ENDIF
NEXT X
ENDIF
RETURN ACLONE(TIMP)
- Code: Select all Expand view RUN
*******************
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)
- Code: Select all Expand view RUN
*******************
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 X, X2
LOCAL TENV := {}
LOCAL TENVDRIVER := {}
LOCAL oReg
LOCAL cDriver := ""
cSubKeys := "System\CurrentControlSet\Control\Print\Environments"
IF RegOpenKey( HKEY_LOCAL_MACHINE, cSubKeys, @nHandle ) == 0
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()
FOR X := 1 TO LEN(TENV)
cSubKeys2 := cSubKeys + "\" + TENV[X] + "\Drivers"
oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys2 + "\" + cNomDriver)
IF oReg:nError = 0
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
TENVDRIVER := {}
DO WHILE .T.
cValue := ""
n2 := RegEnumKey( nHandle, n1, @cvalue )
IF n2 = 0
IF ASCAN(TENVDRIVER, STRTRAN(cValue, "," , "\")) = 0
AADD(TENVDRIVER, STRTRAN(cValue, "," , "\"))
ENDIF
ELSE
EXIT
ENDIF
SysRefresh()
n1 ++
ENDDO
RegCloseKey( nHandle )
SysRefresh()
FOR X2 := 1 TO LEN(TENVDRIVER)
oReg := TReg32():New(HKEY_LOCAL_MACHINE, cSubKeys2 + "\" + TENVDRIVER[X2] + "\" + cNomDriver)
IF oReg:nError = 0
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
ENDIF
SysRefresh()
NEXT X2
IF !EMPTY(cDriver)
EXIT
ENDIF
ENDIF
ENDIF
SysRefresh()
NEXT X
ENDIF
SysRefresh()
RETURN cDriver
- Code: Select all Expand view RUN
*******************
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 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)
oReg := TReg32():New(HKEY_LOCAL_MACHINE,;
"System\CurrentControlSet\Control\Print\Printers\" + STRTRAN(TIMP[X],"\",","))
IF oReg:nError <> 0
* Recherche les imprimantes réseau non répertoriées (ajouté le 20/10/2006)
oReg:Close()
oReg := NIL
TSERVEURS := WinGetSerP()
FOR Y := 1 TO LEN(TSERVEURS)
oReg := TReg32():New(HKEY_LOCAL_MACHINE,;
"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers" ;
+ "\" + TSERVEURS[Y] + "\Printers\" + STRTRAN(TIMP[X],"\",","))
IF oReg:nError = 0
EXIT
ELSE
oReg:Close()
oReg := NIL
ENDIF
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
IF cNomDriver != ""
cDriver := WinGetPrnD(@cNomDriver)
ENDIF
ENDIF
RETURN cDriver + "," + cPort