First part of the code is to retrieve data from the web. It takes only a part of the second to complete the request. Second part of the code is to split data so that parts of data can be shown in different labels and it takes around 5-6 second to complete this operation?
Why is that? Can it be done faster?
First part of the code (textbox1 key down event)
If e.KeyCode = Keys.Enter Then
TextBox1.Text = UCase(TextBox1.Text)
If TextBox1.Text = "" Then
GoTo exx
Else
Dim strURL As String
Dim strSymbol As String = TextBox1.Text
strURL = " http://quote.yahoo.com/d/quotes.csv?" & _
"s=" & strSymbol & _
"&d=t" & _
"&f=snl1pmwvj1l1"
MessageBox.Show(RequestWebData(strURL))
Second part of the code and functions :
Label24.Text = (GetName2(RequestWebData(strURL), 3))
Dim myText = Label24.Text
Dim dIndex = myText.IndexOf("Inc.")
If (dIndex > -1) Then
Label24.Text = (Strings.Left(Label24.Text, dIndex + 4))
Else
Label24.Text = (Label24.Text)
End If
Dim myText2 = Label24.Text
Dim dIndex2 = myText2.IndexOf("Common")
If (dIndex2 > -1) Then
Label24.Text = (Label24.Text.Replace("Common", ""))
Else
Label24.Text = (Label24.Text)
End If
Label6.Text = (GetName(RequestWebData(strURL), 4))
Label6.Text = (GetName3(Label6.Text, 1))
Label6.Text = FormatNumber(Label6.Text, 2)
Label17.Text = (GetName(RequestWebData(strURL), 5))
Label21.Text = (GetName(RequestWebData(strURL), 7))
Dim x As String = GetName(RequestWebData(strURL), 8)
Label30.Text = GetName3(x, 1)
Label30.Text = FormatNumber(Label30.Text, 0)
Label32.Text = GetName3(x, 2)
TextBox2.Focus()
Function GetName(ByVal LineIn As String, ByVal i As Integer) As String
'Dim x As Integer
Return LineIn.Split(""",")(i)
End Function
Function GetName2(ByVal LineIn As String, ByVal i As Integer) As String
'Dim x As Integer
Return LineIn.Split("""")(i)
End Function
Function GetName3(ByVal LineIn As String, ByVal i As Integer) As String
'Dim x As Integer
Return LineIn.Split(",")(i)
End Function
Maybe it is so slow because of these three functions that I am using to split data?
Related
I have created a service that is supposed to pass data from SQL to CSV, by creating a CSV file. It has no errors, but i run it and nothing happens.
1) Is there something I am missing?
2) If it works, and i want to convert to txt file, is it enough to change the "CSV" to "txt" parts?
My code:
#Region "Export SQL TO CSV"
Public Shared Function WriteCSV(ByVal input As String) As String
Try
If (input Is Nothing) Then
Return String.Empty
End If
Dim containsQuote As Boolean = False
Dim containsComma As Boolean = False
Dim len As Integer = input.Length
Dim i As Integer = 0
Do While ((i < len) _
AndAlso ((containsComma = False) _
OrElse (containsQuote = False)))
Dim ch As Char = input(i)
If (ch = Microsoft.VisualBasic.ChrW(34)) Then
containsQuote = True
ElseIf (ch = Microsoft.VisualBasic.ChrW(44)) Then
containsComma = True
End If
i = (i + 1)
Loop
If (containsQuote AndAlso containsComma) Then
input = input.Replace("""", """""")
End If
If (containsComma) Then
Return """" & input & """"
Else
Return input
End If
Catch ex As Exception
Throw
End Try
End Function
Private Sub ExtoCsv(ByVal sender As Object, ByVal e As EventArgs)
Dim sb As StringBuilder = New StringBuilder
Using db As Database.RecordSet = admin.Database.OpenRecordsetReadOnly("select USERID, NAME1 from usertable WHERE I_ID=2")
Dim userid As String = db("USERID").Value
Dim name1 As String = db("NAME1").Value
For i As Integer = 1 To db.RecordCount
sb.Append(WriteCSV(userid + "," + name1 + ","))
sb.AppendLine()
db.MoveNext()
Next
End Using
File.WriteAllText("C:\Users\user1\Desktop\ex1.csv", sb.ToString)
If (Not System.IO.Directory.Exists("C:\Users\user1\Desktop\ex1")) Then
System.IO.Directory.CreateDirectory("C:\Users\user1\Desktop\ex1")
End If
End Sub
#End Region
I am new with this encryption stuff and also i am looking into a pervious engineers code. The encrypt works find but i would like a decryptor, i am not sure what or how to start
There is a PasswordEncryption class which looks as below
Public Class PasswordEncryption
Public Shared arrBase64EncMap(64) As String
Public Shared arrBase64DecMap(127) As Integer
Const BASE_64_MAP_INIT As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Public Shared Function EncryptionPassword() As String
Return "F2oWrB4sA3feEh1tz"
End Function
Public Shared Function simpleXor(ByVal strIn As String, ByVal strKey As String) As String
Dim iInIndex As Integer
Dim iKeyIndex As Integer
Dim strReturn As String
If Len(strIn) = 0 Or Len(strKey) = 0 Then
simpleXor = ""
Exit Function
End If
iInIndex = 1
iKeyIndex = 1
strReturn = ""
'** Step through the plain text source XORing the character at each point with the next character in the key **
'** Loop through the key characters as necessary **
Do While iInIndex <= Len(strIn)
strReturn = strReturn & Chr(Asc(Mid(strIn, iInIndex, 1)) Xor Asc(Mid(strKey, iKeyIndex, 1)))
iInIndex = iInIndex + 1
If iKeyIndex = Len(strKey) Then iKeyIndex = 0
iKeyIndex = iKeyIndex + 1
Loop
simpleXor = strReturn
End Function
Public Shared Function base64Encode(ByVal strPlain As String) As String
Dim iLoop As Integer
Dim iBy3 As Integer
Dim strReturn As String
Dim iIndex As Integer
Dim iFirst As Integer
Dim iSecond As Integer
Dim iiThird As Integer
If strPlain.Length = 0 Then
base64Encode = ""
Exit Function
End If
'** Set up Base64 Encoding and Decoding Maps for when we need them **
For iLoop = 0 To Len(BASE_64_MAP_INIT) - 1
arrBase64EncMap(iLoop) = Mid(BASE_64_MAP_INIT, iLoop + 1, 1)
Next
For iLoop = 0 To Len(BASE_64_MAP_INIT) - 1
arrBase64DecMap(Asc(arrBase64EncMap(iLoop))) = iLoop
Next
'** Work out rounded down multiple of 3 bytes length for the unencoded text **
iBy3 = (strPlain.Length \ 3) * 3
strReturn = ""
'** For each 3x8 byte chars, covert them to 4x6 byte representations in the Base64 map **
iIndex = 1
Do While iIndex <= iBy3
iFirst = Asc(Mid(strPlain, iIndex + 0, 1))
iSecond = Asc(Mid(strPlain, iIndex + 1, 1))
iiThird = Asc(Mid(strPlain, iIndex + 2, 1))
strReturn = strReturn & arrBase64EncMap((iFirst \ 4) And 63)
strReturn = strReturn & arrBase64EncMap(((iFirst * 16) And 48) + ((iSecond \ 16) And 15))
strReturn = strReturn & arrBase64EncMap(((iSecond * 4) And 60) + ((iiThird \ 64) And 3))
strReturn = strReturn & arrBase64EncMap(iiThird And 63)
iIndex = iIndex + 3
Loop
'** Handle any trailing characters not in groups of 3 **
'** Extend to multiple of 3 characters using = signs as per RFC **
If iBy3 < strPlain.Length Then
iFirst = Asc(Mid(strPlain, iIndex + 0, 1))
strReturn = strReturn & arrBase64EncMap((iFirst \ 4) And 63)
If (strPlain.Length Mod 3) = 2 Then
iSecond = Asc(Mid(strPlain, iIndex + 1, 1))
strReturn = strReturn & arrBase64EncMap(((iFirst * 16) And 48) + ((iSecond \ 16) And 15))
strReturn = strReturn & arrBase64EncMap((iSecond * 4) And 60)
Else
strReturn = strReturn & arrBase64EncMap((iFirst * 16) And 48)
strReturn = strReturn & "="
End If
strReturn = strReturn & "="
End If
'** Return the encoded result string **
base64Encode = strReturn
End Function
End Class
I have a simple form which has two buttons Encrypt and Decrypt and couple of textboxes.
The click event of the encrypt button does the following
Private Sub btnEncrypt_Click(sender As Object, e As EventArgs) Handles btnEncrypt.Click
If tbxPassword.Text IsNot Nothing Then
Dim PasswordEncryption As PasswordEncryption = New PasswordEncryption()
Dim strXOR As String = PasswordEncryption.simpleXor(Strings.Left(tbxPassword.Text.ToString().Trim, 20), PasswordEncryption.EncryptionPassword)
Dim encryptedPassword = PasswordEncryption.base64Encode(strXOR)
tbxResult.Text = encryptedPassword
Else
MessageBox.Show("No action can be performed")
End If
End Sub
I have the following code in the decrypt button but it does not bring my original string back
Private Sub btnDecrypt_Click(sender As Object, e As EventArgs) Handles btnDecrypt.Click
If tbxPassword.Text IsNot Nothing Then
Dim PasswordEncryption As PasswordEncryption = New PasswordEncryption()
Dim strXOR As String = PasswordEncryption.simpleXor(Strings.Left(tbxPassword.Text.ToString().Trim, 20), PasswordEncryption.EncryptionPassword)
Dim decryptedPassword = PasswordEncryption.base64Encode(strXOR)
tbxResult.Text = decryptedPassword
Else
MessageBox.Show("No action can be performed")
End If
What is that i need to implement to get the original string back. Thank you guys!
Ok guys i have figured it out from the following link
https://www.codingforums.com/archive/index.php/t-28425.html
I have included the decode method and as per comment from MarkL I have first Base64Decoded the string and then performed simpleXOR and i got the original string back.
My decrypt method looks like this
Private Sub btnDecrypt_Click(sender As Object, e As EventArgs) Handles btnDecrypt.Click
If tbxPassword.Text IsNot Nothing Then
Dim PasswordEncryption As PasswordEncryption = New PasswordEncryption()
' Dim strXOR As String = PasswordEncryption.simpleXor(Strings.Left(tbxPassword.Text.ToString().Trim, 20), PasswordEncryption.EncryptionPassword)
Dim base64DecodedValue = PasswordEncryption.base64Decode(tbxPassword.Text)
tbxResult.Text = PasswordEncryption.simpleXor(Strings.Left(base64DecodedValue.Trim, 20), PasswordEncryption.EncryptionPassword)
Else
MessageBox.Show("No action can be performed")
End If
End Sub
If I manually put my address in for EmailMessage.To.Add(GetDelimitedField(x, strEmailRep, ";")) It sends me the message just fine. However If I use the code as is below which is using a list that looks like ;email1#mail.com;email2.mail.com
Then it gives an error that email address cannot be blank
Somewhere in GetDelimitedField is erasing addresses. I'm not sure where the problem is actually occurring. Here is all the code involved with this.
strmsg = "LOW STOCK ALERT: Component (" & rsMPCS("MTI_PART_NO") & ") has reached or fallen below it's minimum quantity(" & rsMPCS("MIN_QTY") & ")."
Dim EmailMessage As MailMessage = New MailMessage
EmailMessage.From = New MailAddress("noreply#mail.com")
For x = 1 To GetCommaCount(strEmailRep) + 1
EmailMessage.To.Add(GetDelimitedField(x, strEmailRep, ";"))
Next
EmailMessage.Subject = ("LOW STOCK ALERT!")
EmailMessage.Body = strmsg
EmailMessage.Priority = MailPriority.High
EmailMessage.IsBodyHtml = True
Dim smtp As New SmtpClient("smtp.mycompany.com")
smtp.UseDefaultCredentials = True
smtp.Send(EmailMessage)
Public Function GetCommaCount(ByVal sText As String)
Dim X As Integer
Dim Count As Integer
Dim Look As String
For X = 1 To Len(sText)
Look = Microsoft.VisualBasic.Left(sText, X)
If InStr(X, Look, ";", 1) > 0 Then
Count = Count + 1
End If
Next
GetCommaCount = Count
End Function
Public Function GetDelimitedField(ByRef FieldNum As Short, ByRef DelimitedString As String, ByRef Delimiter As String) As String
Dim NewPos As Short
Dim FieldCounter As Short
Dim FieldData As String
Dim RightLength As Short
Dim NextDelimiter As Short
If (DelimitedString = "") Or (Delimiter = "") Or (FieldNum = 0) Then
GetDelimitedField = ""
Exit Function
End If
NewPos = 1
FieldCounter = 1
While (FieldCounter < FieldNum) And (NewPos <> 0)
NewPos = InStr(NewPos, DelimitedString, Delimiter, CompareMethod.Text)
If NewPos <> 0 Then
FieldCounter = FieldCounter + 1
NewPos = NewPos + 1
End If
End While
RightLength = Len(DelimitedString) - NewPos + 1
FieldData = Microsoft.VisualBasic.Right(DelimitedString, RightLength)
NextDelimiter = InStr(1, FieldData, Delimiter, CompareMethod.Text)
If NextDelimiter <> 0 Then
FieldData = Microsoft.VisualBasic.Left(FieldData, NextDelimiter - 1)
End If
GetDelimitedField = FieldData
End Function
You can split the list easier using string.Split:
Dim strEmails = "a#test.com;b#test.com;c#test.com;"
Dim lstEmails = strEmails.Split(";").ToList()
'In case the last one had a semicolon:
If (lstEmails(lstEmails.Count - 1).Trim() = String.Empty) Then
lstEmails.RemoveAt(lstEmails.Count - 1)
End If
If (lstEmails.Count > 0) Then
lstEmails.AddRange(lstEmails)
End If
I am trying to convert the following VB6 code to VB.NET:
Public Function SingleToHex(ByVal Tmp As Single) As String
Dim TmpBytes(0 To 3) As Byte
Dim TmpSng As Single
Dim tmpStr As String
Dim x As Long
TmpSng = Tmp
Call CopyMemory(ByVal VarPtr(TmpBytes(0)), ByVal VarPtr(TmpSng), 4)
For x = 3 To 0 Step -1
If Len(Hex(TmpBytes(x))) = 1 Then
tmpStr = tmpStr & "0" & Hex(TmpBytes(x))
Else
tmpStr = tmpStr & Hex(TmpBytes(x))
End If
Next x
SingleToHex = tmpStr
End Function
I tried to find a function in the "Conversions" namespace, but I did not find any.
Can anybody tell me how this can easily be done?
Public Function SingleToHex(ByVal Tmp As Single) As String
Dim arr = BitConverter.GetBytes(Tmp)
Array.Reverse(arr)
Return BitConverter.ToString(arr).Replace("-", "")
End Function
Can you help me in having a proper casing,
I have this code...
Private Function NameCsing(ByVal sValue As String) As String
Dim toConvert As String() = sValue.Split(" ")
Dim lst As New List(Of String)
For i As Integer = 0 To toConvert.Length - 1
Dim converted As String = ""
If toConvert(i).Contains("~") Then
Dim toName As String() = toConvert(i).Split("~")
Dim sName As String = ""
For n As Integer = 0 To toName.Length - 1
Dim sconvert As String = ""
If n = 0 Then
sName = StrConv(toName(n), VbStrConv.ProperCase)
Else
sName += StrConv(toName(n), VbStrConv.ProperCase)
End If
Next
converted = sName
Else
converted = toConvert(i)
End If
lst.Add(converted)
Next
Dim ret As String = ""
For i As Integer = 0 To lst.Count - 1
If i = 0 Then
ret = lst(0)
Else
ret += " " + lst(i)
End If
Next
Return ret
End Function
My codes will just output like this "McDonalds" is you input "mc~donalds"
now my problem is eh I input "evalue", my output must be "eValue"
The only way to know how to treat a special string is to code it yourself from a list of rules:
Private Function NameCsing(ByVal sValue As String) As String
If sValue.Trim.ToLower = "evalue" Then Return "eValue"
'Then process any other special cases
End Function