calling HTTP web page in vb.net - vb.net

i have this code in my vb.net application:
myHttpWebRequest = WebRequest.Create(url)
myHttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
receivestream = myHttpWebResponse.GetResponseStream()
encode = System.Text.Encoding.GetEncoding("utf-8")
Dim readStream As New StreamReader(receivestream, encode)
response = readStream.ReadToEnd()
myHttpWebResponse.Close()
receivestream.Close()
readStream.Close()
TextBox1.Text = TextBox1.Text + DateTime.Now.ToString("dd/MM/yyyy HH:mm:ss") + vbCrLf + "URL: " + url + vbCrLf + vbCrLf
'scroll to bottom
TextBox1.SelectionStart = TextBox1.Text.Length
TextBox1.ScrollToCaret()
Me.Refresh()
Else
TextBox1.Text = TextBox1.Text + "Could not contact server for: " + url + vbCrLf + vbCrLf
'scroll to bottom
TextBox1.SelectionStart = TextBox1.Text.Length
TextBox1.ScrollToCaret()
Me.Refresh()
End If
sometimes i get 500 internal server errors or 404 not found
also if the internet connection goes down that this program is running on i get an error too
the above code is inside a loop. how can i just skip this loop if there is an error

Use a try catch outside your loop, and log your errors. You can exit a for loop with a simple Exit keyword. Also you can refactor your code into a single method and just exit that as well.

Related

Image location won't write to file and Image won't load from file location

