Kick Open Cash Drawer On USB Till Receipt Printer in VB6
Here's how to open a cash drawer programatically using VB6 driving a USB printer directly by sending raw data to the USB printer using Windows API functions. This method works with USB versions of receipt printers such as a Star TSP100 / Termal TSP143. It will also work with an Epson such as a TM88 / TM-T88III and other USB receipt printers provided you specify the right codes.
I've been successful opening cash drawers connected to COM: ports or LPT: ports but had come up against a brick wall trying to get it working with USB printer. I was previously using code such as this:
Open "LPT1:" For Binary Access Write As #fn For i = 0 To UBound(sCodes) sOut = sOut & Chr$(Val(sCodes(i))) Next Put #fn, , sOut Close #fn
...but discovered that you can't write to virtual printer ports in VB6, such as "USB001:". You just get "Run-Time error '52': Bad file name or number."
The way to get this working is to send your cash drawer codes direct to the print spooler, bypassing the printer driver. I've hacked about with examples from the Microsoft site and other places to get this to work.
Declare this lot at the top of your Form, or Module:
Private Declare Function ClosePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Function EndDocPrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Function EndPagePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _ (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" _ (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As DOCINFO) As Long Private Declare Function StartPagePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Function WritePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, _ pcWritten As Long) As Long Private Type DOCINFO pDocName As String pOutputFile As String pDatatype As String End Type
Here's the actual function that opens the cash drawer:
Public Sub openTillDrawerUsb(ByVal sUsbPrinterName As String, _ ByVal sOpenCodes As String) Dim lPrinterHandle As Long Dim lpcWritten As Long Dim lRet As Long Dim sWriteData As String Dim MyDocInfo As DOCINFO Dim sCodeArray() As String Dim i As Integer On Error GoTo errError1 If OpenPrinter(sUsbPrinterName, lPrinterHandle, 0) = 0 Then Err.Raise 1, , "USB Printer Name specified [" & sUsbPrinterName & _ "] " & "when trying to open the till drawer wasn't valid" End If On Error GoTo errError2 With MyDocInfo .pDocName = "DRAWERKICK" .pOutputFile = vbNullString .pDatatype = vbNullString End With lRet = StartDocPrinter(lPrinterHandle, 1, MyDocInfo) Call StartPagePrinter(lPrinterHandle) ' Split cash drawer code list into array sCodeArray = Split(sOpenCodes, ",") ' Convert array into actual characters to send to printer For i = 0 To UBound(sCodeArray) sWriteData = sWriteData & Chr$(Val(sCodeArray(i))) Next lRet = WritePrinter(lPrinterHandle, ByVal sWriteData, _ Len(sWriteData), lpcWritten) lRet = EndPagePrinter(lPrinterHandle) lRet = EndDocPrinter(lPrinterHandle) lRet = ClosePrinter(lPrinterHandle) On Error GoTo errError1 Exit Sub errError2: lRet = ClosePrinter(lPrinterHandle) errError1: Err.Raise Err.number, , Err.description End Sub
And here's how to call the function to open the till drawer connected to a USB Star TSP100 connected as the default printer.
Dim sPrinter as string Dim sCodes as string ' Replace the name of your printer here if you are not ' using the default printer sPrinter = Printer.DeviceName ' This is for Star TSP100 receipt printer. Replace here ' with a comma separated list of the codes required for ' your receipt printer sCodes = "7" Call openTillDrawerUsb(sPrinter , sCodes)
Specify your own printer name and cash drawer kick codes as stated above. Hopefully that should point you in the right direction!