idlpr.pas

photo.163.com 相册下载器 多线程下载

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11657: IdLPR.pas 
{
{   Rev 1.12    7/24/04 12:56:14 PM  RLebeau
{ Compiler fix for Print(TIdBytes)
}
{
{   Rev 1.11    7/23/04 7:15:16 PM  RLebeau
{ Added extra exception handling to various Print...() methods
}
{
{   Rev 1.10    2004.05.20 11:36:50 AM  czhower
{ IdStreamVCL
}
{
{   Rev 1.9    2004.03.03 11:54:32 AM  czhower
{ IdStream change
}
{
{   Rev 1.8    2004.02.03 5:43:56 PM  czhower
{ Name changes
}
{
{   Rev 1.7    1/21/2004 3:11:22 PM  JPMugaas
{ InitComponent
}
{
{   Rev 1.6    10/24/2003 02:54:52 PM  JPMugaas
{ These should now work with the new code.
}
{
{   Rev 1.5    2003.10.24 10:43:10 AM  czhower
{ TIdSTream to dos
}
{
{   Rev 1.4    2003.10.12 4:04:00 PM  czhower
{ compile todos
}
{
{   Rev 1.3    2/24/2003 09:07:26 PM  JPMugaas
}
{
{   Rev 1.2    2/6/2003 03:18:08 AM  JPMugaas
{ Updated components that compile with Indy 10.
}
{
{   Rev 1.1    12/6/2002 05:30:18 PM  JPMugaas
{ Now decend from TIdTCPClientCustom instead of TIdTCPClient.
}
{
{   Rev 1.0    11/13/2002 07:56:22 AM  JPMugaas
}
unit IdLPR;

(*******************************************************}
{                                                       }
{       Indy Line Print Remote TIdLPR                   }
{                                                       }
{       Version 9.1.0                                   }
{                                                       }
{       Original author Mario Mueller                   }
{                                                       }
{       home: www.hemasoft.de                           }
{       mail: [e-mail]                    }
{                                                       }
{       27.07. rewrite component for integration        }
{              in Indy core library                     }
{                                                       }
{*******************************************************)

interface

uses
  Classes,
  IdAssignedNumbers, IdGlobal, IdException, IdStreamVCL, IdTCPClient, IdComponent,
  SysUtils;

type
  TIdLPRFileFormat =
    (ffCIF, // CalTech Intermediate Form
     ffDVI, //   DVI (TeX output).
     ffFormattedText, //add formatting as needed to text file
     ffPlot, //   Berkeley Unix plot library
     ffControlCharText, //text file with control charactors
     ffDitroff, // ditroff output
     ffPostScript, //Postscript output file
     ffPR,//'pr' format    {Do not Localize}
     ffFORTRAM, // FORTRAN carriage control
     ffTroff, //Troff output
     ffSunRaster); //  Sun raster format file

const
  DEF_FILEFORMAT = ffControlCharText;
  DEF_INDENTCOUNT = 0;
  DEF_BANNERPAGE = False;
  DEF_OUTPUTWIDTH = 0;
  DEF_MAILWHENPRINTED = False;
type
  TIdLPRControlFile = class(TPersistent)
  protected
    FBannerClass: String;			// 'C'    {Do not Localize}
    FHostName: String;				// 'H'    {Do not Localize}
    FIndentCount: Integer;		// 'I'    {Do not Localize}
    FJobName: String;					// 'J'    {Do not Localize}
    FBannerPage: Boolean;			// 'L'    {Do not Localize}
    FUserName: String;					// 'P'    {Do not Localize}
    FOutputWidth: Integer;		// 'W'    {Do not Localize}

    FFileFormat : TIdLPRFileFormat;
    FTroffRomanFont : String; //substitue the Roman font with the font in file
    FTroffItalicFont : String;//substitue the Italic font with the font in file
    FTroffBoldFont : String;  //substitue the bold font with the font in file
    FTroffSpecialFont : String; //substitue the special font with the font
                                //in this file
    FMailWhenPrinted : Boolean; //mail me when you have printed the job
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    property HostName: String read FHostName write FHostName;
  published
    property BannerClass: String read FBannerClass write FBannerClass;
    property IndentCount: Integer read FIndentCount write FIndentCount
      default DEF_INDENTCOUNT;
    property JobName: String read FJobName write FJobName;
    property BannerPage: Boolean read FBannerPage write FBannerPage
      default DEF_BANNERPAGE;
    property UserName: String read FUserName write FUserName;
    property OutputWidth: Integer read FOutputWidth write FOutputWidth
      default DEF_OUTPUTWIDTH;
    property FileFormat: TIdLPRFileFormat read FFileFormat write FFileFormat
      default DEF_FILEFORMAT;
    {font data }
    property TroffRomanFont : String read FTroffRomanFont write FTroffRomanFont;
    property TroffItalicFont : String read FTroffItalicFont
      write FTroffItalicFont;
    property TroffBoldFont : String read FTroffBoldFont write FTroffBoldFont;
    property TroffSpecialFont : String read FTroffSpecialFont
      write FTroffSpecialFont;
    {misc}
    property MailWhenPrinted : Boolean read FMailWhenPrinted
      write FMailWhenPrinted default DEF_MAILWHENPRINTED;

  end;

type
  TIdLPRStatus = (psPrinting, psJobCompleted, psError, psGettingQueueState,
    psGotQueueState, psDeletingJobs, psJobsDeleted, psPrintingWaitingJobs,
    psPrintedWaitingJobs);

type
  TIdLPRStatusEvent = procedure(ASender: TObject;
    const AStatus: TIdLPRStatus;
    const AStatusText: String) of object;

type
  TIdLPR = class(TIdTCPClientCustom)
  protected
    FOnLPRStatus: TIdLPRStatusEvent;
    FQueue: String;
    FJobId: Integer;
    FControlFile: TIdLPRControlFile;
    procedure DoOnLPRStatus(const AStatus: TIdLPRStatus;
    const AStatusText: String);
    procedure SeTIdLPRControlFile(const Value: TIdLPRControlFile);
    procedure CheckReply;
    function GetJobId: String;
    procedure SetJobId(JobId: String);
    procedure InternalPrint(Data: TIdStreamVCL);
    function GetControlData: String;
    procedure InitComponent; override;
  public
    destructor Destroy; override;
    procedure Print(AText: String); overload;
    procedure Print(const ABuffer: TIdBytes); overload;
    procedure PrintFile(AFileName: String);
    function GetQueueState(const AShortFormat: Boolean = false;
      const AList : String = '') : String;    {Do not Localize}
    procedure PrintWaitingJobs;
    procedure RemoveJobList(AList : String; const AAsRoot: Boolean =False);
    property JobId: String read GetJobId write SetJobId;
  published
    property Queue: String read FQueue write FQueue;
    property ControlFile: TIdLPRControlFile read FControlFile write SeTIdLPRControlFile;
    property OnLPRStatus: TIdLPRStatusEvent read FOnLPRStatus write FOnLPRStatus;
  end;

type EIdLPRErrorException = class(EIdException);

implementation

uses
  IdIOHandlerStack, IdGlobalProtocols, IdResourceStringsProtocols, IdStack;

{*********************** TIdLPR **********************}
procedure TIdLPR.InitComponent;
begin
  Inherited;

  Port := IdPORT_LPD;
  Queue := 'pr1';    {Do not Localize}
  FJobId := 1;
  FControlFile := TIdLPRControlFile.Create;

  // Restriction in RFC 1179
  // The source port must be in the range 721 to 731, inclusive.

//  known -problem with this some trouble while multible printjobs are running
//  This is the FD_WAIT port problem where a port is in a FD_WAIT state
//  but you can bind to it.  You get a port reuse error.
  IOHandler := TIdIOHandlerStack.Create(nil);
  TIdIOHandlerStack(IOHandler).BoundPortMin:=721;;
  TIdIOHandlerStack(IOHandler).BoundPortMax:=731; ;
end;


procedure TIdLPR.Print(AText: String);
var
  LStream: TStream;
  LIdStream: TIdStreamVCL;
begin
  LStream := TMemoryStream.Create;
  try
    LIdStream := TIdStreamVCL.Create(LStream);
    try
      LIdStream.Write(AText);
      LIdStream.VCLStream.Position := 0;
      InternalPrint(LIdStream);
    finally
      FreeAndNil(LIdStream);
    end;
  finally
    FreeAndNil(LStream);
  end;
end;

procedure TIdLPR.Print(const ABuffer: TIdBytes);
var
  LStream: TStream;
  LIdStream: TIdStreamVCL;
begin
  LStream := TMemoryStream.Create;
  try
    LIdStream := TIdStreamVCL.Create(LStream);
    try
      LIdStream.Write(ABuffer);
      LIdStream.VCLStream.Position := 0;
      InternalPrint(LIdStream);
    finally
      FreeAndNil(LIdStream);
    end;
  finally
    FreeAndNil(LStream);
  end;
end;

procedure TIdLPR.PrintFile(AFileName: String);
var
  LStream: TStream;
  LIdStream : TIdStreamVCL;
  p: Integer;
begin
  p := RPos(GPathDelim, AFileName);
  ControlFile.JobName := Copy(AFileName, p+1, Length(AFileName)-p);
  LStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    LIdStream := TIdStreamVCL.Create(LStream);
    try
      InternalPrint(LIdStream);
    finally
      FreeAndNil(LIdStream);
    end;
  finally
    FreeAndNil(LStream);
  end;
end;

function TIdLPR.GetJobId: String;
begin
  Result:=Format('%.3d', [FJobId]);    {Do not Localize}
end;

procedure TIdLPR.SetJobId(JobId: String);