{**********************************************************************
Copyright (C) 2009 by Salvatore Licciardi

Web http://www.webalice.it/turylicciardi    eMail turylicciardi@tiscali.it

 This program is free software: you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free Software
 Foundation, version 3 of the License.
 This program is distributed in the hope  that it will be useful , but WITHOUT
 ANY WARRANTY without even the implied warranty  of MERCHANTABILITY or FITNESS
 FOR A PARTICULAR PURPOSE.
 See the GNU General Public License for more details. You should have received
 a copy of the GNU General Public License along with this program. If not, see
 http://www.gnu.org/licenses/

 **********************************************************************}

{ this unit is for FreePascal / BP7 .
  Target OS: Go32v2 , Win32 , OS/2 and similar .
  with Printers unit you can use your printer as LPT 1..9, COM 1..4 and other file.

  written by: Salvatore Licciardi
  WWW page  : www.webalice.it/turylicciardi
  E-Mail    : turylicciardi@tiscali.it
  this file : www.webalice.it/turylicciardi/prog/printers.zip
  version   : 2.0.0  2005/07/10

}

unit print2;

interface

{$ifdef FPC}
uses SysUtils;
{$endif}

type print=object

     public
       constructor  Init;
       destructor   Destroy;                              { ver 2.00 }
       function     Set_Printer(s:string):longint;        { 0=open , 1=not open , 2=isn't valid }
       {$ifdef FPC}
        function     Set_This_Printer(s:string):boolean;   { ver 2.00 }
       {$endif}
       function     Set_This_Printer(s:string; overwrite:boolean):boolean;  { ver 2.00 }
       function     Get_Printer:string;
       function     Get_Status_Printer(s:string):longint; { 0=open , 1=not open , 2=isn't valid }
       function     Close_Printer:boolean;
       function     write(s:string):boolean;              { ver 2.00 }
       function     writeln(s:string):boolean;            { ver 2.00 }

     private
       lst: text;
       default_printer:string;
     end;

implementation

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$ifndef FPC}
function UpCase(s:string):string;
var i:longint;
begin
for i:=1 to length(s) do
    if s[i] in ['a'..'z'] then s[i]:=char( ord(s[i])-32 );
UpCase:=s;
end;
{$endif}

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$ifndef FPC}
function Trim(s:string):string;
begin
while copy(s,1,1)=' ' do s:=copy(s,2,length(s)-1);
while copy(s,length(s),1)=' ' do s:=copy(s,1,length(s)-1);
Trim:=s;
end;
{$endif}

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

constructor  print.init;
begin
default_printer:='';
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  print.Get_Status_Printer(s:string):longint;  { 0=open , 1=not open , 2=isn't valid }
begin
s:=upcase(trim(s));
Get_Status_Printer:=0;
if (s=default_printer)and(s<>'') then Exit;
Get_Status_Printer:=1;
if length(s)<>4 then
                begin
                Get_Status_Printer:=2;
                Exit;
                end;
if ( (copy(s,1,3)='LPT') and (s[4] in ['1'..'9']) ) or
   ( (copy(s,1,3)='COM') and (s[4] in ['1'..'4']) ) then { valid name }
                                                    else
                                                     begin
                                                     Get_Status_Printer:=2;
                                                     Exit;
                                                     end;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  print.Get_Printer:string;
begin
Get_Printer:=default_printer;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  print.Close_Printer:boolean;
begin
{$i-}
close(lst);
{$i+}
if ioresult<>0 then Close_Printer:=false
               else
                begin
                close_printer:=true;
                default_printer:='';
                end;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  print.Set_Printer(s:string):longint;
begin
Set_Printer:=2;
default_printer:='';
s:=trim(upcase(s));
if length(s)<>4 then Exit;
if ( (copy(s,1,3)='LPT') and (s[4] in ['1'..'9']) ) or
   ( (copy(s,1,3)='COM') and (s[4] in ['1'..'4']) ) then { valid name }
                                                    else Exit;
default_printer:=s;
assign(lst,s);
{$i-}
rewrite(lst);
{$i+}
if ioresult=0 then set_printer:=0
              else set_printer:=1;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$ifdef FPC}
function  print.Set_This_Printer(s:string):boolean;  { ver 2.00 }
begin
exit(Set_This_Printer(s,true));
end;
{$endif}

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  print.Set_This_Printer(s:string; overwrite:boolean):boolean;  { ver 2.00 }
begin
default_printer:=s;
assign(lst,s);
if overwrite then
    begin
    {$i-}
    rewrite(lst);
    {$i+}
    if ioresult=0 then set_this_printer:=true
                  else set_this_printer:=false;
    end
   else
    begin
    {$i-}
    reset(lst);
    {$i+}
    if ioresult<>0 then;
    {$i-}
    append(lst);
    {$i+}
    if ioresult=0 then set_this_printer:=true
                  else
                   begin
                   {$i-}
                   rewrite(lst);
                   {$i+}
                   if ioresult=0 then set_this_printer:=true
                                 else set_this_printer:=false;
                   end;
    end;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  print.write(s:string):boolean;  { ver 2.00 }
begin
{$i-}
system.write(lst,s);
{$i+}
if ioresult=0 then write:=true
              else write:=false;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  print.writeln(s:string):boolean;  { ver 2.00 }
begin
{$i-}
system.writeln(lst,s);
{$i+}
if ioresult=0 then writeln:=true
              else writeln:=false;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

destructor print.Destroy;                   { ver 2.00 }
begin
Close_Printer;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

end.
