James West
James West

Reputation: 763

How to change the default printer

I am attempting to change the default printer in the on change event of a combo box that list the printer index. I use "Printers" to get the printer index but the actual printing is done with proprietary print code that allows for direct to pdf printing and easier page layout. I am trying to use the below code to change the default printer and then my print code will print to that printer. However the program becomes unresponsive without any errors or program not responding messages when this line of code executes:

SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0,LongInt(cs1));

Here is the full function.

function TMainFrm.SetDefaultPrinter(const PrinterName: string): boolean;
// Printername is bv: '\\MYPRINTER\HP5-k'
var
s2 : string;
dum1 : Pchar;
xx, qq : integer;

const
cs1 : pchar = 'Windows';
cs2 : pchar = 'Device';
cs3 : pchar = 'Devices';
cs4 : pchar = #0;

begin
    xx := 254;
    GetMem( dum1, xx);
    Result := False;
    try
        qq := GetProfileString( cs3, pchar( PrinterName ), #0, dum1, xx);
    if (qq > 0) and (trim( strpas( dum1 )) <> '') then
    begin
        s2 := PrinterName + ',' + strpas( dum1 );
        while GetProfileString( cs1, cs2, cs4, dum1, xx) > 0 do
            WriteProfileString( cs1, cs2, #0);
            WriteProfileString( cs1, cs2, pchar( s2 ));
        case Win32Platform of
        VER_PLATFORM_WIN32_NT :
            SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0,LongInt(cs1));
        VER_PLATFORM_WIN32_WINDOWS :
            SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0,LongInt(cs1));
        end; { case }
        Result := True;
    end;
    finally
        FreeMem( dum1 );
    end;
end;

Anyone have any tips or a better way to do this?

As a side note this is not my function. It's a piece of code I picked up while searching for a solution to my problem.

Few more pieces of info:

The user selects the printer in the drop down. This is where the PDF will be sent

The print job is actually a PDF being printed using

 ShellExecute(Application.Handle, 'print', PChar(sPath), nil, nil, SW_HIDE); 

The goal is to change the default printer to the selected printer in order to print the pdf to the desired printer and then return the printer to the original default on exit of the application

Upvotes: 1

Views: 9805

Answers (3)

F. Fabiano
F. Fabiano

Reputation: 31

I also tried to use the "SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0,LongInt(cs1))" code block and my program was hang. So, I tried to simply write the SetDefaultPrinter as local function and then no hang occours. Here is the code that works fine for me.

function SetDefaultPrinter(const PrinterName: string): boolean;
// Printername is bv: '\\MYPRINTER\HP5-k'
var
s2 : string;
dum1 : PChar;
xx, qq : integer;

const
cs1 : pChar = 'Windows';
cs2 : pChar = 'Device';
cs3 : pChar = 'Devices';
cs4 : pChar = #0;

begin
    xx := 254;
    GetMem( dum1, xx);
    Result := False;
    try
            qq := GetProfileString( cs3, pChar( PrinterName ), #0, dum1, xx);
            if (qq > 0) and (trim( strpas( dum1 )) <> '') then
            begin
                s2 := PrinterName + ',' + strpas( dum1 );
                while GetProfileString( cs1, cs2, cs4, dum1, xx) > 0 do
                    WriteProfileString( cs1, cs2, #0);
                    WriteProfileString( cs1, cs2, pChar( s2 ));

                case Win32Platform of
                VER_PLATFORM_WIN32_NT :
                    SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(cs1));
                VER_PLATFORM_WIN32_WINDOWS :
                    SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0,LongInt(cs1));
                end; { case }
                Result := True;
            end;
    finally
        FreeMem( dum1 );
    end;
end;

Upvotes: 0

James
James

Reputation: 9985

Just a brief look at this link and it appears you're mising the most critical function SetDefaultPrinterA/SetDefaultPrinterW in 'winspool.drv'

Also the broadcast message is designed to be polite to other running programs to let them know something has changed the default printer, even in the above article it doesn't seem to pay any attention to the result so you could change the call to PostMessage

Upvotes: 2

RRUZ
RRUZ

Reputation: 136441

Try using the Win32_Printer WMI class to list the printers and the SetDefaultPrinter method to set the default printer.

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

procedure  ListPrinters;
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT DeviceID, Name FROM Win32_Printer','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('DeviceID %s Name %s',[FWbemObject.DeviceID,FWbemObject.Name]));
    FWbemObject:=Unassigned;
  end;
end;

function  SetDefaultPrinter(const DeviceID:string):boolean;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('Win32_Printer.DeviceID="%s"',[DeviceID]));
  if not VarIsClear(FWbemObject) then
   Result:=FWbemObject.SetDefaultPrinter()=0
  else
   Result:=false;
end;


begin
 try
    CoInitialize(nil);
    try
      ListPrinters;
      SetDefaultPrinter('HP LaserJet'); //here you must pass the DeviceID of one the printers listed above
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Upvotes: 3

Related Questions