here's the code:
;***************************************************************************
; BarrelGen
;
; Date Created 3/7/2007
; Programmer Michael Dever
;
; Description: BarrelGen
;
;***************************************************************************
; Changes - Please change version number
;
; Version Made by Date Description
;
; 1.00.00 Michael Dever
;
vBarrelGenVersion = '1.00.00'
;***************************************************************************
;
; ODBC Extender
;
;***************************************************************************
;Extenders
AddExtender("wwodb44i.dll") ; ODBC Capability
AddExtender("WWPST44I.DLL") ; SMTP Capability
;AddExtender("WWINT44i.DLL") ; FTP Capability
;User Defined Functions
; Create UDF Create PAS File ******************************************************************
#DefineFunction CreatePASFile(vJob_Name, vFormat_Var, vDuplicates_Var, vQuantity_Var, vPrinter_Number_Var, PASVar)
; Requires an Array be created with 2 dimensions, the first is name of Loftware Field
; the second is Loftware Field Variable
; Requires the following Parameters: vJob_Name, vFormat (Label Name), vDuplicates, vPrinter_Number, PASVar (Array)
;Set Variables
vLoftwarePSFolder = '\\smwecolapps4\wddrop\'
ArrayNumElements = Arrinfo(PasVar,6)
vTempPASFolder = 'c:\Program Files\LabelGen\'
vUnique = StrReplace(TimeYmdHms ( ),':','') ;Suffix to File Name to make Unique
;Create PAS File in temp directory - Still needs to be moved to Loftware Print Server folder
vPASFileName = FileOpen("%vTempPASFolder%%vJob_Name%-%vUnique%.PAS","WRITE")
FileWrite(vPASFileName, '*Format, %vFormat_Var%')
FileWrite(vPASFileName, '*JobName, %vJob_Name%')
FileWrite(vPASFileName, '*Duplicates, %vDuplicates_Var%')
FileWrite(vPASFileName, '*Quantity, %vQuantity_Var%')
FileWrite(vPASFileName, '*PrinterNumber, %vPrinter_Number_Var%')
y = (ArrayNumElements/2) - 1
i = 0
For i = 0 to y
FileWrite(vPASFileName, StrCat(PasVar[i,0],',',PasVar[i,1]))
Next
FileWrite(vPASFileName, '*PRINTLABEL')
FileClose(vPASFileName)
FileMove("%vTempPASFolder%%vJob_Name%-%vUnique%.PAS","%vLoftwarePSFolder%%vJob_Name%-%vUnique%.PAS",@False)
Return @True
#EndFunction
;End of UDF Create***********************************************************************************
;Set Label Variables
vLabel = 'BarrelTracking.lwl'
;End Set Variables***********************************************************************************
;UDF Lookup/Change Label File
;#DefineFunction ChangeLabel()
:ChangeLabel
vLabelAllFiles = FileItemize("\\SMWECOLAPPS4\BarrelTracking\*.*")
vLabel = AskItemList("Loftware Labels - Choose PM4i for newer printers", vLabelAllFiles, @TAB, @sorted, @single)
Message('Label Changed to:',vLabel)
Drop(vLabelAllFiles, vLabelFile)
;Return
;#EndFunction
;End of UDF Lookup/Change Label File
;End UDF*********************************************************************************************
;Set Variables***************************************************************************************
vTodayDate_a = StrSub (TimeDate(), 5, 15)
vLen = StrScan(vTodayDate_a, " ", 1, @FWDSCAN)
vTodayDate = StrSub (vTodayDate_a, 1, vLen)
;Open Program Log File
; Set Default Directory to current directory
DirChange (DirGet ( ))
BarrelGenLogHndl = FileOpen ('BarrelGenLog.txt', 'WRITE')
FileWrite(BarrelGenLogHndl, 'BarrelGen Log')
;Set ODBC Environment*******************************************************************************
henv = qAllocEnv()
If henv == -1
retcode = qLastCode()
vErrorMessage = 'qAllocEnv failed - '
GoSub ErrorControl
Endif
hdbc = qAllocConnect(henv)
If hdbc == -1
retcode = qLastCode()
vErrorMessage = "qAllocConnect failed - "
GoSub ErrorControl
Endif
retcode = qDriverCon(hdbc,"Driver={SQL Server};Server=SMWECOLAPPS1\SQL2005;Database=LabelGen;UID=Label_Gen;PWD=Label_Gen_123",0)
If (retcode != @qSuccess) && (retcode != @qSuccessInfo)
vErrorMessage = "qDriverCon failed - "
GoSub ErrorControl
Endif
;End ODBC Environment*******************************************************************************
;***************************************************************************************************
;********************************
;********************************
; Capture Variables from Database
; Discover the workstation's env var "COMPUTERNAME"
; This program can be run from a local workstation or from the MetaFrame Server
; The Metaframe server captures the local workstation's env var "COMPUTERNAME" and stores it as env var "CLIENTNAME"
; The Variable "vComputer_Name" is used to query the data base to discover the default printers and bonded warehouse
IF Environment ('COMPUTERNAME') != ''
vComputer_Name = Environment ('COMPUTERNAME')
Else
vComputer_Name = Environment ('CLIENTNAME')
Endif
;Set Default Lot Number
vLot_Number = StrCat( StrSub (TimeYmdHms( ), 1, 4), StrSub(TimeYmdHms( ), 6,2), StrSub(TimeYmdHms( ), 9, 2) )
;set Default Print Quantity
vLabel_Quantity = 1
;********************************
;Call database to set default printer variables and set default bonded warehouse
;Prepare to send statement
hstmt = qAllocStmt(hdbc)
If hstmt == -1
retcode = qLastCode()
vErrorMessage = "qAllocStmt failed - "
GoSub ErrorControl
Endif
;Send Statement to get printer info
;Required to break up select statement due to 256 character limit in WinBatch
vSelect1 = "SELECT Workstation_Description, Bonded_Warehouse_Code, Default_Bott_Line, Default_Printer_4, PRT4_Desc from vWorkstation where Workstation_ID = '%vComputer_Name%' "
; vSelect2 = "Default_Printer_4, PRT1_Desc, PRT2_Desc, PRT3_Desc from vWorkstation where Workstation_ID = '%vComputer_Name%'"
retcode = qExecDirect(hstmt, vSelect1)
If (retcode != @qSuccess) && (retcode != @qSuccessInfo)
vErrorMessage = "qExecDirect failed - Select Statement to WorkStation Table"
GoSub ErrorControl
Endif
;In general, Printers 1-3 are for Bottling Line Printers, Printer 4 is assigned for Label Printers on the Desk or Cabinets i.e. Intermec Printers.
;Assign data to variables
While @TRUE
retcode = qFetch(hstmt)
If retcode == @qNoData Then Break
If (retcode != @qSuccess) && (retcode != @qSuccessInfo)
vErrorMessage = "qFetch failed - "
GoSub ErrorControl
Endif
retcode = qGetData(hstmt, 1, "vWorkstation_Description", 80)
retcode = qGetData(hstmt, 2, "vBonded_Warehouse_Code", 80)
retcode = qGetData(hstmt, 3, "vDefault_Bott_Line", 80)
retcode = qGetData(hstmt, 4, "vDefault_Printer_4", 80)
retcode = qGetData(hstmt, 5, "vPRT4_Desc", 80)
EndWhile
;Frees hstmt handle but leaves open for future use.
;qFreeStmt(hstmt, 'SQL_CLOSE')
;End setting printer variables
;********************************
; End Capture Variables from Database
;********************************
;********************************
;************************************************************************************************
;************************************************************************************************
;********************************
;********************************
;Menu for 5 label printing senerios and exit
:BarrelGenMainMenu
vBarrelGroupNum = 'CR03E'
;*************************************************************************************
vBarrelGroupNumMenuFormat=`WWWDLGED,6.1`
vBarrelGroupNumMenuCaption=`Barrel Group Number Query`
vBarrelGroupNumMenuX=134
vBarrelGroupNumMenuY=105
vBarrelGroupNumMenuWidth=168
vBarrelGroupNumMenuHeight=145
vBarrelGroupNumMenuNumControls=004
vBarrelGroupNumMenuProcedure=`DEFAULT`
vBarrelGroupNumMenuFont=`DEFAULT`
vBarrelGroupNumMenuTextColor=`DEFAULT`
vBarrelGroupNumMenuBackground=`DEFAULT,DEFAULT`
vBarrelGroupNumMenuConfig=0
vBarrelGroupNumMenu001=`031,093,036,012,PUSHBUTTON,DEFAULT,"OK",1,2,32,DEFAULT,DEFAULT,DEFAULT`
vBarrelGroupNumMenu002=`079,093,036,012,PUSHBUTTON,DEFAULT,"Cancel",0,3,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelGroupNumMenu003=`047,065,054,012,EDITBOX,vBarrelGroupNum,DEFAULT,DEFAULT,1,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelGroupNumMenu004=`021,017,112,034,STATICTEXT,DEFAULT,"Enter the Barrel Group Number",DEFAULT,1,512,"Microsoft Sans Serif|10752|70|34","0|0|0",DEFAULT`
ButtonPushed=Dialog("vBarrelGroupNumMenu")
;Process the menu selection
;Pad the BarrelGroupNum with 0's
vBarrelGroupNumber = STRCAT( StrFix (vBarrelGroupNum, '0', 9) , '1')
Select ButtonPushed
case 1
Goto BarrelNumberValidation
case 0
Exit
EndSelect
;End LabelGenMailMenu
;
;********************************
;********************************
;************************************************************************************************
;************************************************************************************************
;********************************
;********************************
qFreeStmt(hstmt, 1)
:BarrelNumberValidation
;********************************
; Clear all variables of pre-existing values
vBegin_Barrel_Num = ''
vEnd_Barrel_Num = ''
vWood_Type = ''
vBarrel_Capacity = ''
vPurchase_Year = ''
vOak_Source = ''
vInsert_Type = ''
vStart_Barrel_Number = ''
vNumber_of_Barrels = ''
;********************************
;Call Database for list of attributes
hstmt = qAllocStmt(hdbc)
If hstmt == -1
retcode = qLastCode()
vErrorMessage = "qAllocStmt failed"
GoSub ErrorControl
Endif
vSelect1 = "SELECT Begin_Barrel_Num, End_Barrel_Num, Wood_Type, Barrel_Capacity, Purchase_Year, Oak_Source, Insert_Type,"
vSelect2 = " Number_of_Barrels FROM CREBARRELS Where Begin_Barrel_Num = '%vBarrelGroupNumber%'"
retcode = qExecDirect(hstmt, STRCAT(vSelect1, vSelect2))
If (retcode != @qSuccess) && (retcode != @qSuccessInfo)
vErrorMessage = "qExecDirect failed - Barrel List"
GoSub ErrorControl
Endif
While @TRUE
retcode = qFetch(hstmt)
If retcode == @qNoData Then Break
If (retcode != @qSuccess) && (retcode != @qSuccessInfo)
vErrorMessage = "qFetch failed"
GoSub ErrorControl
Endif "qFetch failed"
vListBarrels = ''
;Assign data to variables
retcode = qGetData(hstmt, 1, "vBegin_Barrel_Num", 80)
retcode = qGetData(hstmt, 2, "vEnd_Barrel_Num", 80)
retcode = qGetData(hstmt, 3, "vWood_Type", 80)
retcode = qGetData(hstmt, 4, "vBarrel_Capacity", 80)
retcode = qGetData(hstmt, 5, "vPurchase_Year", 80)
retcode = qGetData(hstmt, 6, "vOak_Source", 80)
retcode = qGetData(hstmt, 7, "vInsert_Type", 80)
retcode = qGetData(hstmt, 8, "vNumber_of_Barrels", 80)
EndWhile
;Frees hstmt handle but leaves open for future use.
qFreeStmt(hstmt, 0)
;*********************************************************************************
;*******************************************
;*******************************************
;Screen to Validate Barrel information to print on label
vBarrelInfoValidateFormat=`WWWDLGED,6.1`
vBarrelInfoValidateCaption=`Barrel Information Validation`
vBarrelInfoValidateX=128
vBarrelInfoValidateY=104
vBarrelInfoValidateWidth=268
vBarrelInfoValidateHeight=207
vBarrelInfoValidateNumControls=022
vBarrelInfoValidateProcedure=`DEFAULT`
vBarrelInfoValidateFont=`DEFAULT`
vBarrelInfoValidateTextColor=`DEFAULT`
vBarrelInfoValidateBackground=`DEFAULT,DEFAULT`
vBarrelInfoValidateConfig=0
vBarrelInfoValidate001=`063,181,036,012,PUSHBUTTON,DEFAULT,"Print Labels",1,1,32,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate002=`157,181,036,012,PUSHBUTTON,DEFAULT,"Exit",0,2,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate003=`009,015,234,016,STATICTEXT,DEFAULT,"Barrel Information",DEFAULT,1,512,"Microsoft Sans Serif|12288|70|34","0|0|0",DEFAULT`
vBarrelInfoValidate004=`011,041,058,012,STATICTEXT,DEFAULT,"Begining Barrel Number",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate005=`011,061,058,012,STATICTEXT,DEFAULT,"Ending Barrel Number",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate006=`011,083,058,012,STATICTEXT,DEFAULT,"Wood Type Code",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate007=`011,103,058,012,STATICTEXT,DEFAULT,"Barrel Capacity",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate008=`011,123,058,012,STATICTEXT,DEFAULT,"Purchase Year",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate009=`011,159,058,012,STATICTEXT,DEFAULT,"Insert Type",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate010=`011,141,058,012,STATICTEXT,DEFAULT,"Oark Source",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate011=`151,097,062,012,STATICTEXT,DEFAULT,"Number of Labels to Print",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate012=`217,097,036,012,EDITBOX,vNumberOfLabels,"2",DEFAULT,20,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate013=`107,181,040,012,PUSHBUTTON,DEFAULT,"Choose Again",2,1,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate014=`077,083,064,012,EDITBOX,vWood_Type,"vWood_Type",DEFAULT,23,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate015=`077,041,064,012,EDITBOX,vBegin_Barrel_Num,"vBegin_Barrel_Num",DEFAULT,22,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate016=`079,061,062,012,VARYTEXT,vEnd_Barrel_Num,DEFAULT,DEFAULT,19,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate017=`079,103,062,012,VARYTEXT,vBarrel_Capacity,DEFAULT,DEFAULT,19,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate018=`079,123,062,012,VARYTEXT,vPurchase_Year,DEFAULT,DEFAULT,19,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate019=`079,141,062,012,VARYTEXT,vOak_Source,DEFAULT,DEFAULT,19,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate020=`079,159,062,012,VARYTEXT,vInsert_Type,DEFAULT,DEFAULT,19,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate021=`151,077,062,012,STATICTEXT,DEFAULT,"Starting Barrel Number",DEFAULT,5,0,DEFAULT,DEFAULT,DEFAULT`
vBarrelInfoValidate022=`217,077,036,012,EDITBOX,vStarting_Barrel_Number,"1",DEFAULT,20,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
ButtonPushed=Dialog("vBarrelInfoValidate")
Select ButtonPushed
case 2
GoSub BarrelGenMainMenu
break
case 1
GoSub PrintLabels
break
case 0
Exit
EndSelect
:PrintLabels
;Print PASVar Array
PasVar = ArrDimension(3,2)
PasVar[0,0] = 'Barrel_Number_1'
PasVar[0,1] = STRSUB(vBarrelGroupNumber,1,6)
PasVar[1,0] = 'Wood_Type'
PasVar[1,1] = vWood_Type
PasVar[2,0] = 'Barrel_Number_2'
PasVar[2,1] = StrFixLeft(vStarting_Barrel_Number, '0', 4)
;Print Label
vJob_Name = 'BarrelBarCodeLabelJob'
vFormat_Var = vLabel
vDuplicates_Var = 1
vQuantity_var = vNumberOfLabels
vPrinter_Number_Var = 'vPrinterLoftwareNum'
CreatePASFile(vJob_Name, vFormat_Var, vDuplicates_Var, vQuantity_Var, vPrinter_Number_Var, PASVar)
ArrInitialize(PASVar, 0)
Message('Print', 'Label(s) Printed')
Goto BarrelGenMainMenu
; End Still Bottling Line Label
;
;********************************
;********************************
;************************************************************************************************
;***************************************************************************
;Captures and logs all error reports
:ErrorControl
FileWrite(BarrelGenLogHndl, StrCat(vErrorMessage, retcode))
FileClose(BarrelGenLogHndl)
Message(vErrorMessage, retcode)
;Send Email
smtphost="172.16.201.20" ;Notes Server IP
fromaddr="LabelGen@Ste-Michelle.com" ;Return Address this address is undeliverable
vToList = 'Michael.Dever@Ste-Michelle.com'
vSubject = 'LabelGen Error Auto Email'
vMsg = STRCAT('Computer Name: ',vComputer_Name,'Error Message: ', vErrorMessage,' - retcode = ',retcode)
kInit(smtphost,fromaddr,"","","") ;3 lines used to send the email
kDest(vTolist,"","")
send = kSendText(vSubject,vMsg,"","")
errline=kStatusInfo() ;traps any errors from the SMTP lines above.
Exit
Return ;ErrorControl
;***************************************************************************