I am a total novice with visual basic and teaching myself as I go along. I am building a VB in studio 2008 (I'm obliged to use this version) that logs into a device , transmits log in and password and then transmits commands read from a .txt file using reflections. All of this is working fine. The device executes the command and outputs 1 of 28 possible responses.
I am using select case to evaluate the responses and act accordingly. The device session stops as expected when EXECUTED is seen in the session window, my test data is designed so the first response I get is "EXECUTED", the weird thing is my VB "sees" the EXECUTED message (Case 1) but select case responds as if it has seen FAILED (Case 2), subsequent lines of the test data illicit different cases (5 and 6) but the response is always the next case along. I have tried Case n, case is = n, case "string value" but I get errors.
Here's my code - note that I haven't defined all 28 cases yet but the undefined ones are REM'ed out in my active version. Any ideas or suggestions would be gratefully received!
Option Explicit On
Public Class modCaseSelect
Shared Sub Dev_Responses(ByVal refl)
Dim Result As String
Dim CR = vbCr
Dim Resp As Integer
Dim Dev_Resp(28) As String
Dev_Resp(0) = "RUNNING"
Dev_Resp(1) = "EXECUTED"
Dev_Resp(2) = "FAILED"
Dev_Resp(3) = "SEMANTICS ERROR"
Dev_Resp(4) = "NONEXISTENT"
Dev_Resp(5) = "NOT FOUND"
Dev_Resp(6) = "SPECIAL"
Dev_Resp(7) = "CONFIRM: Y/N"
Dev_Resp(8) = "CONFIRM (Y/N)"
Dev_Resp(9) = "CONFIRM EXECUTION: Y/N"
Dev_Resp(10) = "ALREADY EXECUTED"
Dev_Resp(11) = ""
Dev_Resp(12) = ""
Dev_Resp(13) = ""
Dev_Resp(14) = ""
Dev_Resp(15) = ""
Dev_Resp(16) = ""
Dev_Resp(17) = ""
Dev_Resp(18) = ""
Dev_Resp(19) = ""
Dev_Resp(20) = ""
Dev_Resp(21) = ""
Dev_Resp(23) = ""
Dev_Resp(23) = ""
Dev_Resp(24) = ""
Dev_Resp(25) = ""
Dev_Resp(26) = ""
Dev_Resp(27) = ""
Dev_Resp(28) = "IN PROGRESS"
With refl
Select Case .WaitForStrings(Dev_Resp, "0:4:30") 'checkDev_Resp
Case 0 ' "RUNNING"
Result = Dev_Resp(0)
Resp = MsgBox((Dev_Resp(0) & CR & CR & Continue?"), 17, "Case 0 error")
Case 1 ' "EXECUTED"
Result = Dev_Resp(1)
Resp = MsgBox((Dev_Resp(1) & CR & CR & "Continue?"), 17, "Case 1")
Case 2 ' "FAILED"
Result = Dev_Resp(2)
Resp = MsgBox((Dev_Resp(2) & CR & CR & "Continue?"), 17, "Case 2 error")
Case 3 ' "SEMANTICS ERROR"
Result = Dev_Resp(3)
Resp = MsgBox((Dev_Resp(3) & CR & CR & "Continue?"), 17, "Case 3 error")
Case 4 ' "NONEXISTENT"
Result = Dev_Resp(4)
Resp = MsgBox((Dev_Resp(4) & CR & CR & "Continue?"), 17, "Case 4 error")
Case 5 ' "NOT FOUND"
Result = Dev_Resp(5)
Resp = MsgBox((Dev_Resp(5) & CR & CR & "Continue?"), 17, "Case 5 error")
Case 6 ' "SPECIAL"
Result = Dev_Resp(6)
Resp = MsgBox((Dev_Resp(6) & CR & CR & "Continue?"), 17, "Case 6 error")
Case 7 ' "CONFIRM: Y/N"
Result = Dev_Resp(7)
.Transmit("Y" & CR)
Case 8 ' "CONFIRM (Y/N)"
Result = Dev_Resp(8)
.Transmit("Y" & CR)
Case 9 ' "CONFIRM EXECUTION: Y/N"
Result = Dev_Resp(9)
.Transmit("Y" & CR)
Case 10 ' "ALREADY EXECUTED"
Result = Dev_Resp(10)
Resp = MsgBox((Dev_Resp(10) & CR & CR & "Continue?"), 17, "Case 10 error")
Case 11 ' ""
Result = Dev_Resp(11)
Case 12 ' ""
Result = Dev_Resp(12)
Case 13 ' ""
Result = Dev_Resp(13)
Case 14 ' ""
Result = Dev_Resp(14)
Case 15 ' ""
Result = Dev_Resp(15)
Case 16 ' ""
Result = Dev_Resp(16)
Case 17 ' ""
Result = Dev_Resp(17)
Case 18 ' ""
Result = Dev_Resp(18)
Case 19 ' ""
Result = Dev_Resp(19)
Case 20 ' ""
Result = Dev_Resp(20)
Case 21 ' ""
Result = Dev_Resp(21)
Case 22 ' ""
Result = Dev_Resp(22)
Case 23 ' ""
Result = Dev_Resp(23)
Case 24 ' ""
Result = Dev_Resp(24)
Case 25 ' ""
Result = Dev_Resp(25)
Case 26 ' ""
Result = Dev_Resp(26)
Case 27 ' ""
Result = Dev_Resp(27)
Case 28 ' "IN PROGRESS"
Result = Dev_Resp(28)
Resp = MsgBox((Dev_Resp(28) & CR & CR & "Continue?"), 17, "Case 28 error")
Case Else
End Select
End With
End Sub
End Class
You are missing a double quote " in your first Case. Try changing it to this:
Case 0 ' "RUNNING"
Result = Dev_Resp(0)
Resp = MsgBox((Dev_Resp(0) & CR & CR & "Continue?"), 17, "Case 0 error")
Notice I've added the double quote before "Continue?".
Get rid of the With statement. Create and assign a holder variable and use that with the select statement. Doing so will allow you to see what is actually getting passed into the select statement by setting a stop point in the debugger.
Dim temp_resp as integer = refl.WaitForStrings(Dev_Resp, "0:4:30")
Select Case temp_resp
'the case statements here.
End Select
Reflections WaitForStrings uses a zero-based array parameter, but it returns a 1-based index of strings. Waitforstrings sees array entry zero as the first valid entry so the first select case (Case = 1) corresponds to array entry 0.
Related
I wanted a visual basic in excel code to convert numbers into text. The code is already available on Microsoft site, but I wanted more specific one. So someone helped me and edited the Microsoft's code. It worked fine, but one critical problem occurred. I asked him for help but he is not responding anymore.
The problem is that if there is two parts, only the first part is written.
For example: 284,323.00 is written as "Two hundred eighty-four thousand dollars only"
877,666.00 is written as "Eight hundred seventy-seven thousand dollars only"
I want the full number to be converted into text like this : "877,666.00 > Eight hundred seventy-seven thousand six hundred sixty-six dollars only"
Can you help me correct the code?
This is the code:
Option Explicit
'Main Function
Function SpellNum_Dollar(ByVal MyNumber As Variant) As String
Dim Dollars, Cents, Temp, D
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert Cents and set MyNumber to dollars amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & D
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = ""
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNum_Dollar = LowerCaseWords(Dollars & Cents)
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty-"
Case 3: Result = "Thirty-"
Case 4: Result = "Forty-"
Case 5: Result = "Fifty-"
Case 6: Result = "Sixty-"
Case 7: Result = "Seventy-"
Case 8: Result = "Eighty-"
Case 9: Result = "Ninety-"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
If Right(Result, 1) = "-" Then
Result = Left(Result, Len(Result) - 1)
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function
Function LowerCaseWords(MyNumber As String) As String
'Splits the number into an array and then loops through the array, starting at the second word, and lower cases all of them
'Just need to check if the first word has a dash, if so, the first letter after the dash will be lower cased
Const ArrayLoopStart As Long = 1
Dim WordArray As Variant
Dim WordCounter As Long
Dim FindDash As Long
WordArray = Split(MyNumber, " ")
FindDash = InStr(1, WordArray(0), "-")
If FindDash > 0 Then
WordArray(0) = Left(WordArray(0), FindDash) & LCase(Mid(WordArray(0), FindDash + 1, 1)) & Right(WordArray(0), Len(WordArray(0)) - 1 - FindDash)
End If
For WordCounter = ArrayLoopStart To UBound(WordArray)
WordArray(WordCounter) = LCase(WordArray(WordCounter))
Next WordCounter
LowerCaseWords = Join(WordArray, " ")
End Function
I have an Excel file that contains some datas that I want to export into an Access db. In the C column I've got a field called 'Description'. Usually this field occupy just one cell, but it can happens that is more long.
In this case, for example, AP.01 has got 5 rows of description. How can update the first row with the next rows?
Public Sub updateDB(ByVal PathDB As String, str As String, id As Integer)
Dim db As New cDB
Dim v As New cVoce
Dim rs As ADODB.Recordset = db.RecordSet
v.Description = str
db.connetti_DB(PathDB)
db.get_rs("UPDATE Voice SET Description = '" + v.Description + "' WHERE id= '"+id+"'")
End Sub
Public Function get_rs(ByVal query As String) As ADODB.Recordset
If db Is Nothing Then rs = Nothing : Return rs
rs = New ADODB.Recordset
rs.CursorType = ADODB.CursorTypeEnum.adOpenStatic
rs.LockType = ADODB.LockTypeEnum.adLockOptimistic
rs.Open(query, db)
Return rs
End Function
This code doesn't work because I update my current row, for this reason is useless the UPDATE instruction. How can I fix my code?
EDIT I post here the For loop
For r = 2 To grid.RowCount - 1
vett = Split(grid(r, 1).Text)
total = UBound(Split(grid(r, 1).Text, "."))
If grid(r, 1).Text <> "" Then
Select Case total
Case 0
Dim chapter As New cChapter
flag = 1
id = id + 1
chapter.Cod = grid(r, 1).Text.Substring(0, 1)
chapter.Description = grid(r, 3).Text
If Left(vett(0), 1) >= Chr(65) And Left(vett(0), 1) <= Chr(90) Then
chapter.Cod = Left(vett(0), 1)
oldChap = chap.Cod
If chapter.Cod <> oldCap Then
chapters.Add(chapter)
End If
End If
chapters.Add(chapter)
stringChap = chap.Description
Dim par As New cParagraph
If Left(vett(0), 2) >= Chr(65) And Left(vett(0), 2) <= Chr(90) Then
par.Cod = Left(vett(0), 2)
par.Cod_Chapter = Left(vett(0), 1)
oldPar = par.Cod
If par.Cod <> oldPar Then
paragraphs.Add(par)
End If
End If
If grid(r, 3).Text.Length > 255 Then
par.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
par.Description = grid(r, 3).Text.ToString
End If
paragraphs.Add(par)
stringPar = par.Description
Case 1
flag = 2
id = id + 1
c_Voc = voc.Cod_Chapter
p_Voc = voc.Cod_Paragraph
voc.Cod_Chapter = grid(r, 1).Text.Substring(0, 1)
voc.Cod_Paragraph = grid(r, 1).Text.Split(".")(0)
voc.Cod_Voice = Right(vett(0), 2)
If grid(r, 3).Text.Length > 255 Then
voc.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
voc.Description = grid(r, 3).Text.ToString
If voc.Description.EndsWith("-") Then
a = Replace(voc.Description, "-", "")
voc.Description = a
End If
End If
stringVoice = voc.Description
voices.Add(voc)
voices.Save_DB(dbDest)
Case 2
flag = 3
id = id + 1
sVoice = New cVoice
oldSvoice = voice.Cod_SVoice
sVoice.Cod_SVoice = Left(vett(0), 2)
If sVoice.Cod_SVoce <> oldSvoice Then
voices.Add(sVoice)
voices.Save_DB(dbDest)
End If
If grid(r, 3).Text.Length > 255 Then
sVoice.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
sVoice.Description = grid(r, 3).Text
End If
stringSvoice = sVoice.Description
sVoice.Cod_Voce = Left(vett(0), 5)
sVoice.Price1 = grid(r, 12).Text
sVoice.Price2 = sVoice.Price1
sVoice.UniMi = grid(r, 11).Text
sVoce.Sep = "."
voices.Add(sVoce)
voices.Save_DB(dbDest)
End Select
Else
If flag = 1 Then
stringChap = grid(r, 3).Text
chap.Description = stringChap & grid(r, 3).Text
stringPar = grid(r, 3).Text
paragraph.Description = stringPar & grid(r, 3).Text
End If
If flag = 2 Then
stringVoice = grid(r, 3).Text
voc.Description = voc.Description & stringVoice
voices.updateDB(dbDest, stringVoice, id)
voices.Add(voc)
End If
If flag = 3 Then
stringSvoice = grid(r, 3).Text
sVoice.Description = stringSvoice & grid(r, 3).Text
voices.Add(sVoice)
End If
chapter.Save_DB(dbDest)
paragraph.Save_DB(dbDest)
voice.Save_DB(dbDest)
End If
Next
EDIT2 I declared id As Integer and when Code column has a value then id=id+1. In this way I always know which row I have to modify. I modified also updateDB (now I'm using 3 parameters) and I added a WHERE condition into my query. Despite the update, nothing has changed
In database you cannot store records without PrimaryKey (actually you can, but it is bad idea). Since in your solution id is in fact Excel row number (sorry if I'm not correct but it looks like from code) it could be very hard to maintain it in future (in case someone add or remove description row). It would be better to change id column to text and use code as PK.
Storing description then could be solved in 2 ways:
1) Concatenate all rows containing description into 1 variable adding vbNewLine in between and store it in description field.
2) More relational but also more complex - create 2nd table for description with PK as i.e. autonumber, ForeignKey Code referring to main table. Maintenance will be here very complex. Not really worth effort.
Amount of changes in code is quite big, so sorry I'll not provide fixed code but I hope idea is clear.
BTW: The reason why description is not updated is described in your post. You are increasing id only when code is present, so every description field from first group have id = 1. The most simple fix in your code would be to create 2 update statements - One for rows with code
UPDATE Voice SET Description = '" + v.Description + "' WHERE id= '"+id+"'
Second one for rows without code:
UPDATE Voice SET Description = Description + CHAR(13) + CHAR(10) + '" + v.Description + "' WHERE id= '"+id+"'
This code is supposed to create a graph of revenue from money made through sales tickets at an event.
The code only executes up to da.Fill(ds) when it returns the error, which can be seen at the end of the code.
Does anybody know why
Private Sub frmRevenue_Load(sender As Object, e As EventArgs) Handles Me.Load
frmMDI.addFormToCMS()
Dim dt As DataTable
dt = New DataTable
dt.Columns.Add("Fee")
Dim sales As Integer = 0
Dim gridtable As New DataTable
gridtable.Columns.Add("Month")
gridtable.Columns.Add("Total")
gridtable.Columns.Add("#")
For i = 1 To 12
sql = "SELECT Fee FROM tblTickets WHERE MONTH(DatePurchased) = " & i & " AND (YEAR(DatePurchased) = " & Today.Year & " OR " & Year(Today.AddYears(1)) & ") AND (Status = 'SOLD' OR RESERVED" _
& " = 'AWAITING CONFIRMATION' OR Status = 'AVAILABLE' OR Status = 'AWAITING PAYMENT');"
da = New OleDb.OleDbDataAdapter(sql, con)
ds = New DataSet
da.Fill(ds)
Dim dr As DataRow
For Each dr In ds.Tables(0).Rows
monthly(i) = monthly(i) + 1
contracts = sales + 1
total(i) = total(i) + dr.Item("Fee")
yearlytotal = yearlytotal + dr.Item("Fee")
Next
Next
For i = 1 To 12
Dim month As String
Select Case i
Case 1
month = "Jan"
Case 2
month = "Feb"
Case 3
month = "Mar"
Case 4
month = "Apr"
Case 5
month = "May"
Case 6
month = "Jun"
Case 7
month = "Jul"
Case 8
month = "Aug"
Case 9
month = "Sep"
Case 10
month = "Oct"
Case 11
month = "Nov"
Case 12
month = "Dec"
Case Else
month = "ERR"
End Select
gridtable.Rows.Add(month, FormatCurrency(total(i)), monthly(i))
Next
ugTickets.DataSource = gridtable
ugTickets.DisplayLayout.Bands(0).Columns("Month").Width = 35
ugTickets.DisplayLayout.Bands(0).Columns("#").Width = 20
ugTickets.DisplayLayout.Override.AllowUpdate = DefaultableBoolean.False
txtAnnual.ReadOnly = True
txtAnnual.BackColor = Color.White
txtAnnualContracts.ReadOnly = True
txtAnnualContracts.BackColor = Color.White
chRevenue.Titles("chTitle").Text = "Predicted revenue for " & Today.Year & " - " & Year(Today.AddYears(1))
txtAnnual.Text = FormatCurrency(yearlytotal, 2)
txtAnnualContracts.Text = contracts
chRevenue.Series("Series1").Name = "Revenue"
For i = 1 To 12
chRevenue.Series("Revenue").Points.AddY(total(i))
Next
Try
chRevenue.BackColor = Color.Transparent
chRevenue.Legends("Revenue").BackColor = Color.Transparent
chRevenue.Series("Revenue").ChartArea = "ChartArea1"
chRevenue.Series("Revenue").Color = Color.SkyBlue
chRevenue.Series("Revenue").ToolTip = FormatCurrency("#VALY", 2)
Catch
End Try
End Sub
An expression of non-boolean type specified in a context where a condition is expected, near ')'.
The problem is with this bit of the SQL:
(YEAR(DatePurchased) = " & Today.Year & " OR " & Year(Today.AddYears(1)) & ")
It should probably be
(YEAR(DatePurchased) = " & Today.Year & " OR YEAR(DatePurchased) = " & Year(Today.AddYears(1)) & ")
The OR in SQL (and in most other languages) needs to have two independently valid conditions on each side. The left hand side currently looks like this:
YEAR(DatePurchased) = 2016
...which is fine. But the right looks like this:
2017
...which isn't a valid boolean.
When you get an error like this on the da.Fill() line (ie. the line that's actually running the SQL in the database), the easiest way to debug it is to print out the value of the "sql" variable.
Often, you can just look at the SQL it's generated and the problem will be obvious. Other times you have to copy it and run it directly against your database to see what the problem is.
Might be your SQL, try:
"SELECT Fee FROM tblTickets WHERE MONTH(DatePurchased) = '" & i &
"' AND (YEAR(DatePurchased) = '" & Today.Year &
"' OR '" & Year(Today.AddYears(1)) & "') " &
"AND (Status = 'SOLD' OR RESERVED = 'AWAITING CONFIRMATION' " &
"OR Status = 'AVAILABLE' " &
"OR Status = 'AWAITING PAYMENT');"
I am trying to convert a number to a word from a RDLC report:
Public Shared Function changeToWords(ByVal numb As [String]) As [String]
Dim val As [String] = ""
Dim wholeNo As [String] = numb
Dim points As [String] = ""
Dim andStr As [String] = ""
Dim pointStr As [String] = ""
Dim endStr As [String] = ""
Try
Dim decimalPlace As Integer = numb.IndexOf(".")
If decimalPlace > 0 Then
wholeNo = numb.Substring(0, decimalPlace)
points = numb.Substring(decimalPlace + 1)
If Convert.ToInt32(points) > 0 Then
andStr = "point"
' just to separate whole numbers from points
pointStr = translateCents(points)
End If
End If
val = [String].Format("{0} {1}{2} {3}", translateWholeNumber(wholeNo).Trim(), andStr, pointStr, endStr)
Catch
End Try
Return val
End Function
Private Shared Function translateWholeNumber(ByVal number As [String]) As [String]
Dim word As String = ""
Try
Dim beginsZero As Boolean = False
'tests for 0XX
Dim isDone As Boolean = False
'test if already translated
Dim dblAmt As Double = (Convert.ToDouble(number))
'if ((dblAmt > 0) && number.StartsWith("0"))
If dblAmt > 0 Then
'test for zero or digit zero in a nuemric
beginsZero = number.StartsWith("0")
Dim numDigits As Integer = number.Length
Dim pos As Integer = 0
'store digit grouping
Dim place As [String] = ""
'digit grouping name:hundres,thousand,etc...
Select Case numDigits
Case 1
'ones' range
word = ones(number)
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 2
'tens' range
word = tens(number)
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 3
'hundreds' range
pos = (numDigits Mod 3) + 1
place = " Hundred "
Exit Select
' TODO: might not be correct. Was : Exit Select
'thousands' range
Case 4, 5, 6
pos = (numDigits Mod 4) + 1
place = " Thousand "
Exit Select
' TODO: might not be correct. Was : Exit Select
'millions' range
Case 7, 8, 9
pos = (numDigits Mod 7) + 1
place = " Million "
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 10
'Billions's range
pos = (numDigits Mod 10) + 1
place = " Billion "
Exit Select
Case Else
' TODO: might not be correct. Was : Exit Select
'add extra case options for anything above Billion...
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
If Not isDone Then
'if transalation is not done, continue...(Recursion comes in now!!)
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
'check for trailing zeros
If beginsZero Then
word = " and " & word.Trim()
End If
End If
'ignore digit grouping names
If word.Trim().Equals(place.Trim()) Then
word = ""
End If
End If
Catch
End Try
Return word.Trim()
End Function
Private Shared Function tens(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = Nothing
Select Case digt
Case 10
name = "Ten"
Exit Select
' TODO: might not be correct. Was : Exit Select \
Case 11
name = "Eleven"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 12
name = "Twelve"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 13
name = "Thirteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 14
name = "Fourteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 15
name = "Fifteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 16
name = "Sixteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 17
name = "Seventeen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 18
name = "Eighteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 19
name = "Nineteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 20
name = "Twenty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 30
name = "Thirty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 40
name = "Fourty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 50
name = "Fifty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 60
name = "Sixty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 70
name = "Seventy"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 80
name = "Eighty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 90
name = "Ninety"
Exit Select
Case Else
' TODO: might not be correct. Was : Exit Select
If digt > 0 Then
name = (Convert.ToString(tens(digit.Substring(0, 1) & "0")) & " ") & Convert.ToString(ones(digit.Substring(1)))
End If
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
Return name
End Function
Private Shared Function ones(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = ""
Select Case digt
Case 1
name = "One"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 2
name = "Two"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 3
name = "Three"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 4
name = "Four"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 5
name = "Five"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 6
name = "Six"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 7
name = "Seven"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 8
name = "Eight"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 9
name = "Nine"
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
Return name
End Function
Private Shared Function translateCents(ByVal cents As [String]) As [String]
Dim cts As [String] = ""
Dim digit As [String] = ""
Dim engOne As [String] = ""
For i As Integer = 0 To cents.Length - 1
digit = cents(i).ToString()
If digit.Equals("0") Then
engOne = "Zero"
Else
engOne = ones(digit)
End If
cts += " " & engOne
Next
Return cts
End Function
I am getting the wrong output from the conversion.
For 52001 the given output is Fifty Two Thousand and Hundred One.
However, it should be Fifty Two Thousand and One.
You'll need to add a conditional statement to modify your string concatenation behavior when the beginning of your substring is a zero.
'if transalation is not done, continue...(Recursion comes in now!!)
If (number.Substring(0, 1) = "0") Then
word = translateWholeNumber(number.Substring(pos))
Else
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
End If
Edit: Doing this breaks output if the original string sent to changeToWords begins with any zeros. To rectify that condition, you can trim leading zeros, before the string is processed:
Dim wholeNo As [String] = numb.TrimStart("0"c)
Just change this line:
If Not isDone Then
'if transalation is not done, continue...(Recursion comes in now!!)
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
'check for trailing zeros
If beginsZero Then
word = translateWholeNumber(number.Substring(0, pos))+ " and " + translateWholeNumber(number.Substring(pos))
End If
End If
Using the below functions how could I use a stored procedure with parameters.
I have to call a stored procedure using parameters for work experience but i can't seem to work how this would work, usually i would have a command.execute in a recordset parameter then loop through the recordset to get my output.
The below functions are a selected few of which I narrowed down to use. I have called a stored procedure using the recordset function.
recordset
function Recordset(sNewCommandText, iNewCommandType, iNewCommandTimeout, lng_RecordsetNumber)
obj_Command.CommandText = sNewCommandText
if IsNumeric(iNewCommandType) then
obj_Command.CommandType = iNewCommandType
else
obj_Command.CommandType = 1
end if
if IsNumeric(iNewCommandTimeout) then
obj_Command.CommandTimeout = iNewCommandTimeout
else
obj_Command.CommandTimeout = 3
end if
if RecordsetIsOpen(lng_RecordsetNumber) = 1 then
CloseRecordset lng_RecordsetNumber
end if
select case lng_RecordsetNumber
case 0
case 1
obj_Recordset1.Open obj_Command
case 2
obj_Recordset2.Open obj_Command
case 3
obj_Recordset3.Open obj_Command
case else
obj_ExtraRecSets.Item(lng_RecordsetNumber).Open obj_Command
end select
end function
Execute
function Execute(sNewCommandText, iNewCommandType, iNewCommandTimeout)
Execute= 0
obj_Command.CommandText = sNewCommandText
if IsNumeric(iNewCommandType) then
obj_Command.CommandType = iNewCommandType
else
obj_Command.CommandType = 1
end if
if IsNumeric(iNewCommandTimeout) then
obj_Command.CommandTimeout = iNewCommandTimeout
else
obj_Command.CommandTimeout = 3
end if
obj_Command.Execute
Execute= 1
end function
Get field
function GetField(FieldNumber, iFieldAttribute, lng_RecordsetNumber)
dim lng_tmpcnt
if RecordsetIsOpen(lng_RecordsetNumber) = 1 and IsNumeric(iFieldAttribute) and BOF(lng_RecordsetNumber) = 0 and EOF(lng_RecordsetNumber) = 0 then
select case iFieldAttribute
case 0
select case lng_RecordsetNumber
case 1
GetField = obj_Recordset1.Fields(FieldNumber).Type
case 2
GetField = obj_Recordset2.Fields(FieldNumber).Type
case 3
GetField = obj_Recordset3.Fields(FieldNumber).Type
case else
GetField = obj_ExtraRecSets.Item(lng_RecordsetNumber).Fields(FieldNumber).Type
end select
case 1
select case lng_RecordsetNumber
case 1
GetField = obj_Recordset1.Fields(FieldNumber).Name
case 2
GetField = obj_Recordset2.Fields(FieldNumber).Name
case 3
GetField = obj_Recordset3.Fields(FieldNumber).Name
case else
GetField = obj_ExtraRecSets.Item(lng_RecordsetNumber).Fields(FieldNumber).Name
end select
case 2
select case lng_RecordsetNumber
case 1
GetField = obj_Recordset1.Fields(FieldNumber).Value
case 2
GetField = obj_Recordset2.Fields(FieldNumber).Value
case 3
GetField = obj_Recordset3.Fields(FieldNumber).Value
case else
GetField = obj_ExtraRecSets.Item(lng_RecordsetNumber).Fields(FieldNumber).Value
end select
case 3
select case lng_RecordsetNumber
case 1
GetField = obj_Recordset1.Fields(FieldNumber).ActualSize
case 2
GetField = obj_Recordset2.Fields(FieldNumber).ActualSize
case 3
GetField = obj_Recordset3.Fields(FieldNumber).ActualSize
case else
GetField = obj_ExtraRecSets.Item(lng_RecordsetNumber).Fields(FieldNumber).ActualSize
end select
case else
select case lng_RecordsetNumber
case 1
for lng_tmpcnt=0 to obj_Recordset1.Fields(FieldNumber).Properties.count-1
if lng_tmpcnt <> 15 and lng_tmpcnt <> 17 then
GetField = GetField & lng_tmpcnt & " (" & obj_Recordset1.Fields(FieldNumber).Properties(lng_tmpcnt).name & "(" & obj_Recordset1.Fields(FieldNumber).Properties(lng_tmpcnt).type & ")= " & obj_Recordset1.Fields(FieldNumber).Properties(lng_tmpcnt).value & ")<br>" & vbcrlf
end if
next
case 2
for lng_tmpcnt=0 to obj_Recordset2.Fields(FieldNumber).Properties.count-1
if lng_tmpcnt <> 15 and lng_tmpcnt <> 17 then
GetField = GetField & lng_tmpcnt & " (" & obj_Recordset2.Fields(FieldNumber).Properties(lng_tmpcnt).name & "(" & obj_Recordset2.Fields(FieldNumber).Properties(lng_tmpcnt).type & ")= " & obj_Recordset1.Fields(FieldNumber).Properties(lng_tmpcnt).value & ")<br>" & vbcrlf
end if
next
case 3
for lng_tmpcnt=0 to obj_Recordset3.Fields(FieldNumber).Properties.count-1
if lng_tmpcnt <> 15 and lng_tmpcnt <> 17 then
GetField = GetField & lng_tmpcnt & " (" & obj_Recordset3.Fields(FieldNumber).Properties(lng_tmpcnt).name & "(" & obj_Recordset3.Fields(FieldNumber).Properties(lng_tmpcnt).type & ")= " & obj_Recordset3.Fields(FieldNumber).Properties(lng_tmpcnt).value & ")<br>" & vbcrlf
end if
next
case else
end select
end select
end if
end function
This function takes the name of the SP and an array of parameters and returns a disconnected recordset
Function RunSPReturnRS(strSP, params())
On Error Resume next
''//Create the ADO objects
Dim rs , cmd
Set rs = server.createobject("ADODB.Recordset")
Set cmd = server.createobject("ADODB.Command")
''//Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = strSP
cmd.CommandType = adCmdStoredProc
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
dim i
for i = 0 to ubound( Params )
''//Use: .CreateParameter("#inVar1", 200, 1, 255, VALUE1) to create the parameters
cmd.Parameters.Append Params(i)
next
''//Execute the query for readonly
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
If err.number > 0 then
exit function
end if
''//Disconnect the recordset
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set rs.ActiveConnection = Nothing
''//Return the resultant recordset
Set RunSPReturnRS = rs
End Function
Or check this question for more info creating parameters Execute Stored Procedure from Classic ASP