вторник, 6 октября 2015 г.

#1171. Коротко. Боролся тут с непечатью из нашего продукта на неумолчательный принтер

Боролся тут с непечатью из нашего продукта на неумолчательный принтер.

Ох ну там и "макароны".

Вот:

procedure TPrinter.SetPrinter(ADevice, ADriver, APort: PChar; ADeviceMode: THandle);
var
  I, J: Integer;
  StubDevMode: TDeviceMode;
  BufSize: Longint;
begin
  CheckPrinting(False);
  if ADeviceMode <> DeviceMode then
  begin  // free the devmode block we have, and take the one we're given
    if DeviceMode <> 0 then
    begin
      GlobalUnlock(DeviceMode);
      GlobalFree(DeviceMode);
    end;
    DeviceMode := ADeviceMode;
  end;
  if DeviceMode <> 0 then
  begin
    DevMode := GlobalLock(DeviceMode);
    SetPrinterCapabilities(DevMode.dmFields);
  end;
  FreeFonts;
  if FPrinterHandle <> 0 then
  begin
    ClosePrinter(FPrinterHandle);
    FPrinterHandle := 0;
  end;
  SetState(psNoHandle);
  J := -1;
  with Printers do   // < - this rebuilds the FPrinters list
    for I := 0 to Count - 1 do
    begin
      if TPrinterDevice(Objects[I]).IsEqual(ADriver, ADevice, APort) then
      begin
        TPrinterDevice(Objects[I]).Port := APort;
        J := I;
        Break;
      end;
    end;
  if J = -1 then
  begin
    J := FPrinters.Count;
    FPrinters.AddObject(Format(SDeviceOnPort, [ADevice, APort]),
      TPrinterDevice.Create(ADriver, ADevice, APort));
  end;
  FPrinterIndex := J;
  if OpenPrinter(ADevice, FPrinterHandle, nil) then
  begin
    if DeviceMode = 0 then  // alloc new device mode block if one was not passed in
    begin
      BufSize := DocumentProperties(0, FPrinterHandle, ADevice, StubDevMode, StubDevMode, 0);
      if BufSize > 0 then {V}
        DeviceMode := GlobalAlloc(GHND, BufSize);
      if DeviceMode <> 0 then
      begin
        DevMode := GlobalLock(DeviceMode);
        if DocumentProperties(0, FPrinterHandle, ADevice, DevMode^,
          DevMode^, DM_OUT_BUFFER) < 0 then
        begin
          GlobalUnlock(DeviceMode);
          GlobalFree(DeviceMode);
          DeviceMode := 0;
        end
      end;
    end;
    if DeviceMode <> 0 then
      SetPrinterCapabilities(DevMode^.dmFields);
  end;
end;

...
procedure TPrinter.SetToDefaultPrinter;
var
  I: Integer;
  ByteCnt, StructCnt: DWORD;
  DefaultPrinter: array[0..1023] of Char;
  Cur, Device: PChar;
  PrinterInfo: PPrinterInfo5;
begin
  ByteCnt := 0;
  StructCnt := 0;
  if not EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 5, nil, 0, ByteCnt,
    StructCnt) and (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
  begin
    // With no printers installed, Win95/98 fails above with "Invalid filename".
    // NT succeeds and returns a StructCnt of zero.
    if GetLastError = ERROR_INVALID_NAME then
      RaiseError(SNoDefaultPrinter)
    else
      RaiseLastOSError;
  end;
  PrinterInfo := AllocMem(ByteCnt);
  try
    EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 5, PrinterInfo, ByteCnt, ByteCnt,
      StructCnt);
    if StructCnt > 0 then
      Device := PrinterInfo.pPrinterName
    else begin
      GetProfileString('windows', 'device', '', DefaultPrinter,
        SizeOf(DefaultPrinter) - 1);
      Cur := DefaultPrinter;
      Device := FetchStr(Cur);
    end;
    with Printers do
      for I := 0 to Count-1 do
      begin
        if AnsiSameText(TPrinterDevice(Objects[I]).Device, Device) then
        begin
          with TPrinterDevice(Objects[I]) do
            SetPrinter(PChar(Device), PChar(Driver), PChar(Port), 0);
          Exit;
        end;
      end;
  finally
    FreeMem(PrinterInfo);
  end;
  RaiseError(SNoDefaultPrinter);