well I want to make the program write a an image location to a text file, and then when the user presses the "load" button, it reads that image location and sets it as the Image of the PictureBox, but so far I have had no success at all.
Private Sub Btn_Save_Click(sender As Object, e As EventArgs) Handles Btn_Save.Click
Dim path As String = My.Computer.FileSystem.SpecialDirectories.MyPictures + "\Card Library\Configs\" + "config_card.aygo"
Dim path2 As String = My.Computer.FileSystem.SpecialDirectories.MyPictures + "\Card Library\Configs\" + "set_cardimg.aygo"
' Create or overwrite the file.
Dim fs As FileStream = File.Create(path)
Dim fs2 As FileStream = File.Create(path2)
' Add text to the file.
Dim info As Byte() =
New UTF8Encoding(True).GetBytes(
"----------Saved Card Settings----------" + vbNewLine +
"Level: " + My.Settings.Level.ToString + vbNewLine +
"NoMonster: " + My.Settings.NoMonster.ToString + vbNewLine +
"Spell: " + My.Settings.Spell.ToString + vbNewLine +
"Trap: " + My.Settings.Trap.ToString + vbNewLine +
"XYZLevel: " + My.Settings.XyzLevel.ToString + vbNewLine +
"ATKValue: " + My.Settings.ATKValue.ToString + vbNewLine +
"DEFValue: " + My.Settings.DEFValue.ToString + vbNewLine +
"AttributeID: " + My.Settings.AttributeID.ToString + vbNewLine +
"CardID: " + My.Settings.CardID.ToString)
fs.Write(info, 0, info.Length)
fs.Close()
Dim info2 As Byte() =
New UTF8Encoding(True).GetBytes(CardImage.InitialImage.ToString)
fs2.Write(info2, 0, info2.Length)
fs2.Close()
MsgBox("Configuration saved successfully!", vbInformation)
End Sub
Private Sub Btn_Load_Click(sender As Object, e As EventArgs) Handles Btn_Load.Click
Dim path As String = My.Computer.FileSystem.SpecialDirectories.MyPictures + "\Card Library\Configs\" + "config_card.aygo"
Try
My.Settings.Level = CInt(GetSettingItem(path, "level"))
My.Settings.NoMonster = CInt(GetSettingItem(path, "nomonster"))
My.Settings.Spell = CBool(GetSettingItem(path, "spell"))
My.Settings.Trap = CBool(GetSettingItem(path, "trap"))
If My.Settings.NoMonster = 1 Then
If My.Settings.Spell = True Then
CardFt.Card_Spell()
Else
If My.Settings.Trap = True Then
CardFt.Card_Trap()
Else
CardFt.Card_Legendary()
End If
End If
End If
My.Settings.XyzLevel = CInt(GetSettingItem(path, "xyzlevel"))
If My.Settings.XyzLevel = 1 Then
CardFt.Card_XYZ()
End If
My.Settings.ATKValue = GetSettingItem(path, "atkvalue")
ATKText.Text = GetSettingItem(path, "atkvalue")
My.Settings.DEFValue = GetSettingItem(path, "defvalue")
DEFText.Text = GetSettingItem(path, "defvalue")
My.Settings.AttributeID = CInt(GetSettingItem(path, "attributeid"))
If My.Settings.AttributeID = 1 Then
AttributeLayer.Image = My.Resources.Earth
ElseIf My.Settings.AttributeID = 2 Then
AttributeLayer.Image = My.Resources.Water
ElseIf My.Settings.AttributeID = 3 Then
AttributeLayer.Image = My.Resources.Fire
ElseIf My.Settings.AttributeID = 4 Then
AttributeLayer.Image = My.Resources.Wind
ElseIf My.Settings.AttributeID = 5 Then
AttributeLayer.Image = My.Resources.Dark
ElseIf My.Settings.AttributeID = 6 Then
AttributeLayer.Image = My.Resources.Light
ElseIf My.Settings.AttributeID = 7 Then
AttributeLayer.Image = My.Resources.Divine
End If
My.Settings.CardID = CInt(GetSettingItem(path, "cardid"))
CardFt.Card_Loader()
If My.Computer.FileSystem.FileExists(My.Computer.FileSystem.SpecialDirectories.MyPictures + "\Card Library\Configs\" + "set_cardimg.aygo") Then
Try
Dim fileReader As String
fileReader = My.Computer.FileSystem.ReadAllText(My.Computer.FileSystem.SpecialDirectories.MyPictures + "\Card Library\Configs\" + "set_cardimg.aygo")
Catch ex As Exception : End Try
End If
Dim bitmap As New Bitmap(My.Computer.FileSystem.SpecialDirectories.MyPictures + "Card Library\Configs\" + "set_cardimg.aygo")
CardImage.Image = CType(bitmap, System.Drawing.Image)
Catch ex As Exception
MsgBox("An error occured while loading the configuration file: " & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.ToString, vbExclamation)
My.Computer.Clipboard.SetText(ex.ToString)
End Try
End Sub
The error that I get from this is:
System.ArgumentException: Parameter is not valid.
at System.Drawing.Bitmap..ctor(String filename)
at AnimeYuGiOhCardMaker.CardMaker.Btn_Load_Click(Object sender, EventArgs e) in C:\Users\Compusys\Documents\Visual Studio 2012\Projects\Anime Yu-Gi-Oh Card Maker\Anime Yu-Gi-Oh Card Maker\Form1.vb:line 521
Now then, when the Save Button is being pressed It does not write the image location to file however it writes the following:
System.Drawing.Bitmap
This is why I get the error above.
The actual error is from here:
Dim bitmap As New Bitmap(My.Computer.FileSystem.SpecialDirectories.MyPictures + "Card Library\Configs\" + "set_cardimg.aygo")
CardImage.Image = CType(bitmap, System.Drawing.Image)
The error occurs even with an actual file path.
I tried a few different ways but none of them worked. Any help would be really appreciated. Thanks.
--
Dom
The original question has changed several times, including the exception. The current state of the question has several problems, the main one being this:
If My.Computer.FileSystem.FileExists(My.Computer.FileSystem.SpecialDirectories.MyPictures + "\Card Library\Configs\" + "set_cardimg.aygo") Then
Try
Dim fileReader As String
fileReader = My.Computer.FileSystem.ReadAllText(My.Computer.FileSystem.SpecialDirectories.MyPictures _
+ "\Card Library\Configs\" + "set_cardimg.aygo")
' EMPTY CATCH !!!!!!
Catch ex As Exception : End Try
End If
Dim bitmap As New Bitmap(My.Computer.FileSystem.SpecialDirectories.MyPictures _
+ "Card Library\Configs\" + "set_cardimg.aygo")
CardImage.Image = CType(bitmap, System.Drawing.Image)
set_cardimg.aygo is just a config file which contains some text. it is not a valid image file, so you cannot create a bitmap from it.
You should open that file, read the contents into a variable, then if it is a valid location, create the bitmap from it, or better just set the picturebox .Location and let it load the image without you creating a bitmap first.

vb.net send email with image

there is a lot of topic about sending email with attachment but i couldn't find what i was looking for
my form contain 8 textbox and 1 PictureBox i can send all textbox via email but ican't send PictureBox i try many code
this is my form.
and here is my code
Dim MyMessage As New MailMessage
Try
MyMessage.From = New MailAddress("x#gmail.com")
MyMessage.To.Add("x#gmail.com")
MyMessage.Subject = "Data"
MyMessage.Body = Label1.Text + " = " + IDTextBox.Text + Environment.NewLine + Label2.Text + " = " + ناوی_سیانی_کارمەندTextBox.Text + Environment.NewLine + Label3.Text + " = " + ساڵی_لە__دایک_بوونTextBox.Text + Environment.NewLine + Label4.Text + " = " + شوێنی_دانیشتنTextBox.Text + Environment.NewLine + Label5.Text + " = " + گروپی_خوێنTextBox.Text + Environment.NewLine + Label6.Text + " = " + ناو_نیشانی_کار_لە_کۆمپانیاTextBox.Text + Environment.NewLine + Label7.Text + " = " + ژمارەی_مۆبایلTextBox.Text + Environment.NewLine + Label8.Text + " = " + شوێنی_کارTextBox.Text
Dim SMTP As New SmtpClient("smtp.gmail.com")
SMTP.Port = 587
SMTP.EnableSsl = True
SMTP.Credentials = New System.Net.NetworkCredential("x#gmail.com", "x")
SMTP.Send(MyMessage)
MsgBox("your message Has been sent successfully")
Catch ex As Exception
End Try
i will be greatfull if you could help me :)
Have you tried this.You can use the LinkedResource and AlternatiView for the same.
string path = Filelocation; // as you are using picture box,give the location from where the image is loading into picture box.
LinkedResource imageLink = new LinkedResource(path);
imageLink.ContentId = "myImage";
AlternateView altView = AlternateView.CreateAlternateViewFromString(
"<html><body><img src=cid:myImage/>" +
"<br></body></html>" + strMailContent,
null, MediaTypeNames.Text.Html);
altView.LinkedResources.Add(imageLink);
//now append it to the body of the mail
msg.AlternateViews.Add(altView);
msg.IsBodyHtml = true;
or
You can send it with HtmlBody here is the
reference : http://vba-useful.blogspot.fr/2014/01/send-html-email-with-embedded-images.html
You need to add the directory of the picture file or any file you have and add it as attachment to your mail like this...
Dim attachment As System.Net.Mail.Attachment
attachment = New System.Net.Mail.Attachment(FilePath)
MyMessage.Attachments.Add(attachment)

VB 2010 Login system

I've been trying to make a login system some time but couldn't find a good tutorial or code. But then i found this code that worked as it should. Except there's a little problem. The problem is that i get a syntax error and i haven't been able to find a solution too this error.
Can you please help?
When i write this: Do passline = TextBox2.Text userline = USERREAD.ReadLine
It says that passline is a syntax error.
This is the code:
If TextBox1.Text = "" Then
MsgBox("You need atleast 1 Character", MsgBoxStyle.Critical)
ElseIf My.Computer.FileSystem.DirectoryExists("C:\Users\Rebecca\Desktop\ACCOUNTS\ACCOUNTS" + TextBox1.Text + "\") Then
Dim USERREAD As System.IO.StreamReader = New System.IO.StreamReader("C:\Users\Rebecca\Desktop\ACCOUNTS\ACCOUNTS" + TextBox1.Text + "\" + "username.txt")
Dim userline As String
Dim PASSREAD As System.IO.StreamReader = New System.IO.StreamReader("C:\Users\Rebecca\Desktop\ACCOUNTS\ACCOUNTS" + TextBox2.Text + "\" + "password.txt")
Dim passline As String
Do passline = TextBox2.Text userline = USERREAD.ReadLine Console.WriteLine(passline)
Console.WriteLine(userline)
Loop Until userline Is Nothing
If TextBox2.Text = "" Then
MsgBox("Please enter a Password(", MsgBoxStyle.Critical, "ERROR")
ElseIf passline = PASSREAD.ReadLine() = True Then
MsgBox("Welcome to LoginSystem " + TextBox1.Text)
Form2.Show()
Me.Hide()
Else : MsgBox("The information you entered is Incorrect", MsgBoxStyle.Critical, "ERROR")
End If
End If
The syntax error is caused by missing new lines in your Do loop, change to this:
Do
passline = TextBox2.Text
userline = USERREAD.ReadLine
Console.WriteLine(passline)
Console.WriteLine(userline)
Loop Until userline Is Nothing

If possible to cotinue a For Each loop after an error jump in VB.NET?

I have a BackGroundWorker with a For Each loop that is inside of a Try Catch and I need to detect the error and continue the For Each loop whit the next item.
Actually I have a list of data to send to a server trough UDP and wait for an ACK, but if the server didn't answer in 5 seconds the timeout error is cachet and the whole process is aborted.
I need to do something like this
Dim MyData_Array As String()
For Each MyData As String In MyData_Array
MyData_Actual = MyData
' Translate the passed message into ASCII and store it as a Byte array.
Dim data As [Byte]() = System.Text.Encoding.ASCII.GetBytes(MyData)
Dim RemoteIpEndPoint As New IPEndPoint(IPAddress.Any, 0)
If data.Length = 67 Then
XMyData += 1
Dim Tx As New UdpClient()
Tx.Connect(Host, Port)
Tx.Client.SendTimeout = 5000
Tx.Client.ReceiveTimeout = 5000
Tx.Send(data, data.Length)
data = Tx.Receive(RemoteIpEndPoint)
Tx.Close()
Else
MyData_ErrorList += MyData & vbCrLf
End If
'Report progress
Porcentaje = (XMyData * 100) / MyData_Array.Count
BackgroundWorker1.ReportProgress(Porcentaje, "Sending MyData " & XMyData.ToString & " de " & MyData_Array.Count.ToString & " : " & MyData)
If BackgroundWorker1.CancellationPending Then
e.Cancel = True
Exit For
End If
Next
End If
Catch ex As TimeoutException
MyData_ErrorList += MyData_Actual & vbCrLf
'**********************************************************
'Here need to delay 100mS and get back to the For Each to process the next item
'**********************************************************
Catch ex As Exception
MyData_List = ex.Message & vbCrLf & "StackTrace: " & ex.StackTrace & vbCrLf & MyData_List
End Try
Put the Try/Catch inside the for loop.
Dim MyData_Array As String()
For Each MyData As String In MyData_Array
Try
MyData_Actual = MyData
' Translate the passed message into ASCII and store it as a Byte array.
Dim data As [Byte]() = System.Text.Encoding.ASCII.GetBytes(MyData)
Dim RemoteIpEndPoint As New IPEndPoint(IPAddress.Any, 0)
If data.Length = 67 Then
XMyData += 1
Dim Tx As New UdpClient()
Tx.Connect(Host, Port)
Tx.Client.SendTimeout = 5000
Tx.Client.ReceiveTimeout = 5000
Tx.Send(data, data.Length)
data = Tx.Receive(RemoteIpEndPoint)
Tx.Close()
Else
MyData_ErrorList += MyData & vbCrLf
End If
'Report progress
Porcentaje = (XMyData * 100) / MyData_Array.Count
BackgroundWorker1.ReportProgress(Porcentaje, "Sending MyData " & XMyData.ToString & " de " & MyData_Array.Count.ToString & " : " & MyData)
If BackgroundWorker1.CancellationPending Then
e.Cancel = True
Exit For
End If
Catch ex As TimeoutException
MyData_ErrorList += MyData_Actual & vbCrLf
Catch ex As Exception
MyData_List = ex.Message & vbCrLf & "StackTrace: " & ex.StackTrace & vbCrLf & MyData_List
'If you want to exit the For loop on generic exceptions, uncomment the following line
'Exit For
End Try
Next
You might consider putting the try catch inside the for loop, if the iterative collection is not modified somehow by the error. Then handle the exception and continue the for loop.
How you have your loop and try/catch setup now will cause the entire loop to be broken out of on the timeout exception since the try/catch is placed outside the loop.
The your code would look more like this:
For Each MyData As String In MyData_Array
Try
'Perform code for each loop iteration
Catch ex As TimeoutException
'Handle Exception Here
End Try
Next

Internal server error (500) httpwebrequest

System.Net.WebException: The remote
server returned an error: (500)
Internal Server Error. at
System.Net.HttpWebRequest.GetResponse()
at
refill.btnRequestRefill_Click(Object
sender, EventArgs e)
I get this error when trying to submit a form. Here is my code:
Protected Sub btnRequestRefill_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnRequestRefill.Click
Try
Dim url As String = "www.domainname.com"
url += "lastName=" & LastName.Text
url += "&birthDate=" & Birthdate.Text
url += "&RxNumbers=" & RxNumber.Text
url += "&deliveryMethod=" & deliverymethod.SelectedValue
url += "&phone=" & PhoneNumber.Text
url += "&email=" & Email.Text
Dim myrequest As HttpWebRequest = TryCast(WebRequest.Create(url), HttpWebRequest)
Dim docresponse As WebResponse = myrequest.GetResponse()
Dim responsestream As Stream = docresponse.GetResponseStream()
Dim objXMLDoc As New XmlDocument()
Dim colElements As XmlNodeList
Dim colElements2 As XmlNodeList
Dim mywebclient As New WebClient()
Dim a As Object
Dim listingscount As Integer = 0
objXMLDoc.Load(responsestream)
colElements = objXMLDoc.GetElementsByTagName("script")
For Each objnode As XmlNode In colElements
Dim attCol As XmlAttributeCollection = objnode.Attributes
If objnode.Name = "script" Then
If attCol(0).Value = "false" Then
colElements2 = objXMLDoc.GetElementsByTagName("rxResponse")
For Each objnode2 As XmlNode In colElements2
Response.Write("<br/>" & objnode2.InnerText & "<br/>")
Next
Else
Response.Write("<br/>yay it when through<br/>")
Dim redir, mailto, mailfrom, subject, item, body, cc, bcc, message, html, template, usetemplate, testmode
subject = "Refill Submit - test"
usetemplate = False
Dim msg = Server.CreateObject("CDO.Message")
msg.subject = subject
msg.to = "name#domainname.com,name#domainname.com,name#domainname.com"
msg.from = "name#domainname.com"
For Each item In Request.Form
Select Case item
Case "redirect", "mailto", "cc", "bcc", "subject", "message", "template", "html", "testmode", "__EVENTTARGET", "__EVENTARGUMENT", "__VIEWSTATE", "__EVENTVALIDATION", "btnRequestRefill","__LASTFOCUS"
Case Else
If Not usetemplate Then
If item <> "mailfrom" Then body = body & item & ": " & Request.Form(item) & vbCrLf & vbCrLf
Else
body = Replace(body, "[$" & item & "$]", Replace(Request.Form(item), vbCrLf, "<br>"))
End If
End Select
Next
If usetemplate Then 'remove any leftover placeholders
Dim rx As New Regex("\[\$.*\$\]")
body = rx.Replace(body, "")
End If
If usetemplate And LCase(Request.Form("html")) = "yes" Then
msg.htmlbody = body
Else
msg.textbody = body
End If
msg.send()
msg = Nothing
End If
Else
Response.Write("<br/>" & "not script" & "<br/>")
End If
'Response.Write("<br/>" & objnode.Name & ": " & objnode.InnerText & "<br/>")
Next
Catch ex As Exception
Response.Write("<br/>" & ex.ToString & "<br/>")
End Try
End Su
I just wanted to make note that i was taking over this code from another developer. I found from the company that this was suppose to before that there was actually a missing querystring that was required by the service. by just adding url +="querystring=" & value it worked.