Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Printing a file in M$ Windows

by slloyd (Hermit)
on Jun 05, 2007 at 12:54 UTC ( #619374=snippet: print w/ replies, xml ) Need Help??

Description: For what it is worth, I have written the following subroutines to make it easy to print pretty much any file to any printer on Windows. Also to get a list of available printers, get the default printer, etc... Thanks to node 193470 for the inspiration to do this.
Enjoy :)
########################################################
### subs_win32printer.pl - requires the following modules
#use Win32::GUI();
#use Win32::GUI::AxWindow;
#use Win32::API;
#use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>0 );
########################################################
### References
###        http://www.perlmonks.org/?node_id=193470
###        http://support.microsoft.com/kb/267240
########################################################
##############
sub printText
{
    my $text=shift;
    my $printer=shift || getDefaultPrinter();
    if(-e $text){$text=getFileContents($text);}
    #initialize Win32 API calls
    my $OpenPrinter = new Win32::API('winspool.drv', 'OpenPrinter',['P
+','P','P'], 'N');
    my $StartDocPrinter = new Win32::API('winspool.drv','StartDocPrint
+er', ['N','N','P'], 'N');
    my $StartPagePrinter = new Win32::API('winspool.drv','StartPagePri
+nter', ['N'], 'N');
    my $WritePrinter =     new Win32::API('winspool.drv','WritePrinter
+',  ['N','P','N','P'], 'N');
    my $EndPagePrinter =   new Win32::API('winspool.drv','EndPagePrint
+er',  ['N'], 'N');
    my $EndDocPrinter =    new Win32::API('winspool.drv', 'EndDocPrint
+er', ['N'],  'N');
    my $ClosePrinter =     new Win32::API('winspool.drv', 'ClosePrinte
+r', ['N'],  'N');
    #Setup devicename
    $printer .= "\0";
    my $hprinter = pack('x4');
    # RAW mode
    my $datatype = "RAW\0";
    # devmode not passed in pdefaults
    # user selected paper/orientation/duplex have no effect in RAW mod
+e
    # defaults set at printer will be used
    my $pdefaults = pack('px4L', $datatype, 0x8); # PRINTER_ACCESS_USE
    $OpenPrinter->Call($printer, $hprinter, $pdefaults) || return $^E;
    $hprinter = unpack('L', $hprinter);
    # name of document in print manager display
    # this won't be there very long unless the printer is off or busy 
+with another job
    my $docname = "Win32::API print test\0";
    my $docinfo = pack("px12", $docname);
    $StartDocPrinter->Call($hprinter, 1, $docinfo) || return $^E;
    $StartPagePrinter->Call($hprinter) || return $^E;
    my $written = pack('x4');
    $text .= "\f";
    my $len = length $text;
    $WritePrinter->Call($hprinter, $text, $len, $written) || return $^
+E;
    # one canvas per sheet, next postscript would start new sheet
    $EndPagePrinter->Call($hprinter) || return $^E;
    $EndDocPrinter->Call($hprinter) || return $^E;
    $ClosePrinter->Call($hprinter);
    return 1;
}
##############
sub printHtml{
    my $file=shift || return "No file passed to printHtml";
    my $printer=shift || getDefaultPrinter();
    my $navigate='';
    if($file=~/^http/is){$navigate=$file;}
    else{
        if($file !~/[\\\/]/s && -e "$progpath\\$file"){$navigate="file
+://$progpath\\$file";}
        elsif(-e $file){$navigate="file://$file";}
        }
    if(!length($navigate)){return("No such file: $file");}
    if(length($printer) && !changeDefaultPrinter($printer)){return "Un
+able to change printer to $printer";}
    # Create a window to host the axWindow in
    my $Window = new Win32::GUI::Window(
        -name  => "Window",
          -title => "Win32::GUI::AxWindow test",
          -pos   => [100, 100],
          -size  => [400, 400],
          );
    # Add a WebBrowser AxtiveX
    my $Control = new Win32::GUI::AxWindow (
        -parent   => $Window,
        -name     => "Control",
        -control  => "Shell.Explorer",
        -pos      => [0, 0],
        -size     => [400, 400],
      );
    our $loaded=0;
    # Register some event
    $Control->RegisterEvent("StatusTextChange",
        sub {
            my $self    = shift;
            my $eventid = shift;
            my $event = shift;
            print "Event : [$eventid][$event]\n" if length($event) && 
+$debug;
            if($eventid==102 && $event=~/^done$/is){$loaded=1;}
            } );
    # Call Method Navigate to load the page
    print "printing $navigate\n" if $debug;
    $Control->CallMethod("Navigate", $navigate);
    #loop until the page has loaded
    while(!$loaded){
        Win32::GUI::DoEvents();
        select(undef,undef,undef,.1);
        }
    #Print the URL, page, or image
    my $PRINT = 6;
    my $DONTPROMPTUSER = 2;
    print "Printing $file to $printer\n" if $debug;
    #Setting custom header and footer - does not work yet
    #http://support.microsoft.com/kb/267240
    #my $array = Win32::OLE::Variant->new(VT_ARRAY | VT_BSTR, 2);
    #$array->Put(0, 'Custom Header');
    #$array->Put(1, 'Custom Footer');

    #Call print without prompting user
    my $ok=$Control->CallMethod("ExecWB",$PRINT,$DONTPROMPTUSER);
    print "Done printing [$ok]...\n" if $debug;
    # Event loop
    $Window->Hide();
    $Window->AddTimer('Shutdown', 1500);
    Win32::GUI::Dialog();
    exit(0);
    sub Shutdown_Timer{
        print "shutting down\n" if $debug;
        changeDefaultPrinter('',1);
        return -1;
        }
    }
################
sub changeDefaultPrinter
{
    my $printer=shift;
    my $reset=shift;
    #Get current Default Printer
    my $default = $Registry->{"CUser/Software/Microsoft/Windows NT/Cur
+rentVersion/Windows/Device"};
    if($reset && length($Registry->{"CUser/Software/Microsoft/Windows 
+NT/CurrentVersion/Windows/PreDevice"}))
    {
        #Reset default printer back
        my $previous = $Registry->{"CUser/Software/Microsoft/Windows N
+T/CurrentVersion/Windows/PreDevice"};
        $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersio
+n/"}={
            "Windows/"    => {"/Device"=>$previous}
            };
        #remove previous key
        $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersio
+n/"}={
            "Windows/"    => {"/PreDevice"=>''}
            };
        return 1;
    }
    if(!length($printer)){return 0;}
    #if the printer is already set, return true
    if($default=~/^\Q$printer\E\,/is){return 1;}
    #Does the printer exist?
    if(!defined $Registry->{"CUser/Software/Microsoft/Windows NT/Curre
+ntVersion/Devices/$printer"}){return 0;}
    #Set PreDevice to current default printer
    $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersion/"}
+={
            "Windows/"    => {"/PreDevice"=>$default}
            };
    my $newval=$Registry->{"CUser/Software/Microsoft/Windows NT/Curren
+tVersion/Devices/$printer"};
    $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersion/"}
+={
        "Windows/"    => {"/Device"=>"$printer\,$newval"}
        };
    return 1;
}
################
sub getDefaultPrinter
{
my ($printer,$drv,$port)=split(/\,/,$Registry->{"CUser/Software/Micros
+oft/Windows NT/CurrentVersion/Windows/Device"},3);
return $printer;
}
################
sub getPrinters
{
    my $printers=$Registry->{"CUser/Software/Microsoft/Windows NT/Curr
+entVersion/Devices/"};
    my @printers=();
    foreach my $printer (keys(%{$printers}))
    {
        $printer=~s/^\/+//sg;
        push(@printers,$printer);
        #print "Printer: $printer\n";
    }
    if(wantarray){return @printers};
    return join(',',@printers);
}
return 1;

Comment on Printing a file in M$ Windows
Download Code
Re: Printing a file in M$ Windows
by ww (Bishop) on Jun 05, 2007 at 18:31 UTC

    Moved the last "}" at 176; placed it below the "return 1;"
    because, oddly,

    F:\_wo\pl_test>perl -c prettyprinter.pl
    prettyprinter.pl syntax OK

    but

    F:\_wo\pl_test>perl prettyprinter.pl
    Can't return outside a subroutine at prettyprinter.pl line 180.

    WTF?

    Also, think you need to UNcomment the "use" statements at the top... and maybe use warnings and strict?

    ...and having done all those, I've run out of time to psych out this:

    Useless use of a constant in void context at prettyprinter.pl line 6, <DATA> line 164.

    Still, I'm impressed. ++

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://619374]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2014-12-25 16:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (160 votes), past polls