By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
454,158 Members | 1,156 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 454,158 IT Pros & Developers. It's quick & easy.

Outlook security, MAPI32 and RtlMoveMemory (oh my!)

P: n/a
Howdy, all.

I am currently looking for a way to, using VB.NET, get around those
annoying little "Allow Access for X Minutes" dialogs that pop up in
Outlook 2003, without resorting to 3rd party add-ins, utilities, or
changes to Exchange Server policies.

After a lot of digging around, I came across an article on
MAPILab.com that contained some VB6 source code. Here's the URL for
those who are curious:

http://www.mapilab.com/articles/vb_o...ecurity_4.html

Basically the article involves hooking into MAPI32.DLL via API
calls, which gives you a pointer to a structure (SPropValue), which in
turn contains a pointer (stored in val1) to a string variable which
contains the value I want. Anyway, I tried it in VB6, and it worked
like a charm. Exactly what I want. Here's the working VB6 source
code:

Private Declare Function HrGetOneProp Lib "mapi32" Alias
"HrGetOneProp@12" ( _
ByVal lpMapiProp As IUnknown, _
ByVal ulPropTag As Long, _
ByRef lppProp As Long) As Long

Private Declare Function MAPIFreeBuffer Lib "mapi32" ( _
ByVal lppProp As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function lstrlenA Lib "kernel32.dll" ( _
ByVal lpString As Long) As Long

Private Type SPropValue
ulPropTag As Long
dwAlignPad As Long
val1 As Long
val2 As Long
val3 As Long
End Type

Private Function LPSTRtoBSTR(ByVal lpsz As Long) As String
Dim cChars As Long
cChars = lstrlenA(lpsz)
LPSTRtoBSTR = String$(cChars, 0)
CopyMemory ByVal StrPtr(LPSTRtoBSTR), ByVal lpsz, cChars
LPSTRtoBSTR = Trim(StrConv(LPSTRtoBSTR, vbUnicode))
End Function

Public Sub PrintEmail()
Dim objSesson As Object
Dim objItem As Object

Set objSession = CreateObject("MAPI.Session")
objSession.Logon
Set objItem = objSession.Inbox.Messages.GetFirst

Dim ptrSProp As Long
ptrSProp = 0
If HrGetOneProp(objItem.MAPIOBJECT, CdoPR_SENDER_NAME, ptrSProp) =
0 Then
Dim sprop As SPropValue
CopyMemory sprop, ByVal ptrSProp, 20
MsgBox LPSTRtoBSTR(sprop.val1)
MAPIFreeBuffer ptrSProp
End If

Set objItem = Nothing
Set objSession = Nothing
End Sub

Now I am trying to convert it to VB.NET, and this is where it all
goes horribly pear-shaped. I ran it through the upgrader (just to see
what the heck I SHOULD be doing), took care of all the comments and
such, and I have read previous postings regarding upgraded API calls
and believe I have what SHOULD be working code.

However, when I run the new application, the resulting structure
does not contain any non-zero values, and the final string I want is
also blank. Could someone take a look at my source code (posted below)
and see if anything looks glaringly obvious? Or perhaps suggest a
different solution altogether? I'm guessing I'm just doing something
wrong with my CopyMemory calls, but God only knows...

If all else fails, I'll simply turn the VB6 code into a DLL and
just do the COM wrapper thing, but that seems really kludgy, so I'd
like to see this work in .NET.

Thanks in advance! Here's the new source code. Sorry about the
length:

Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Outlook
Imports MAPI

Module MapiProps
#Region " API Calls "
Public Declare Auto Function HrGetOneProp Lib "mapi32.dll" Alias
"HrGetOneProp@12" ( _
<MarshalAsAttribute(UnmanagedType.IUnknown)> ByVal lpMapiProp
As Object, _
ByVal ulPropTag As Integer, _
ByRef lppProp As Integer) As Integer

Private Declare Function MAPIFreeBuffer Lib "mapi32" (ByVal lppProp
As Integer) As Integer

Private Declare Sub CopyMemoryStruct Lib "kernel32" Alias
"RtlMoveMemory" ( _
ByVal Destination As SPropValue, _
ByVal Source As Integer, _
ByVal Length As Integer)

Private Declare Sub CopyMemoryString Lib "kernel32" Alias
"RtlMoveMemory" ( _
ByVal Destination As String, _
ByVal Source As Integer, _
ByVal Length As Integer)

Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal
lpString As Integer) As Integer
#End Region

Private Structure SPropValue
Dim ulPropTag As Integer
Dim dwAlignPad As Integer
Dim val1 As Integer
Dim val2 As Integer
Dim val3 As Integer
End Structure

Private Function LPSTRtoBSTR(ByVal lpsz As Integer) As String
Dim cChars As Integer = lstrlenA(lpsz)
Dim strValue As String = New String("0", cChars)
CopyMemoryString(strValue, lpsz, cChars)
Return Trim(strValue)
End Function

Public Sub PrintEmail()
Dim objSession As Object
Dim objSesson As Object
Dim objItem As Object

objSession = CreateObject("MAPI.Session")
objSession.Logon()
objItem = objSession.Inbox.Messages.GetFirst

Dim ptrSProp As Integer
ptrSProp = 0
Dim sprop As SPropValue
If HrGetOneProp(objItem.MAPIOBJECT,
MAPI.CdoPropTags.CdoPR_SENDER_NAME, ptrSProp) = 0 Then
CopyMemoryStruct(sprop, ptrSProp, 20)
MsgBox(LPSTRtoBSTR(sprop.val1))
MAPIFreeBuffer(ptrSProp)
End If

Object_Dispose(objItem)
Object_Dispose(objSession)
End Sub

Public Sub Object_Dispose(ByVal aobjItem As Object)
' Add the following statement to the top of any vb file where
you place this Sub
' Imports System.Runtime.InteropServices
Dim count As Integer
Debug.WriteLine("DisposeObject Called")
Try
If aobjItem Is Nothing Then
Exit Try
End If
count = Marshal.ReleaseComObject(aobjItem)
Debug.WriteLine(String.Format("DisposeObject - Release {0},
RefCount: {1}", aobjItem.ToString(), count), "")
While count > 0
count = Marshal.ReleaseComObject(aobjItem)
End While
Catch ex As SystemException
Debug.WriteLine(String.Format("DisposeObject Exception:
{0}"), ex.Message)
Finally
aobjItem = Nothing
End Try
End Sub
End Module

Nov 21 '05 #1
Share this question for a faster answer!
Share on Google+

This discussion thread is closed

Replies have been disabled for this discussion.