end;

DevMode, DeviceMode, TPrinterDevice, with, StringList.

Масса "вкусностей".

Особенно "доставляет" вот это: "< - this rebuilds the FPrinters list"

Т.е. парни что-то "закостыляли" и оставили себе "напоминалку".

Что Borland, что MicroSoft - "на высоте".

"Вкус" программирования тут по моему скромному мнению - отсутствует напрочь.

А я привык "учиться у других".

Но конкретно тут - "сложно учиться".

Ну и Embarcadero к сожалению код так и не переработала, только щедро добавили IfDef:

[PrintingPermission(SecurityAction.LinkDemand, Level=PrintingPermissionLevel.AllPrinting)]
{$IF DEFINED(CLR)}
procedure TPrinter.SetPrinter(ADevice, ADriver, APort: string; ADeviceMode: IntPtr);
{$ELSE}
procedure TPrinter.SetPrinter(ADevice, ADriver, APort: PChar; ADeviceMode: THandle);
{$ENDIF}
var
  I, J: Integer;
{$IF DEFINED(CLR)}
  LDevMode: TDeviceMode;
{$ENDIF}
begin
  CheckPrinting(False);
{$IF DEFINED(CLR)}
  if ADeviceMode <> FDeviceMode then
    UpdateDeviceMode(ADeviceMode);
  if FDeviceMode <> nil then
  begin
    LDevMode := TDeviceMode(Marshal.PtrToStructure(FDeviceMode, TypeOf(TDeviceMode)));
    SetPrinterCapabilities(LDevMode.dmFields);
  end;
{$ELSE}
  if ADeviceMode <> FDeviceMode then
  begin  // free the devmode block we have, and take the one we're given
    if FDeviceMode <> 0 then
    begin
      GlobalUnlock(FDeviceMode);
      GlobalFree(FDeviceMode);
      FDevMode := nil;
    end;
    FDeviceMode := ADeviceMode;
  end;
  if FDeviceMode <> 0 then
  begin
    FDevMode := GlobalLock(FDeviceMode);
    SetPrinterCapabilities(FDevMode.dmFields);
  end;
{$ENDIF}
  FreeFonts;
  if FPrinterHandle <> 0 then
  begin
    ClosePrinter(FPrinterHandle);
    FPrinterHandle := 0;
  end;
  SetState(TPrinterState.psNoHandle);
  J := -1;
  with Printers do   // <- this rebuilds the FPrinters list
    for I := 0 to Count - 1 do
    begin
      if TPrinterDevice(Objects[I]).IsEqual(ADriver, ADevice, APort) then
      begin
        TPrinterDevice(Objects[I]).Port := APort;
        J := I;
        Break;
      end;
    end;
  if J = -1 then
  begin
    J := FPrinters.Count;
    FPrinters.AddObject(Format(SDeviceOnPort, [ADevice, APort]),
      TPrinterDevice.Create(ADriver, ADevice, APort));
  end;
  FPrinterIndex := J;
  if OpenPrinter(ADevice, FPrinterHandle, nil) then
  begin
{$IF DEFINED(CLR)}
    if FDeviceMode = nil then  // alloc new device mode block if one was not passed in
    begin
      FDeviceMode := Marshal.AllocHGlobal(
        DocumentProperties(0, FPrinterHandle, ADevice, FDeviceMode, FDeviceMode, 0));  //set to intptr 0,0
      if FDeviceMode <> nil then
        if DocumentProperties(0, FPrinterHandle, ADevice, FDeviceMode, 0, DM_OUT_BUFFER) < 0 then
          UpdateDeviceMode(nil)
    end;
    if FDeviceMode <> nil then
      SetPrinterCapabilities(LDevMode.dmFields);
{$ELSE}
    if FDeviceMode = 0 then  // alloc new device mode block if one was not passed in
    begin
      FDeviceMode := GlobalAlloc(GHND, DocumentProperties(0, FPrinterHandle, ADevice, nil, nil, 0));

      if FDeviceMode <> 0 then
      begin
        FDevMode := GlobalLock(FDeviceMode);
        if DocumentProperties(0, FPrinterHandle, ADevice, FDevMode, nil, DM_OUT_BUFFER) < 0 then
        begin
          GlobalUnlock(FDeviceMode);
          GlobalFree(FDeviceMode);
          FDeviceMode := 0;
          FDevMode := nil;
        end
      end;
    end;
    if FDeviceMode <> 0 then
      SetPrinterCapabilities(FDevMode^.dmFields);
{$ENDIF}
  end;
