I have code in a VSTO addin to decrypt emails in an Outlook 16 client. The email account is with MS Excahnge. Full code is below but I hope there are no surprises with this code. I am not creating a copy of the email. I have noticed that sometimes when I decrypt an email it automatically encrypts again. On other times the body of the email disappears in my decrypted email.
I believe this is because of sync issues with exchange but am not sure, nor do I understand exactly what the sync issue is. I think a copy of many of these emails end up in a Sync Issues folder.
Is the email not fully downloaded from the server? Or Is Outlook "re-syncing" old emails again, wrongly seeing a difference in the emails (because the client has a changed email through the decryption) and therefore downloading the email again?
My question is how can I fix this? What do I need to wait for or how can I ensure that my changes to the email locally will be synced to the server correctly?
Below is my code. I basically leverage the MailItem.PropertyAccessor and the PR_SECURITY_FLAGS to set the value to 0. I therefore call the below funtion SetExtendedPropertyDecryptValue passing in a MmailItem object and the PR_SECURITY_FLAGS value. The property is then set to SECFLAG_NONE.
Const PR_SECURITY_FLAGS As String = "http://schemas.microsoft.com/mapi/proptag/0x6E010003"
Const SECFLAG_NONE = &H0
Const SECFLAG_ENCRYPTED = &H1
Const SECFLAG_SIGNED = &H2
Const SECFLAG_ENCRYPTED_SIGNED = &H3
Const SECFLAG_BITWISE = &H3
Private Function SetExtendedPropertyDecryptValue(ByVal aMailItem As Outlook.MailItem, ByVal aProperty As String) As Boolean
Dim uFlag As Long
GetExtendedPropertyValue(aMailItem, aProperty, uFlag)
If (uFlag And SECFLAG_BITWISE) = SECFLAG_NONE Then
Return True
Else
Return SetExtendedPropertyValue(aMailItem, PR_SECURITY_FLAGS, uFlag And SECFLAG_NONE)
End If
End Function
Private Function GetExtendedPropertyValue(ByVal aMailItem As Outlook.MailItem, ByVal aProperty As String, ByRef res As Object) As Boolean
Dim oPropAcc As Outlook.PropertyAccessor = Nothing
Try
oPropAcc = DirectCast(aMailItem.PropertyAccessor, Outlook.PropertyAccessor)
res = oPropAcc.GetProperty(aProperty)
Return True
Catch ex As System.Exception
'logging goes here
Finally
If Not oPropAcc Is Nothing Then
Runtime.InteropServices.Marshal.ReleaseComObject(oPropAcc)
oPropAcc = Nothing
End If
End Try
Return False
End Function
Private Function SetExtendedPropertyValue(ByVal aMailItem As Outlook.MailItem, ByVal aProperty As String, ByVal value As Integer) As Boolean
Dim oPropAcc As Outlook.PropertyAccessor = Nothing
Try
oPropAcc = DirectCast(aMailItem.PropertyAccessor, Outlook.PropertyAccessor)
oPropAcc.SetProperty(aProperty, value)
Return True
Catch ex As System.Exception
'logging goes here
Finally
If Not oPropAcc Is Nothing Then
Runtime.InteropServices.Marshal.ReleaseComObject(oPropAcc)
oPropAcc = Nothing
End If
End Try
Return False
End Function
Try to preserve existing security flags when you add or remove any other flags. So, if you want to get it decrypted there is no need to remove the SECFLAG_SIGNED flag.
Related
I do SAP Gui Scripting in VB.Net with .Net Framework 4.8. At some point the SAP will be unresponsive due to circumstances out of my control, and the called function will completely block further execution forever. In this case i want to safely exit the code.
In order to overcome this obstacle where the SAP function call completely blocks execution my approach is to create a New System.Threading.Task, execute the blocking function in it and after a given timeout cancel the operation. I'd also like to be informed if the element had been found.
For this reason i created the following code mostly by reading docs.mycrosoft.com
Dim propablyBlockingFn = Function ()
Dim found = False
While not found
'code that interacts with sap and will either set found to true or completly block execution
End While
Return found
End Function
Dim timeout = 5000 'ms
Dim t As Task(Of Boolean) = Task.Run(fn)
Dim cts As New CancellationTokenSource()
Dim token As CancellationToken = cts.Token
Dim taskRef = t.Wait(timeout, token)
If Not taskRef Then
cts.Cancel()
End If
Dim exists = t.Result 'it will stuck here
t.Dispose()
However, at the point where i try to read the Result of the function, the code wont execute any further and the cancel call does not have any effect.
Does anyone have an idea?
I've found a last resort solution after reading the following answer. Keep in mind that sideeffects may happen. But they would be even worse if in this case i won't abort the Thread.
Dim taskThread As Thread = Nothing
Dim propablyBlockingFn = Function ()
taskThread = Thread.CurrentThread 'Get the Thread the Task is running in
Dim found = False
While not found
'code that interacts with sap and will either set found to true or completly block execution
End While
Return found
End Function
Dim timeout = 5000 'ms
Dim t As Task(Of Boolean) = Task.Run(fn)
Dim taskRef = t.Wait(timeout)
If Not taskRef Then
taskThread.Abort() 'Abort the Thread
End If
Dim exists = t.Result
I'm trying to make a simple client-side application to recieve small text data, compare it and then does something on client machine depending on what server sent.
Server Logic: The server side is made in java, so can't change anything there. Server sends string "abc001" on connecting to client.
Client Logic: Client recieves the string "abc001" from server & checks if it's recieved string is the same as "abc001", then does something accordingly.
Problem: When the client recieves data, I display it in msgbox. But instead of just "abc001", there pops up an extra blank msgbox(image included).
Client Code - On Start:
Try
' declare vals
Dim ip As String = "127.0.0.1"
Dim port As Integer = 5000
' set client
_client = New TcpClient(ip, port)
' disable cross thread calls checking
CheckForIllegalCrossThreadCalls = False
' recieve msg
Threading.ThreadPool.QueueUserWorkItem(AddressOf RecieveMessages)
Catch ex As Exception
MsgBox(ex.ToString)
End Try
Client Code - Recieve Data
Private Sub RecieveMessages(state As Object)
Try
While True
Dim ns As NetworkStream = _client.GetStream()
Dim toRecieve(_client.ReceiveBufferSize) As Byte
ns.Read(toRecieve, 0, CInt(_client.ReceiveBufferSize))
Dim txt As String = Encoding.ASCII.GetString(toRecieve)
MsgBox(txt)
End While
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
MsgBox 1
MsgBox 2
How to not get the blank msgbox. Even when compared, the data recived does not match parameters. Tried to use delay, tried fixing the buffer size to 6 bytes but no use.. Any help is appreciated. Thanks.
EDIT 1: Tried my best to figure it out but can't.. Tried cleaning the returned string data and even tried storing each return data in array. Saw the stack and it says the msgbox has "nothing" in it. It's null.. I don't even know what to do.. Here's the code for strings clean:
Private Sub RecieveMessages(state As Object)
Dim message(0) As String
Dim command_raw, command_clean, command As String
Dim counter As Integer = 0
Try
While True
Dim ns As NetworkStream = _client.GetStream()
Dim toRecieve(_client.ReceiveBufferSize) As Byte
ns.Read(toRecieve, 0, CInt(_client.ReceiveBufferSize))
Dim txt As String = Encoding.ASCII.GetString(toRecieve)
message(0) = txt
command_raw = message(0)
command_clean = command_raw.Replace(vbCrLf, Nothing)
command = command_clean.Substring(0, 6)
MsgBox(command)
End While
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
I have an access database with a field that requires an integer. I am passing in some data that is retrieved from an Excel spreadsheet and if a string is retrieved from the cell then the calling function's Try/Catch will hit a FormatException. What I am trying to figure out is if it's possible (and it always is) to throw a custom error message that will display the cell address that contained the invalid data. Here is some example code of what I have.
Public Class Main
Private cellAddress As String
Private Sub btn_Import(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnImport.Click
Dim openFileDialog As New OpenFileDialog()
openFileDialog.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
openFileDialog.Filter = "Excel Files (*.xls)|*.xlsx|All files (*.*)|*.*"
openFileDialog.RestoreDirectory = True
If openFileDialog.ShowDialog() <> Windows.Forms.DialogResult.OK Then
Return
End If
Try
ImportWorksheet(New FileInfo(openFileDialog.FileName))
Catch ex As FormatException
MessageBox.Show("The data contained within cell " & cellAddress & " is invalid.", "Error")
End Try
End Sub
Private Sub ImportWorksheet(ByVal excelFile As FileInfo)
Dim cnn As New OleDbConnection(My.Settings.cnn)
Dim cmd As OleDbCommand = GetCommand("UpdateSite")
Dim worksheet1 As ExcelWorksheet = package.Workbook.Worksheets(1)
Using package As New ExcelPackage(excelFile)
Using cmd.Connection
cmd.Connection.Open()
cmd.Parameters.Add("#MyData", OleDbType.Integer).Value = GetCellContents(worksheet1, "K8")
cmd.ExecuteNonQuery()
End Using
End Sub
Private Function GetCellContents(ByVal worksheet As ExcelWorksheet, ByVal address As String) As Object
If worksheet.Cells(address).Value Is Nothing Then
Return DBNull.Value
Else
cellAddress = address
Return worksheet.Cells(address).Value
End If
End Function
End Class
Don't think I'm missing anything here, I kind of copied and pasted and altered the code to shorten and not give up any unneeded info. Once the code hits the ExecuteNonQuery() method, the error bubbles up and says whatever I have written in. I want to pass the cell address when this happens if at all possible so they know where to look.
The only way I can think of doing this would be to add a class level variable and set it to the current cell every time it gets the value. The only issue is that since it only fires at ExecuteNonQuery(), and I have multiple parameters, if the first added parameter is invalid but the next parameter isn't, then the cell is set to the last parameter every time and I get the wrong result. Is there a way to get some kind of message back from the database that will tell me specifically which parameter didn't convert properly?
Nevermind, I just went with this for now... It works, but if you guys can give me something better, please do.
cmd.Parameters.Add("#MyData", OleDbType.Integer).Value = GetCellContents(worksheet2, "K8", "Int32")
Private Function GetCellContents(ByVal worksheet As ExcelWorksheet, ByVal address As String, Optional ByVal type As String = Nothing) As Object
If worksheet.Cells(address).Value Is Nothing Then
Return DBNull.Value
Else
cellAddress = address
Select Case type
Case Is = "String"
Return Convert.ToString(worksheet.Cells(address).Value)
Case Is = "Int32"
Return Convert.ToInt32(worksheet.Cells(address).Value)
Case Is = "DateTime"
Return Convert.ToDateTime(worksheet.Cells(address).Value)
Case Else
Return worksheet.Cells(address).Value
End Select
End If
End Function
I am using vb.net 2010 and I have created a program that uses sockets to transfer data between our windows server and a unix server. The code was originally from a Microsoft sample project hence my little understanding of it.
Everything was fine until I had the idea of changing the program into a service. The Invoke command is not accessable from a service. I think I understand why but more importantly how do I get around it or fix it?
' need to call Invoke before can update UI elements
Dim args As Object() = {command, data}
Invoke(_processInStream, args)
Someone please help I am desperate to finish this program so I can move on :)
Below is the rest of the class, there is a server socket class too but I didnt want to complicate things?
Public Class srvMain
' start the InStream code to receive data control.Invoke callback, used to process the socket notification event on the GUI's thread
Delegate Sub ProcessSocketCommandHandler(ByVal command As NotifyCommandIn, ByVal data As Object)
Dim _processInStream As ProcessSocketCommandHandler
' network communication
Dim WithEvents _serverPRC As New ServerSocket
Dim _encryptDataIn() As Byte
Dim myConn As SqlConnection
Dim _strsql As String = String.Empty
Protected Overrides Sub OnStart(ByVal args() As String)
' watch for filesystem changes in 'FTP Files' folder
Watch()
' hookup Invoke callback
_processInStream = New ProcessSocketCommandHandler(AddressOf ProcessSocketCommandIn)
' listen for Ultimate sending signatures
_serverPRC.Start(My.Settings.listen_port_prc)
myConn = New SqlConnection(My.Settings.Mill_SQL_Connect)
End Sub
Protected Overrides Sub OnStop()
' Add code here to perform any tear-down necessary to stop your service.
End Sub
' this is where we will break the data down into arrays
Private Sub processDataIn(ByVal data As Object)
Try
If data Is Nothing Then
Throw New Exception("Stream empty!")
End If
Dim encdata As String
' decode to string and perform split(multi chars not supported)
encdata = Encoding.Default.GetString(data)
_strsql = encdata
myConn.Open()
Dim commPrice As New SqlCommand(_strsql, myConn)
Dim resPrice As SqlDataReader = commPrice.ExecuteReader
'********************************THIS MUST BE DYNAMIC FOR MORE THAN ONE NATIONAL
If resPrice.Read = True And resPrice("ats" & "_price") IsNot DBNull.Value Then
'If resPrice("ats" & "_price") Is DBNull.Value Then
' cannot find price so error
'natPrice = ""
'natAllow = 2
'End If
natPrice = resPrice("ats" & "_price")
natAllow = resPrice("ats" & "_allow")
Else
' cannot find price so error
natPrice = ""
natAllow = 2
End If
myConn.Close()
' substring not found therefore must be a pricing query
'MsgBox("string: " & encdata.ToString)
'natPrice = "9.99"
Catch ex As Exception
ErrHandle("4", "Process Error: " + ex.Message + ex.Data.ToString)
Finally
myConn.Close() ' dont forget to close!
End Try
End Sub
'========================
'= ServerSocket methods =
'========================
' received a socket notification for receiving from Ultimate
Private Sub ProcessSocketCommandIn(ByVal command As NotifyCommandIn, ByVal data As Object)
' holds the status message for the command
Dim status As String = ""
Select Case command
Case NotifyCommandIn.Listen
'status = String.Format("Listening for server on {0} ...", CStr(data))
status = "Waiting..."
Case NotifyCommandIn.Connected
'status = "Connected to Ultimate" ' + CStr(data)
status = "Receiving..."
Case NotifyCommandIn.Disconnected
status = "Waiting..." ' disconnected from Ultimate now ready...
Case NotifyCommandIn.ReceivedData
' store the encrypted data then process
processDataIn(data)
End Select
End Sub
' called from socket object when a network event occurs.
Private Sub NotifyCallbackIn(ByVal command As NotifyCommandIn, ByVal data As Object) Handles _serverPRC.Notify
' need to call Invoke before can update UI elements
Dim args As Object() = {command, data}
Invoke(_processInStream, args)
End Sub
End Class
Any help is appreciated
Many thanks
Invoke is a member of System.Windows.Forms.Form, and it is used to make sure that a certain method is invoked on the UI thread. This is a necessity in case the method in question touches UI controls.
In this case it looks like you simply can call the method directly, i.e.
instead of
Dim args As Object() = {command, data}
Invoke(_processInStream, args)
you can simply write
ProcessSocketCommandIn(command, data)
Also, in this case you can get rid of the _processInStream delegate instance.
i want to open the outlook from my vb.net application. I want to fill out the To,Subject, Body and Attachment part of mail through my application. here i don't need to send mail . I want to just open the outlook with mail parameter.
Please suggest how can i achieve this task
The general procedure is as follows:
Create a mailto: link string with the required information
Pass that string to Process.Start. This will open the default mail client, not necessary Outlook.
For example, the string might look like this: mailto:mail#example.com?subject=Hello&body=test. The individual fields have to be properly escaped (URL encoded). More information about the syntax can be found in RFC 2368.
An attachment can be added by using the attachment argument in the mailto string. According to a comment on MSDN this has to be doubly quoted, though. That is:
mailto:mail#example.com?subject=Hello&body=Test&attachment=""C:\file.txt""
This task can be achieved using office interop, just add a reference to our projecto to `Microsoft.Office.Interop.Outlook'. Then in your applicattion can créate a mail and then attach files as follows:
Imports Microsoft.Office.Interop
...
Dim Outlook As Outlook.Application
Dim Mail As Outlook.MailItem
Dim Acc As Outlook.Account
Outlook = New Outlook.Application()
Mail = Outlook.CreateItem(Microsoft.Office.Interop.Outlook.OlItemType.olMailItem)
Mail.To = "test#test.com"
Mail.Subject = "Hello World!"
'If you have multiple accounts you could change it in sender:
For Each Acc In Outlook.Session.Accounts
'Select first pop3 for instance.
If Acc.AccountType = Microsoft.Office.Interop.Outlook.OlAccountType.olPop3 Then
Mail.Sender = Acc
End If
Next
'Take default account if no sender...
If Not Sender Is Nothing Then Mail.Sender = Sender.CurrentUser.AddressEntry
'Attach files
Mail.Attachments.Add("C:\Path\To\File.pdf")
Mail.Attachments.Add("C:\Path\To\File1.pdf")
'Append some text:
Mail.HTMLBody &= "Hello World!"
Mail.Display()
It's an old question, but I guess it could help to somebody else.
In case someone wants to do this without using outlook...
Imports System.Net.Mail
Public Function SendEmail(EmailBody As String, EmailSubject As String, EmailTo As String, AttachmentPath As String, EmailAsHTML As Boolean)
Dim Mail As New MailMessage
Try
Dim SMTP As New SmtpClient("smtp.gmail.com")
SMTP.EnableSsl = True
SMTP.Credentials = New System.Net.NetworkCredential("[your gmail address#gmail.com]", "[the associated password]")
SMTP.Port = 587
Mail.From = New MailAddress("""[Friendly Name]"" <[your gmail address#gmail.com>")
'Split Multiple Addresses
If EmailTo.Contains(";") Then
For Each EmailAddress In EmailTo.Split(";")
Mail.To.Add(Trim(EmailAddress))
Next
Else
Mail.To.Add(Trim(EmailTo))
End If
Mail.Subject = EmailSubject
Mail.Body = EmailBody
If AttachmentPath <> "" Then Mail.Attachments.Add(New Mail.Attachment(AttachmentPath))
Mail.IsBodyHtml = EmailAsHTML
SMTP.Send(Mail)
'Clear Mail Object
Mail.Dispose()
'Function Return
Return True
Catch ex As Exception
'Function Return
Return False
End Try
End Function
Found this great post.
Programmatically adding attachments to emails in C# and VB.NET
The linked article documents how to use the MAPISendMail function provided by MAPI32.dll.
<DllImport("MAPI32.DLL")> _
Private Shared Function MAPISendMail(ByVal sess As IntPtr,
ByVal hwnd As IntPtr, ByVal message As MapiMessage,
ByVal flg As Integer, ByVal rsv As Integer) As Integer
End Function
Private Function SendMail(ByVal strSubject As String,
ByVal strBody As String, ByVal how As Integer) As Integer
Dim msg As MapiMessage = New MapiMessage()
msg.subject = strSubject
msg.noteText = strBody
msg.recips = GetRecipients(msg.recipCount)
msg.files = GetAttachments(msg.fileCount)
m_lastError = MAPISendMail(New IntPtr(0), New IntPtr(0), msg, how,
0)
If m_lastError > 1 Then
MessageBox.Show("MAPISendMail failed! " + GetLastError(),
"MAPISendMail")
End If
Cleanup(msg)
Return m_lastError
End Function
Hope it will help somebody who might find themselves way here as I did.