get / set the default printer

get / set the default printer? 
 
 uses 
  Printers, Messages; 

function GetDefaultPrinter: string; 
var 
  ResStr: array[0..255] of Char; 
begin 
  GetProfileString('Windows', 'device', '', ResStr, 255); 
  Result := StrPas(ResStr); 
end; 

procedure SetDefaultPrinter1(NewDefPrinter: string); 
var 
  ResStr: array[0..255] of Char; 
begin 
  StrPCopy(ResStr, NewdefPrinter); 
  WriteProfileString('windows', 'device', ResStr); 
  StrCopy(ResStr, 'windows'); 
  SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, Longint(@ResStr)); 
end; 

procedure SetDefaultPrinter2(PrinterName: string); 
var 
  I: Integer; 
  Device: PChar; 
  Driver: PChar; 
  Port: PChar; 
  HdeviceMode: THandle; 
  aPrinter: TPrinter; 
begin 
  Printer.PrinterIndex := -1; 
  GetMem(Device, 255); 
  GetMem(Driver, 255); 
  GetMem(Port, 255); 
  aPrinter := TPrinter.Create; 
  try 
    for I := 0 to Printer.Printers.Count - 1 do 
    begin 
      if Printer.Printers = PrinterName then 
      begin 
        aprinter.PrinterIndex := i; 
        aPrinter.getprinter(device, driver, port, HdeviceMode); 
        StrCat(Device, ','); 
        StrCat(Device, Driver); 
        StrCat(Device, Port); 
        WriteProfileString('windows', 'device', Device); 
        StrCopy(Device, 'windows'); 
        SendMessage(HWND_BROADCAST, WM_WININICHANGE, 
          0, Longint(@Device)); 
      end; 
    end; 
  finally 
    aPrinter.Free; 
  end; 
  FreeMem(Device, 255); 
  FreeMem(Driver, 255); 
  FreeMem(Port, 255); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  label1.Caption := GetDefaultPrinter2; 
end; 

//Fill the combobox with all available printers 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Combobox1.Items.Clear; 
  Combobox1.Items.AddStrings(Printer.Printers); 
end; 

//Set the selected printer in the combobox as default printer 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  SetDefaultPrinter(Combobox1.Text); 

end; 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

const
  MAXPRINTERBUFFER = 8000;
  MAXPRINTERNAME = 500;
  MAXPRINTERINFO = 50;

type
  TPrinterBuffer = array[0..MAXPRINTERBUFFER - 1] of char;
  TForm1 = class(TForm)
  ListBox1: TListBox;
  Button2: TButton;
  Button1: TButton;
  Label1: TLabel;
procedure Button2Click(Sender: TObject);
procedure GetPrinterNames;
function ParseNames(const namebuffer: TPrinterBuffer; var startPos: integer): string;
function SetPrinter(const PrinterName : String) : boolean;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  Form1: TForm1;
  printerNames: TStringList;
  defaultPrinter: integer;

implementation

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
var
  x : integer;
begin
  try
  for x := 0 to printerNames.Count -1 do begin
    If ListBox1.Selected[x] then begin
      if (SetPrinter(ListBox1.Items.Strings[x]))
      then label1.Caption := 'Printer set to ' + ListBox1.Items.Strings[x]
      else label1.Caption := 'Printer not set';
    end;
  end;
  except
    label1.Caption := 'An error occured while setting the printer';
  end;
end;

procedure TForm1.GetPrinterNames;
var
  buffer: TPrinterBuffer;
  currPos: integer;
  printerName: string;
begin
  printerNames.Free;
  printerNames := TStringList.Create;
  if GetProfileString(PChar('PrinterPorts'), nil, '', buffer, MAXPRINTERBUFFER) > 0 then
  begin
    currPos := 0;
    while (true) do
      begin
        printerName := ParseNames(buffer, currPos);
        if printerName <> '' then
        printerNames.Add(printerName)
    else
      break;
    end;
  end;
end;

function TForm1.ParseNames(const namebuffer: TPrinterBuffer;
var startPos: integer): string;
var
  i, j, NameLength: integer;
  str: string;
begin
  result := '';
  if (startPos > High(namebuffer)) or (namebuffer[startPos] = Chr(0))  

  then
    exit;
  for i := startPos to High(namebuffer) do begin
    if namebuffer[i] = Chr(0) 

    then begin
      nameLength := i - startPos;
      SetLength(str, nameLength);
      for j := 0 to nameLength - 1 do
      str[j+1] := namebuffer[startPos + j];
      result := str;
      startPos := i + 1;
      break;
    end;
  end;
end;

function TForm1.SetPrinter(const PrinterName: String): boolean;
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; 
  Result := True;
end;
finally
  FreeMem( dum1 );
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetPrinterNames;
  Listbox1.Items.AddStrings(PrinterNames);
end;

end.