end;
...
procedure TPrinter.SetToDefaultPrinter;
var
  I: Integer;
  ByteCnt, StructCnt: DWORD;
{$IF DEFINED(CLR)}
  Device: string;
  PrinterInfo, NamePtr: IntPtr;
  PD: System.Drawing.Printing.PrintDocument;
{$ELSE}
  DefaultPrinter: array[0..1023] of Char;
  Cur, Device: PChar;
  PrinterInfo: PPrinterInfo5;
{$ENDIF}
begin
  ByteCnt := 0;
  StructCnt := 0;
  if not EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 5, nil, 0, ByteCnt,
    StructCnt) and (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
  begin
    // With no printers installed, Win95/98 fails above with "Invalid filename".
    // NT succeeds and returns a StructCnt of zero.
    if GetLastError = ERROR_INVALID_NAME then
      RaiseError(SNoDefaultPrinter)
    else
      RaiseLastOSError;
  end;
{$IF DEFINED(CLR)}
  PrinterInfo := Marshal.AllocHGlobal(ByteCnt);
  try
    EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 5, PrinterInfo, ByteCnt, ByteCnt,
      StructCnt);
    if StructCnt > 0 then
    begin
      NamePtr := Marshal.ReadIntPtr(PrinterInfo, 0); // pPrinterName
      Device := Marshal.PtrToStringAuto(NamePtr);
    end;
  finally
    Marshal.FreeHGlobal(PrinterInfo);
  end;
  if StructCnt <= 0 then {EnumPrinters didnt work, try using CLR}
  begin
    PD := System.Drawing.Printing.PrintDocument.Create;
    Device := PD.DefaultPageSettings.PrinterSettings.PrinterName;
  end;
  with Printers do
    for I := 0 to Count-1 do
    begin
      if WideSameText(TPrinterDevice(Objects[I]).Device, Device) then
      begin
        with TPrinterDevice(Objects[I]) do
          SetPrinter(Device, Driver, Port, nil);
        Exit;
      end;
    end;
{$ELSE}
  PrinterInfo := AllocMem(ByteCnt);
  try
    EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 5, PrinterInfo, ByteCnt, ByteCnt,
      StructCnt);
    if StructCnt > 0 then
      Device := PrinterInfo.pPrinterName
    else
    begin
{$IF DEFINED(UNICODE)}
      I := Length(DefaultPrinter);
      if not GetDefaultPrinter(DefaultPrinter, I) then
        ZeroMemory(@DefaultPrinter[0], I * SizeOf(Char));
{$ELSE}
      GetProfileString('windows', 'device', '', DefaultPrinter, SizeOf(DefaultPrinter) - 1);
{$ENDIF}
      Cur := DefaultPrinter;
      Device := FetchStr(Cur);
    end;
    with Printers do
      for I := 0 to Count-1 do
      begin
        if AnsiSameText(TPrinterDevice(Objects[I]).Device, Device) then
        begin
          with TPrinterDevice(Objects[I]) do
            SetPrinter(PChar(Device), PChar(Driver), PChar(Port), 0);
          Exit;
        end;
      end;
  finally
    FreeMem(PrinterInfo);
  end;
{$ENDIF}
  RaiseError(SNoDefaultPrinter);
end;


В чём была проблема? А в том, что тут:

    if Assigned(CreateHandleFunc) then
      with TPrinterDevice(Printers.Objects[PrinterIndex]) do
      begin
        DC := CreateHandleFunc(PChar(Driver), PChar(Device), PChar(Port), DevMode);

Driver был от ОДНОГО (неумолчательного) принтера, а DevMode от ПРЕДЫДУЩЕГО (умолчательного).

