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@1 2" ( _
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 "RtlMoveMem ory" ( _
Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenA Lib "kernel32.d ll" ( _
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(ByV al lpsz As Long) As String
Dim cChars As Long
cChars = lstrlenA(lpsz)
LPSTRtoBSTR = String$(cChars, 0)
CopyMemory ByVal StrPtr(LPSTRtoB STR), ByVal lpsz, cChars
LPSTRtoBSTR = Trim(StrConv(LP STRtoBSTR, vbUnicode))
End Function
Public Sub PrintEmail()
Dim objSesson As Object
Dim objItem As Object
Set objSession = CreateObject("M API.Session")
objSession.Logo n
Set objItem = objSession.Inbo x.Messages.GetF irst
Dim ptrSProp As Long
ptrSProp = 0
If HrGetOneProp(ob jItem.MAPIOBJEC T, CdoPR_SENDER_NA ME, ptrSProp) =
0 Then
Dim sprop As SPropValue
CopyMemory sprop, ByVal ptrSProp, 20
MsgBox LPSTRtoBSTR(spr op.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.Offic e.Interop
Imports Microsoft.Offic e.Interop.Outlo ok
Imports MAPI
Module MapiProps
#Region " API Calls "
Public Declare Auto Function HrGetOneProp Lib "mapi32.dll " Alias
"HrGetOneProp@1 2" ( _
<MarshalAsAttri bute(UnmanagedT ype.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 CopyMemoryStruc t Lib "kernel32" Alias
"RtlMoveMem ory" ( _
ByVal Destination As SPropValue, _
ByVal Source As Integer, _
ByVal Length As Integer)
Private Declare Sub CopyMemoryStrin g Lib "kernel32" Alias
"RtlMoveMem ory" ( _
ByVal Destination As String, _
ByVal Source As Integer, _
ByVal Length As Integer)
Private Declare Function lstrlenA Lib "kernel32.d ll" (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(ByV al lpsz As Integer) As String
Dim cChars As Integer = lstrlenA(lpsz)
Dim strValue As String = New String("0", cChars)
CopyMemoryStrin g(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("M API.Session")
objSession.Logo n()
objItem = objSession.Inbo x.Messages.GetF irst
Dim ptrSProp As Integer
ptrSProp = 0
Dim sprop As SPropValue
If HrGetOneProp(ob jItem.MAPIOBJEC T,
MAPI.CdoPropTag s.CdoPR_SENDER_ NAME, ptrSProp) = 0 Then
CopyMemoryStruc t(sprop, ptrSProp, 20)
MsgBox(LPSTRtoB STR(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 ("DisposeObj ect Called")
Try
If aobjItem Is Nothing Then
Exit Try
End If
count = Marshal.Release ComObject(aobjI tem)
Debug.WriteLine (String.Format( "DisposeObj ect - Release {0},
RefCount: {1}", aobjItem.ToStri ng(), count), "")
While count > 0
count = Marshal.Release ComObject(aobjI tem)
End While
Catch ex As SystemException
Debug.WriteLine (String.Format( "DisposeObj ect Exception:
{0}"), ex.Message)
Finally
aobjItem = Nothing
End Try
End Sub
End Module
