Friday, May 27, 2005

Call VB.NET from a COM script

In my continuing pursuit for the ultimate new idea in programming, I learnt something new today.

At work we, rather I, am testing a new network/system monitoring tool. This one from ActiveXperts called Network Monitor 6.0 (how original, eh?) allows the use of VBScripts. Well, lo and behold, I couldn't get ADO 2.8 to work in a VBScript. So what did I do? I looked up how to get VB.NET to work through a COM call. The example I had to go by used C#, but not to worry, translating to VB.NET was a piece of cake.

So how do you do it? Make that call to a .NET object via a COM call? Simple, you use RegAsm.exe as explained in the example or you can use CLR ComReg . This tool is provided as part of Visual Studio .NET SDK as source code which adds some features left out by RegAsm. These are noted in the Read Me.

First you'll want to create your VB.NET solution as a class library. Simple enough.

Here's the entire class I created for my project here at HP (it checks the Oracle database TEMP tablespace for percent used):



 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Imports Oracle.DataAccess.Client

Namespace OracleChecks
 Public Class OraDBChecks
 
  Private m_connectString As String
  Private m_dbuser As String
  Private m_dbpass As String
  Private m_dbname As String
  
  Public Sub New()
   ' Required for access from COM
   ' Don't do anything here...
  End Sub
  
  Public Sub Init(ByVal dbname As String, ByVal dbuser As String, ByVal dbpass As String)
   m_dbname = dbname
   m_dbuser = dbuser
   m_dbpass = dbpass
   m_connectString = "User ID=" & m_dbuser & ";Password=" & m_dbpass & ";Data Source=" & m_dbname
  End Sub
  
  Public Function CheckTempTablespace(ByVal threshold As Decimal) As Boolean
   Dim sSqlCommand As String = "SELECT decode(sum(s.blocks),NULL, 0, (sum(s.blocks)/sum(t.blocks))*100) temp_percent_used "
   sSqlCommand = sSqlCommand & "FROM SYS.v_$sort_usage s RIGHT OUTER JOIN SYS.dba_temp_files t "
   sSqlCommand = sSqlCommand & "ON s.TABLESPACE = t.tablespace_name"
   
   Dim drTestValue As OracleDataReader
   Dim conTestTable As OracleConnection = New OracleConnection(m_connectString)
   Dim cmdTestTable As New OracleCommand(sSqlCommand, conTestTable)
   conTestTable.Open()   
   drTestValue = cmdTestTable.ExecuteReader(CommandBehavior.SingleRow)
   Do While drTestValue.Read()
    If drTestValue.GetDecimal(0) >= threshold Then
     conTestTable.Close()
     Return True
    Else
     conTestTable.Close()
     Return False
    End If
   Loop
  End Function
 End Class
End Namespace


COM requires a no argument constructor so that's the reason for the Public Sub New statement. You don't have to make it empty, it just can't be passed any values.

Now compile the project and register using RegAsm or ComReg. If you use ComReg and the /gac parameter to add the assembly to the GAC, you need to sign it with a strong name. This is fairly simple enough using some tools provided with the Framework SDK.

First you create a key pair using the sn.exe tool. Simply use this syntax:

sn -k <keyfilename>


For my assembly I used:

sn -k dbchecks.snk


To create the public key file, use this syntax:

sn -p <private_keyfilename>  <public_keyfilename>


For my assembly I used:

sn -p dbchecks.snk dbchecks_public.snk


In Visual Studio, all you need to do now is add the following to the AssemblyInfo.vb file, replacing the path and the key file name appropriately:

<Assembly: AssemblyKeyFileAttribute("C:\Documents and Settings\JOBA\My Documents\VISUAL STUDIO PROJECTS\DBChecks\dbchecks.snk")> 


If you are not using Visual Studio, you will need to sign your assembly using the Assembly Linker (al.exe). This one is a little more complex so I am not going to go into that here.

Now, all that is left is calling your assembly from your COM application.

Since my COM app was a VBScript, here's how I used it:


1
2
3
4
5
6
7
Function CheckTempTablespace(servername, dbuser, dbpass, warnThreshold)
 Dim c
 Set c = CreateObject("HP_PSGIT.OracleChecks.OraDBChecks")
 
 c.Init servername, dbuser, dbpass
 CheckTempTablespace = c.CheckTempTablespace(warnThreshold)   
End Function


And that's all there is. Enjoy!

Tuesday, May 24, 2005

Bit Shifting in VB.NET

Here's a good tidbit of info from Scott Hanselman: "Machine.Shift.Left and Bit Shifting in VB.NET"

