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

  • PBCC 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.
    „Let the machine do the dirty work.“
    The Elements of Programming Style, Brian W. Kernighan, P. J. Plauger 1978

  • #2
    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"
    „Let the machine do the dirty work.“
    The Elements of Programming Style, Brian W. Kernighan, P. J. Plauger 1978

    Comment


    • #3
      Here is a more recent version, automatic word wrap and minor improvements included. See discussion thread for more details.
      Code:
      '  ---------------------------------------------------------------------------
      '  Source name     : LPT.BAS
      '  Executable name : LPT.EXE
      '  Version         : 1.2
      '  Created date    : 21-Feb-2022
      '  Last update     : 19-May-2023
      '  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 gPaperWidth()   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 gPaWidth        as long      ' Paper Width
      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 gPaperWidth(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
      '   --------
      
          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 b0100
                 end if
                 if left$(sOption,1)="w" and val(mid$(sOption,2)) then
                    gPaWidth = val(mid$(sOption,2))
                    goto b0100
                 end if
              end if
      b0100:
          next lTemp
      
          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
                    goto b0200
                 end if
                 if left$(sOption,1)="w" and val(mid$(sOption,2)) then
                    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
                    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 = 0 then
             if environ$("ETAGE") = "1" then
                gPrinter = 2
             else
                gPrinter = 1
             end if
          end if
      
          if gPrinter < lbound(gFullName) or gPrinter > ubound(gFullName) then
             stderr "Illegal printer number."
             function = %TRUE
             goto closedown
          end if
      
          if gPrPitch = 0 then
             gPrPitch = gDefaultPitch(gPrinter)
          end if
      
          if gPaWidth = 0 then
             gPaWidth = gPaperWidth(gPrinter)
          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
                  sData = LineWrap(sData,gPrPitch,gPaWidth)
                  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)
                    case "PAPERWIDTH"
                      gPaperWidth(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
      
      
      '------------------------------------------------------------------------------
      '   LineWrap
      '   --------
      '
      '   passed  : Data string
      '             Pitch (10, 12 or 15)
      '             Paper Width in inch
      '
      '   returns : wrapped lines according to lPitch and lWidth
      '
      '------------------------------------------------------------------------------
      function LineWrap(sData as string,lPitch as long,lWidth as long) as string
          local lMLen as long
          local lLine as long
          local lTemp as long
          local sTemp as string
          if len(sData) then
             lMLen = lPitch*lWidth
             lLine = parsecount(sData,$crlf)
             dim sVect(1 to lLine) as string
             parse sData,sVect(),$crlf
             for lTemp = 1 to lLine
                 sVect(lTemp) = SplitLine(sVect(lTemp),lMLen)
             next lTemp
             function = join$(sVect(),$crlf)
          end if
      end function
      
      
      '------------------------------------------------------------------------------
      '   SplitLine
      '   ---------
      '
      '   passed  : Data string sData
      '             Line length lLine
      '
      '   returns : splitted lines ($crlf) max. len. to lLine
      '
      '------------------------------------------------------------------------------
      function SplitLine(sData as string,lLine as long) as string
          local lOrig as long
          local lTemp as long
          local sOrig as string
          local sDest as string
          sOrig = sData
          sDest = ""
          lOrig = len(sOrig)
          while lOrig
            if len(sOrig)>lLine then
               for lTemp = lLine to 1 step -1
                   if instr($spc+$tab,mid$(sOrig,lTemp,1)) then
                      sDest = sDest+rtrim$(left$(sOrig,lTemp-1))+$crlf
                      sOrig = ltrim$(mid$(sOrig,lTemp))
                      goto b0100
                   end if
               next lTemp
               sDest = sDest+left$(sOrig,lLine)+$crlf
               sOrig = mid$(sOrig,lLine)
            else
               sDest = sDest+sOrig
               sOrig = ""
            end if
      b0100:
            lOrig = len(sOrig)
          wend
          function = rtrim$(sDest,$crlf)
      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"
          stdout " -tcp  : force IP print (Windows XP / NetWare only)"
          stdout " -hq   : hold in queue (Windows XP / NetWare only)"
          stdout " -nv   : non-verbose mode"
          stdout " -w{n} : paper width n, e.g. -w12 for 12"+$dq
          stdout " -h    : display this help text"
          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"
      DefaultPitch  = "10"
      PaperWidth    = "8"
      
      ;
      ; 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  = "10"
      PaperWidth    = "8"​
      „Let the machine do the dirty work.“
      The Elements of Programming Style, Brian W. Kernighan, P. J. Plauger 1978

      Comment

      Working...
      X