Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Set default printer

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Set default printer

    Routine to set Windows's default printer,
    tested succesfully under 95, 98, Me, NT, 2000 and XP.

    Major rewrite on 2003/05/05
    Made routines much more portable and easy to use.
    Removed many globals variables.
    Added optionnal command line switch, thank to Fred Buffington.

    Code:
    #COMPILE EXE             '#Win 702#
    #DIM ALL
    #INCLUDE "Win32Api.Inc"  '2003-03-27
      
    $AppName         = "PrinterSelect"
      
    %FramePS         = 1001
    %ButtonSetPS     = 1002
    %ButtonInfoPS    = 1003
    %ButtonExitPS    = 1004
    %ListboxPS       = 1005
    %LabelPS         = 1006
      
    %MaxPrinterCount = 20
      
    GLOBAL hDlg AS LONG
    '______________________________________________________________________________
      
    FUNCTION GetPrinterDefault(PList() AS STRING) AS LONG
     LOCAL zPrinterDefault AS ASCIIZ * 255
     LOCAL Counter         AS LONG
      
     'GetProfileString will return: Printer Name,Driver,Port
     'Like...                       Epson LQ-500,EPSON24,LPT1:
     GetProfileString "WINDOWS", "DEVICE", ",,,", zPrinterDefault, SIZEOF(zPrinterDefault)
     FOR Counter = 1 TO UBOUND(PList())
       IF PARSE$(PList(Counter), "=", 1) = PARSE$(zPrinterDefault, ",", 1) THEN
         FUNCTION = Counter
         EXIT FUNCTION
       END IF
     NEXT
      
    END FUNCTION
      
    '______________________________________________________________________________
      
    SUB GetPrinterAll(PList() AS STRING)
     LOCAL  Section       AS ASCIIZ * 32767
     LOCAL  SectionPtr    AS ASCIIZ PTR
     LOCAL PrintersCount AS  LONG
     LOCAL Retval        AS  LONG
     
     Retval = GetProfileSection("PrinterPorts", Section,  SIZEOF(Section))
     IF Retval THEN
       SectionPtr =  VARPTR(Section)
       PrintersCount = 0
        DO
         IF LEN(@SectionPtr) = 0 THEN EXIT  DO
         INCR PrintersCount
         IF  PrintersCount > %MaxPrinterCount THEN EXIT LOOP
          REDIM PRESERVE PList(0 TO PrintersCount) AS STRING
          PList(PrintersCount) = @SectionPtr 'Printer  Name=Driver,Port,NonSelect,Retry
                                             'Like... Epson LQ-500=EPSON24,LPT1:,15,45
         SectionPtr  = SectionPtr + LEN(@SectionPtr) + 1
       LOOP
     END  IF
     
    END  SUB
    '______________________________________________________________________________
       
    SUB SetPrinterDefault(Printer AS STRING)
     LOCAL OsInfo      AS OSVERSIONINFO
     LOCAL PD          AS PRINTER_DEFAULTS
     LOCAL PI5         AS PRINTER_INFO_5
     LOCAL DeviceLine  AS STRING
     LOCAL Win         AS STRING
     LOCAL hPrinter    AS LONG
     LOCAL Need        AS LONG
     LOCAL LastError   AS LONG
     LOCAL Retval      AS LONG
     LOCAL Counter     AS LONG
     DIM PList(0 TO 0) AS STRING
      
     OsInfo.dwOsVersionInfoSize = SIZEOF(OsInfo)
     GetVersionEx OsInfo
      
     IF OsInfo.dwPlatformId = %VER_PLATFORM_WIN32_WINDOWS THEN 'Windows 95/98/Me
      
       'Get the selected printer
       IF Printer = "" THEN
         MSGBOX "Error: No printer specified !", %MB_ICONERROR OR %MB_OK, $AppName
         EXIT SUB
       END IF
      
       'Set the PRINTER_DEFAULTS members
       PD.pDatatype = 0&
       PD.DesiredAccess = %PRINTER_ALL_ACCESS OR PD.DesiredAccess
      
       'Get an handle to the printer
       Retval = OpenPrinter(BYCOPY Printer, hPrinter, PD)
       IF Retval = 0 THEN
         MSGBOX "Error: " & Printer & " not found !", %MB_ICONERROR OR %MB_OK, $AppName
         EXIT SUB
       END IF
      
       'Check how many bytes we need
       Retval = GetPrinter(hPrinter, 5, BYVAL 0, BYVAL 0, Need)
       REDIM PArray((Need \ 4)) AS LONG
      
       'Get info
       Retval = GetPrinter(hPrinter, 5, PArray(0), Need, Need)
       IF Retval = %False THEN
         MSGBOX "Error: GetPrinter !", %MB_ICONERROR OR %MB_OK, $AppName
         EXIT SUB
       END IF
      
       'Set default printer
       PI5.pPrinterName             = PArray(0)
       PI5.pPortName                = PArray(1)
       PI5.Attributes               = PArray(2)
       PI5.DeviceNotSelected        = PArray(3)
       PI5.TransmissionRetryTimeout = PArray(4)
       PI5.Attributes               = %PRINTER_ATTRIBUTE_DEFAULT          'This make it the default printer
       Retval = SetPrinter(hPrinter, BYVAL 5, BYVAL VARPTR(PI5), BYVAL 0) 'Tell Windows to set default printer
       IF Retval = 0 THEN
         MSGBOX "SetPrinter failed !", %MB_ICONERROR OR %MB_OK, $AppName
         EXIT SUB
       END IF
      
       ClosePrinter hPrinter
      
     ELSE 'Windows NT/2000/XP
      
       GetPrinterAll PList()  'String Array in the form of: Printer Name=Driver,Port,NonSelect,Retry
       FOR Counter = 1 TO UBOUND(PList())
         IF UCASE$(PARSE$(PList(Counter), "=", 1)) = UCASE$(Printer) THEN
           DeviceLine = PARSE$(PList(Counter), ANY "=,", 1) & "," & _
                        PARSE$(PList(Counter), ANY "=,", 2) & "," & _
                        PARSE$(PList(Counter), ANY "=,", 3)
      
           'Store WIN.INI, [WINDOWS], DEVICE =
           Retval = WriteProfileString("Windows", "Device", BYCOPY DeviceLine)
      
           'Cause all applications to reload the INI file
           Win = "Windows"
           Retval = SendMessage(%HWND_BROADCAST, %WM_WININICHANGE, 0, BYCOPY VARPTR(Win))
           EXIT FOR
         END IF
       NEXT
       IF LEN(Win) = 0 THEN
         MSGBOX "Error: " & Printer & " not found !", %MB_ICONERROR OR %MB_OK, $AppName
       END IF
      
     END IF
    END SUB
    '______________________________________________________________________________
      
    CALLBACK FUNCTION DlgProc() AS LONG
     LOCAL Retval      AS LONG
     LOCAL Counter     AS LONG
     LOCAL Printer     AS STRING
     DIM PList(0 TO 0) AS STATIC STRING
      
     SELECT CASE CBMSG
       CASE %WM_INITDIALOG
         GetPrinterAll PList()  'StringArray in the form of: Printer Name=Driver,Port,NonSelect,Retry
         FOR COUNTER = 1 TO UBOUND(PList())
           LISTBOX ADD hDlg, %ListboxPS, PARSE$(PList(Counter), "=", 1)
         NEXT
         LISTBOX SELECT hDlg, %ListboxPS, GetPrinterDefault(PList())
         CONTROL SET TEXT hDlg, %LabelPS, "Default is: " _
                 & PARSE$(PList(GetPrinterDefault(PList())), "=" , 1)
      
       CASE %WM_COMMAND
         SELECT CASE CBCTL
      
           CASE %ButtonSetPS
             IF CBCTLMSG = %BN_CLICKED THEN
               LISTBOX GET TEXT hDlg, %ListboxPS TO Printer
               SetPrinterDefault Printer
             END IF
      
           CASE %ListboxPS
             IF CBCTLMSG = %LBN_DBLCLK THEN
               LISTBOX GET TEXT hDlg, %ListboxPS TO Printer
               SetPrinterDefault Printer
             END IF
      
           CASE %ButtonInfoPS
             IF CBCTLMSG = %BN_CLICKED THEN
               CONTROL SEND hDlg, %ListboxPS, %LB_GetCurSel, 0, 0 TO Retval
               INCR Retval
               MSGBOX "Name:"   & $TAB & PARSE$(PList(Retval), ANY "=,", 1) & $CRLF & _
                      "Driver:" & $TAB & PARSE$(PList(Retval), ANY "=,", 2) & $CRLF & _
                      "Port:"   & $TAB & PARSE$(PList(Retval), ANY "=,", 3) & $CRLF & _
                      "Select:" & $TAB & PARSE$(PList(Retval), ANY "=,", 4) & $CRLF & _
                      "Retry:"  & $TAB & PARSE$(PList(Retval), ANY "=,", 5), _
                      %MB_ICONINFORMATION OR %MB_OK, $AppName
             END IF
      
           CASE  %ButtonExitPS, %IDCANCEL
             IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL, 0
      
         END SELECT
      
       CASE %WM_WININICHANGE
         'Here, we will be inform by Window if the default printer change
         CONTROL SET TEXT hDlg, %LabelPS, "Default is: " _
                 & PARSE$(PList(GetPrinterDefault(PList())), "=" , 1)
      
     END SELECT
      
    END FUNCTION
    '______________________________________________________________________________
      
    FUNCTION PBMAIN AS LONG
     LOCAL Counter       AS LONG
     LOCAL Retval        AS LONG
     LOCAL Kommand       AS STRING
     DIM   PList(0 TO 0) AS STRING
      
     Kommand = TRIM$(COMMAND$)
     'Kommand = TRIM$("Epson LQ-500") 'Use your printer name for testing...
      
     IF LEN(Kommand) THEN
      
       SetPrinterDefault Kommand
      
     ELSE
      
       DIALOG NEW 0, $AppName, , , 280, 150, %WS_POPUP OR %WS_VISIBLE OR %WS_CLIPSIBLINGS _
                     OR %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %DS_3DLOOK _
                     OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT TO hDlg
      
       CONTROL ADD FRAME, hDlg, %FramePS, "Printer", 9, 9, 264, 93
      
       CONTROL ADD LISTBOX, hDlg, %ListboxPS, , 21, 24, 240, 76, %WS_CHILD OR %WS_VISIBLE _
                   OR %WS_BORDER OR %WS_VSCROLL OR %WS_TABSTOP OR %LBS_NOTIFY, 0
      
       CONTROL ADD LABEL, hDlg, %LabelPS, "Default Printer is...", 21, 110, 240, 12
      
       CONTROL ADD BUTTON, hDlg, %ButtonSetPS, "Set default printer", 9, 126, 130, 18, _
                 %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_CENTER OR %BS_VCENTER
      
       CONTROL ADD BUTTON, hDlg, %ButtonInfoPS, "Info", 150, 126, 30, 18, _
                 %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_CENTER OR %BS_VCENTER
      
       CONTROL ADD BUTTON, hDlg, %ButtonExitPS, "Exit", 192, 126, 78, 18, _
                 %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_CENTER OR %BS_VCENTER
      
       DIALOG SHOW MODAL hDlg, CALL DlgProc
      
     END IF
      
    END FUNCTION
    '______________________________________________________________________________
    [This message has been edited by Pierre Bellisle (edited May 12, 2003).]

  • #2
    Code updated, 2003/05/05

    Made routines more portable.
    Removed most globals variables.
    Added optionnal command line switch, thank to Fred Buffington.

    ------------------
    Pierre Bellisle


    [This message has been edited by Pierre Bellisle (edited February 27, 2004).]

    Comment

    Working...
    X