И некоторые драйвера принтеров "плюют" на это, а некоторые (видимо более дотошные) - возвращают код ошибки.

Как так получилось - пока до конца не понял. Но - "залечил".

Перечитыванием настроек из принтера.

Но тут - "ПЯТЁРКА с ПЛЮСОМ" Майкрософту.

Вообще не очень понятно - "зачем плодить и дублировать сущности".

Да и к классу TPrinter - у меня много вопросов. С SRP - там явно проблемы.

А уж публикация "кишочков" через GetPrinter/SetPrinter - это отдельная песня.

Ну и DocumentProperties - вот уж точно - НЕ SRP. И швец и жнец и на дуде игрец.

И читает свойства, и пишет, да ещё и диалог показывает.

Молодцы короче - ВСЕ. И Borland, и Microsoft, и Embarcadero, да и я с коллегами. Тоже...

Вот так - не работает:

function Tl3Printer.Clone: Il3Printer;
//#UC START# *49BAA14602EC_4799D40F0004_var*

 function CopyData(Handle: THandle): THandle;
 var
   Src, Dest: PChar;
   Size: Integer;
 begin
   if Handle <> 0 then
   begin
     Size := GlobalSize(Handle);
     Result := GlobalAlloc(GHND, Size);
     if Result <> 0 then
       try
         Src := GlobalLock(Handle);
         Dest := GlobalLock(Result);
         if (Src <> nil) and (Dest <> nil) then l3Move(Src^, Dest^, Size);
       finally
         GlobalUnlock(Handle);
         GlobalUnlock(Result);
       end
   end
   else Result := 0;
 end;

var
 l_PrinterIndex : Integer;
 l_Device,
 l_Driver,
 l_Port        : Array[0..255] of Char;
 l_hDeviceMode : THandle;
//#UC END# *49BAA14602EC_4799D40F0004_var*
begin
//#UC START# *49BAA14602EC_4799D40F0004_impl*
  Result := nil;
  l_PrinterIndex := Self.PrinterIndex; // Если что-то с принтером, то лучше упадем уже здесь...
  Result := Make;
  Result.PrinterIndex := l_PrinterIndex;
  Result.Copies := Self.Copies;
  Result.Title := Self.Get_Title;
  Result.FileName := Self.Get_FileName;
  Result.Collate := Self.Get_Collate;

  // Копируем настройки принтера:
  Self.GetPrinter(l_Device, l_Driver, l_Port, l_hDeviceMode);
  Result.SetPrinter(l_Device, l_Driver, l_Port, CopyData(l_hDeviceMode));
//#UC END# *49BAA14602EC_4799D40F0004_impl*
end;//Tl3Printer.Clone

А вот так - работает:

function Tl3Printer.Clone: Il3Printer;
//#UC START# *49BAA14602EC_4799D40F0004_var*
var
 l_PrinterIndex : Integer;
 l_Device,
 l_Driver,
 l_Port        : Array[0..255] of Char;
 l_hDeviceMode : THandle;
//#UC END# *49BAA14602EC_4799D40F0004_var*
begin
//#UC START# *49BAA14602EC_4799D40F0004_impl*
  Result := nil;
  l_PrinterIndex := Self.PrinterIndex; // Если что-то с принтером, то лучше упадем уже здесь...
  Result := Make;
  Result.PrinterIndex := l_PrinterIndex;
  Result.Copies := Self.Copies;
  Result.Title := Self.Get_Title;
  Result.FileName := Self.Get_FileName;
  Result.Collate := Self.Get_Collate;

  // Копируем настройки принтера:
  Self.GetPrinter(l_Device, l_Driver, l_Port, l_hDeviceMode);
  Result.SetPrinter(l_Device, l_Driver, l_Port, 0);
  // - тут ЗА СЧЁТ нуля - настройки - ПЕРЕЧИТАЮТСЯ, а не СКОПИРУЮТСЯ.
//#UC END# *49BAA14602EC_4799D40F0004_impl*
end;//

Комментарий - "Если что-то с принтером, то лучше упадем уже здесь..." - тоже - "доставляет".

Но "с волками жить"...

Комментариев нет:

Отправить комментарий