Imports System.IO Imports System.Net Partial Class _Default Inherits System.Web.UI.Page Private ws As HttpListener 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 Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Sub Solicitud(ByVal ar As IAsyncResult) Dim ws As HttpListener = DirectCast(ar.AsyncState, HttpListener) Dim lc As HttpListenerContext = ws.EndGetContext(ar) Dim lr As HttpListenerRequest = lc.Request Dim resp As HttpListenerResponse = lc.Response Dim pdf As Byte() = File.ReadAllBytes("pepe.pdf") '<<<------------- resp.ContentLength64 = pdf.Length resp.OutputStream.Write(pdf, 0, pdf.Length) resp.OutputStream.Close() End Sub 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 Protected Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click 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(TextBox4.Text) If REGIS <> 0 Then If PARTI = 0 Then TextBox27.Text = "FALTA DIGITAR EL NUMERO DE PARTIDA" TextBox4.Focus() Exit Sub End If Dim PAT As String PAT = System.AppDomain.CurrentDomain.BaseDirectory() FileOpen(1, PAT + "ARCHIVOS\CONTRI.DAT", OpenMode.Random, OpenAccess.Read, OpenShare.Shared, 355) Dim REG As New REGWEB FileGet(1, REG, REGIS) TextBox2.Text = REG.CONTRI TextBox3.Text = REG.CUIT TextBox5.Text = REG.DOMI TextBox6.Text = REG.LOCA TextBox7.Text = REG.UBICA TextBox8.Text = REG.ZONA TextBox9.Text = REG.MANZ TextBox10.Text = REG.STERR TextBox11.Text = REG.SMEJO TextBox12.Text = REG.AVATERR TextBox13.Text = REG.AVAMEJ TextBox14.Text = REG.TASA TextBox15.Text = REG.FDO TextBox16.Text = REG.CLOACA TextBox17.Text = "" TextBox18.Text = REG.DESCU TextBox21.Text = REG.ANO TextBox22.Text = REG.PER FileClose() If Val(TextBox21.Text) <> 0 Then If Val(TextBox22.Text) <> 0 Then Dim ANO As Integer Dim PE As Integer Dim U As Integer PAT = System.AppDomain.CurrentDomain.BaseDirectory() ANO = Val(TextBox21.Text) PE = Val(TextBox22.Text) FileOpen(1, PAT + "ARCHIVOS\VENCIM.DAT", OpenMode.Random, OpenAccess.Read, 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 TextBox23.Text = VEN.FE1 If PE = 2 Then TextBox23.Text = VEN.FE2 If PE = 3 Then TextBox23.Text = VEN.FE3 If PE = 4 Then TextBox23.Text = VEN.FE4 If PE = 5 Then TextBox23.Text = VEN.FE5 If PE = 6 Then TextBox23.Text = VEN.FE6 If PE = 7 Then TextBox23.Text = VEN.FE7 If PE = 8 Then TextBox23.Text = VEN.FE8 If PE = 9 Then TextBox23.Text = VEN.FE9 If PE = 10 Then TextBox23.Text = VEN.FE10 If PE = 11 Then TextBox23.Text = VEN.FE11 If PE = 12 Then TextBox23.Text = VEN.FE12 TextBox23.Text = Mid$(TextBox23.Text, 1, 2) + "/" + Mid$(TextBox23.Text, 3, 2) + "/" + Mid$(TextBox23.Text, 5, 4) FileClose() Dim FECVEN2 As String Dim FECVEN1 As String Dim ANO2 As Integer Dim ANO1 As Integer Dim DIA1 As Integer Dim DIA2 As Integer Dim MES1 As Integer Dim MES2 As Integer Dim WD As Integer Dim DD As Integer Dim MM As Integer Dim AA As Integer FECVEN2 = TextBox25.Text FECVEN1 = TextBox23.Text DD = Val(Mid$(FECVEN2, 1, 2)) MM = Val(Mid$(FECVEN2, 4, 2)) AA = Val(Mid$(FECVEN2, 7, 4)) FECVEN2 = Format(AA, "0000") + Format(MM, "00") + Format(DD, "00") DD = Val(Mid$(FECVEN1, 1, 2)) MM = Val(Mid$(FECVEN1, 4, 2)) AA = Val(Mid$(FECVEN1, 7, 4)) FECVEN1 = Format(AA, "0000") + Format(MM, "00") + Format(DD, "00") REM ************ CALCULO DE DIAS **************** ANO2 = Val(Mid$(FECVEN2, 1, 4)) DIA1 = Val(Mid$(FECVEN1, 7, 2)) DIA1 = 30 - DIA1 MES1 = Val(Mid$(FECVEN1, 5, 2)) MES1 = (12 - MES1) * 30 ANO1 = Val(Mid$(FECVEN1, 1, 4)) ANO1 = ((ANO2) - ANO1) * 360 DIA2 = Val(Mid$(FECVEN2, 7, 2)) DIA2 = 30 - DIA2 MES2 = Val(Mid$(FECVEN2, 5, 2)) MES2 = (12 - MES2) * 30 WD = (DIA1 + MES1 + ANO1) - (DIA2 + MES2) If WD < 1 Then WD = 0 TASA = Trim(TextBox14.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 TextBox14.Text = TASA FONDO = Trim(TextBox15.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 TextBox15.Text = FONDO CLOACA = Trim(TextBox16.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 TextBox16.Text = CLOACA DESCU = Trim(TextBox18.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 TextBox18.Text = Str$(DESCU) PMORA = Val(TextBox24.Text) MORA = "" 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 TextBox17.Text = Str$(MORAX) MORA = Trim(TextBox17.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 TextBox17.Text = MORA TOTAL = Val(TASA) + Val(FONDO) + Val(CLOACA) + Val(MORA) - Val(DESCU) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox20.Text = Str$(TOTAL) FileClose() End If End If End If End Sub Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load Dim FEC As String FEC = Mid$(DateString, 4, 2) + "/" + Mid$(DateString, 1, 2) + "/" + Mid$(DateString, 7, 4) TextBox25.Text = FEC Dim PAT As String PAT = System.AppDomain.CurrentDomain.BaseDirectory() Microsoft.VisualBasic.FileOpen(1, PAT + "ARCHIVOS\MORA.DAT", OpenMode.Random, OpenAccess.Read, OpenShare.Shared, 40) Dim CMO As New CMOR FileGet(1, CMO, 1) TextBox24.Text = Trim(CMO.MT) FileClose() Button4.Attributes.Add("onclick", "history.back(); return false;") End Sub Protected Sub TextBox22_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox22.TextChanged If Val(TextBox21.Text) <> 0 Then If Val(TextBox22.Text) <> 0 Then Dim ANO As Integer Dim PE As Integer Dim PAT As String Dim U 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 PAT = System.AppDomain.CurrentDomain.BaseDirectory() ANO = Val(TextBox21.Text) PE = Val(TextBox22.Text) FileOpen(1, PAT + "ARCHIVOS\VENCIM.DAT", OpenMode.Random, OpenAccess.Read, 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 TextBox23.Text = VEN.FE1 If PE = 2 Then TextBox23.Text = VEN.FE2 If PE = 3 Then TextBox23.Text = VEN.FE3 If PE = 4 Then TextBox23.Text = VEN.FE4 If PE = 5 Then TextBox23.Text = VEN.FE5 If PE = 6 Then TextBox23.Text = VEN.FE6 If PE = 7 Then TextBox23.Text = VEN.FE7 If PE = 8 Then TextBox23.Text = VEN.FE8 If PE = 9 Then TextBox23.Text = VEN.FE9 If PE = 10 Then TextBox23.Text = VEN.FE10 If PE = 11 Then TextBox23.Text = VEN.FE11 If PE = 12 Then TextBox23.Text = VEN.FE12 TextBox23.Text = Mid$(TextBox23.Text, 1, 2) + "/" + Mid$(TextBox23.Text, 3, 2) + "/" + Mid$(TextBox23.Text, 5, 4) FileClose() Dim FECVEN2 As String Dim FECVEN1 As String Dim ANO2 As Integer Dim ANO1 As Integer Dim DIA1 As Integer Dim DIA2 As Integer Dim MES1 As Integer Dim MES2 As Integer Dim WD As Integer Dim DD As Integer Dim MM As Integer Dim AA As Integer FECVEN2 = TextBox25.Text FECVEN1 = TextBox23.Text DD = Val(Mid$(FECVEN2, 1, 2)) MM = Val(Mid$(FECVEN2, 4, 2)) AA = Val(Mid$(FECVEN2, 7, 4)) FECVEN2 = Format(AA, "0000") + Format(MM, "00") + Format(DD, "00") DD = Val(Mid$(FECVEN1, 1, 2)) MM = Val(Mid$(FECVEN1, 4, 2)) AA = Val(Mid$(FECVEN1, 7, 4)) FECVEN1 = Format(AA, "0000") + Format(MM, "00") + Format(DD, "00") REM ************ CALCULO DE DIAS **************** ANO2 = Val(Mid$(FECVEN2, 1, 4)) DIA1 = Val(Mid$(FECVEN1, 7, 2)) DIA1 = 30 - DIA1 MES1 = Val(Mid$(FECVEN1, 5, 2)) MES1 = (12 - MES1) * 30 ANO1 = Val(Mid$(FECVEN1, 1, 4)) ANO1 = ((ANO2) - ANO1) * 360 DIA2 = Val(Mid$(FECVEN2, 7, 2)) DIA2 = 30 - DIA2 MES2 = Val(Mid$(FECVEN2, 5, 2)) MES2 = (12 - MES2) * 30 WD = (DIA1 + MES1 + ANO1) - (DIA2 + MES2) If WD < 1 Then WD = 0 TASA = Trim(TextBox14.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 TextBox14.Text = TASA FONDO = Trim(TextBox15.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 TextBox15.Text = FONDO CLOACA = Trim(TextBox16.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 TextBox16.Text = CLOACA DESCU = Trim(TextBox18.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 TextBox18.Text = DESCU PMORA = Val(TextBox24.Text) MORA = "" 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 TextBox17.Text = Str$(MORAX) MORA = Trim(TextBox17.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 TextBox17.Text = MORA TOTAL = Val(TASA) + Val(FONDO) + Val(CLOACA) + Val(MORA) - Val(DESCU) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox20.Text = Str$(TOTAL) Button1.Focus() End If End If End Sub Protected Sub TextBox14_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox14.TextChanged Dim TOTAL As Double TOTAL = Val(TextBox14.Text) + Val(TextBox15.Text) + Val(TextBox16.Text) + Val(TextBox17.Text) - Val(TextBox18.Text) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox20.Text = Str$(TOTAL) End Sub Protected Sub TextBox16_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox16.TextChanged Dim TOTAL As Double TOTAL = Val(TextBox14.Text) + Val(TextBox15.Text) + Val(TextBox16.Text) + Val(TextBox17.Text) - Val(TextBox18.Text) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox20.Text = Str$(TOTAL) End Sub Protected Sub TextBox18_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox18.TextChanged Dim TOTAL As Double TOTAL = Val(TextBox14.Text) + Val(TextBox15.Text) + Val(TextBox16.Text) + Val(TextBox17.Text) - Val(TextBox18.Text) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox20.Text = Str$(TOTAL) End Sub Protected Sub TextBox15_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox15.TextChanged Dim TOTAL As Double TOTAL = Val(TextBox14.Text) + Val(TextBox15.Text) + Val(TextBox16.Text) + Val(TextBox17.Text) - Val(TextBox18.Text) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox20.Text = Str$(TOTAL) End Sub Protected Sub TextBox17_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox17.TextChanged Dim TOTAL As Double TOTAL = Val(TextBox14.Text) + Val(TextBox15.Text) + Val(TextBox16.Text) + Val(TextBox17.Text) - Val(TextBox18.Text) TOTAL = Int((TOTAL * 100) + 0.5) / 100 TextBox20.Text = Str$(TOTAL) End Sub Protected Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click Dim PAT As String PAT = System.AppDomain.CurrentDomain.BaseDirectory() Dim NOMBRE As String Dim CUIT As String Dim UBICA As String Dim DOM As String Dim LOCA As String Dim REG As Integer Dim FECHAV As String Dim FECHAA As String Dim ANO As Integer Dim PER As Integer Dim DEBI As String Dim DEBITO As String Dim LE As Integer Dim RESTO As Integer Dim NL As String Dim NL1 As String Dim NL2 As String Dim NL3 As String Dim NL4 As String Dim NL5 As String Dim NL6 As String Dim TTASA As Integer Dim TFONDO As Integer Dim TMORA As Integer Dim TCLOACA As Integer Dim TGRAL As Double Dim PASO As Integer Dim PARA As String Dim CODIGOXP As String Dim TASA As Double Dim FONDO As Double Dim CLOACA As Double Dim MORA As Double Dim DESCU As Double Dim PARTIDA As Integer Dim ZONA As String Dim MANZ As String Dim SPTERR As Double Dim SPMEJO As Double Dim AVATERR As Double Dim AVAMEJO As Double REM ACTIVIDAD 1 TASA = Val(TextBox14.Text) FONDO = Val(TextBox15.Text) CLOACA = Val(TextBox16.Text) MORA = Val(TextBox17.Text) DESCU = Val(TextBox18.Text) NOMBRE = Trim(TextBox2.Text) CUIT = Trim(TextBox3.Text) UBICA = Trim(TextBox7.Text) DOM = Trim(TextBox5.Text) LOCA = Trim(TextBox6.Text) FECHAV = Trim(TextBox23.Text) FECHAA = Trim(TextBox25.Text) ANO = Val(TextBox21.Text) PER = Val(TextBox22.Text) REG = Val(TextBox1.Text) PARTIDA = Val(TextBox4.Text) ZONA = Trim(TextBox8.Text) MANZ = Trim(TextBox9.Text) SPTERR = Val(TextBox10.Text) SPMEJO = Val(TextBox11.Text) AVATERR = Val(TextBox12.Text) AVAMEJO = Val(TextBox13.Text) TASA = Val(TextBox14.Text) FONDO = Val(TextBox15.Text) CLOACA = Val(TextBox16.Text) MORA = Val(TextBox17.Text) DESCU = Val(TextBox18.Text) TTASA = Int((TASA - DESCU) * 100) TFONDO = Int(FONDO * 100) TCLOACA = Int(CLOACA * 100) TMORA = Int(MORA * 100) CODIGOXP = Format(REG, "0000") + Format(PARTIDA, "000000") + Format(TTASA, "00000000") + Format(TFONDO, "000000") + Format(TCLOACA, "000000") + Format(TMORA, "000000") + Format(PER, "00") + Format(ANO, "0000") TextBox26.Text = Code128a(CODIGOXP, 0) REM Dim objWord As Object Dim objSelection As Object Dim objDoc As Object Dim objword As New Microsoft.Office.Interop.Word.Application REM objWord = CreateObject("Word.Application") ' referencia al nuevo documento objDoc = objword.Documents.Open(PAT + "ARCHIVOS\BOLETAS.DOC") ' referencia a la selección objSelection = objword.Selection With objSelection ' formato de fuente para el título PASO = 0 PARA = "PARA EL CONTRIBUYENTE" .InlineShapes.AddPicture(PAT + "LOGO TASA INMOBILIARIA.jpg") 10: .Font.Name = "Verdana" .Font.Size = "8" ' tamaño .TypeText("LIQUIDACION DE TASA FECHA DE EMISION " + Trim(TextBox25.Text) + vbCrLf) .Font.Size = "8" .font.bold = True .TypeText("---------------------------------------------------------------------------------------------" + vbCrLf) .TypeText("REGISTRO " + Format(REG, "0000") + " PARTIDA " + Format(PARTIDA, "000000") + " PER. " + Format(PER, "00") + " AÑO " + Format(ANO, "0000") + " VENCIM. " + FECHAV + vbCrLf) .TypeText("---------------------------------------------------------------------------------------------" + vbCrLf) .font.bold = False .TypeText("CONTRIBUYENTE " + NOMBRE + Space(10) + "CUIT " + CUIT + vbCrLf) .TypeText("DOMICILIO" + Space(10) + DOM + Space(20) + vbCrLf) .TypeText("LOCALIDAD" + Space(10) + LOCA + vbCrLf) .font.bold = True .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .TypeText(Space(5) + "DATOS CATASTRALES" + vbCrLf) .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .font.bold = False .TypeText("UBICACION " + UBICA + vbCrLf) .TypeText("ZONA " + Space(25) + ZONA + vbTab + vbTab + vbTab + "MANZANA" + Space(20) + MANZ + vbCrLf) DEBI = Format(SPTERR, "###,###,##0.00") DEBITO = Strings.Right(DEBI, 14) LE = Len(DEBITO) RESTO = 14 - LE NL = Space(RESTO) + DEBITO DEBI = Format(SPMEJO, "###,###,##0.00") DEBITO = Strings.Right(DEBI, 14) LE = Len(DEBITO) RESTO = 14 - LE NL1 = Space(RESTO) + DEBITO DEBI = Format(AVATERR, "###,###,##0.00") DEBITO = Strings.Right(DEBI, 14) LE = Len(DEBITO) RESTO = 14 - LE NL3 = Space(RESTO) + DEBITO DEBI = Format(AVAMEJO, "###,###,##0.00") DEBITO = Strings.Right(DEBI, 14) LE = Len(DEBITO) RESTO = 14 - LE NL4 = Space(RESTO) + DEBITO .TypeText("SUP.TERRERO" + vbTab + NL + vbTab + vbTab + "AVAL.TERRENO" + vbTab + NL3 + vbCrLf) .TypeText("SUP.MEJORA " + vbTab + NL1 + vbTab + vbTab + "AVAL.MEJORA" + vbTab + NL4 + vbCrLf) .font.bold = True .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .TypeText(Space(25) + "L I Q U I D A C I O N" + vbCrLf) .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .font.bold = False DEBI = Format(TASA, "###,##0.00") DEBITO = Strings.Right(DEBI, 10) LE = Len(DEBITO) RESTO = 10 - LE NL = Space(RESTO) + DEBITO DEBI = Format(FONDO, "###,##0.00") DEBITO = Strings.Right(DEBI, 10) LE = Len(DEBITO) RESTO = 10 - LE NL1 = Space(RESTO) + DEBITO DEBI = Format(CLOACA, "###,##0.00") DEBITO = Strings.Right(DEBI, 10) LE = Len(DEBITO) RESTO = 10 - LE NL2 = Space(RESTO) + DEBITO DEBI = Format(MORA, "###,##0.00") DEBITO = Strings.Right(DEBI, 10) LE = Len(DEBITO) RESTO = 10 - LE NL3 = Space(RESTO) + DEBITO DEBI = Format(DESCU, "###,##0.00") DEBITO = Strings.Right(DEBI, 10) LE = Len(DEBITO) RESTO = 10 - LE NL5 = Space(RESTO) + DEBITO TGRAL = TASA + FONDO + MORA - DESCU DEBI = Format(TGRAL, "##,###,##0.00") DEBITO = Strings.Right(DEBI, 13) LE = Len(DEBITO) RESTO = 13 - LE NL6 = Space(RESTO) + DEBITO .TypeText(vbTab + vbTab + "TASA" + vbTab + vbTab + NL + vbCrLf) .TypeText(vbTab + vbTab + "FONDO" + vbTab + vbTab + NL1 + vbCrLf) .TypeText(vbTab + vbTab + "CLOACA" + vbTab + vbTab + NL2 + vbCrLf) .TypeText(vbTab + vbTab + "MORA" + vbTab + vbTab + NL3 + vbCrLf) REM .TypeText(vbTab + vbTab + "MULTA" + vbTab + vbTab + NL4 + vbCrLf) .TypeText(vbTab + vbTab + "DESCUENTO" + vbTab + NL5 + vbCrLf) .TypeText(vbCrLf) .font.bold = True .TypeText(vbTab + vbTab + "TOTAL" + vbTab + vbTab + NL6 + vbCrLf) .font.bold = True .TypeText(PARA + vbCrLf) .TypeText("- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" + vbCrLf) .font.bold = True PARA = "PARA EL COMPUTOS" .TypeText("---------------------------------------------------------------------------------------------" + vbCrLf) .TypeText("REGISTRO " + Format(REG, "0000") + " PARTIDA " + Format(PARTIDA, "000000") + " PER. " + Format(PER, "00") + " AÑO " + Format(ANO, "0000") + " VENCIM. " + FECHAV + vbCrLf) .TypeText("---------------------------------------------------------------------------------------------" + vbCrLf) .font.bold = False .TypeText("CONTRIBUYENTE " + NOMBRE + Space(10) + "CUIT " + CUIT + vbCrLf) .TypeText("DOMICILIO" + Space(10) + DOM + Space(20) + vbCrLf) .TypeText("LOCALIDAD" + Space(10) + LOCA + vbCrLf) .font.bold = True .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .TypeText(Space(25) + "L I Q U I D A C I O N" + vbCrLf) .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .font.bold = False .TypeText(vbTab + vbTab + "TASA" + vbTab + vbTab + NL + vbCrLf) .TypeText(vbTab + vbTab + "FONDO" + vbTab + vbTab + NL1 + vbCrLf) .TypeText(vbTab + vbTab + "CLOACA" + vbTab + vbTab + NL2 + vbCrLf) .TypeText(vbTab + vbTab + "MORA" + vbTab + vbTab + NL3 + vbCrLf) REM .TypeText(vbTab + vbTab + "MULTA" + vbTab + vbTab + NL4 + vbCrLf) .TypeText(vbTab + vbTab + "DESCUENTO" + vbTab + NL5 + vbCrLf) .TypeText(vbCrLf) .font.bold = True .TypeText(vbTab + vbTab + "TOTAL" + vbTab + vbTab + NL6 + vbCrLf) .font.bold = True .TypeText(PARA + vbCrLf) .TypeText("- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" + vbCrLf) .font.bold = False PARA = "PARA LA CAJA" .TypeText("---------------------------------------------------------------------------------------------" + vbCrLf) .TypeText("REGISTRO " + Format(REG, "0000") + " PARTIDA " + Format(PARTIDA, "000000") + " PER. " + Format(PER, "00") + " AÑO " + Format(ANO, "0000") + " VENCIM. " + FECHAV + vbCrLf) .TypeText("---------------------------------------------------------------------------------------------" + vbCrLf) .font.bold = False .TypeText("CONTRIBUYENTE " + NOMBRE + Space(10) + "CUIT " + CUIT + vbCrLf) .font.bold = True .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .TypeText(Space(25) + "L I Q U I D A C I O N" + vbCrLf) .TypeText("------------------------------------------------------------------------------------------------" + vbCrLf) .font.bold = False .TypeText(vbTab + vbTab + "TASA" + vbTab + vbTab + NL + vbCrLf) .TypeText(vbTab + vbTab + "FONDO" + vbTab + vbTab + NL1 + vbCrLf) .TypeText(vbTab + vbTab + "CLOACA" + vbTab + vbTab + NL2 + vbCrLf) .TypeText(vbTab + vbTab + "MORA" + vbTab + vbTab + NL3 + vbCrLf) REM .TypeText(vbTab + vbTab + "MULTA" + vbTab + vbTab + NL4 + vbCrLf) .TypeText(vbTab + vbTab + "DESCUENTO" + vbTab + NL5 + vbCrLf) .TypeText(vbCrLf) .font.bold = True .TypeText(vbTab + vbTab + "TOTAL" + vbTab + vbTab + NL6 + vbCrLf) .font.bold = True .TypeText(PARA + vbCrLf) .TypeText("- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" + vbCrLf) .TypeText(vbTab + CODIGOXP + vbCrLf) .font.bold = False .Font.Name = "code 128" .Font.Size = "20" ' tamaño .TypeText(TextBox26.Text) End With With objword.ActiveDocument .SaveAs(PAT + "archivo.doc") 'Abre el documento objword.Documents.Open(PAT + "archivo.doc") ' Imprime el documento activo con Printout objword.ActiveDocument.PrintOut() ' Cierra el documento objword.Quit() ' Elimina la referencia objword = Nothing REM .Close() End With REM objWord.Quit() objSelection = Nothing objDoc = Nothing objword = Nothing 500: FileClose() End Sub Protected Sub Button3_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button3.Click TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" TextBox8.Text = "" TextBox9.Text = "" TextBox10.Text = "" TextBox11.Text = "" TextBox12.Text = "" TextBox13.Text = "" TextBox14.Text = "" TextBox15.Text = "" TextBox16.Text = "" TextBox17.Text = "" TextBox18.Text = "" TextBox20.Text = "" TextBox21.Text = "" TextBox22.Text = "" TextBox23.Text = "" TextBox24.Text = "" TextBox25.Text = "" TextBox26.Text = "" TextBox27.Text = "" TextBox1.Focus() End Sub Protected Sub TextBox4_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox4.TextChanged TextBox27.Text = "" End Sub Protected Sub TextBox20_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox20.TextChanged Dim CODIGOXP As String Dim REG As Integer Dim PARTIDA As Integer Dim CCOD As Integer Dim TTASA As Integer CODIGOXP = Format(REG, "0000") + Format(PARTIDA, "000000") + Format(CCOD, "00000") + Format(TTASA, "0000000") TextBox26.Text = Code128a(CODIGOXP, 0) End Sub Protected Sub Button4_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button4.Click End Sub Protected Sub Button5_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button5.Click Dim ofile As Object Dim oprinter As Object Dim impresora As String impresora = "Epson Stylus C67 Series (M)" ofile = CreateObject("Scripting.FileSystemObject") oprinter = ofile.CreateTextFile(impresora) oprinter.write("Titulo") oprinter.write("Fechac") oprinter.write("Horas") oprinter.CLOSE() End Sub End Class