Haven't used bit shifting in a long while, but this info is pretty cool and goes back to BASICs...

(Thanks, Scott for the refresher on how to use VB! And yes, VB can be a bit too high level for some intense operations. Isn't that why MS created VS Studio?)

Here's a bit of code from NNTP:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
Function SafeLeftShift(ShiftThis As Integer, ShiftPlaces As Integer) As Integer
    Dim ShiftThisPrivate As Integer ' Private copy with extraneous bits unset
    Dim SignBitMask As Integer ' Mask for fixing msb

    ' Unset leftmost bits that will be discarded
    ShiftThisPrivate = ShiftThis And ((2 ^ (15 - ShiftPlaces)) - 1)

    ' Determine whether the sign bit should
    ' be set in the bit-shifted result
    If ShiftThis And (2 ^ (15 - ShiftPlaces)) Then
        SignBitMask = &H8000
    End If

    ' Do the bit shift.
    SafeLeftShift = (ShiftThisPrivate * (2 ^ ShiftPlaces)) Or SignBitMask
End Function

Thursday, May 19, 2005

db4objects version 4.5 released

db4objects, Inc. announced on 5/5/2005 that version 4.5 of their Open Source Object Database.

If you haven't at least looked at this product, you should! Among some of it's features is the ability to save data with one line of code, object oriented(!!!), embeddable(only a 350K footprint!), and multi- and cross- platform support.

Excerpt from the press release:
Additional improvements in db4o Version 4.5 include a pluggable reflector and a new generic reflector that help developers build more diverse and exciting architectures, along with a new object-oriented ObjectManager for easy browsing of database files.
db4o's pluggable reflector interface allows Java and .NET developers to write their own reflectors. Version 4.5 advances this functionality with a powerful new generic reflector further enabling tuning for distributed systems, cross-platform support, and enhanced encryption capabilities.
With the generic reflector, developers can now run a db4o server without having to deploy application classes. They can also easily access objects and values where classes or fields are no longer available as source code.
One implementation of this is the new ObjectManager, which allows developers to "look" into databases and monitor what's happening in real-time while they write applications. It can also be used by third parties to browse a database file, and/or to build ad-hoc queries for instances of a class. This helps ease the transition to OOP-thinking for developers new to OOP or ODBMS or both and boosts the benefits of OOPs such as Java and .NET.

Wednesday, May 18, 2005

BusinessObjects 6.5.1 VBA macro to refresh, categorize and email reports

It's not VB.NET code, but its pretty cool. I had to use this macro to send a report to the proper user and category. After some troubleshooting with BusinessObjects support, they sent me a hotfix to patch a bug in the Broadcast Agent Publisher (Hotfix 621). After installing the hotfix and rebooting the server all is in working order.

The macro requires an SMTP DLL I found on the internet by Dean Dusenberyat FreeVBCode.com

So without further ado, I present to you the source code for the VBA macro:
Option Explicit

' These lists are "|" delimited
Private Const CATEGORY_LIST As String = "Category 1"
Private Const USER_LIST As String = "USER_GROUP"

Private Const EXCHANGE_DOMAIN As String = "Document"
Private Const EXHANGE_MODE As Integer = BoExchangeMode.boRepositoryMode

Private Const PROMPT_COUNT As Integer = 0
Private Const PROMPT_1 As String = "Replace with prompt text string"

' Email address lists are semi-colon delimited
Private Const EMAIL_RECIPIENT As String = "billyjo.jimbob@yourdomain.com"
Private Const EMAIL_SUBJECT_USE_REPORT_NAME As Boolean = True
Private Const EMAIL_SUBJECT As String = "TEST:BO report automation"
Private Const EMAIL_MESSAGE As String = "Please ignore this test email"
Private Const EMAIL_DOC As Boolean = False
Private Const EMAIL_PDF As Boolean = True
' These generally will not change
Private Const EMAIL_FROM As String = "bo_admin@yourdomain.com"
Private Const EMAIL_FROM_DISPLAY As String = "BO Admin"

' Not used for now
'Private Const BO_REPOSITORY As String = "BO_REPOSIT"
'Private Const BO_PASSWORD As String = "PASSWORD"
'Private Const BO_REPOSITORY_SERVER As String = "BO_SERVER"

' Necessary variables for emailing
' ||===============================||
' || ||
' || DO NOT MODIFY!!! ||
' || ||
' ||===============================||

Private m_emailSubject As String
Private WithEvents poSendMail As vbSendMail.clsSendMail
'Private Const CONNECTION_STRING As String = "Provider=MSDAORA;User ID=" & BO_REPOSITORY & ";Password=" & BO_PASSWORD & ";Data Source=" & BO_REPOSITORY_SERVER
'Private Const EMAIL_LIST_QUERY As String = "SELECT i.EMAILADDRESS emailaddress FROM ipuser i,(select a.actor_name actor_name, " & _
"g.group_name group_name, count(*) dummy from (select distinct " & _
"aa.M_ACTOR_C_NAME actor_name, al.M_ACTL_N_FATLINKID " & _
"actor_link_id from obj_m_actor aa,obj_m_actorlink al " & _
"WHERE aa.M_ACTOR_N_TYPE = 16 and aa.M_ACTOR_N_ID = al.M_ACTL_N_ACTORID and " & _
"aa.M_ACTOR_N_STATUS <> 0 order by 2) a, (select distinct ga.M_ACTOR_C_NAME group_name, " & _
"gl.M_ACTL_N_ID group_link_id from obj_m_actor ga," & _
"obj_m_actorlink gl WHERE ga.M_ACTOR_N_TYPE = 1 " & _
"and ga.M_ACTOR_N_ID = gl.M_ACTL_N_ACTORID order by 2) g WHERE a.actor_link_id " & _
"= g.group_link_id group by g.group_name, a.actor_name order by 2, 1) u " & _
"WHERE u.group_name = '" & USER_LIST & "' AND i.USERLOGONNAME = u.actor_name " & _
"AND i.USERLOGONTYPE = 'NT'"

Private Sub SetPrompts(ByRef variables As busobj.variables)
Dim i As Integer

With variables
If PROMPT_COUNT > 0 Then
For i = 1 To PROMPT_COUNT
Select Case i
' |===================================|
' | Only modify this section below! |
' |===================================|
Case 1
.Item(PROMPT_1).Value = Get6MonthPreviousStartDate()
Case 2
Case 3
Case 4
' |=============================|
' | Do not modify below this! |
' |=============================|
End Select
Next
End If
End With
End Sub

Public Sub Automate()
Dim doc As New Document
Dim tempPath As String
Dim docName As String
Dim pdfName As String

Application.Interactive = False
Application.ActiveDocument.DocAgentOption.CategoryList = CATEGORY_LIST

Set doc = Application.ActiveDocument

tempPath = Application.GetInstallDirectory(boTemporaryDirectory)
docName = tempPath & doc.Name & ".rep"
pdfName = tempPath & doc.Name & ".pdf"

With doc
SetPrompts .variables

.Refresh

If EMAIL_DOC Or EMAIL_PDF Then
If EMAIL_DOC Then
Call doc.SaveAs(docName)
Else
docName = ""
End If

If EMAIL_PDF Then
Call doc.ExportAsPDF(pdfName)
Else
pdfName = ""
End If

If EMAIL_SUBJECT_USE_REPORT_NAME Then
m_emailSubject = doc.Name
End If

Email docName, pdfName
End If

.Send USER_LIST, False, , CATEGORY_LIST, EXHANGE_MODE, EXCHANGE_DOMAIN
End With

Application.Interactive = True
End Sub

Private Function Get6MonthPreviousStartDate() As String
Dim dtDate As Date
Dim nMonth As Integer
Dim nYear As Integer

nMonth = Month(Now)
nYear = Year(Now)

dtDate = CDate(CStr(nMonth) & "/1/" & CStr(nYear))

dtDate = DateAdd("m", -6, dtDate)

GetStartDate = Format(dtDate, "dd-mmm-yy")
End Function

Private Function GetPreviousFridayDate() As String
Dim nFridaySubtractor As Integer
Dim nMonth As Integer
Dim nYear As Integer
Dim nDay As Integer
Dim nWeekday As Integer

nMonth = Month(Now)
nYear = Year(Now)
nDay = Day(Now)
nWeekday = Weekday(Now)

Select Case nWeekday
Case 0
nFridaySubtractor = 1
Case 1
nFridaySubtractor = 2
Case 2
nFridaySubtractor = 3
Case 3
nFridaySubtractor = 4
Case 4
nFridaySubtractor = 5
Case 5
nFridaySubtractor = 1
Case 6
nFridaySubtractor = 0
End Select

dtDate = CDate(CStr(nMonth) & "/" & CStr(nDay - nFridaySubtractor) & "/" & CStr(nYear))

GetEndDate = Format(dtDate, "dd-mmm-yy")
End Function

Private Function GetPreviousFiscalQuarterStart(ByVal dtDate As Date) As String
Select Case GetQuarter(dtDate)
Case 1
GetPreviousFiscalQuarterStart = Format(CDate("01-Nov-" & CStr(DateAdd("yyyy", -1, Year(Now)))), "dd-mmm-yy")
Case 2
GetPreviousFiscalQuarterStart = Format(CDate("01-Feb-" & CStr(Year(Now))), "dd-mmm-yy")
Case 3
GetPreviousFiscalQuarterStart = Format(CDate("01-May-" & CStr(Year(Now))), "dd-mmm-yy")
Case 4
GetPreviousFiscalQuarterStart = Format(CDate("01-Aug-" & CStr(Year(Now))), "dd-mmm-yy")
End Select
End Function

Private Function GetPreviousFiscalQuarterEnd(ByVal dtDate As Date) As String
Select Case GetQuarter(dtDate)
Case 1
GetPreviousFiscalQuarterEnd = Format(CDate("31-Jan-" & CStr(Year(Now))), "dd-mmm-yy")
Case 2
GetPreviousFiscalQuarterEnd = Format(CDate("30-Apr-" & CStr(Year(Now))), "dd-mmm-yy")
Case 3
GetPreviousFiscalQuarterEnd = Format(CDate("31-Jul-" & CStr(Year(Now))), "dd-mmm-yy")
Case 4
GetPreviousFiscalQuarterEnd = Format(CDate("31-Oct-" & CStr(Year(Now))), "dd-mmm-yy")
End Select
End Function

Private Function GetQuarter(ByVal dtDate As Date) As Integer
Dim sDate As String

sDate = Format(dtDate, "dd-mmm")

Select Case True
Case dtDate >= "01-Nov" And dtDate <= "31-Jan"
GetQuarter = 1
Case dtDate >= "01-Feb" And dtDate <= "30-Apr"
GetQuarter = 2
Case dtDate >= "01-May" And dtDate <= "31-Jul"
GetQuarter = 3
Case dtDate >= "01-Aug" And dtDate <= "31-Oct"
GetQuarter = 4
End Select
End Function

' ||=======================||
' || Email generation code ||
' ||=======================||

Private Sub Email(ByVal docName As String, ByVal pdfName As String)
Dim list As String
Dim attachList As String

Set poSendMail = New clsSendMail

With poSendMail
If GetEmailList(list) Then
.SMTPHost = "localhost"
.From = EMAIL_FROM
.FromDisplayName = EMAIL_FROM_DISPLAY
.Recipient = list ' semi-colon (;) delimited list
.Subject = IIf(EMAIL_SUBJECT_USE_REPORT_NAME, m_emailSubject, EMAIL_SUBJECT)

If EMAIL_DOC Or EMAIL_PDF Then
Select Case True
Case EMAIL_DOC And Not EMAIL_PDF
attachList = docName
Case Not EMAIL_DOC And EMAIL_PDF
attachList = pdfName
Case EMAIL_DOC And EMAIL_PDF
attachList = docName & ";" & pdfName
End Select

.Attachment = attachList
End If

.Message = EMAIL_MESSAGE
.Send
End If
End With
End Sub

Private Function GetEmailList(ByRef list As String) As Boolean
' We'll just bypass this section for now.
' We are going to use a single user for now.
list = EMAIL_RECIPIENT
GetEmailList = True

' This code demonstrates how to get the email list from the repository.
' Note the very LARGE query above. (The query is in Oracle syntax,
' but should port since I tried to avoid using Oracle specific SQL)
' Dim rs As New ADODB.Recordset
' Dim tempString As String
' Dim i As Integer
'
' With rs
' .ActiveConnection = CONNECTION_STRING
' .CursorLocation = adUseClient
' .LockType = adLockBatchOptimistic
' .CursorType = adOpenKeyset
' .Source = EMAIL_LIST_QUERY
' .Open
' Set .ActiveConnection = Nothing
' End With
'
' rs.MoveFirst
' If Not rs.EOF Then
' For i = 1 To rs.RecordCount
' If i = 1 Then
' list = rs!emailaddress
' Else
' list = list & ";" & rs!emailaddress
' End If
' rs.MoveNext
' Next
' GetEmailList = True
' Else
' GetEmailList = False
' End If
'
' Set rs = Nothing
End Function



I added this in a module to get it to run:

Option Explicit

Public Sub RefreshReport()
Dim bca As New BCA_RefreshAndEmail_Class

bca.Automate
End Sub


Now, when you send to Broadcast Agent, all you need to do is select the macro. All else is handled!

Enjoy!

Project idea: Code Library

Ok, it will be three tools in one.
  • A code library

  • A source code to HTML formatter

  • An FTP tool to upload to your favorite web/FTP site.

This will be a VB.NET project and I would like to recognize the following other projects:
fish's Code Library.NET
Lore's Source To HTML Converter