uses WinSpool;
 
procedure GetBinnames(sl: TStrings);
type
  TBinName = Array [0..23] of Char;
  TBinNameArray = Array [1..High(Integer) div Sizeof(TBinName)] of TBinName;
  PBinnameArray = ^TBinNameArray;
  TBinArray = Array [1..High(Integer) div Sizeof(Word)] of Word;
  PBinArray = ^TBinArray;
var
  Device, Driver, Port: Array [0..255] of Char;
  hDevMode: THandle;
  i, numBinNames, numBins, temp: Integer;
  pBinNames: PBinnameArray;
  pBins: PBinArray;
begin
  Printer.PrinterIndex := - 1;
  Printer.GetPrinter(Device, Driver, Port, hDevmode);
  numBinNames := WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, Nil, Nil);
  numBins := WinSpool.DeviceCapabilities(Device, Port, DC_BINS, Nil, Nil);
  if numBins <> numBinNames then
  begin
    raise Exception.Create('DeviceCapabilities reports different number of bins and '+ 'bin names!');
  end;
  if numBinNames > 0 then
  begin
    pBins := Nil;
    GetMem(pBinNames, numBinNames * Sizeof(TBinname));
    GetMem(pBins, numBins * Sizeof(Word));
    try
      WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, Pchar(pBinNames), Nil);
      WinSpool.DeviceCapabilities(Device, Port, DC_BINS, Pchar(pBins), Nil);
      sl.clear;
      for i := 1 to numBinNames do
      begin
        temp := pBins^[i];
        sl.addObject(pBinNames^[i], TObject(temp));
      end;
    finally
      FreeMem(pBinNames);
      if pBins <> Nil then
        FreeMem(pBins);
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 GetBinnames(Memo1.Lines);
end;