Public Class TASAINM Structure REGWEB Public PART As String Public PER As String Public ANO As String Public CONTRI As String Public CUIT As String Public UBICA As String Public DOMI As String Public LOCA As String Public ZONA As String Public MANZ As String Public STERR As String Public AVATERR As String Public SMEJO As String Public AVAMEJ As String Public TASA As String Public FDO As String Public CLOACA As String Public IVA As String Public DESCU As String End Structure Structure CMOR Public MT As String Public MO As String Public MUL As String Public SUELD As String End Structure Structure VENC1 Public ANO As String Public FE1 As String Public FE2 As String Public FE3 As String Public FE4 As String Public FE5 As String Public FE6 As String Public FE7 As String Public FE8 As String Public FE9 As String Public FE10 As String Public FE11 As String Public FE12 As String End Structure Structure CREDIX Public FECHA As String Public REG As String Public PART As String Public PER As String Public ANO As String Public TASA As String Public FDO As String Public MOR As String Public MULTA As String Public DESCU As String End Structure Dim I As Integer Dim J As Integer Dim F As Integer Dim DataToPrint As String Dim OnlyCorrectData As String Dim PrintableString As String Dim Encoding As String Dim WeightedTotal As Long Dim WeightValue As Integer Dim CurrentValue As Long Dim CheckDigitValue As Integer Dim Factor As Integer Dim CheckDigit As Integer Dim CurrentEncoding As String Dim NewLine As String Dim msg As String Dim CurrentChar As String Dim CurrentCharNum As Integer Dim C128_StartA As String Dim C128_StartB As String Dim C128_StartC As String Dim C128_Stop As String Dim C128Start As String Dim C128CheckDigit As String Dim StartCode As String Dim StopCode As String Dim Fnc1 As String Dim LeadingDigit As Integer Dim EAN2AddOn As String Dim EAN5AddOn As String Dim EANAddOnToPrint As String Dim HumanReadableText As String Dim StringLength As Integer Dim CorrectFNC As Integer Dim CID As Integer Dim FID As Integer Dim NCID As Integer 'Arrays Dim SetAry(100) As String Dim ProcessTilde(100) As String Dim EAN13(100) As String 'END OF DECLARACTIONS Public Function Code128a(ByVal DataToEncode As String, Optional ByVal ReturnType As Integer = 0) As String 'This method has been updated to support ReturnTypes 6 to 9, 'which increases its complexity. IDAutomation suggests using 'the prior version (http://www.idautomation.com/fonts/tools/barcodeapp/module1.txt) 'of this code when performing conversions or modifications. 'ReturnTypes are explained at http://www.idautomation.com/barcode/return-type.html ' 'The next 7 lines were added to support ReturnTypes 6-9 CID = 0 'Character ID FID = 0 'Function ID used for start, stop and check characters If ReturnType = 6 Or ReturnType = 7 Then CID = 11000 If ReturnType = 8 Then CID = 11300 If ReturnType = 9 Then CID = 11500 If ReturnType = 6 Or ReturnType = 9 Then FID = 11500 If ReturnType = 7 Or ReturnType = 8 Then FID = 11300 PrintableString = "" WeightedTotal = 103 PrintableString = ChrW(203 + FID) StringLength = Len(DataToEncode) For I = 1 To StringLength CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32 If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100 CurrentValue = CurrentValue * I WeightedTotal = WeightedTotal + CurrentValue If CurrentCharNum = 32 Then CurrentCharNum = 194 'The next 6 lines include updates to support ReturnTypes 6 and 7 'This update keeps control characters out of HR text. If (ReturnType = 6 Or ReturnType = 7) And (CurrentCharNum > 95) Then PrintableString = PrintableString & ChrW(CurrentCharNum + 11500) Else PrintableString = PrintableString & ChrW(CurrentCharNum + CID) End If Next I CheckDigitValue = (WeightedTotal Mod 103) If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32 + FID) If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100 + FID) If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194 + FID) PrintableString = PrintableString & C128CheckDigit & ChrW(206 + FID) Code128a = PrintableString End Function Public Function Code128b(ByVal DataToEncode As String, Optional ByVal ReturnType As Integer = 0) As String 'This method has been updated to support ReturnTypes 6 to 9, 'which increases its complexity. IDAutomation suggests using 'the prior version (http://www.idautomation.com/fonts/tools/barcodeapp/module1.txt) 'of this code when performing conversions or modifications. 'ReturnTypes are explained at http://www.idautomation.com/barcode/return-type.html ' PrintableString = "" WeightedTotal = 104 'The next 9 lines were added to support ReturnTypes 6-9 'in addition, CSID must be added to all ChrW statements 'Return types: 6=HR mode; 7=HR tall FID; 8=comp mode no HR; 9=comp mode no hr short CID = 0 'Character ID FID = 0 'Function ID used for start, stop and check characters If ReturnType = 6 Or ReturnType = 7 Then CID = 11000 If ReturnType = 8 Then CID = 11300 If ReturnType = 9 Then CID = 11500 If ReturnType = 6 Or ReturnType = 9 Then FID = 11500 If ReturnType = 7 Or ReturnType = 8 Then FID = 11300 PrintableString = ChrW(204 + FID) StringLength = Len(DataToEncode) For I = 1 To StringLength CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32 If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100 CurrentValue = CurrentValue * I WeightedTotal = WeightedTotal + CurrentValue If CurrentCharNum = 32 Then CurrentCharNum = 194 PrintableString = PrintableString & ChrW(CurrentCharNum + CID) Next I CheckDigitValue = (WeightedTotal Mod 103) If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32 + FID) If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100 + FID) If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194 + FID) PrintableString = PrintableString & C128CheckDigit & ChrW(206 + FID) Code128b = PrintableString End Function Public Function I2of5(ByVal DataToEncode As String) As String DataToPrint = "" DataToEncode = RTrim(LTrim(DataToEncode)) OnlyCorrectData = "" ' Check to make sure data is numeric and remove dashes, etc. StringLength = Len(DataToEncode) For I = 1 To StringLength 'Add all numbers to OnlyCorrectData string '2006.2 BDA modified the next 3 lines for compatibility with different office versions 'If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) If CurrentCharNum > 47 And CurrentCharNum < 58 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) Next I DataToEncode = OnlyCorrectData 'Check for an even number of digits, add 0 if not even If (Len(DataToEncode) Mod 2) = 1 Then DataToEncode = "0" & DataToEncode 'Assign start and stop codes StartCode = ChrW(203) StopCode = ChrW(204) StringLength = Len(DataToEncode) For I = 1 To StringLength Step 2 'Get the value of each number pair CurrentCharNum = Val((Mid(DataToEncode, I, 2))) 'Get the ASCII value of CurrentChar If CurrentCharNum < 94 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 33) If CurrentCharNum > 93 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 103) Next I 'Get Printable String PrintableString = StartCode + DataToPrint + StopCode 'Return PrintableString I2of5 = PrintableString End Function Public Function Code39(ByVal DataToEncode As String) As String DataToEncode = RTrim(LTrim(DataToEncode)) DataToPrint = "" 'Check for spaces in code StringLength = Len(DataToEncode) For I = 1 To StringLength 'Get each character one at a time CurrentChar = (Mid(DataToEncode, I, 1)) 'To print the barcode symbol representing a space it is necessary 'to type or print "=" (the equal character) instead of a space character. If CurrentChar = " " Then CurrentChar = "=" DataToPrint = DataToPrint & CurrentChar Next I 'Get Printable String Code39 = "!" & DataToPrint & "!" DataToEncode = "" End Function Public Function MSI(ByVal DataToEncode As String, Optional ByVal ReturnType As Integer = 0) As String 'Additional logic needed in case ReturnType is not entered correctly If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 Then ReturnType = 0 'The MSI encoding function will only accept digits. Any non-numeric characters 'will be discarded Dim DataToPrint As String 'output for function Dim OnlyCorrectData As String 'Only numeric characters pulled from DataToEncode Dim StringLength As Long 'Length of string Dim Idx As Integer 'for loop counter Dim OddNumbers As String 'String of odd position numbers used to create check digit Dim EvenNumberSum As Long 'all of the even position numbers added up Dim OddNumberProduct As Long 'Product of OddNumbers variable Dim sOddNumberProduct As String 'String version of OddNumberProduct variable Dim OddNumberSum As Long 'Sum of individual digits in sOddNumberProduct Dim OddDigit As Boolean 'Used to determine even/odd position digits. Dim CheckDigit As String 'This is the CheckDigit DataToPrint = "" OnlyCorrectData = "" 'Check to make sure data is numeric StringLength = Len(DataToEncode) For I = 1 To StringLength 'Add all numbers to OnlyCorrectData string '2006.2 BDA modified the next 3 lines for compatibility with different office versions 'If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) If CurrentCharNum > 47 And CurrentCharNum < 58 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) Next I DataToEncode = OnlyCorrectData '<<<< Calculate Check Digit >>>> 'To create the check digit follow these steps: '1)Starting from the units position, create a new number with all of the odd ' position digits in their original sequence. '2)Multiply this new number by 2. '3)Add all of the digits of the product from step two. '4)Add all of the digits not used in step one to the result in step three. '5)Determine the smallest number which when added to the result in step four ' will result in a multiple of 10. This is the check character. 'Step 1 -- Create a new number of the odd position digits starting from the right and going left, but store the 'digits from left to right. 'Create the odd position number & prepare for Step 4 by getting the sum of all even position characters StringLength = Len(DataToEncode) OddNumbers = "" OddDigit = True EvenNumberSum = 0 For Idx = StringLength To 1 Step -1 If OddDigit = True Then OddNumbers = Mid(DataToEncode, Idx, 1) & OddNumbers OddDigit = False Else EvenNumberSum = EvenNumberSum + Val(Mid(DataToEncode, Idx, 1)) OddDigit = True End If Next Idx 'Step 2 -- Multiply this new number by 2. OddNumberProduct = Val(OddNumbers) * 2 'Step 3 -- Add all of the digits of the product from step two. sOddNumberProduct = Format(OddNumberProduct) StringLength = Len(sOddNumberProduct) OddNumberSum = 0 For Idx = 1 To StringLength OddNumberSum = OddNumberSum + Val(Mid(sOddNumberProduct, Idx, 1)) Next Idx 'Step 4 -- Add all of the digits not used in step one to the result in step three. 'We will store the result in OddNumberSum just so we don't have to create another variable OddNumberSum = OddNumberSum + EvenNumberSum 'Step 5 -- Determine the smallest number which when added to the result in step four 'will result in a multiple of 10. This is the check character. OddNumberSum = OddNumberSum Mod 10 If OddNumberSum <> 0 Then CheckDigit = Format(10 - OddNumberSum) Else CheckDigit = "0" End If Select Case ReturnType Case 0 'Returns formatted data for barcode DataToPrint = "(" & DataToEncode & CheckDigit & ")" Case 1 'Returns data formatted for human readable text. 'Which means all of the invalid characters are 'stripped out. DataToPrint = DataToEncode Case 2 'Returns just the check digit DataToPrint = CheckDigit End Select MSI = DataToPrint End Function Public Function IDAEAN13(ByVal DataToEncode As String) As String 'This function was added for compatibility with Excel 2007 which refers to EAN13 as a cell location IDAEAN13 = EAN13(DataToEncode) End Function Public Function Code11(ByVal DataToEncode As String) As String DataToPrint = "" OnlyCorrectData = "" ' Check to make sure data is numeric and remove dashes, etc. StringLength = Len(DataToEncode) For I = 1 To StringLength 'Add all numbers to OnlyCorrectData string '2006.2 BDA modified the next 2 lines for compatibility with different office versions CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) If (CurrentCharNum > 47 And CurrentCharNum < 58) Or CurrentCharNum = 45 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) Next I DataToEncode = OnlyCorrectData 'Calculate Check Digit Factor = 1 WeightedTotal = 0 For I = Len(DataToEncode) To 1 Step -1 'Get the value of each number starting at the end CurrentChar = Mid(DataToEncode, I, 1) 'Set the "-" character to the value of 10 If CurrentChar = "-" Then CurrentChar = "10" 'Multiply by the weighting character and add together WeightedTotal = WeightedTotal + Val(CurrentChar) * Factor 'Change factor for next calculation Factor = Factor + 1 Next I 'Find the Modulo 11 check digit CheckDigit = WeightedTotal Mod 11 Code11 = "(" & DataToEncode & CheckDigit & ")" End Function Public Function RM4SCC(ByVal DataToEncode As String) As String DataToEncode = UCase(DataToEncode) OnlyCorrectData = "" StringLength = Len(DataToEncode) For I = 1 To StringLength 'Get each character one at a time CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) 'Get the value of CurrentChar according to MOD43 '0-9 If CurrentCharNum < 58 And CurrentCharNum > 47 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) 'A-Z If CurrentCharNum < 91 And CurrentCharNum > 64 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) Next I DataToEncode = OnlyCorrectData Dim r As Integer Dim C As Integer Dim Rtotal As Long Dim Ctotal As Long Rtotal = 0 Ctotal = 0 WeightedTotal = 0 StringLength = Len(DataToEncode) For I = 1 To StringLength 'Get each character one at a time CurrentChar = Mid(DataToEncode, I, 1) 'Get the values of CurrentChar Select Case CurrentChar Case "0" r = 1 C = 1 Case "1" r = 1 C = 2 Case "2" r = 1 C = 3 Case "3" r = 1 C = 4 Case "4" r = 1 C = 5 Case "5" r = 1 C = 0 Case "6" r = 2 C = 1 Case "7" r = 2 C = 2 Case "8" r = 2 C = 3 Case "9" r = 2 C = 4 Case "A" r = 2 C = 5 Case "B" r = 2 C = 0 Case "C" r = 3 C = 1 Case "D" r = 3 C = 2 Case "E" r = 3 C = 3 Case "F" r = 3 C = 4 Case "G" r = 3 C = 5 Case "H" r = 3 C = 0 Case "I" r = 4 C = 1 Case "J" r = 4 C = 2 Case "K" r = 4 C = 3 Case "L" r = 4 C = 4 Case "M" r = 4 C = 5 Case "N" r = 4 C = 0 Case "O" r = 5 C = 1 Case "P" r = 5 C = 2 Case "Q" r = 5 C = 3 Case "R" r = 5 C = 4 Case "S" r = 5 C = 5 Case "T" r = 5 C = 0 Case "U" r = 0 C = 1 Case "V" r = 0 C = 2 Case "W" r = 0 C = 3 Case "X" r = 0 C = 4 Case "Y" r = 0 C = 5 Case "Z" r = 0 C = 0 End Select 'add the values together Rtotal = Rtotal + r Ctotal = Ctotal + C Next I 'divide the Totals by 6 and get the remainder, this is a reference 'to the Check Digit. 'set check digit to CurrentChar (a string) Rtotal = (Rtotal Mod 6) Ctotal = (Ctotal Mod 6) Select Case Rtotal Case 1 Select Case Ctotal Case 1 CurrentChar = "0" Case 2 CurrentChar = "1" Case 3 CurrentChar = "2" Case 4 CurrentChar = "3" Case 5 CurrentChar = "4" Case 0 CurrentChar = "5" End Select Case 2 Select Case Ctotal Case 1 CurrentChar = "6" Case 2 CurrentChar = "7" Case 3 CurrentChar = "8" Case 4 CurrentChar = "9" Case 5 CurrentChar = "A" Case 0 CurrentChar = "B" End Select Case 3 Select Case Ctotal Case 1 CurrentChar = "C" Case 2 CurrentChar = "D" Case 3 CurrentChar = "E" Case 4 CurrentChar = "F" Case 5 CurrentChar = "G" Case 0 CurrentChar = "H" End Select Case 4 Select Case Ctotal Case 1 CurrentChar = "I" Case 2 CurrentChar = "J" Case 3 CurrentChar = "K" Case 4 CurrentChar = "L" Case 5 CurrentChar = "M" Case 0 CurrentChar = "N" End Select Case 5 Select Case Ctotal Case 1 CurrentChar = "O" Case 2 CurrentChar = "P" Case 3 CurrentChar = "Q" Case 4 CurrentChar = "R" Case 5 CurrentChar = "S" Case 0 CurrentChar = "T" End Select Case 0 Select Case Ctotal Case 1 CurrentChar = "U" Case 2 CurrentChar = "V" Case 3 CurrentChar = "W" Case 4 CurrentChar = "X" Case 5 CurrentChar = "Y" Case 0 CurrentChar = "Z" End Select End Select 'Return Printable String RM4SCC = "(" & DataToEncode & CurrentChar & ")" End Function Public Function Codabar(ByVal DataToEncode As String) As String DataToPrint = "" OnlyCorrectData = "" StringLength = Len(DataToEncode) 'Check to make sure data is numeric, $, +, -, /, or :, and remove all others. For I = 1 To StringLength '2006.2 BDA modified the next 9 lines for compatibility with different office versions CurrentChar = Mid(DataToEncode, I, 1) CurrentCharNum = AscW(CurrentChar) If CurrentCharNum > 47 And CurrentCharNum < 58 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) If CurrentChar = "$" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) If CurrentChar = "+" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) If CurrentChar = "-" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) If CurrentChar = "/" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) If CurrentChar = "." Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) If CurrentChar = ":" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1) Next I DataToPrint = OnlyCorrectData 'Get Printable String Codabar = "A" & DataToPrint & "B" End Function Public Function Code93(ByVal DataToEncode As String) As String DataToEncode = UCase(DataToEncode) DataToPrint = "" OnlyCorrectData = "" 'Only pass correct data StringLength = Len(DataToEncode) For I = 1 To StringLength CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) If Code93Val(CurrentCharNum) < 47 Then If CurrentCharNum = 32 Then CurrentCharNum = 61 OnlyCorrectData = OnlyCorrectData & ChrW(CurrentCharNum) End If Next I DataToEncode = OnlyCorrectData CurrentCharNum = 0 StringLength = Len(DataToEncode) Dim C As Integer Dim K As Integer Dim CW As Integer Dim KW As Integer Dim CWSum As Integer Dim KWSum As Integer CW = 1 KW = 2 I = 1 '2006.2 BDA modified the next line for compatibility with different office versions For I = StringLength To 1 Step -1 'Get each character one at a time from the back CurrentCharNum = AscW(Mid(DataToEncode, I, 1)) 'Get the value CurrentValue = Code93Val(CurrentCharNum) 'Calculate check digit C CWSum = CWSum + (CurrentValue * CW) CW = CW + 1 If CW = 21 Then CW = 1 'Calculate check digit K KWSum = KWSum + (CurrentValue * KW) KW = KW + 1 If KW = 16 Then KW = 1 'Gather data to print DataToPrint = ChrW(CurrentCharNum) & DataToPrint Next I 'Divide the C sum by 47 and get the remainder, this is the Check Digit C = (CWSum Mod 47) 'Add the last digit to the K sum KWSum = KWSum + C 'Divide the K sum by 47 and get the remainder, this is the Check Digit K = (KWSum Mod 47) Code93 = "(" & DataToPrint & Code93Char(C) & Code93Char(K) & ")" End Function Private Function Code93Char(ByVal CharValue As Integer) As String 'Returns a character from a character value 'An invalid character value returns nothing Code93Char = "" If CharValue < 10 And CharValue > -1 Then Code93Char = ChrW(CharValue + 48) 'A-Z If CharValue < 36 And CharValue > 9 Then Code93Char = ChrW(CharValue + 55) '- If CharValue = 36 Then Code93Char = ChrW(45) '. If CharValue = 37 Then Code93Char = "." 'Space If CharValue = 38 Then Code93Char = "=" '$ If CharValue = 39 Then Code93Char = "$" '/ If CharValue = 40 Then Code93Char = "/" '+ If CharValue = 41 Then Code93Char = "+" '% If CharValue = 42 Then Code93Char = "%" '! If CharValue = 43 Then Code93Char = "!" '# If CharValue = 44 Then Code93Char = "#" '& If CharValue = 45 Then Code93Char = "&" '@ If CharValue = 46 Then Code93Char = "@" End Function Private Function Code93Val(ByVal CharASCValue As Integer) As Integer 'Returns a character value from a character 'An invalid character value returns 99 Code93Val = 99 '0-9 If CharASCValue < 58 And CharASCValue > 47 Then Code93Val = CharASCValue - 48 'A-Z If CharASCValue < 91 And CharASCValue > 64 Then Code93Val = CharASCValue - 55 'Space If CharASCValue = 32 Then Code93Val = 38 '= If CharASCValue = 61 Then Code93Val = 38 '- If CharASCValue = 45 Then Code93Val = 36 '. If CharASCValue = 46 Then Code93Val = 37 '$ If CharASCValue = 36 Then Code93Val = 39 '/ If CharASCValue = 47 Then Code93Val = 40 '+ If CharASCValue = 43 Then Code93Val = 41 '% If CharASCValue = 37 Then Code93Val = 42 '! If CharASCValue = 33 Then Code93Val = 43 '# If CharASCValue = 35 Then Code93Val = 44 '& If CharASCValue = 38 Then Code93Val = 45 '@ If CharASCValue = 64 Then Code93Val = 46 End Function Public Function SpliceText(ByVal DataToFormat As String, Optional ByVal SpacingNumber As Integer = 4, Optional ByVal ApplyTilde As Boolean = False) As String 'This function inserts a space for every SpacingNumber of characters '2006.2 BDA added the next line to move code to the ProcessTilde function If ApplyTilde Then DataToFormat = ProcessTilde(DataToFormat) HumanReadableText = "" StringLength = Len(DataToFormat) J = 0 For I = 1 To StringLength CurrentCharNum = AscW(Mid(DataToFormat, I, 1)) If CurrentCharNum > 31 And CurrentCharNum < 128 Then HumanReadableText = HumanReadableText & Mid(DataToFormat, I, 1) J = J + 1 End If If (J Mod SpacingNumber) = 0 Then HumanReadableText = HumanReadableText & " " Next I SpliceText = HumanReadableText End Function Public Function MOD10(ByVal M10NumberData As String) As Integer '*********************************************************************** ' This is a general MOD10 function compatible with EAN and UPC standards '*********************************************************************** Dim M10StringLength As Integer Dim M10OnlyCorrectData As String Dim M10Factor As Integer Dim M10WeightedTotal As Integer Dim M10CheckDigit As Integer Dim M10I As Integer M10OnlyCorrectData = "" M10StringLength = Len(M10NumberData) 'Check to make sure data is numeric and remove dashes, etc. For M10I = 1 To M10StringLength 'Add all numbers to OnlyCorrectData string '2006.2 BDA modified the next 2 lines for compatibility with different office versions CurrentCharNum = AscW(Mid(M10NumberData, M10I, 1)) If CurrentCharNum > 47 And CurrentCharNum < 58 Then M10OnlyCorrectData = M10OnlyCorrectData & Mid(M10NumberData, M10I, 1) Next M10I 'Generate MOD 10 check digit M10Factor = 3 M10WeightedTotal = 0 M10StringLength = Len(M10NumberData) For M10I = M10StringLength To 1 Step -1 'Get the value of each number starting at the end 'CurrentCharNum = Mid(M10NumberData, I, 1) 'Multiply by the weighting factor which is 3,1,3,1... 'and add the sum together M10WeightedTotal = M10WeightedTotal + (Val(Mid(M10NumberData, M10I, 1)) * M10Factor) 'Change factor for next calculation M10Factor = 4 - M10Factor Next M10I 'Find the CheckDigit by finding the smallest number that = a multiple of 10 M10I = (M10WeightedTotal Mod 10) If M10I <> 0 Then M10CheckDigit = (10 - M10I) Else M10CheckDigit = 0 End If MOD10 = Str(M10CheckDigit) End Function Public Function ProcessEAN5AddOn(ByVal EAN5AddOn As String) As String If Len(EAN5AddOn) = 5 Then EANAddOnToPrint = "" 'Get the check digit for the add on Factor = 3 WeightedTotal = 0 For I = Len(EAN5AddOn) To 1 Step -1 'Get the value of each number starting at the end CurrentCharNum = Mid(EAN5AddOn, I, 1) 'Multiply by the weighting factor which is 3,9,3,9. 'and add the sum together If Factor = 3 Then WeightedTotal = WeightedTotal + CurrentCharNum * 3 If Factor = 1 Then WeightedTotal = WeightedTotal + CurrentCharNum * 9 'Change factor for next calculation Factor = 4 - Factor Next I 'Find the CheckDigit by extracting the right-most number from WeightedTotal CheckDigit = Val(Strings.Right(WeightedTotal, 1)) 'Encode the add-on CheckDigit into the number sets 'by using variable parity between character sets A and B Select Case CheckDigit Case 0 Encoding = "BBAAA" Case 1 Encoding = "BABAA" Case 2 Encoding = "BAABA" Case 3 Encoding = "BAAAB" Case 4 Encoding = "ABBAA" Case 5 Encoding = "AABBA" Case 6 Encoding = "AAABB" Case 7 Encoding = "ABABA" Case 8 Encoding = "ABAAB" Case 9 Encoding = "AABAB" End Select 'Determine the characters to print for proper barcoding For I = 1 To Len(EAN5AddOn) 'Get the value of each number encoded with variable parity CurrentChar = Mid(EAN5AddOn, I, 1) CurrentEncoding = Mid(Encoding, I, 1) 'Print different barcodes according to the location of the CurrentChar and CurrentEncoding Select Case CurrentEncoding Case "A" If CurrentChar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(34) If CurrentChar = "1" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(35) If CurrentChar = "2" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(36) If CurrentChar = "3" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(37) If CurrentChar = "4" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(38) If CurrentChar = "5" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(44) If CurrentChar = "6" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(46) If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(47) If CurrentChar = "8" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(58) If CurrentChar = "9" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(59) Case "B" If CurrentChar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(122) If CurrentChar = "1" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(61) If CurrentChar = "2" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(63) If CurrentChar = "3" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(64) If CurrentChar = "4" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(91) If CurrentChar = "5" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(92) If CurrentChar = "6" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(93) If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(95) If CurrentChar = "8" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(123) If CurrentChar = "9" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(125) End Select 'Add in the space & add-on guard pattern Select Case I Case 1 EANAddOnToPrint = ChrW(43) & EANAddOnToPrint & ChrW(33) 'Print add-on delineators between each add-on character Case 2 EANAddOnToPrint = EANAddOnToPrint & ChrW(33) Case 3 EANAddOnToPrint = EANAddOnToPrint & ChrW(33) Case 4 EANAddOnToPrint = EANAddOnToPrint & ChrW(33) Case 5 EANAddOnToPrint = EANAddOnToPrint End Select Next I End If ProcessEAN5AddOn = EANAddOnToPrint End Function Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim FEC As String FEC = Mid$(DateString, 4, 2) + "/" + Mid$(DateString, 1, 2) + "/" + Mid$(DateString, 7, 4) TextBox7.Text = FEC Dim PAT As String PAT = System.AppDomain.CurrentDomain.BaseDirectory() Microsoft.VisualBasic.FileOpen(1, PAT + "ARCHIVOS\MORA", OpenMode.Random, OpenAccess.Read, OpenShare.Shared, 40) Dim CMO As New CMOR FileGet(1, CMO, 1) TextBox17.Text = Trim(CMO.MT) FileClose() End Sub Private Sub Label23_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label23.Click End Sub Private Sub Label22_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label22.Click End Sub Private Sub TextBox20_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox20.TextChanged End Sub Private Sub TextBox19_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox19.TextChanged End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Me.Close() End Sub Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged If Len(TextBox2.Text) = 6 Then Dim REGIS As Integer Dim PARTI As Integer Dim TOTAL As Double Dim TASA As String Dim FONDO As String Dim CLOACA As String Dim MORA As String Dim DESCU As String Dim X1 As String Dim XX1 As String Dim CX As Integer Dim LE As Integer Dim PMORA As Double Dim PPMORA As Double Dim MORAX As Double REGIS = Val(TextBox1.Text) PARTI = Val(TextBox2.Text) If REGIS <> 0 Then If PARTI = 0 Then MsgBox("FALTA DIGITAR EL NUMERO DE PARTIDA") TextBox2.Focus() Exit Sub End If Dim PAT As String PAT = System.AppDomain.CurrentDomain.BaseDirectory() FileOpen(1, PAT + "ARCHIVOS\CONTRI", OpenMode.Random, OpenAccess.ReadWrite, OpenShare.Shared, 355) Dim REG As New REGWEB FileGet(1, REG, REGIS) TextBox3.Text = REG.CONTRI TextBox4.Text = REG.CUIT TextBox5.Text = REG.DOMI TextBox6.Text = REG.LOCA TextBox8.Text = REG.UBICA TextBox9.Text = REG.ZONA TextBox10.Text = REG.MANZ TextBox12.Text = REG.STERR TextBox11.Text = REG.SMEJO TextBox14.Text = REG.AVATERR TextBox13.Text = REG.AVAMEJ TextBox20.Text = REG.TASA TextBox19.Text = REG.FDO TextBox22.Text = REG.CLOACA TextBox21.Text = "" TextBox24.Text = REG.DESCU TextBox16.Text = REG.ANO TextBox15.Text = REG.PER FileClose() If Val(TextBox16.Text) <> 0 Then If Val(TextBox15.Text) <> 0 Then Dim ANO As Integer Dim PE As Integer Dim U As Integer PAT = System.AppDomain.CurrentDomain.BaseDirectory() ANO = Val(TextBox16.Text) PE = Val(TextBox15.Text) FileOpen(1, PAT + "ARCHIVOS\VENCIM", OpenMode.Random, OpenAccess.ReadWrite, OpenShare.Shared, 113) Dim VEN As New VENC1 For U = 1 To 50 FileGet(1, VEN, U) If ANO = Val(VEN.ANO) Then GoTo 500 Next U MsgBox("NO EXISTE AŅO DE BUSQUEDA, DEBERA GRABARLO", 0, "ERRORES") FileClose() Exit Sub 500: If PE = 1 Then TextBox18.Text = VEN.FE1 If PE = 2 Then TextBox18.Text = VEN.FE2 If PE = 3 Then TextBox18.Text = VEN.FE3 If PE = 4 Then TextBox18.Text = VEN.FE4 If PE = 5 Then TextBox18.Text = VEN.FE5 If PE = 6 Then TextBox18.Text = VEN.FE6 If PE = 7 Then TextBox18.Text = VEN.FE7 If PE = 8 Then TextBox18.Text = VEN.FE8 If PE = 9 Then TextBox18.Text = VEN.FE9 If PE = 10 Then TextBox18.Text = VEN.FE10 If PE = 11 Then TextBox18.Text = VEN.FE11 If PE = 12 Then TextBox18.Text = VEN.FE12 TextBox18.Text = Mid$(TextBox18.Text, 1, 2) + "/" + Mid$(TextBox18.Text, 3, 2) + "/" + Mid$(TextBox18.Text, 5, 4) FileClose() Dim datTim1 As Date = TextBox18.Text Dim datTim2 As Date = TextBox7.Text Dim wD As Long = DateDiff(DateInterval.Day, datTim1, datTim2) TASA = Trim(TextBox20.Text) X1 = "" XX1 = "" LE = Len(TASA) For CX = 1 To LE X1 = Mid$(TASA, CX, 1) If X1 = "," Then X1 = "." XX1 = XX1 + X1 Next CX TASA = XX1 TextBox20.Text = TASA FONDO = Trim(TextBox19.Text) X1 = "" XX1 = "" LE = Len(FONDO) For CX = 1 To LE X1 = Mid$(FONDO, CX, 1) If X1 = "," Then X1 = "." XX1 = XX1 + X1 Next CX FONDO = XX1 TextBox19.Text = FONDO CLOACA = Trim(TextBox22.Text) X1 = "" XX1 = "" LE = Len(CLOACA) For CX = 1 To LE X1 = Mid$(CLOACA, CX, 1) If X1 = "," Then X1 = "." XX1 = XX1 + X1 Next CX CLOACA = XX1 TextBox22.Text = CLOACA DESCU = Trim(TextBox24.Text) X1 = "" XX1 = "" LE = Len(DESCU) For CX = 1 To LE X1 = Mid$(DESCU, CX, 1) If X1 = "," Then X1 = "." XX1 = XX1 + X1 Next CX DESCU = XX1 TextBox24.Text = Str$(DESCU) PMORA = Val(TextBox17.Text) MORA = "" REM TextBox17.Text = "" If wD <> 0 Then PPMORA = (PMORA / 30) * wD PPMORA = Int((PPMORA * 100) + 0.5) / 100 MORAX = (Val(TASA) + Val(FONDO) + Val(CLOACA) - Val(DESCU)) * PPMORA MORAX = MORAX / 100 MORAX = Int((MORAX * 100) + 0.5) / 100 End If TextBox21.Text = Str$(MORAX) MORA = Trim(TextBox21.Text) X1 = "" XX1 = "" LE = Len(MORA) For CX = 1 To LE X1 = Mid$(MORA, CX, 1) If X1 = "," Then X1 = "." XX1 = XX1 + X1 Next CX MORA = XX1 TextBox21.Text = MORA TOTAL = Val(TASA) + Val(FONDO) + Val(CLOACA) + Val(MORA) - Val(DESCU) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox23.Text = Str$(TOTAL) FileClose() End If End If End If End If End Sub End Class