Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Line Printer Tool

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Albert Richheimer
    replied
    Here is the code with a refinement (and minor changes). Please see the discussion thread for details.
    Code:
    '  ---------------------------------------------------------------------------
    '  Source name     : LPT.BAS
    '  Executable name : LPT.EXE
    '  Version         : 1.0
    '  Created date    : 21-Feb-2022
    '  Last update     : 07-Apr-2022
    '  Author          : Albert Richheimer
    '  Description     : Line Printer Tool
    '  ---------------------------------------------------------------------------
    '
    #compile exe
    #dim all
    #include once "WIN32API.INC"
    
    $OEM_CHARS  = "äöü+-++-+"
    $ANS_CHARS  = "õ÷³ÚÓÞ"
    %ANS_CHAR   = 0
    %OEM_CHAR   = 1
    
    type DirData
        FileAttributes as dword
        CreationTime   as quad
        LastAccessTime as quad
        LastWriteTime  as quad
        FileSizeHigh   as dword
        FileSizeLow    as dword
        Reserved0      as dword
        Reserved1      as dword
        FileName       as wstringz*260
        ShortName      as wstringz*14
    end type
    
    global gArgTab()       as string
    global gReturn         as long
    global gProgPath       as string
    global gNetWarePrint   as string
    
    global gQueueFolder    as string
    global gFullName()     as string
    global gNetWareQueue() as string
    global gPort9100Addr() as string
    global gInitPrinter()  as string
    global gPitch10CPI()   as string
    global gPitch12CPI()   as string
    global gPitch15CPI()   as string
    global gDefaultPitch() as long
    global gPropSpace()    as string
    
    '   Option Switches
    '   ---------------
    '
    global gSwNFF          as long
    global gSwVerbose      as long
    global gSwHold         as long
    
    global gSwWindowsXP    as long
    global gSwWindows7     as long
    
    global gPrinter        as long      ' Printer #
    global gPrPitch        as long      ' Print pitch
    global gNWPrint        as long      ' Print via NetWare Queue
    global gCharSet        as long      ' ANSI or OEM
    global gANSChars       as long      ' Option -a: Force ANSI Charset
    global gOEMChars       as long      ' Option -o: Force OEM Charset
    
    
    '
    '   Program Entry Point
    '   -------------------
    '
    function pbmain as long
    
        local lPtr     as long
        local lTemp    as long
        local hFile    as long
        local lArgTab  as long
        local lArgPtr  as long
        local lFiles   as long
        local lFilePtr as long
        local lCharSet as long
        local sTemp    as string
        local sResult  as string
        local sData    as string
        local sOption  as string
        local sArgPath as string
        local szTemp   as asciiz*256
    
        dim   sArgs()  as string
        dim   sFile()  as string
        dim   sSNam()  as string
    
        redim gFullName(1 to 2)
        redim gNetWareQueue(1 to 2)
        redim gPort9100Addr(1 to 2)
        redim gInitPrinter(1 to 2)
        redim gPitch10CPI(1 to 2)
        redim gPitch12CPI(1 to 2)
        redim gPitch15CPI(1 to 2)
        redim gDefaultPitch(1 to 2)
    
        redim gArgTab(1 to 20)
        lArgTab = 0
    
        if GetWinVersion() > "501" then
           gSwWindowsXP = %FALSE
           gSwWindows7  = %TRUE
        else
           gSwWindowsXP = %TRUE
           gSwWindows7  = %FALSE
        end if
    
        if GetIniFile then
           stderr "Error reading lpt.ini"
           exit function
        end if
    
    '   Defaults
    '   --------
    
        if environ$("ETAGE") = "1" then
           gPrinter = 2
        else
           gPrinter = 1
        end if
    
        gPrPitch   = gDefaultPitch(gPrinter)
        gNWPrint   = gSwWindowsXP
        gSwVerbose = %TRUE
    
        gSwHold    = %FALSE
    
    b0000:
    
        if isfolder(gQueueFolder) = %FALSE then
           mkdir gQueueFolder
        end if
    
        if GetCommandArgs(sArgs()) = 0 then
           ShowHelp
           goto closedown
        end if
    
        for lTemp = 1 to ubound(sArgs)
            if left$(sArgs(lTemp),1) = "-" or _
               left$(sArgs(lTemp),1) = "/" then
               sOption = lcase$(mid$(sArgs(lTemp),2))
               if left$(sOption,1)="p" and val(mid$(sOption,2,1)) then
                  gPrinter = val(mid$(sOption,2,1))
                  goto b0200
               end if
               select case sOption
                 case "oem"    ' OEM character Set
                   gOEMChars = %TRUE
                 case "ans"    ' ANSI character Set"
                   gANSChars = %TRUE
                 case "acs"    ' automatic character detection (default)
                   gOEMChars = %FALSE
                   gANSChars = %FALSE
                 case "10"     ' 10 Pitch (default)
                   gPrPitch = 10
                 case "12"     ' 12 Pitch
                   gPrPitch = 12
                 case "15"     ' 15 Pitch
                   gPrPitch = 15
                 case "nff"    ' no form feed after print (NFF)
                   gSwNFF = %TRUE
                 case "tcp"    ' Force TCP print (XP only)
                   gNWPrint = %FALSE
                 case "nv"     ' Non-Verbose
                   gSwVerbose = %FALSE
                 case "hq"     ' Hold in queue
                   gSwHold = %TRUE
                 case "h"      ' display this help text"
                   ShowHelp
                   goto closedown
                 case else
                   stderr "Illegal option: "+sArgs(lTemp)
                   goto closedown
               end select
            else
               if val(sArgs(lTemp))>=1 and _
                  val(sArgs(lTemp))<=ubound(gFullName) then
                  gPrinter = val(sArgs(lTemp))
                  goto b0200
               end if
               incr lArgTab
               if lArgTab > ubound(gArgTab) then
                  redim gArgTab(1 to lArgTab+10)
               end if
               gArgTab(lArgTab) = sArgs(lTemp)
            end if
    b0200:
        next lTemp
        if gPrinter > ubound(gFullName) then
           stderr "Illegal printer number."
           function = %TRUE
           goto closedown
        end if
        for lArgPtr = 1 to lArgTab
            if lcase$(gArgTab(lArgPtr)) = "eject" then      ' handle eject
               GetTempFileName(bycopy gQueueFolder,"LPT",0,szTemp)
               hFile = freefile
               open szTemp for output as #hFile
               print #hFile,$FF;
               close #hFile
               select case gNWPrint
                 case %TRUE
                   sResult = NetWarePrint(bycopy szTemp)
                 case %FALSE
                   sResult = SendData(bycopy szTemp)
                   if len(sResult) then
                      stderr sResult
                      goto b0270
                   end if
               end select
               if gSwVerbose then
                  stdout "Formfeed sent to "+gFullName(gPrinter)
               end if
            b0270:
               kill szTemp
            goto b0290
            end if
    
            lFiles = GetFiles(gArgTab(lArgPtr),sFile(),sSNam())
            if lFiles = 0 then
               stderr "Cannot find files: "+gArgTab(lArgPtr)+"."
               goto b0290
            end if
            sArgPath = pathname$(path,gArgTab(lArgPtr))
            for lFilePtr = 1 to lFiles
                hFile = freefile
                open sArgPath+sFile(lFilePtr) for binary lock shared as #hFile
                if err then
                   stderr "Cannot open file "+sArgPath+sFile(lFilePtr)
                   goto b0280
                end if
                get$ #hFile,lof(#hFile),sData
                close #hFile
                if gOEMChars = %FALSE and gANSChars = %FALSE then
                   lCharSet = DetectCharSet(sData)
                else
                   lCharSet = iif(gANSChars,%ANS_CHAR,%OEM_CHAR)
                end if
                if lCharSet = %ANS_CHAR then
                   sData = ChrToOem$(sData)
                end if
               szTemp = gQueueFolder+sSNam(lFilePtr)
               hFile = freefile
               open szTemp for output as #hFile
               print #hFile,gInitPrinter(gPrinter);
               select case gPrPitch
                 case 10
                   print #hFile,gPitch10CPI(gPrinter);
                 case 12
                   print #hFile,gPitch12CPI(gPrinter);
                 case 15
                   print #hFile,gPitch15CPI(gPrinter);
               end select
               print #hFile,sData;
               if gSwNFF = %FALSE then
                  print #hFile,$FF;
               end if
               close #hFile
               select case gNWPrint
                 case %TRUE
                   sResult = NetWarePrint(bycopy szTemp)
                 case %FALSE
                   sResult = SendData(bycopy szTemp)
                   if len(sResult) then
                      stderr sResult
                      goto b0280
                   end if
               end select
               if gSwVerbose then
                  stdout "File "+$dq+sFile(lFilePtr)+$dq+" sent to "+ _
                         gFullName(gPrinter)
               end if
               kill szTemp
    
        b0280:
            next lFilePtr
    b0290:
        next lArgPtr
    
    closedown:
        function=gReturn
    
    end function
    
    
    '------------------------------------------------------------------------------
    '   NetwarePrint
    '   ------------
    '
    '   passed  : Path\Filename to be queued
    '
    '   returns : none
    '
    '------------------------------------------------------------------------------
    function NetWarePrint(sFile as string) as string
        local sOptions as string
        if pathscan$(full,gNetWarePrint)="" then
           function = "NetWare Print Utility not specified."
           exit function
        end if
        sOptions = " /nt /nb /nff /q="+gNetWareQueue(gPrinter)
        if gSwHold then
           sOptions = sOptions + " /hold"
        end if
        shell gNetWarePrint+" "+sFile+sOptions+">nul",0
        function = ""
    end function
    
    
    '------------------------------------------------------------------------------
    '   Send Data
    '   ---------
    '
    '   passed  : Path\Filename to be sent
    '
    '   returns : error message if failing
    '
    '------------------------------------------------------------------------------
    function SendData(sFile as string) as string
        local hSocket  as long
        local hFile    as long
        local lResult  as long
        local sData    as string
        hFile = freefile
        open sFile for binary lock shared as #hFile
        lResult = err
        if lResult then
           function = "Cannot open file "+sFile+$crlf+ _
                      "Error "+format$(lResult)+": "+error$(lResult)
           exit function
        end if
        get$ #hFile,lof(#hFile),sData
        close #hFile
        hSocket = freefile
        tcp open port 9100 at gPort9100Addr(gPrinter) as hSocket timeout 1000
        lResult = err
        if lResult then
           function = "Cannot open port "+gPort9100Addr(gPrinter)+$crlf+ _
                      "Error "+format$(lResult)+": "+error$(lResult)
           tcp close hSocket
           exit function
        end if
        tcp send #hSocket,sData
        lResult = err
        if lResult then
           function = "Cannot send data to port "+gPort9100Addr(gPrinter)+$crlf+ _
                      "Error "+format$(lResult)+": "+error$(lResult)
           tcp close hSocket
           exit function
        end if
        tcp close #hSocket
        function = ""
    end function
    
    
    '------------------------------------------------------------------------------
    '   GetFiles
    '   --------
    '
    '   passed  : sMask containing file name, wildcard optional
    '
    '   returns : function value # of files found
    '           : sFile array containing long file name(s)
    '           : sSNam array containing short file name(s)
    '
    '------------------------------------------------------------------------------
    function GetFiles(sMask as string,sFile() as string,sSNam() as string) as long
        local sTemp   as string
        local lTemp   as long
        local uDir    as DirData
        redim sFile(1 to  10)
        redim sSNam(1 to  10)
        sTemp = dir$(sMask,to uDir)
        while len(sTemp)
          incr lTemp
          if lTemp > ubound(sFile) then
             redim preserve sFile(1 to lTemp+10)
             redim preserve sSNam(1 to lTemp+10)
          end if
          sFile(lTemp) = uDir.FileName
          sSNam(lTemp) = uDir.ShortName
          if sSNam(lTemp) = "" then
             sSNam(lTemp) = uDir.FileName
          end if
          sTemp = dir$(next to uDir)
        wend
        if lTemp then
           redim preserve sFile(1 to lTemp)
           redim preserve sSNam(1 to lTemp)
        end if
        function = lTemp
    end function
    
    
    '------------------------------------------------------------------------------
    '   GetIniFile
    '   ----------
    '------------------------------------------------------------------------------
    function GetIniFile as long
        local szTemp      as asciiz*%MAX_PATH
        local hFile       as long
        local lTemp       as long
        local lPtr        as long
        local sTemp       as string
        local sFile       as string
        local sPath       as string
        local sMatch      as string
        local sData       as string
    
        lPtr = 1
    
        GetModuleFileName %NULL, byval varptr(szTemp), byval %MAX_PATH
        lTemp=instr(-1,szTemp,"\")
        if lTemp then
           sTemp=left$(szTemp,lTemp)
           gProgPath=sTemp
           sFile=mid$(szTemp,lTemp+1)
           replace "EXE" with "ini" in sFile
           hFile=freefile
           errclear
           open gProgPath+sFile for input lock shared as #hFile
           if err then
              stderr "Cannot open "+gProgPath+sFile
              function = %TRUE
              exit function
           end if
           while not eof(hFile)
             line input #hFile,sTemp
             lTemp = instr(sTemp,";")
             if lTemp then
                sTemp = trim$(left$(sTemp,lTemp-1))
             end if
             if len(sTemp) then
                sMatch = ucase$(trim$(parse$(sTemp,"=",1)))
                sData  = trim$(parse$(sTemp,"=",2),any $dq+$spc)
                if left$(sMatch,1) = "P" then
                   lTemp = val(mid$(sMatch,2))
                   if lTemp > 0 and lTemp < =ubound(gFullName) then
                      lPtr = lTemp
                   end if
                end if
                select case sMatch
                  case "NETWAREPRINT"
                    gNetWarePrint = sData
                  case "QUEUEFOLDER"
                    gQueueFolder = sData
                  case "FULLNAME"
                    gFullName(lPtr) = sData
                  case "NETWAREQUEUE"
                    gNetWareQueue(lPtr) = sData
                  case "PORT9100ADDR"
                    gPort9100Addr(lPtr) = sData
                  case "INITPRINTER"
                    gInitPrinter(lPtr) = CharString(sData)
                  case "PITCH10CPI"
                    gPitch10CPI(lPtr) = CharString(sData)
                  case "PITCH12CPI"
                    gPitch12CPI(lPtr) = CharString(sData)
                  case "PITCH15CPI"
                    gPitch15CPI(lPtr) = CharString(sData)
                  case "DEFAULTPITCH"
                    gDefaultPitch(lPtr) = val(sData)
                end select
             end if
           wend
           close #hFile
           if trim$(gQueueFolder)="" then
              stderr "QueueFolder missing."
              function = %TRUE
              exit function
           end if
           if right$(gQueueFolder,1)<>"\" then
              gQueueFolder = gQueueFolder+"\"
           end if
        end if
        function = %FALSE
    end function
    
    
    '------------------------------------------------------------------------------
    '   CharString
    '   -----------
    '   returns char string
    '------------------------------------------------------------------------------
    function CharString(sData as string) as string
        local lTemp as long
        local sTemp as string
        if len(trim$(sData)) then
           for lTemp = 1 to parsecount(sData," ")
               sTemp = sTemp+chr$(val(parse$(sData," ",lTemp)))
           next lTemp
        end if
        function = sTemp
    end function
    
    
    '------------------------------------------------------------------------------
    '   GetCommandArgs
    '   --------------
    '
    '   passed  : command$ with space-delimited arguments,
    '             spaces will remain in double-quoted arguments
    '
    '   returns : function value # of argument elements in array
    '           : filled argument array
    '
    '------------------------------------------------------------------------------
    function GetCommandArgs(sArgs() as string) as long
        local lTemp1 as long
        local lTemp2 as long
        lTemp1 = 1
        while len(command$(lTemp1))
          incr lTemp1
        wend
        decr lTemp1
        if lTemp1 then
           redim sArgs(1 to lTemp1)
           for lTemp2 = 1 to lTemp1
               sArgs(lTemp2) = command$(lTemp2)
           next lTemp2
        end if
        function = lTemp1
    end function
    
    
    '------------------------------------------------------------------------------
    '   Get Windows Version
    '   -------------------
    '
    '   Windows NT    --> 400
    '   Windows 98    --> 410
    '   Windows 2000  --> 500
    '   Windows XP    --> 501
    '   Windows 7     --> 601
    '
    '------------------------------------------------------------------------------
    function GetWinVersion() as string
        local vi as OSVERSIONINFO
        vi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO)
        GetVersionEx vi
        function=format$(vi.dwMajorVersion)+format$(vi.dwMinorVersion,"00")
    end function
    
    
    '------------------------------------------------------------------------------
    '   DetectCharSet
    '   -------------
    '
    '   passed  : Data string
    '
    '   returns : Function value
    '
    '------------------------------------------------------------------------------
    function DetectCharSet(sData as string) as long
        local lOEMTally as long
        local lANSTally as long
        if gANSChars or gOEMChars then  ' Override by option switch
           exit function
        end if
        lOEMTally = tally(sData, any $OEM_CHARS)
        lANSTally = tally(sData, any $ANS_CHARS)
        if lANSTally >= lOEMTally then
           function = %ANS_CHAR
        else
           function = %OEM_CHAR
        end if
    end function
    
    
    '------------------------------------------------------------------------------
    '   ShowHelp
    '   --------
    '
    '   passed  : none
    '
    '   returns : none
    '
    '------------------------------------------------------------------------------
    sub ShowHelp
        local lTemp as long
        stdout ""
        stdout "LPT - Line Printer Tool"
        stdout ""
        stdout "Usage: lpt {options} {file names} {printer_number} eject"
        for lTemp = 1 to ubound(gFullName)
            stdout " -p"+format$(lTemp)+"   : "+gFullName(lTemp);
            if lTemp = gPrinter then stdout " (default)";
            stdout ""
        next lTemp
        stdout " -oem  : OEM character set"
        stdout " -ans  : ANSI character set"
        stdout " -acs  : automatic character set (default)"
        stdout " -10   : 10 cpi spacing";
        if gPrPitch = 10 then stdout " (default)";
        stdout ""
        stdout " -12   : 12 cpi spacing";
        if gPrPitch = 12 then stdout " (default)";
        stdout ""
        stdout " -15   : 15 cpi spacing";
        if gPrPitch = 15 then stdout " (default)";
        stdout ""
        stdout " -nff  : no form feed after print (NFF)"
        stdout " -tcp  : force IP print (Windows XP / NetWare only)"
        stdout " -hq   : hold in queue (Windows XP / NetWare only)"
        stdout " -nv   : non-verbose mode"
        stdout " -h    : display this help text"
        for lTemp = 1 to ubound(gFullName)
            stdout " "+format$(lTemp)+"     : "+gFullName(lTemp);
            if lTemp = gPrinter then stdout " (default)";
            stdout ""
        next lTemp
        stdout " eject : send form feed to printer"
        stdout ""
        stdout "LPT assumes the printer's code page set to 437."
    end sub
    LPT.INI:
    Code:
    ;
    ;   LPT.INI
    ;   -------
    ;
    QueueFolder   = "\\Fs11\db0\TMP\LPT\"
    NetWarePrint  = "nprint.exe"
    ;
    ; Printer_1
    ; ---------
    P1
    FullName      = "OKI MicroLine 3390"
    NetWareQueue  = "ML3390"
    Port9100Addr  = "192.168.1.12"
    InitPrinter   = ""
    Pitch10CPI    = "27 80"
    Pitch12CPI    = "27 77"
    Pitch15CPI    = "27 103
    DefaultPitch  = "10"
    
    ;
    ; Printer_2
    ; ---------
    P2
    FullName      = "TallyGenicom 6312"
    NetWareQueue  = "TALLY"
    Port9100Addr  = "192.168.1.13"
    InitPrinter   = ""
    Pitch10CPI    = "27 91 52 119"
    Pitch12CPI    = "27 91 53 119"
    Pitch15CPI    = "27 91 49 119"
    DefaultPitch  = "12"

    Leave a comment:


  • Albert Richheimer
    started a topic PBCC Line Printer Tool

    Line Printer Tool

    As probably many of the elderly forum members (like myself) have "grown up" in the early computing era, they are accustomed to programming with the help of fanfold listings. I still need paper for getting an overview, and looking for errors. Fanfold paper is the issue...

    For my home use I have written a Line Printer Tool (LPT) giving me an easy command line interface fo two (or more) line printers, taking into account that there are OEM as well as ANSI codes to be printed. For my inhouse use I am working with Windows XP (in virtual systems) as well as Windows 7 and above. The Novell Open Enterprise Server's Print Queue System is working only with Windows XP, for above I need to use the TCP printing feature (port 9100).

    There are printers on each floor, in my office a tiny OKI ML3390, and in the server room there is a TallyGenicom 6312 Line Printer. The default printer is selected upon an environment variable "ETAGE" (German – stands for floor).

    Click image for larger version  Name:	lpt.png Views:	3 Size:	14.2 KB ID:	815404

    Here is the program

    Code:
    '  ---------------------------------------------------------------------------
    '  Source name     : LPT.BAS
    '  Executable name : LPT.EXE
    '  Version         : 1.0
    '  Created date    : 21-Feb-2022
    '  Last update     : 16-Mar-2022
    '  Author          : Albert Richheimer
    '  Description     : Line Printer Tool
    '  ---------------------------------------------------------------------------
    '
    #compile exe
    #dim all
    #include once "WIN32API.INC"
    
    $OEM_CHARS  = "äöü╚═╝┌─┐"
    $ANS_CHARS  = "õ÷³ÚÓÞ"
    %ANS_CHAR   = 0
    %OEM_CHAR   = 1
    
    type DirData
        FileAttributes as dword
        CreationTime   as quad
        LastAccessTime as quad
        LastWriteTime  as quad
        FileSizeHigh   as dword
        FileSizeLow    as dword
        Reserved0      as dword
        Reserved1      as dword
        FileName       as wstringz*260
        ShortName      as wstringz*14
    end type
    
    global gArgTab()       as string
    global gReturn         as long
    global gProgPath       as string
    global gNetWarePrint   as string
    
    global gQueueFolder    as string
    global gFullName()     as string
    global gNetWareQueue() as string
    global gPort9100Addr() as string
    global gInitPrinter()  as string
    global gPitch10CPI()   as string
    global gPitch12CPI()   as string
    global gPitch15CPI()   as string
    global gPropSpace()    as string
    
    '   Option Switches
    '   ---------------
    '
    global gSwNFF          as long
    global gSwVerbose      as long
    global gSwHold         as long
    
    global gSwWindowsXP    as long
    global gSwWindows7     as long
    
    global gPrinter        as long      ' Printer #
    global gPrPitch        as long      ' Print pitch
    global gNWPrint        as long      ' Print via NetWare Queue
    global gCharSet        as long      ' ANSI or OEM
    global gANSChars       as long      ' Option -a: Force ANSI Charset
    global gOEMChars       as long      ' Option -o: Force OEM Charset
    
    
    '
    '   Program Entry Point
    '   -------------------
    '
    function pbmain as long
    
        local lPtr     as long
        local lTemp    as long
        local hFile    as long
        local lArgTab  as long
        local lArgPtr  as long
        local lFiles   as long
        local lFilePtr as long
        local lCharSet as long
        local sTemp    as string
        local sResult  as string
        local sData    as string
        local sOption  as string
        local sArgPath as string
        local szTemp   as asciiz*256
    
        dim   sArgs()  as string
        dim   sFile()  as string
        dim   sSNam()  as string
    
        redim gFullName(1 to 2)
        redim gNetWareQueue(1 to 2)
        redim gPort9100Addr(1 to 2)
        redim gInitPrinter(1 to 2)
        redim gPitch10CPI(1 to 2)
        redim gPitch12CPI(1 to 2)
        redim gPitch15CPI(1 to 2)
    
        redim gArgTab(1 to 20)
        lArgTab = 0
    
        if GetWinVersion() > "501" then
           gSwWindowsXP = %FALSE
           gSwWindows7  = %TRUE
        else
           gSwWindowsXP = %TRUE
           gSwWindows7  = %FALSE
        end if
    
    '   Defaults
    '   --------
    
        if environ$("ETAGE") = "1" then
           gPrinter = 2
        else
           gPrinter = 1
        end if
    
        gPrPitch   = 10
        gNWPrint   = gSwWindowsXP
        gSwVerbose = %TRUE
    
        gSwHold    = %FALSE
    
    b0000:
        if GetIniFile then
           exit function
        end if
    
        if isfolder(gQueueFolder) = %FALSE then
           mkdir gQueueFolder
        end if
    
        if GetCommandArgs(sArgs()) = 0 then
           ShowHelp
           goto closedown
        end if
    
        for lTemp = 1 to ubound(sArgs)
            if left$(sArgs(lTemp),1) = "-" or _
               left$(sArgs(lTemp),1) = "/" then
               sOption = lcase$(mid$(sArgs(lTemp),2))
               if left$(sOption,1)="p" and val(mid$(sOption,2,1)) then
                  gPrinter = val(mid$(sOption,2,1))
                  goto b0200
               end if
               select case sOption
                 case "oem"    ' OEM character Set
                   gOEMChars = %TRUE
                 case "ans"    ' ANSI character Set"
                   gANSChars = %TRUE
                 case "acs"    ' automatic character detection (default)
                   gOEMChars = %FALSE
                   gANSChars = %FALSE
                 case "10"     ' 10 Pitch (default)
                   gPrPitch = 10
                 case "12"     ' 12 Pitch
                   gPrPitch = 12
                 case "15"     ' 15 Pitch
                   gPrPitch = 15
                 case "nff"    ' no form feed after print (NFF)
                   gSwNFF = %TRUE
                 case "tcp"    ' Force TCP print (XP only)
                   gNWPrint = %FALSE
                 case "nv"     ' Non-Verbose
                   gSwVerbose = %FALSE
                 case "hq"     ' Hold in queue
                   gSwHold = %TRUE
                 case "h"      ' display this help text"
                   ShowHelp
                   goto closedown
                 case else
                   stderr "Illegal option: "+sArgs(lTemp)
                   goto closedown
               end select
            else
               if val(sArgs(lTemp))>=1 and _
                  val(sArgs(lTemp))<=ubound(gFullName) then
                  gPrinter = val(sArgs(lTemp))
                  goto b0200
               end if
               incr lArgTab
               if lArgTab > ubound(gArgTab) then
                  redim gArgTab(1 to lArgTab+10)
               end if
               gArgTab(lArgTab) = sArgs(lTemp)
            end if
    b0200:
        next lTemp
        if gPrinter > ubound(gFullName) then
           stderr "Illegal printer number."
           function = %TRUE
           goto closedown
        end if
        for lArgPtr = 1 to lArgTab
            if lcase$(gArgTab(lArgPtr)) = "eject" then      ' handle eject
               GetTempFileName(bycopy gQueueFolder,"LPT",0,szTemp)
               hFile = freefile
               open szTemp for output as #hFile
               print #hFile,$FF;
               close #hFile
               select case gNWPrint
                 case %TRUE
                   sResult = NetWarePrint(bycopy szTemp)
                 case %FALSE
                   sResult = SendData(bycopy szTemp)
                   stdout format$(len(sResult))
                   if len(sResult) then
                      stderr sResult
                      goto b0270
                   end if
               end select
               if gSwVerbose then
                  stdout "Formfeed sent to "+gFullName(gPrinter)
               end if
            b0270:
               kill szTemp
            goto b0290
            end if
    
            lFiles = GetFiles(gArgTab(lArgPtr),sFile(),sSNam())
            if lFiles = 0 then
               stderr "Cannot find files: "+gArgTab(lArgPtr)+"."
               goto b0290
            end if
            sArgPath = pathname$(path,gArgTab(lArgPtr))
            for lFilePtr = 1 to lFiles
                hFile = freefile
                open sArgPath+sFile(lFilePtr) for binary lock shared as #hFile
                if err then
                   stderr "Cannot open file "+sArgPath+sFile(lFilePtr)
                   goto b0280
                end if
                get$ #hFile,lof(#hFile),sData
                close #hFile
                if gOEMChars = %FALSE and gANSChars = %FALSE then
                   lCharSet = DetectCharSet(sData)
                else
                   lCharSet = iif(gANSChars,%ANS_CHAR,%OEM_CHAR)
                end if
                if lCharSet = %ANS_CHAR then
                   sData = ChrToOem$(sData)
                end if
               szTemp = gQueueFolder+sSNam(lFilePtr)
               hFile = freefile
               open szTemp for output as #hFile
               print #hFile,gInitPrinter(gPrinter);
               select case gPrPitch
                 case 10
                   print #hFile,gPitch10CPI(gPrinter);
                 case 12
                   print #hFile,gPitch12CPI(gPrinter);
                 case 15
                   print #hFile,gPitch15CPI(gPrinter);
               end select
               print #hFile,sData;
               if gSwNFF = %FALSE then
                  print #hFile,$FF;
               end if
               close #hFile
               select case gNWPrint
                 case %TRUE
                   sResult = NetWarePrint(bycopy szTemp)
                 case %FALSE
                   sResult = SendData(bycopy szTemp)
                   if len(sResult) then
                      stderr sResult
                      goto b0280
                   end if
               end select
               if gSwVerbose then
                  stdout "File "+$dq+sFile(lFilePtr)+$dq+" sent to "+ _
                         gFullName(gPrinter)
               end if
               kill szTemp
    
        b0280:
            next lFilePtr
    b0290:
        next lArgPtr
    
    closedown:
        function=gReturn
    
    end function
    
    
    '------------------------------------------------------------------------------
    '   NetwarePrint
    '   ------------
    '
    '   passed  : Path\Filename to be queued
    '
    '   returns : none
    '
    '------------------------------------------------------------------------------
    function NetWarePrint(sFile as string) as string
        local sOptions as string
        if pathscan$(full,gNetWarePrint)="" then
           function = "NetWare Print Utility not specified."
           exit function
        end if
        sOptions = " /nt /nb /nff /q="+gNetWareQueue(gPrinter)
        if gSwHold then
           sOptions = sOptions + " /hold"
        end if
        shell gNetWarePrint+" "+sFile+sOptions+">nul",0
        function = ""
    end function
    
    
    '------------------------------------------------------------------------------
    '   Send Data
    '   ---------
    '
    '   passed  : Path\Filename to be sent
    '
    '   returns : error message if failing
    '
    '------------------------------------------------------------------------------
    function SendData(sFile as string) as string
        local hSocket  as long
        local hFile    as long
        local lResult  as long
        local sData    as string
        hFile = freefile
        open sFile for binary lock shared as #hFile
        lResult = err
        if lResult then
           function = "Cannot open file "+sFile+$crlf+ _
                      "Error "+format$(lResult)+": "+error$(lResult)
           exit function
        end if
        get$ #hFile,lof(#hFile),sData
        close #hFile
        hSocket = freefile
        tcp open port 9100 at gPort9100Addr(gPrinter) as hSocket timeout 1000
        lResult = err
        if lResult then
           function = "Cannot open port "+gPort9100Addr(gPrinter)+$crlf+ _
                      "Error "+format$(lResult)+": "+error$(lResult)
           tcp close hSocket
           exit function
        end if
        tcp send #hSocket,sData
        lResult = err
        if lResult then
           function = "Cannot send data to port "+gPort9100Addr(gPrinter)+$crlf+ _
                      "Error "+format$(lResult)+": "+error$(lResult)
           tcp close hSocket
           exit function
        end if
        tcp close #hSocket
        function = ""
    end function
    
    
    '------------------------------------------------------------------------------
    '   GetFiles
    '   --------
    '
    '   passed  : sMask containing file name, wildcard optional
    '
    '   returns : function value # of files found
    '           : sFile array containing long file name(s)
    '           : sSNam array containing short file name(s)
    '
    '------------------------------------------------------------------------------
    function GetFiles(sMask as string,sFile() as string,sSNam() as string) as long
        local sTemp   as string
        local lTemp   as long
        local uDir    as DirData
        redim sFile(1 to  10)
        redim sSNam(1 to  10)
        sTemp = dir$(sMask,to uDir)
        while len(sTemp)
          incr lTemp
          if lTemp > ubound(sFile) then
             redim preserve sFile(1 to lTemp+10)
             redim preserve sSNam(1 to lTemp+10)
          end if
          sFile(lTemp) = uDir.FileName
          sSNam(lTemp) = uDir.ShortName
          if sSNam(lTemp) = "" then
             sSNam(lTemp) = uDir.FileName
          end if
          sTemp = dir$(next to uDir)
        wend
        if lTemp then
           redim preserve sFile(1 to lTemp)
           redim preserve sSNam(1 to lTemp)
        end if
        function = lTemp
    end function
    
    
    '------------------------------------------------------------------------------
    '   GetIniFile
    '   ----------
    '------------------------------------------------------------------------------
    function GetIniFile as long
        local szTemp      as asciiz*%MAX_PATH
        local hFile       as long
        local lTemp       as long
        local lPtr        as long
        local sTemp       as string
        local sFile       as string
        local sPath       as string
        local sMatch      as string
        local sData       as string
    
        lPtr = 1
    
        GetModuleFileName %NULL, byval varptr(szTemp), byval %MAX_PATH
        lTemp=instr(-1,szTemp,"\")
        if lTemp then
           sTemp=left$(szTemp,lTemp)
           gProgPath=sTemp
           sFile=mid$(szTemp,lTemp+1)
           replace "EXE" with "ini" in sFile
           hFile=freefile
           errclear
           open gProgPath+sFile for input lock shared as #hFile
           if err then
              stderr "Cannot open "+gProgPath+sFile
              function = %TRUE
              exit function
           end if
           while not eof(hFile)
             line input #hFile,sTemp
             lTemp = instr(sTemp,";")
             if lTemp then
                sTemp = trim$(left$(sTemp,lTemp-1))
             end if
             if len(sTemp) then
                sMatch = ucase$(trim$(parse$(sTemp,"=",1)))
                sData  = trim$(parse$(sTemp,"=",2),any $dq+$spc)
                if left$(sMatch,1) = "P" then
                   lTemp = val(mid$(sMatch,2))
                   if lTemp > 0 and lTemp < =ubound(gFullName) then
                      lPtr = lTemp
                   end if
                end if
                select case sMatch
                  case "NETWAREPRINT"
                    gNetWarePrint = sData
                  case "QUEUEFOLDER"
                    gQueueFolder = sData
                  case "FULLNAME"
                    gFullName(lPtr) = sData
                  case "NETWAREQUEUE"
                    gNetWareQueue(lPtr) = sData
                  case "PORT9100ADDR"
                    gPort9100Addr(lPtr) = sData
                  case "INITPRINTER"
                    gInitPrinter(lPtr) = CharString(sData)
                  case "PITCH10CPI"
                    gPitch10CPI(lPtr) = CharString(sData)
                  case "PITCH12CPI"
                    gPitch12CPI(lPtr) = CharString(sData)
                  case "PITCH15CPI"
                    gPitch15CPI(lPtr) = CharString(sData)
                end select
             end if
           wend
           close #hFile
           if trim$(gQueueFolder)="" then
              stderr "QueueFolder missing."
              function = %TRUE
              exit function
           end if
           if right$(gQueueFolder,1)<>"\" then
              gQueueFolder = gQueueFolder+"\"
           end if
        end if
        function = %FALSE
    end function
    
    
    '------------------------------------------------------------------------------
    '   CharString
    '   -----------
    '   returns char string
    '------------------------------------------------------------------------------
    function CharString(sData as string) as string
        local lTemp as long
        local sTemp as string
        if len(trim$(sData)) then
           for lTemp = 1 to parsecount(sData," ")
               sTemp = sTemp+chr$(val(parse$(sData," ",lTemp)))
           next lTemp
        end if
        function = sTemp
    end function
    
    
    '------------------------------------------------------------------------------
    '   GetCommandArgs
    '   --------------
    '
    '   passed  : command$ with space-delimited arguments,
    '             spaces will remain in double-quoted arguments
    '
    '   returns : function value # of argument elements in array
    '           : filled argument array
    '
    '------------------------------------------------------------------------------
    function GetCommandArgs(sArgs() as string) as long
        local lTemp1 as long
        local lTemp2 as long
        lTemp1 = 1
        while len(command$(lTemp1))
          incr lTemp1
        wend
        decr lTemp1
        if lTemp1 then
           redim sArgs(1 to lTemp1)
           for lTemp2 = 1 to lTemp1
               sArgs(lTemp2) = command$(lTemp2)
           next lTemp2
        end if
        function = lTemp1
    end function
    
    
    '------------------------------------------------------------------------------
    '   Get Windows Version
    '   -------------------
    '
    '   Windows NT    --> 400
    '   Windows 98    --> 410
    '   Windows 2000  --> 500
    '   Windows XP    --> 501
    '   Windows 7     --> 601
    '
    '------------------------------------------------------------------------------
    function GetWinVersion() as string
        local vi as OSVERSIONINFO
        vi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO)
        GetVersionEx vi
        function=format$(vi.dwMajorVersion)+format$(vi.dwMinorVersion,"00")
    end function
    
    
    '------------------------------------------------------------------------------
    '   DetectCharSet
    '   -------------
    '
    '   passed  : Data string
    '
    '   returns : Function value
    '
    '------------------------------------------------------------------------------
    function DetectCharSet(sData as string) as long
        local lOEMTally as long
        local lANSTally as long
        if gANSChars or gOEMChars then  ' Override by option switch
           exit function
        end if
        lOEMTally = tally(sData, any $OEM_CHARS)
        lANSTally = tally(sData, any $ANS_CHARS)
        if lANSTally >= lOEMTally then
           function = %ANS_CHAR
        else
           function = %OEM_CHAR
        end if
    end function
    
    
    '------------------------------------------------------------------------------
    '   ShowHelp
    '   --------
    '
    '   passed  : none
    '
    '   returns : none
    '
    '------------------------------------------------------------------------------
    sub ShowHelp
        local lTemp as long
        stdout ""
        stdout "LPT - Line Printer Tool"
        stdout ""
        stdout "Usage: lpt {options} {file names} {printer_number} eject"
        for lTemp = 1 to ubound(gFullName)
            stdout " -p"+format$(lTemp)+"   : "+gFullName(lTemp);
            if lTemp = gPrinter then stdout " (default)";
            stdout ""
        next lTemp
        stdout " -oem  : OEM character set"
        stdout " -ans  : ANSI character set"
        stdout " -acs  : automatic character set (default)"
        stdout " -10   : 10 cpi spacing (default)"
        stdout " -12   : 12 cpi spacing"
        stdout " -15   : 15 cpi spacing"
        stdout " -nff  : no form feed after print (NFF)"
        stdout " -tcp  : force IP print (Windows XP / NetWare only)"
        stdout " -hq   : hold in queue (Windows XP / NetWare only)"
        stdout " -nv   : non-verbose mode"
        stdout " -h    : display this help text"
        for lTemp = 1 to ubound(gFullName)
            stdout " "+format$(lTemp)+"     : "+gFullName(lTemp);
            if lTemp = gPrinter then stdout " (default)";
            stdout ""
        next lTemp
        stdout " eject : send form feed to printer"
        stdout ""
        stdout "LPT assumes the printer's code page set to 437."
    end sub
    And here is the ini-file "LPT.INI" (should be in the same folder as the executable, preferably in the search path):

    Code:
    ;
    ;   LPT.INI
    ;   -------
    ;
    QueueFolder   = "\\Fs11\db0\TMP\LPT\"
    NetWarePrint  = "nprint.exe"
    ;
    ; Printer_1
    ; ---------
    P1
    FullName      = "OKI MicroLine 3390"
    NetWareQueue  = "ML3390"
    Port9100Addr  = "192.168.1.12"
    InitPrinter   = ""
    Pitch10CPI    = "27 80"
    Pitch12CPI    = "27 77"
    Pitch15CPI    = "27 103
    
    ;
    ; Printer_2
    ; ---------
    P2
    FullName      = "TallyGenicom 6312"
    NetWareQueue  = "TALLY"
    Port9100Addr  = "192.168.1.13"
    InitPrinter   = ""
    Pitch10CPI    = "27 91 52 119"
    Pitch12CPI    = "27 91 53 119"
    Pitch15CPI    = "27 91 49 119"
    Discussions are here.

    Cheers,
    Albert
    You may only view thumbnails in this gallery. This gallery has 1 photos.
Working...
X