Attaching a screenshot to new email outlook image with vb net - vb.net

been looking for a bit of code to take a screenshot and attach the screenshot to new email. I'll post what I have. It work 99%, just can't for the life of me figure out why it isn't attaching to the email.
It does everything but attach the new screenshot to the email. Is this possible?
Private Sub testStripMenuItem_Click(sender As Object, e As EventArgs) Handles testStripMenuItem.Click
Dim maxHeight As Integer = 0
Dim maxWidth As Integer = 0
For Each scr As Screen In Screen.AllScreens
maxWidth += scr.Bounds.Width
If scr.Bounds.Height > maxHeight Then maxHeight = scr.Bounds.Height
Next
Dim AllScreensCapture As New Bitmap(maxWidth, maxHeight, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim screenGrab As Bitmap
Dim screenSize As Size
Dim g As Graphics
Dim g2 As Graphics = Graphics.FromImage(AllScreensCapture)
Dim a As New Point(0, 0)
For Each scr As Screen In Screen.AllScreens
screenSize = New Size(scr.Bounds.Width, scr.Bounds.Height)
screenGrab = New Bitmap(scr.Bounds.Width, scr.Bounds.Height)
g = Graphics.FromImage(screenGrab)
g.CopyFromScreen(a, New Point(0, 0), screenSize)
g2.DrawImage(screenGrab, a)
a.X += scr.Bounds.Width
Next
Dim Screenshot = "C:\img.png"
If System.IO.File.Exists(Screenshot) Then
System.IO.File.Delete(Screenshot)
End If
AllScreensCapture.Save(Screenshot, System.Drawing.Imaging.ImageFormat.Jpeg)
'Email Code
Dim strUserDomain As String
Dim strCompName As String
strUserDomain = Environ$("UserDomain")
strCompName = Environ$("ComputerName")
Dim theStringBuilder As New StringBuilder()
theStringBuilder.Append("mailto:email#gmail.com.au")
theStringBuilder.Append("&subject=From Domain: " & strUserDomain & ". Computer Name: " & strCompName)
theStringBuilder.Append("&attach=" & Screenshot)
Process.Start(theStringBuilder.ToString())
End Sub

Alternative to sending through an installed mail client...
' Some of these may come from the form or user settings or wherever
Private Const MailSenderEmail As String = ""
Private Const MailSenderName As String = ""
Private Const MailRecipient As String = ""
Private Const MailSubject As String = ""
Private Const MailBody As String = ""
Private Const MailHost As String = ""
Private Const MailPort As String = ""
Private Const MailUser As String = ""
Private Const MailPass As String = ""
Private Const MailEnableSsl As Boolean = False
Private Sub testStripMenuItem_Click(sender As Object, e As EventArgs) Handles testStripMenuItem.Click
'
' Your code to capture the screen
'
Dim Screenshot = "C:\img.png"
If System.IO.File.Exists(Screenshot) Then
System.IO.File.Delete(Screenshot)
End If
AllScreensCapture.Save(Screenshot, System.Drawing.Imaging.ImageFormat.Jpeg)
' Send the email with Screenshot attached
Using MailMessage As New Net.Mail.MailMessage
With MailMessage
.From = New Net.Mail.MailAddress(MailSenderEmail, MailSenderName)
.To.Add(MailRecipient)
.Subject = MailSubject
.Body = MailBody
.Attachments.Add(New Net.Mail.Attachment(Screenshot))
End With
With New Net.Mail.SmtpClient
.Host = MailHost
.Port = MailPort
.EnableSsl = MailEnableSsl
Select Case True
Case String.IsNullOrWhiteSpace(MailUser)
Case String.IsNullOrWhiteSpace(MailPass)
Case Else
.Credentials = New Net.NetworkCredential(MailUser, MailPass)
End Select
.Send(MailMessage)
End With
End Using
End Sub

Related

If and Else statements on Visual Basic

I am having problems figuring out in which order these if and else statements need to be arranged in Visual Basic 2010 Express. As you can probably tell from the code, when it is working properly the program should display data found in a text file externally. If this data is not found then an error message in a label should appear.
Thanks for the help.
Code:
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim filename As String = "..\..\usernamepassword.txt"
Dim objreader As New System.IO.StreamReader(filename)
Dim contents As String
Dim check As String
Dim checkfile As New System.IO.StreamReader("..\..\checkfile.txt")
check = checkfile.ReadToEnd
For i As Integer = 1 To check
contents = objreader.ReadLine
Dim data As New List(Of String)(contents.Split(","))
If forename.Text = data(2) Then
'first if statement is here \/
If surname.Text = data(3) Then
fullname.Text = (data(2) & " " & data(3))
dob.Text = data(4)
phone.Text = data(5)
address.Text = data(6)
password.Text = data(1)
'else statement \/
Else
Label2.Text = "Sorry, no result found for this student."
Label5.Text = "Please note this system is caps sensitive."
End If
End If
Next i
Dim s As String = ""
forename.Text = s
surname.Text = s
End Sub
End Class
You should handle it like this
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim filename As String = "..\..\usernamepassword.txt"
Dim found as Boolean = False
Dim objreader As New System.IO.StreamReader(filename)
Dim contents As String
Dim check As String
Dim checkfile As New System.IO.StreamReader("..\..\checkfile.txt")
check = checkfile.ReadToEnd
For i As Integer = 1 To check
contents = objreader.ReadLine
Dim data As New List(Of String)(contents.Split(","))
If forename.Text = data(2) Then
'first if statement is here \/
If surname.Text = data(3) Then
fullname.Text = (data(2) & " " & data(3))
dob.Text = data(4)
phone.Text = data(5)
address.Text = data(6)
password.Text = data(1)
found = True
Exit For
End If
End If
Next i
If found = False Then
Label2.Text = "Sorry, no result found for this student."
Label5.Text = "Please note this system is caps sensitive."
End If
Dim s As String = ""
forename.Text = s
surname.Text = s
End Sub
Check has been declared as string when it should be an integer.
Set option strict to on and infer to off

Printing two pages in SSRS using VB.net

I am working on a project where a button is clicked in a program and a two page duplex report that is in SSRS prints out. I have gotten it to the point where I get one of the two pages to print but not the duplex page. I know I need to set e.HasMorePages to true and put in an index. The problem is when it goes to page two it errors because of the metafile. I'm not sure how to get around this.
Imports System.IO
Imports System.Drawing.Imaging
Imports System.Drawing.Printing
Imports Microsoft.Reporting.WinForms
Public Class Printing
Dim pages As New List(Of Metafile)
Dim pageIndex As Integer = 0
Dim doc As New System.Drawing.Printing.PrintDocument()
Dim ReportViewer1 As New ReportViewer
Dim TotalQTY As Int32
Dim data() As Byte
Dim receiveText As String
Private Sub Printing_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'receiveText = Command()
receiveText = "08NFA-0000"
With ReportViewer1
.Visible = False
.ProcessingMode = ProcessingMode.Remote
.ServerReport.ReportPath = "/Traveler/Traveler"
.ServerReport.ReportServerUrl = New _
Uri("http://sql01/ReportServer_MADE2MANAGE")
End With
Me.Controls.Add(ReportViewer1)
Dim doc As New System.Drawing.Printing.PrintDocument()
doc = New System.Drawing.Printing.PrintDocument()
AddHandler doc.PrintPage, AddressOf PrintPageHandler
Dim dialog As New PrintDialog()
dialog.Document = doc
doc.PrinterSettings.Duplex = System.Drawing.Printing.Duplex.Vertical
Dim deviceInfo As String =
"<DeviceInfo>" &
"<OutputFormat>emf</OutputFormat>" &
" <PageWidth>8.5in</PageWidth>" &
" <PageHeight>11in</PageHeight>" &
" <MarginTop>0.125in</MarginTop>" &
" <MarginLeft>0.125in</MarginLeft>" &
" <MarginRight>0.125in</MarginRight>" &
" <MarginBottom>0.125in</MarginBottom>" &
"</DeviceInfo>"
Dim warnings() As Microsoft.Reporting.WinForms.Warning
Dim streamids() As String
Dim mimeType, encoding, filenameExtension As String
mimeType = "" : encoding = "" : filenameExtension = ""
Dim Parm As New ReportParameter("JobOrder", receiveText)
Dim parmSO1(0) As ReportParameter
parmSO1(0) = Parm
ReportViewer1.ServerReport.SetParameters(parmSO1)
data = ReportViewer1.ServerReport.Render("Image",
deviceInfo, mimeType, encoding, filenameExtension,
streamids, warnings)
pages.Add(New Metafile(New MemoryStream(data)))
For Each pageName As String In streamids
data = ReportViewer1.ServerReport.RenderStream("Image",
pageName, deviceInfo, mimeType, encoding)
pages.Add(New Metafile(New MemoryStream(data)))
Next
doc.Print()
Me.ReportViewer1.RefreshReport()
Me.Close()
End Sub
Private Sub PrintPageHandler(ByVal sender As Object,
ByVal e As PrintPageEventArgs)
Dim page As Metafile = pages(pageIndex)
pageIndex += 1
Dim pWidth As Integer = 910
Dim pHeight As Integer = 1500
e.Graphics.DrawImage(page, 0, 0, pWidth, pHeight)
e.HasMorePages = pageIndex < pages.Count
End Sub
End Class

Get Active directory user asynchonously

How can I query the Active directory asynchronously.
I have a bit of code to get the users synchronously
Dim UserName as string = ""
Dim Password as string = ""
Dim LDAPPath As String = ""
Dim DirectoryE As DirectoryEntry = New DirectoryEntry(LDAPPath, UserName, Password)
Dim RootDSE As DirectoryServices.DirectoryEntry = globalroot
Dim objSearch As New System.DirectoryServices.DirectorySearcher(RootDSE)
Dim oResult As DirectoryServices.SearchResultCollection = Nothing
'objSearch.PropertiesToLoad.Add("uid")
'objSearch.PropertiesToLoad.Add("cn")
objSearch.Filter = "(&(objectcategory=user))"
objSearch.PageSize = 500
oResult = objSearch.FindAll
For Each ldentry As SearchResult In oResult
Console.WriteLine(ldentry.Properties("cn")(0).ToString)
Next
Console.ReadLine()
Assuming you are using .NET 4.5. Change your code to a function which returns a SearchResultCollection:
Private Function GetAllUsers() As SearchResultCollection
Dim UserName As String = ""
Dim Password As String = ""
Dim LDAPPath As String = ""
Dim DirectoryE As DirectoryEntry = New DirectoryEntry(LDAPPath, UserName, Password)
Dim RootDSE As DirectoryServices.DirectoryEntry = New DirectoryEntry("LDAP://RootDSE")
Dim objSearch As New System.DirectoryServices.DirectorySearcher(RootDSE)
Dim oResult As DirectoryServices.SearchResultCollection = Nothing
'objSearch.PropertiesToLoad.Add("uid")
'objSearch.PropertiesToLoad.Add("cn")
objSearch.Filter = "(&(objectcategory=user))"
objSearch.PageSize = 500
Return objSearch.FindAll
End Function
Then call it like this:
Private Async Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
For Each ldentry As SearchResult In Await Task.Run(Function() GetAllUsers())
Console.WriteLine(ldentry.Properties("cn")(0).ToString)
Next
Console.ReadLine()
End Sub

For Next or a different loop for URL Icon Load

I have an app that basically is a launcher for various web pages. I am trying to, OnLoad, to populate all the pictureBoxes in my form with the FavICON for each URL. 25 to be exact. Should I use a For and Next or some other kind of looping method? New to the looping part so all and any help is appreciated.
My code to load just one single PictureBox is the following:
Private Sub MainFormWPL_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Dim WebICON As New WebBrowser
MainURLLoader.Navigate(Label1.Text)
'URLText.Text = WebBrowser1.Url.ToString
Try
Dim url As Uri = New Uri(Label1.Text)
If url.HostNameType = UriHostNameType.Dns Then
Dim icon = "http://" & url.Host & "/favicon.ico"
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(icon)
Dim response As System.Net.HttpWebResponse = request.GetResponse()
Dim stream As System.IO.Stream = response.GetResponseStream
Dim favicon = Image.FromStream(stream)
PictureBox1.Image = favicon
Else
End If
Catch ex As Exception
End Try
End Sub
Assuming you have Label1 --> PictureBox1, all the way to Label25 --> PictureBox25:
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim matches() As Control
For i As Integer = 1 To 25
matches = Me.Controls.Find("Label" & i, True)
If matches.Length > 0 Then
Dim website As String = matches(0).Text
matches = Me.Controls.Find("PictureBox" & i, True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is PictureBox Then
Dim PB As PictureBox = DirectCast(matches(0), PictureBox)
Task.Run(New Action(Sub() GetFavIcon(website, PB)))
End If
End If
Next
End Sub
Private Sub GetFavIcon(ByVal website As String, ByVal PB As PictureBox)
Dim url As Uri = New Uri(website)
If url.HostNameType = UriHostNameType.Dns Then
Dim icon = "http://" & url.Host & "/favicon.ico"
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(icon)
Dim response As System.Net.HttpWebResponse = request.GetResponse()
Dim stream As System.IO.Stream = response.GetResponseStream
Dim favicon = Image.FromStream(stream)
PB.Invoke(New MethodInvoker(Sub() PB.Image = favicon))
response.Close()
End If
End Sub
End Class

Listview and close form not delete directory

My listview codes:
Const IMAGE_DIRECTORY As String = "outfile"
Dim files As String() = Directory.GetFiles(IMAGE_DIRECTORY)
Dim max_length, i As Integer
Dim fname As String
Dim pname As String
Dim myImage As Image
'Set the ColorDepth and ImageSize properties of imageList1.
ImageList1.ColorDepth = ColorDepth.Depth32Bit
ImageList1.ImageSize = New System.Drawing.Size(106, 150)
max_length = files.Length - 1
'Add images to imageList1.
For i = 0 To max_length
pname = Path.GetFullPath(files(i))
myImage = Image.FromFile(pname)
ImageList1.Images.Add(myImage)
myImage = Nothing
Next
pname = Nothing
'ListView1.View = View.LargeIcon
ListView1.LargeImageList = ImageList1
For i = 0 To files.Length - 1
fname = Path.GetFileName(files(i))
Dim listViewItem1 As ListViewItem = New ListViewItem(fname, i)
'Add listViewItem1 and listViewItem2.
ListView1.Items.AddRange(New ListViewItem() {listViewItem1})
listViewItem1 = Nothing
Next
'Me.Controls.AddRange(New Control() {listView1})
ListView1.Items(0).Selected = True
ListView1.Select()
Exit command button and remove files error now:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Me.PictureBox2.Image.Dispose()
Me.ImageList1.Dispose()
Me.PictureBox2.Image.Dispose()
Me.Dispose()
Me.Close()
End Sub
Exit form and remove directory outfile error :
System.IO.IOException was unhandled
   HRESULT = -2147024864
   Message = The process is being used by another process 'Seite0.Jpg' can not access the file.
   Source = mscorlib
What is the code problem ?