#! perl -w use strict; use Win32::API; &print("foo"); sub print { my $text=$_[0]; my $PrintDialog = new Win32::API('comdlg32', 'PrintDlg', ['P'], 'N'); my $GlobalLock = new Win32::API('kernel32', 'GlobalLock', ['N'], 'N'); my $GlobalFree = new Win32::API('kernel32', 'GlobalFree', ['N'], 'N'); my $OpenPrinter = new Win32::API('winspool.drv', 'OpenPrinter', ['P','P','P'], 'N'); my $StartDocPrinter = new Win32::API('winspool.drv', 'StartDocPrinter', ['N','N','P'], 'N'); my $StartPagePrinter = new Win32::API('winspool.drv', 'StartPagePrinter', ['N'], 'N'); my $WritePrinter = new Win32::API('winspool.drv', 'WritePrinter', ['N','P','N','P'], 'N'); my $EndPagePrinter = new Win32::API('winspool.drv', 'EndPagePrinter', ['N'], 'N'); my $EndDocPrinter = new Win32::API('winspool.drv', 'EndDocPrinter', ['N'], 'N'); my $ClosePrinter = new Win32::API('winspool.drv', 'ClosePrinter', ['N'], 'N'); my $GetLastError = new Win32::API('kernel32', 'GetLastError', [], 'N'); my $FormatMessage = new Win32::API('kernel32', 'FormatMessage',['N','P','N','N','P','N','P'], 'N'); my $pd = pack("Lx16Lx42", 66, 0x10010C); unless ($PrintDialog->Call($pd)) { return 0; } my ($devmode) = unpack("x8L", $pd); # devmode is a handle to movable global memory my $handle = $devmode; # get actual memory pointer unless ($devmode = $GlobalLock->Call($handle)) {ShowError('GlobalLock')}; # get perl to use long integer as a pointer $devmode = unpack('P156', pack('L', $devmode)); # release the global memory unless ($GlobalFree->Call($handle) == 0) {ShowError('GlobalFree')}; # these strings are blank padded my ($devicename) = unpack('A32', $devmode); $devicename .= "\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 mode # defaults set at printer will be used my $pdefaults = pack('px4L', $datatype, 0x8); # PRINTER_ACCESS_USE $OpenPrinter->Call($devicename, $hprinter, $pdefaults) or ShowError('OpenPrinter'); $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) or ShowError('StartDocPrinter'); $StartPagePrinter->Call($hprinter) or ShowError('StartPagePrinter'); my $written = pack('x4'); $text .= "\f"; my $len = length $text; $WritePrinter->Call($hprinter, $text, $len, $written) or ShowError('WritePrinter'); # one canvas per sheet, next postscript would start new sheet $EndPagePrinter->Call($hprinter) or ShowError('EndPagePrinter'); $EndDocPrinter->Call($hprinter) or ShowError('EndDocPrinter'); $ClosePrinter->Call($hprinter); }