/components/printers/unix/cupsprinters.inc
http://github.com/graemeg/lazarus · Pascal · 1398 lines · 1104 code · 142 blank · 152 comment · 162 complexity · a78800d93f61bef146b50b7075d2f012 MD5 · raw file
- {%MainUnit ../osprinters.pas}
- {$IFDEF DebugCUPS}
- {$DEFINE LogPrintoutFile}
- {$ENDIF}
- {**************************************************************
- Implementation for cupsprinter
- ***************************************************************}
- uses
- {%H-}udlgSelectPrinter, // used to compile it on this target
- {%H-}udlgpropertiesprinter, // used to compile it on this target
- FileUtil, LazFileUtils;
- //Return always 72 because, PostScript it's 72 only
- function TCUPSPrinter.GetXDPI: Integer;
- begin
- Result:=InternalGetResolution(True);
- end;
- //Return always 72 because, PostScript it's 72 only
- function TCUPSPrinter.GetYDPI: Integer;
- begin
- Result:=InternalGetResolution(False);
- end;
- procedure TCUPSPrinter.DoEnumBins(Lst: TStrings);
- var
- choice: Pppd_choice_t;
- Option: Pppd_option_t;
- c: Integer;
- begin
- Lst.Clear;
- if CupsPPD<>nil then
- begin
- Option := ppdFindOption(CupsPPD, PChar('InputSlot'));
- if Option<>nil then
- begin
- Choice := Option^.choices;
- c := 0;
- while (Choice<>nil) and (c<Option^.num_choices) do
- begin
- lst.AddObject(Choice^.text, TObject(Choice));
- inc(choice);
- inc(c);
- end;
- end;
- end;
- end;
- function TCUPSPrinter.DoGetDefaultBinName: string;
- var
- Option: Pppd_option_t;
- Choice: pppd_choice_t;
- begin
- Result:=inherited DoGetDefaultBinName;
- if CupsPPD<>nil then
- begin
- Option := ppdFindOption(CupsPPD, 'InputSlot');
- if Option<>nil then
- begin
- choice := PPDOptionChoiceFrom('InputSlot', Option^.defchoice, true);
- if choice<>nil then
- result := choice^.text;
- end;
- end;
- end;
- function TCUPSPrinter.DoGetBinName: string;
- var
- Choice: pppd_choice_t;
- begin
- result := cupsGetOption('InputSlot');
- if result<>'' then
- begin
- Choice := PPDOptionChoiceFrom('InputSlot', result, true);
- if Choice<>nil then
- result := Choice^.text
- else
- result := '';
- end;
- if result='' then
- result := doGetDefaultBinName
- end;
- procedure TCUPSPrinter.DoSetBinName(aName: string);
- var
- Choice: pppd_choice_t;
- begin
- Choice := PPDOptionChoiceFrom('InputSlot', aName, false);
- if Choice<>nil then
- cupsAddOption('InputSlot', choice^.choice)
- else
- inherited doSetBinName(aName); // handle input slot not found
- end;
- //write count bytes from buffer to raw mode stream
- function TCUPSPrinter.Write(const Buffer; Count: Integer; var Written: Integer
- ): Boolean;
- begin
- result := False;
- CheckRawMode(True);
- if not Assigned(FRawModeStream) then
- FRawModeStream := TMemoryStream.Create;
- Written := FRawModeStream.Write(Buffer, Count);
- Result := True;
- end;
- constructor TCUPSPrinter.Create;
- begin
- inherited Create;
- fcupsPrinters:=nil;
- fcupsPrinter :=nil;
- fcupsHttp :=nil;
- fcupsPPD :=nil;
- fcupsOptions :=nil;
- fcupsNumOpts :=0;
-
- FRawModeStream := nil;
- FCupsPapersCount := -1;
- end;
- procedure TCUPSPrinter.DoDestroy;
- begin
- if assigned(fRawModeStream) then
- fRawModeStream.Free;
- FreeOptions;
- if Assigned(fcupsHttp) then
- httpClose(fcupsHttp);
- inherited DoDestroy;
- end;
- procedure TCUPSPrinter.FreeOptions;
- begin
- if Assigned(fcupsOptions) then
- cupsFreeOptions(fcupsNumOpts,fcupsOptions);
- fcupsNumOpts:=0;
- fcupsOptions:=nil;
- FStates := [];
- end;
- procedure TCUPSPrinter.cupsAddOption(aName,aValue: string);
- begin
- if not CUPSLibInstalled then Exit;
- fcupsNumOpts:=cupsdyn.cupsAddOption(PChar(aName),PChar(aValue),fcupsNumOpts,
- @fcupsOptions);
- if (AName='PageSize') then
- begin
- Exclude(FStates,cpsPaperNameValid);
- Exclude(FStates,cpsPaperRectValid);
- end;
- {$IFDEF DebugCUPS}
- DebugLn('TCUPSPrinter.cupsAddOption AName=%s AValue=%s',[AName,AValue]);
- {$ENDIF}
- end;
- //Return the value of option set for the selected printer
- function TCUPSPrinter.cupsGetOption(aKeyWord: string): String;
- begin
- Result:='';
- if not CUPSLibInstalled then Exit;
- if (Printers.Count>0) then
- begin
- if not Assigned(fcupsOptions) then
- SetOptionsOfPrinter;
- Result:=cupsdyn.cupsGetOption(PChar(aKeyWord),fcupsNumOpts,fcupsOptions);
- end;
- end;
- function TCUPSPrinter.CopyOptions(out AOptions: Pcups_option_t): Integer;
- var
- i: Integer;
- begin
- AOptions := nil;
- Result := 0;
- for i:=0 to fcupsNumOpts-1 do
- Result := cupsdyn.cupsAddOption(fcupsOptions[i].name,fcupsOptions[i].value,
- Result,@AOptions);
- end;
- procedure TCUPSPrinter.MergeOptions(const AOptions:Pcups_option_t; const n:Integer);
- var
- i: Integer;
- begin
- for i:=0 to n-1 do
- if
- // always merge some known options
- (strcomp('job-sheets', AOptions[i].name)=0) or
- // check if ppd option value is valid
- IsOptionValueValid(AOptions[i].name, AOptions[i].value)
- then
- cupsAddOption(AOptions[i].name, AOptions[i].value);
- cupsFreeOptions(n, AOptions);
- end;
- function TCUPSPrinter.GetResolutionOption: string;
- var
- L1,L2: TStringlist;
- i: Integer;
- begin
- Result := Self.cupsGetOption('Resolution');
- if Result='' then
- begin
- // get resolution from ppd
- Result := GetPPDAttribute('DefaultResolution');
- if Result='' then
- begin
- // try grouped options
- L1 := TStringList.Create;
- L2 := TStringList.Create;
- try
- i := EnumPPDChoice(L1,'Resolution',L2);
- if i>=0 then
- Result := L2[i]
- finally
- L2.Free;
- L1.Free;
- end;
- end;
- end;
- end;
- procedure TCUPSPrinter.DebugOptions(AOPtions:Pcups_option_t=nil; n:Integer=0);
- var
- i: Integer;
- begin
- if (Printers.Count>0) and CUPSLibInstalled and (fcupsPrinter<>nil) then
- begin
- DebugLn('**************************************************');
- if AOptions=nil then
- begin
- AOptions:= fcupsOptions;
- n := fcupsNumOpts;
- end;
- DebugLn('Printer "%s" Number of Options %d',[fcupsPrinter^.Name,n]);
- for i:=0 to n-1 do
- DebugLn('name="%s" value="%s"',[AOptions[i].name,AOptions[i].value]);
- DebugLn('**************************************************');
- end else
- DebugLn('DebugOptions: There are no valid printers');
- end;
- procedure TCUPSPrinter.DoCupsConnect;
- begin
- if not assigned(fcupsHttp) then
- begin
- if not CUPSLibInstalled then Exit;
- fcupsHttp:=httpConnect(cupsServer(),ippPort());
- if not Assigned(fcupsHttp) then
- raise Exception.Create('Unable to contact server: '+GetLastError);
- end;
- end;
- function TCUPSPrinter.CupsPapersListValid: boolean;
- var
- Lst: TStringlist;
- begin
- if fCupsPapersCount<=0 then begin
- // paper list no exists or
- // paper list is not enumerated yet, try it now.
- Lst := TStringlist.Create;
- try
- DoEnumPapers(Lst);
- finally
- Lst.Free;
- end;
- end;
- result := fCupsPapersCount>0;
- end;
- function TCUPSPrinter.InternalGetResolution(ForX: boolean): Integer;
- procedure ParseResolution(s:string);
- var
- a,b: Integer;
- begin
- if s<>'' then begin
- s := uppercase(s);
- a := pos('X', S);
- b := pos('D', S);
- if b=0 then
- b := Length(S)
- else
- dec(b);
- if a>0 then begin
- // NNNXMMMDPI (or NNN X MMM DPI)
- FCachedResolution.x := StrToIntDef(trim(copy(S,1,a-1)), 0);
- FCAchedResolution.y := StrToIntDef(trim(copy(S,a+1,b)), 0);
- end else begin
- // NNNDPI (or NNN DPI);
- FCachedResolution.x := StrToIntDef(trim(copy(S,1,b)), 0);
- FCachedResolution.y := FCachedResolution.x;
- end;
- end;
- end;
- begin
- if not (cpsResolutionValid in FStates) then begin
- // check user defined resolution
- FCachedResolution.x := 0;
- FCachedResolution.y := 0;
- ParseResolution(GetResolutionOption);
- if (FCachedResolution.x=0) or (FCachedResolution.y=0) then
- begin
- FCachedResolution.x := 300;
- FCachedResolution.y := 300;
- end;
- include(FStates, cpsResolutionValid);
- end;
- if ForX then
- result := FCachedResolution.X
- else
- result := FCachedResolution.Y;
- end;
- {$IFDEF DebugCUPS}
- procedure TCUPSPrinter.DebugCapabilities;
- var
- flags: Integer;
- procedure DumpCap(const aFlag: integer; const flagMsg, Desc: string; invert: boolean=false);
- begin
- if (invert and (aFlag and Flags=0)) or (not invert and (aFlag and Flags<>0)) then
- DebugLn(flagMsg, '(',Desc,')');
- end;
- begin
- flags := GetAttributeInteger('printer-type',CUPS_PRINTER_LOCAL);
- DebugLn('=== CAPABILITIES ===');
- DebugLn;
- DumpCap(CUPS_PRINTER_CLASS or CUPS_PRINTER_REMOTE, 'CUPS_PRINTER_LOCAL ', 'Local printer or class ', true);
- DumpCap(CUPS_PRINTER_CLASS , 'CUPS_PRINTER_CLASS ', 'Printer class ');
- DumpCap(CUPS_PRINTER_REMOTE , 'CUPS_PRINTER_REMOTE ', 'Remote printer or class ');
- DumpCap(CUPS_PRINTER_BW , 'CUPS_PRINTER_BW ', 'Can do B&W printing ');
- DumpCap(CUPS_PRINTER_COLOR , 'CUPS_PRINTER_COLOR ', 'Can do color printing ');
- DumpCap(CUPS_PRINTER_DUPLEX , 'CUPS_PRINTER_DUPLEX ', 'Can do duplexing ');
- DumpCap(CUPS_PRINTER_STAPLE , 'CUPS_PRINTER_STAPLE ', 'Can staple output ');
- DumpCap(CUPS_PRINTER_COPIES , 'CUPS_PRINTER_COPIES ', 'Can do copies ');
- DumpCap(CUPS_PRINTER_COLLATE , 'CUPS_PRINTER_COLLATE ', 'Can collage copies ');
- DumpCap(CUPS_PRINTER_PUNCH , 'CUPS_PRINTER_PUNCH ', 'Can punch output ');
- DumpCap(CUPS_PRINTER_COVER , 'CUPS_PRINTER_COVER ', 'Can cover output ');
- DumpCap(CUPS_PRINTER_BIND , 'CUPS_PRINTER_BIND ', 'Can bind output ');
- DumpCap(CUPS_PRINTER_SORT , 'CUPS_PRINTER_SORT ', 'Can sort output ');
- DumpCap(CUPS_PRINTER_SMALL , 'CUPS_PRINTER_SMALL ', 'Can do Letter/Legal/A4 ');
- DumpCap(CUPS_PRINTER_MEDIUM , 'CUPS_PRINTER_MEDIUM ', 'Can do Tabloid/B/C/A3/A2 ');
- DumpCap(CUPS_PRINTER_LARGE , 'CUPS_PRINTER_LARGE ', 'Can do D/E/A1/A0 ');
- DumpCap(CUPS_PRINTER_VARIABLE , 'CUPS_PRINTER_VARIABLE ', 'Can do variable sizes ');
- DumpCap(CUPS_PRINTER_IMPLICIT , 'CUPS_PRINTER_IMPLICIT ', 'Implicit class ');
- DumpCap(CUPS_PRINTER_DEFAULT , 'CUPS_PRINTER_DEFAULT ', 'Default printer on network');
- end;
- procedure TCUPSPrinter.DebugPPD;
- const
- arruitypes:array[ppd_ui_t] of string[9] = ('boolean','pickone','pickmany');
- arrsection:array[ppd_section_t] of string[9] = ('any','document','exit','jcl','page','prolog');
- var
- i,j,k: Integer;
- AttrRoot : Ppppd_attr_t;
- Attr : Pppd_attr_t;
- Group : pppd_group_t;
- Option : Pppd_option_t;
- choices : Pppd_choice_t;
- function markchar(const AMark:char):char;
- begin
- if AMark=#1 then
- result := '*'
- else
- result := ' ';
- end;
- begin
- DebugLn;
- DebugLn('DebugPPD: ppdfile=',fCupsPPDName);
- if fcupsPPD=nil then
- begin
- DebugLn('No valid ppd file found');
- exit;
- end;
- DebugLn('=== HEADER ===');
- DebugLn;
- DebugLn(' model : %s', [fcupsPPD^.modelname]);
- DebugLn(' modelNumber : %d', [fcupsPPD^.model_number]);
- DebugLn(' manufacturer : %s', [fcupsPPD^.manufacturer]);
- DebugLn(' nickname : %s', [fcupsPPD^.nickname]);
- DebugLn(' shortnickname : %s', [fcupsPPD^.shortnickname]);
- DebugLn(' product : %s', [fcupsPPD^.product]);
- DebugLn(' attributes : %d Current=%d', [fcupsPPD^.num_attrs,fcupsPPD^.cur_attr]);
- DebugLn(' language_level : %d', [fcupsPPD^.language_level]);
- DebugLn(' lang_version : %s', [fcupsPPD^.lang_version]);
- DebugLn(' lang_encoding : %s', [fcupsPPD^.lang_encoding]);
- DebugLn(' landscape : %d', [fcupsPPD^.landscape]);
- DebugLn(' UI groups : %d', [fcupsPPD^.num_groups]);
- DebugLn(' Num Papers : %d', [fcupsPPD^.num_sizes]);
- DebugLn(' Num Attributes : %d', [fcupsPPD^.num_attrs]);
- DebugLn(' Num Constrains : %d', [fcupsPPD^.num_consts]);
- DebugLn;
- DebugLn('=== CUSTOM PAPER SUPPORT ===');
- DebugLn;
- DebugLn(' Custom Min 0 : %.2f',[fcupsPPD^.custom_min[0]]);
- DebugLn(' Custom Min 1 : %.2f',[fCupsPPD^.custom_min[1]]);
- DebugLn(' Custom Max 0 : %.2f',[fcupsPPD^.custom_max[0]]);
- DebugLn(' Custom Max 1 : %.2f',[fcupsPPD^.custom_max[1]]);
- with fcupsPPD^ do
- DebugLn(' Custom Margins : %.2f %.2f %.2f %.2f',
- [custom_margins[0],custom_margins[1],custom_margins[2],custom_margins[3]]);
- DebugLn;
- if fcupsPPD^.num_groups>0 then
- begin
- DebugLn('=== GROUPS ===');
- i := 0;
- Group := fCupsPPD^.groups;
- while (Group<>nil) and (i<fcupsPPD^.num_groups) do
- begin
- DebugLn('Group %d Name="%s" Text="%s" Options=%d SubGroups=%d',
- [i,Group^.name,Group^.text,Group^.num_options,Group^.num_subgroups]);
- j := 0;
- Option := group^.options;
- while j< group^.num_options do
- begin
- with Option^ do
- DebugLn(' Option %d Key="%s" Def="%s" Text="%s" UIType="%s" section="%s" Choices=%d',
- [j,keyword,defchoice,text,arruitypes[ui],arrsection[section],num_choices]);
- k := 0;
- Choices := Option^.choices;
- while k<Option^.num_choices do
- begin
- DebugLn(' Choice %2d %s Choice=%-20s Text="%s"',
- [k,MarkChar(Choices^.marked),Choices^.Choice,Choices^.Text]);
- inc(Choices);
- inc(k);
- end;
- inc(Option);
- inc(j);
- end;
- inc(Group);
- inc(i);
- end;
- end;
- DebugLn;
- if fcupsPPD^.num_attrs>0 then
- begin
- DebugLn('=== Attributes ===');
- i := 0;
- AttrRoot := fCupsPPD^.attrs;
- while (AttrRoot<>nil) and (i<fcupsPPD^.num_attrs) do
- begin
- Attr := AttrRoot^;
- if attr<>nil then
- DebugLn(' i=%d Name=%s Spec=%s Value=%s',[i,Attr^.Name,Attr^.Spec,Attr^.Value]);
- inc(i);
- inc(AttrRoot);
- end;
- end;
- end;
- {$ENDIF}
- //Print the file aFileName with a selected printer and options
- function TCUPSPrinter.PrintFile(aFileName: String): longint;
- var
- aPrinterName : string;
- begin
- Result:=-1;
- //debugln(['TCUPSPrinter.PrintFile START ',aFileName]);
- if aFileName='' then
- raise Exception.Create('TCUPSPrinter.PrintFile missing Filename');
- if not CUPSLibInstalled then Exit;
- aFileName:=ExpandFileNameUTF8(aFileName);
- if (Printers.Count>0) then
- begin
- if not Assigned(fcupsOptions) then
- SetOptionsOfPrinter;
- if Assigned(fcupsPrinter) then
- aPrinterName:=fcupsPrinter^.Name
- else
- aPrinterName:='';
- {$IFDEF DebugCUPS}
- DebugOptions;
- debugln(['TCUPSPrinter.PrintFile aPrinterName="',aPrinterName,'" aFileName="',aFileName,'" Size=',FileSizeUtf8(aFileName)]);
- {$ENDIF}
- Result:=cupsdyn.cupsPrintFile(PChar(aPrinterName),PChar(aFileName),
- PChar(Self.Title),
- fcupsNumOpts,fcupsOptions);
- end;
- end;
- function TCUPSPrinter.GetLastError: string;
- begin
- Result:=ippErrorString(cupsdyn.cupsLastError());
- end;
- function TCUPSPrinter.IsOptionValueValid(AKeyword, AValue: pchar): boolean;
- var
- Option: pppd_option_t;
- i: Integer;
- begin
- result := false;
- if (fcupsPrinter=nil) or (fcupsppd=nil) then
- exit;
- Option := ppdFindOption(fcupsppd, AKeyword);
- if Option=nil then
- exit;
- i:=0;
- while i<Option^.num_choices do
- begin
- if strcomp(Option^.choices[i].choice, AValue)=0 then
- begin
- result := true;
- break;
- end;
- inc(i);
- end;
- end;
- function TCUPSPrinter.PPDOptionChoiceFrom(OptionStr, aKeyOrValue: string;
- IsKey:boolean): pppd_choice_t;
- var
- i: Integer;
- option: pppd_option_t;
- p: pchar;
- begin
- result := nil;
- if (fcupsPrinter=nil) or (fcupsppd=nil) then
- exit;
- option := ppdFindOption(fcupsppd, pchar(OptionStr));
- if option=nil then
- exit;
- for i:=0 to option^.num_choices-1 do
- begin
- if IsKey then
- p := @option^.choices[i].choice
- else
- p := @option^.choices[i].text;
- if strcomp(p, pchar(aKeyOrValue))=0 then
- begin
- result := @option^.choices[i];
- break;
- end;
- end;
- end;
- //Set State of Job
- procedure TCUPSPrinter.SetJobState(aJobId : LongInt; aOp : ipp_op_t);
- var Request,R : Pipp_t; //IPP Request
- Language : Pcups_lang_t; //Default Language
- URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI
- begin
- if not CUPSLibInstalled then Exit;
- if (Printers.Count>0) then
- begin
- if Assigned(fcupsPrinter) then
- begin
- R:=nil;
- DoCupsConnect;
- Request:=ippNew();
- Language:=cupsLangDefault();
- ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET,
- 'attributes-charset', '', cupsLangEncoding(language));
- ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE,
- 'attributes-natural-language', '', Language^.language);
- URI:=Format('http://%s:%d/jobs/%d',[cupsServer,ippPort,aJobId]);
- ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'job-uri','',URI);
- ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_NAME,'requesting-user-name','',cupsUser());
- Request^.request.op.operation_id := aOp;
- Request^.request.op.request_id := 1;
- //Do the request and get back a response...
- R:=cupsDoRequest(fcupsHttp, Request, '/jobs/');
- if Assigned(R) then
- begin
- if (R^.request.status.status_code>IPP_OK_CONFLICT) then
- ippDelete(R);
- end;
- end;
- end;
- end;
- function TCUPSPrinter.GetCupsRequest : Pipp_t;
- var Request : Pipp_t; //IPP Request
- Language : Pcups_lang_t; //Default Language
- URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI
- begin
- Result:=Nil;
- if not CUPSLibInstalled then Exit;
- if (Printers.Count>0) then
- begin
- if Assigned(fcupsPrinter) then
- begin
- DoCupsConnect;
- Request:=ippNew();
- {Build an IPP_GET_PRINTER_ATTRIBUTES request,
- which requires the following attributes:
- attributes-charset
- attributes-natural-language
- printer-uri}
- Request^.request.op.operation_id := IPP_GET_PRINTER_ATTRIBUTES;
- Request^.request.op.request_id := 1;
- Language:=cupsLangDefault;
- ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET,
- 'attributes-charset', '', cupsLangEncoding(language));
- ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE,
- 'attributes-natural-language', '', Language^.language);
- // or this syntax >>
- //URI:=Format('http://%s:%d/printers/%s',[cupsServer,ippPort,fcupsPrinter^.name]);
- URI:=Format('ipp://localhost/printers/%s',[fcupsPrinter^.name]);
- ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'printer-uri','',URI);
- //Do the request and get back a response...
- Result:=cupsDoRequest(fcupsHttp, Request, '/');
- if Assigned(Result) then
- begin
- if (Result^.request.status.status_code>IPP_OK_CONFLICT) then
- begin
- ippDelete(Result);
- Result:=nil;
- end;
- end;
- end;
- end;
- end;
- //Initialize the options with the default options of selected printer
- procedure TCUPSPrinter.SetOptionsOfPrinter;
- Var Opts : Pcups_option_t;
- Opt : Pcups_option_t;
- i : Integer;
- begin
- //if not CUPSLibInstalled then
- Exit;
- if (Printers.Count>0) then
- begin
- if Assigned(fcupsPrinter) then
- begin
- Opts := fcupsPrinter^.Options;
- for i:=0 to fcupsPrinter^.num_options-1 do
- begin
- Opt:=@Opts[i];
- cupsAddOption(Opt^.Name,Opt^.Value);
- end;
- end;
- end;
- end;
- //Enum all options associed with aKeyWord
- function TCUPSPrinter.EnumPPDChoice(Lst : TStrings;
- const aKeyWord : string; OptNames: TStrings = nil) : Integer;
- var i : integer;
- Option : Pppd_option_t;
- Choice : Pppd_choice_t;
- begin
- Result:=-1;
- if not CUPSLibInstalled then Exit;
- if not Assigned(Lst) then Exit;
- Lst.Clear;
- if (Printers.Count>0) then
- begin
- if Assigned(fcupsPrinter) then
- begin
- if Assigned(fcupsPPD) then
- begin
- Option:=nil;
- Option:=ppdFindOption(fcupsPPD,PChar(aKeyWord));
- If Assigned(Option) then
- begin
- for i:=0 to Option^.num_choices-1 do
- begin
- Choice:=@Option^.choices[i];
- if Choice^.marked=#1 then
- Result:=i;
- Lst.Add(Choice^.text);
- if Assigned(OptNames) then
- OptNames.Add(Choice^.choice);
- end;
- //Not marked choice then the choice is default
- if (Result<0) and (Lst.Count>0) then begin
- Result:=Lst.IndexOf(OPtion^.defchoice);
- if (Result<0)and Assigned(OptNames) then
- Result := OptNames.IndexOf(Option^.DefChoice);
- end;
- end;
- end;
- end;
- end;
- end;
- function TCUPSPrinter.GetPPDAttribute(const aName: string): string;
- var
- i : integer;
- AttrRoot : PPppd_attr_t;
- Attr : Pppd_attr_t;
- begin
- Result:='';
- if not CUPSLibInstalled then
- Exit;
- if (Printers.Count>0) and (fcupsPrinter<>nil) and (fcupsPPD<>nil) then
- begin
- i := 0;
- AttrRoot := fCupsPPD^.attrs;
- while (AttrRoot<>nil) and (i<fcupsPPD^.num_attrs) do
- begin
- Attr := AttrRoot^;
- if attr<>nil then
- begin
- if (StrComp(pchar(AName), Attr^.name)=0) then
- begin
- result := attr^.value;
- break;
- end;
- end;
- inc(i);
- inc(AttrRoot);
- end;
- end;
- end;
- procedure TCUPSPrinter.GetEnumAttributeString(aName: PChar; Lst: TStrings);
- var
- Reponse : Pipp_t; //IPP Reponse
- Attribute : Pipp_attribute_t; //Current attribute
- i : Integer;
- begin
- if not assigned(Lst) then
- raise Exception.Create('Lst must be assigned');
- if not CUPSLibInstalled then begin
- DebugLn(['TCUPSPrinter.GetEnumAttributeString CUPSLibInstalled not installed']);
- Exit;
- end;
-
- Reponse:=GetCupsRequest;
- if not Assigned(Reponse) then begin
- DebugLn(['TCUPSPrinter.GetEnumAttributeString no Response']);
- end else begin
- try
- Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
- if Assigned(Attribute) then begin
- for i:=0 to Attribute^.num_values-1 do
- begin
- if Attribute^.value_tag=IPP_TAG_INTEGER then
- Lst.add(IntToStr(Pipp_value_t(@Attribute^.values)[i].aInteger))
- else
- Lst.add(Pipp_value_t(@Attribute^.values)[i]._string.text);
- end;
- end else begin
- DebugLn(['TCUPSPrinter.GetEnumAttributeString Attribute not found: ',aName]);
- end;
- finally
- ippDelete(Reponse);
- end;
- end;
- end;
- function TCUPSPrinter.GetAttributeInteger(aName: PChar; DefaultValue : Integer): Integer;
- var
- Reponse : Pipp_t; //IPP Reponse
- Attribute : Pipp_attribute_t; //Current attribute
- begin
- Result:=DefaultValue;
- if not CUPSLibInstalled then Exit;
- Reponse:=GetCupsRequest;
- if Assigned(Reponse) then
- begin
- try
- Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
- if Assigned(Attribute) then
- Result:=Attribute^.values[0].aInteger;
- finally
- ippDelete(Reponse);
- end;
- end;
- end;
- function TCUPSPrinter.GetAttributeString(aName: PChar;
- const DefaultValue : string): string;
- var
- Reponse : Pipp_t; //IPP Reponse
- Attribute : Pipp_attribute_t; //Current attribute
- begin
- Result:=DefaultValue;
- if not CUPSLibInstalled then Exit;
- Reponse:=GetCupsRequest;
- if Assigned(Reponse) then
- begin
- try
- Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
- if Assigned(Attribute) then
- Result:=Attribute^.values[0]._string.text
- else begin
- DebugLn(['TCUPSPrinter.GetAttributeString failed: aName="',aName,'"']);
- end;
- finally
- ippDelete(Reponse);
- end;
- end;
- end;
- function TCUPSPrinter.GetAttributeBoolean(aName: PChar;
- DefaultValue : Boolean): Boolean;
- var
- Reponse : Pipp_t; //IPP Reponse
- Attribute : Pipp_attribute_t; //Current attribute
- begin
- Result:=DefaultValue;
- if not CUPSLibInstalled then Exit;
- Reponse:=GetCupsRequest;
- if Assigned(Reponse) then
- begin
- try
- Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
- if Assigned(Attribute) then
- Result:=(Attribute^.values[0].aBoolean=#1);
- finally
- ippDelete(Reponse);
- end;
- end;
- end;
- //Override this methode for assign an
- //file name at Canvas
- procedure TCUPSPrinter.DoBeginDoc;
- var
- NewPath: String;
- fs: TFileStream;
- function TryTemporaryPath(const Path: string): Boolean;
- var
- CurPath: String;
- begin
- Result:=false;
- CurPath:=CleanAndExpandDirectory(Path);
- if CurPath='' then exit(false);
- if not DirectoryIsWritable(CurPath) then exit;
- NewPath:=CurPath;
- Result:=true;
- end;
- begin
- if FBeginDocCount>0 then
- raise Exception.Create('TCUPSPrinter.DoBeginDoc already called. Maybe you forgot an EndDoc?');
- inherited DoBeginDoc;
- inc(FBeginDocCount);
- if (not TryTemporaryPath('~/tmp/'))
- and (not TryTemporaryPath('/tmp/'))
- and (not TryTemporaryPath('/var/tmp/')) then
- NewPath:='';
- FOutputFileName := AppendPathDelim(NewPath)+
- 'OutPrinter_'+FormatDateTime('yyyymmmddd-hhnnss',Now);
- if RawMode then
- FOutputFileName := FOutputFileName + '.raw'
- else begin
- FOutputFileName := FOutputFileName + '.ps';
- TFilePrinterCanvas(Canvas).OutputFileName := FOutputFileName;
- end;
- // test writing, on error this raises exception showing the user the filename
- fs:=TFileStream.Create(FOutputFilename,fmCreate);
- try
- fs.Write(FOutputFilename[1],1);
- finally
- fs.free;
- end;
- DeleteFileUTF8(FOutputFilename);
- end;
- //If not aborted, send PostScript file to printer.
- //After, delete this file.
- procedure TCUPSPrinter.DoEndDoc(aAborted: Boolean);
- var
- CupsResult: LongInt;
- begin
- inherited DoEndDoc(aAborted);
- dec(FBeginDocCount);
- Exclude(FStates,cpsPaperRectValid);
- if RawMode then begin
- if not aAborted and (FRawModeStream<>nil)
- and (FRawModeStream.Size>0) then
- begin
- try
- FRawModeStream.SaveToFile(FOutputFileName);
- finally
- FRawModeStream.Clear;
- end;
- end;
-
- end else
- TFilePrinterCanvas(Canvas).OutputFileName:='';
- if not aAborted then begin
- if not FileExistsUTF8(FOutputFileName) then
- raise Exception.Create('Unable to write to "'+FOutputFileName+'"');
- {$IFDEF LogPrintoutFile}
- CopyFile(FOutputFileName, 'printjob'+ExtractFileExt(FOutputFileName));
- {$ENDIF}
- try
- {$IFNDEF DoNotPrint}
- if Filename<>'' then
- CopyFile(FOutputFileName, FileName)
- else begin
- CupsResult:=PrintFile(FOutputFileName);
- if CupsResult<=0 then
- raise Exception.Create('CUPS printing: '+GetLastError);
- end;
- {$ENDIF}
- finally
- DeleteFileUTF8(FOutputFilename);
- end;
- end;
- end;
- procedure TCUPSPrinter.DoResetPrintersList;
- begin
- if Assigned(fcupsPPD) then
- begin
- ppdClose(fcupsPPD);
- fcupsPPD:=nil;
- end;
- if fcupsPPDName<>'' then
- begin
- DeleteFileUTF8(fcupsPPDName);
- fcupsPPDName:='';
- end;
- FreeOptions;
- if Assigned(fcupsPrinters) and CUPSLibInstalled then begin
- cupsFreeDests(Printers.Count,fcupsPrinters);
- fCupsPrinter := nil;
- end;
- inherited DoResetPrintersList;
- end;
- procedure TCUPSPrinter.DoEnumPrinters(Lst: TStrings);
- Var i,Num : Integer;
- P : Pcups_dest_t;
- begin
- inherited DoEnumPrinters(Lst);
- {$IFDEF NOPRINTERS}
- Lst.Clear;
- Exit;
- {$ENDIF}
- if not CUPSLibInstalled then Exit;
- Num:=cupsGetDests(@fcupsPrinters);
- For i:=0 to Num-1 do
- begin
- P:=nil;
- P:=@fcupsPrinters[i];
- if Assigned(P) then
- begin
- if P^.is_default<>0 then
- Lst.Insert(0,P^.name)
- else
- Lst.Add(P^.name);
- end;
- end;
- end;
- procedure TCUPSPrinter.DoEnumPapers(Lst: TStrings);
- var
- choice: Pppd_choice_t;
- Option: Pppd_option_t;
- c: Integer;
- begin
- //DebugLn(['TCUPSPrinter.DoEnumPapers ',dbgsName(Self)]);
- //TODO: note that we are returning here the list of paper "keys"
- // not the human readable paper names. Modify cups support
- // to return human readable paper names.
- Lst.Clear;
- FCupsDefaultPaper := '';
- if CupsPPD<>nil then
- begin
- Option := ppdFindOption(CupsPPD, PChar('PageSize'));
- Choice := Option^.choices;
- fCupsDefaultPaper := Option^.defchoice;
- c := 0;
- while (Choice<>nil) and (c<Option^.num_choices) do
- begin
- lst.AddObject(Choice^.Choice, TObject(Choice));
- inc(choice);
- inc(c);
- end;
- end;
- fCupsPapersCount := lst.Count;
- end;
- function TCUPSPrinter.DoSetPrinter(aName: string): Integer;
- Var i : Integer;
- P : Pcups_dest_t;
- Fn : String;
- begin
- //debugln('TCUPSPrinter.DoSetPrinter aName="',aName,'"');
- Result:=inherited DoSetPrinter(aName);
- if not CUPSLibInstalled then Exit;
- //debugln('TCUPSPrinter.DoSetPrinter B Printers.Count=',dbgs(Printers.Count));
- //Set the current printer. If aName='' then use a default Printer (index 0)
- If (Printers.Count>0) then
- begin
- if (aName<>'') and Assigned(fcupsPPD) then
- begin
- //Printer changed ?
- i:=Printers.IndexOf(aName);
- if i=PrinterIndex then
- begin
- Result:=PrinterIndex;
- //debugln('TCUPSPrinter.DoSetPrinter no change');
- Exit;
- end;
- end;
- //Clear all existing options
- FreeOptions;
- if Assigned(fcupsPPD) then
- begin
- ppdClose(fcupsPPD);
- fcupsPPD:=nil;
- if fcupsPPDName<>'' then
- begin
- DeleteFileUTF8(fcupsPPDName);
- fcupsPPDName:='';
- end;
- end;
- if aName='' then
- i:=0
- else
- i:=Printers.IndexOf(aName);
- if i>-1 then
- begin
- Result:=i;
-
- P:=nil;
- P:=cupsGetDest(PChar(aName),nil,Printers.Count,fcupsPrinters);
- if not Assigned(P) then
- raise Exception.Create(Format('"%s" is not a valid printer.',[aName]));
- fcupsPrinter:=P;
- //Open linked ppdfile
- Fn:=cupsGetPPD(PChar(aName));
- fcupsPPD:=ppdOpenFile(PChar(Fn));
- fcupsPPDName:=Fn;
- {$IFDEF DebugCUPS}
- DebugPPD;
- DebugCapabilities;
- {$ENDIF}
- end;
- end
- else
- begin
- PrinterIndex:=-1;
- fcupsPPD:=nil;
- end;
- end;
- function TCUPSPrinter.DoGetCopies: Integer;
- begin
- if not (cpsCopiesValid in FStates) then begin
- fCachedCopies:=inherited DoGetCopies;
- //Get default value if defined
- fCachedCopies:=GetAttributeInteger('copies-default',fCachedCopies);
- //Get Copies in options or return default value
- fCachedCopies:=StrToIntdef(cupsGetOption('copies'),fCachedCopies);
- {$IFDEF UseCache}
- Include(FStates,cpsCopiesValid);
- {$ENDIF}
- end;
- Result:=fCachedCopies;
- end;
- procedure TCUPSPrinter.DoSetCopies(aValue: Integer);
- var i : Integer;
- begin
- {$IFDEF UseCache}
- if aValue=DoGetCopies then exit;
- Exclude(FStates,cpsCopiesValid);
- {$ENDIF}
- inherited DoSetCopies(aValue);
- if Printers.Count>0 then
- begin
- if not Assigned(fcupsOptions) then
- SetOptionsOfPrinter;
- i:=aValue;
- if i<1 then i:=1;
- cupsAddOption('copies',IntToStr(i));
- end;
- end;
- function TCUPSPrinter.DoGetOrientation: TPrinterOrientation;
- var i : Integer;
- begin
- if not (cpsOrientationValid in FStates) then begin
- if Printers.Count>0 then
- begin
- //Default orientation value
- i:=GetAttributeInteger('orientation-requested-default',3);
- // check if rotation is automatic or out-of-range
- if not (i in [3,4,5,6]) then
- i:=3; // yep, then for us this means portait
- fCachedOrientation:=TPrinterOrientation(i-3);
- end;
- Include(FStates,cpsOrientationValid);
- end;
- Result:=fCachedOrientation;
- {$IFDEF DebugCUPS}
- DebugLn('DoGetOrientation: result=%d',[ord(Result)]);
- {$ENDIF}
- end;
- procedure TCUPSPrinter.DoSetOrientation(aValue: TPrinterOrientation);
- begin
- if aValue=DoGetOrientation then
- exit;
- Exclude(FStates,cpsPaperRectValid);
- inherited DoSetOrientation(aValue);
- fcachedOrientation := AValue;
- Include(FStates,cpsOrientationValid);
- end;
- function TCUPSPrinter.DoGetDefaultPaperName: string;
- begin
- if not (cpsDefaultPaperNameValid in FStates) then begin
- fCachedGetDefaultPaperName:='';
- if not CupsPapersListValid then
- FCachedGetDefaultPaperName:=PaperSize.DefaultPaperName
- else begin
- if FCupsDefaultPaper<>'' then
- fCachedGetDefaultPaperName:= FCupsDefaultPaper
- else
- fCachedGetDefaultPaperName:=
- GetAttributeString('media-default',fCachedGetDefaultPaperName);
- {$IFDEF UseCache}
- Include(FStates,cpsDefaultPaperNameValid);
- {$ENDIF}
- end;
- end;
- Result:=fCachedGetDefaultPaperName;
- end;
- function TCUPSPrinter.DoGetPaperName: string;
- begin
- if not (cpsPaperNameValid in FStates) then begin
- // paper is not yet retrieved for first time
- // first try to see if there is a list of papers available
- if not CupsPapersListValid then
- FCachedPaperName := PaperSize.PaperName
- else begin
- fCachedPaperName := cupsGetOption('PageSize');
- {$IFDEF UseCache}
- Include(FStates,cpsPaperNameValid);
- {$ENDIF}
- end;
- end;
- Result:=fCachedPaperName;
- end;
- procedure TCUPSPrinter.DoSetPaperName(aName: string);
- begin
- {$IFDEF UseCache}
- if aName=DoGetPaperName then exit;
- Exclude(FStates,cpsPaperNameValid);
- {$ENDIF}
- inherited DoSetPaperName(aName);
-
- if FCupsPapersCount<=0 then
- PaperSize.PaperName:=AName
- else
- cupsAddOption('PageSize',aName)
- end;
- //Initialise aPaperRc with the aName paper rect
- //Result : -1 no result
- // 0 aPaperRc.WorkRect is a margins
- // 1 aPaperRc.WorkRect is really the work rect
- function TCUPSPrinter.DoGetPaperRect(aName: string;
- var aPaperRc: TPaperRect): Integer;
-
- var
- P : Pppd_size_t;
- Ky,Kx: Double;
- begin
- if (not (cpsPaperRectValid in FStates)) or
- (fCachePaperRectName<>aName) then
- begin
- fCachePaperRectName:=aName;
- FillChar(fCachePaperRect,SizeOf(fCachePaperRect),0);
- fCachePaperRectResult:=inherited DoGetPaperRect(aName, aPaperRc);
- {$IFDEF UseCache}
- Include(FStates,cpsPaperRectValid);
- {$ENDIF}
- P:=nil;
- if CUPSLibInstalled and Assigned(fcupsPPD) then
- begin
- P:=ppdPageSize(fcupsPPD,PChar(aName));
- if Assigned(P) then
- begin
- fCachePaperRectResult:=1; //CUPS return margins
- // Margins.
- //
- // Cups gives dimensions based on postcript language
- // user space coordinates system which is something like
- //
- // +y +--> +x
- // ^ but our system is |
- // | v
- // +--> +x +y
- //
- // so values in x are the same, but we need to invert values in y,
- // the given bottom value is the margin size at the bottom, we need
- // to re-calc. our bottom offset, and the given top value is offset
- // top value of imageable area, we need to re-calc. our top offset,
- // which is the margin size at the top of the page.
- //
- // The current implementation assumes that paper is fed short-edge-first
- // either in portrait orientation, or in landscape orientation.
- //
- // In landscape orientation, printable margins should preserved.
- // It's based on a 90 degree counterclock wise paper rotation
- //
- // FEED DIRECTION FEED DIRECTION
- //
- // /\ /\
- // / \ / \
- // || ||
- // || ||
- //
- // PORTRAIT LANDSCAPE
- // +-----------------+ +-----------------+
- // | t | | t |
- // | +---------+ | | +---------+ |
- // | | ( ) | | | | | / | |
- // | l | --+-- | r | | l |()-+--- | r |
- // | | / \ | | | | | \ | |
- // | +---------+ | | +---------+ |
- // | b | | b |
- // +-----------------+ +-----------------+
- //
- // REVERSE PORTRAIT REVERSE LANDSCAPE
- // +-----------------+ +-----------------+
- // | t | | t |
- // | +---------+ | | +---------+ |
- // | | \ / | | | | \ | | |
- // | l | --+-- | r | | l | ---+-()| r |
- // | | ( ) | | | | / | | |
- // | +---------+ | | +---------+ |
- // | b | | b |
- // +-----------------+ +-----------------+
- //
- Kx := Printer.XDPI/72;
- Ky := Printer.YDPI/72;
- if Orientation in [poPortrait, poReversePortrait] then begin
- fCachePaperRect.PhysicalRect.Right:=Round(P^.Width*Kx);
- fCachePaperRect.PhysicalRect.Bottom:=Round(P^.Length*Ky);
- fCachePaperRect.WorkRect.Left:=Round(P^.Left*Kx);
- fCachePaperRect.WorkRect.Right:=Round(P^.Right*Kx);
- fCachePaperRect.WorkRect.Top:=Round((P^.Length-P^.Top)*Ky);
- fCachePaperRect.WorkRect.Bottom:=Round((P^.Length-P^.Bottom)*Ky);
- end else begin
- FCachePaperRect.PhysicalRect.Right:=Round(P^.Length*Kx);
- FCachePaperRect.PhysicalRect.Bottom:=Round(P^.Width*Ky);
- FCachePaperRect.WorkRect.Left:=Round((P^.Length-P^.Top)*Kx);
- FCachePaperRect.WorkRect.Right:=Round((P^.Length-P^.Bottom)*Kx);
- FCachePaperRect.WorkRect.Top:=Round((P^.Width-P^.Right)*Ky);
- FCachePaperRect.WorkRect.Bottom:=Round((p^.width - P^.left)*Ky);
- end;
- {$IFDEF DebugCUPS}
- with P^ do
- DebugLn('ORG: Width=%f Length=%f Left=%f Right=%f Top=%f Bottom=%f Name=%s',
- [Width,Length,Left,Right,Top,Bottom,string(Name)]);
- with FCachePaperRect do
- DebugLn('NEW: Width=%d Length=%d Left=%d Top=%d Right=%d Bottom=%d ml=%d mt=%d mr=%d mb=%d',
- [PhysicalRect.Right,PhysicalRect.Bottom,WorkRect.Left,WorkRect.Top,WorkRect.Right,WorkRect.Bottom,
- WorkRect.Left,WorkRect.Top,PhysicalRect.Right-WorkRect.Right,
- PhysicalRect.Bottom-WorkRect.Bottom]);
- {$ENDIF}
- end;
- end;
-
- if P=nil then begin
- FCachePaperRect := PaperSize.PaperRectOf[AName];
- fCachePaperRectResult:=1
- end;
-
- end;
- Result:=fCachePaperRectResult;
- aPaperRc:=fCachePaperRect;
- end;
- function TCUPSPrinter.DoGetPrinterState: TPrinterState;
- var //Request : Pipp_t; //IPP Request
- //Reponse : Pipp_t; //IPP Reponse
- //Attribute : Pipp_attribute_t; //Current attribute
- //Language : Pcups_lang_t; //Default Language
- aState : ipp_pstate_t; //Printer state
- //URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI
- begin
- Result:=inherited DoGetPrinterState;
- aState:=ipp_pstate_t(GetAttributeInteger('printer-state',0));
- Case aState of
- IPP_PRINTER_IDLE : Result:=psReady;
- IPP_PRINTER_PROCESSING : Result:=psPrinting;
- IPP_PRINTER_STOPPED : Result:=psStopped;
- end;
- end;
- function TCUPSPrinter.DoGetDefaultCanvasClass: TPrinterCanvasRef;
- begin
- {$IFDEF UseCairo}
- Result := TCairoPsCanvas;
- {$ELSE}
- Result := TPostscriptPrinterCanvas;
- {$ENDIF}
- end;
- function TCUPSPrinter.GetPrinterType: TPrinterType;
- Var i : Integer;
- begin
- Result:=inherited GetPrinterType;
- i:=GetAttributeInteger('printer-type',CUPS_PRINTER_LOCAL);
- If (i and CUPS_PRINTER_REMOTE)=CUPS_PRINTER_REMOTE then
- Result:=ptNetWork;
- end;
- function TCUPSPrinter.GetCanPrint: Boolean;
- begin
- Result:=inherited GetCanPrint;
- Result:=GetAttributeBoolean('printer-is-accepting-jobs',Result)
- end;
- initialization
- if Assigned(Printer) then
- Printer.Free;
- Printer:=TCUPSPrinter.Create;
- FINALIZATION
- // Free the printer before unloading library
- Printer.Free;
- Printer:=nil;
- //Unload CUPSLib if loaded
- FinalizeCups;
- END.