--- joko/ToolBox/Windows/HylaPrintMon_MapiContactsDumper/ModuleMain.bas	2007/09/01 12:40:38	1.1
+++ joko/ToolBox/Windows/HylaPrintMon_MapiContactsDumper/ModuleMain.bas	2007/09/01 15:18:39	1.2
@@ -1,4 +1,189 @@
 Attribute VB_Name = "ModuleMain"
-Sub Main()
-    MsgBox ("hello world!")
+' (c) Andreas Motl <andreas.motl@ilo.de>, 2007-09-01
+
+Option Explicit
+
+Public Sub Main()
+    
+    ' get port name from command line
+    Dim hfax_port As String
+    'hfax_port = "HFAX1:"
+    hfax_port = getCmdArg("--port")
+    
+    ' sanity checks
+    If hfax_port = "" Then
+        MsgBox "Command line argument '--port' is missing.", vbOKOnly, "ERROR"
+        End
+    End If
+    
+    ' read essential information from registry settings of Winprint HylaFAX Port
+    Dim MapiFolderPath As String, AddressBookPath As String, AddressBookType As String
+    MapiFolderPath = getRegistrySetting(hfax_port, "MapiFolderPath")
+    AddressBookPath = getRegistrySetting(hfax_port, "AddressBookPath")
+    AddressBookType = getRegistrySetting(hfax_port, "AddressBookType")
+    
+    ' sanity checks
+    If Not DirectoryExists(AddressBookPath) Then
+        MsgBox "AddressBookPath '" & AddressBookPath & "' does not exist.", vbCritical + vbOKOnly, "ERROR"
+        End
+    End If
+    
+    If AddressBookType = "" Then
+        MsgBox "AddressBookType is empty.", vbCritical + vbOKOnly, "ERROR"
+        End
+    End If
+    
+    
+    ' open MAPI folder
+    mailerStart
+    Dim contactsFolder As Outlook.MAPIFolder
+    
+    If MapiFolderPath = "" Then
+        Set contactsFolder = mailer.Session.GetDefaultFolder(olFolderContacts)
+    Else
+        'Set contactsFolder = getFolderByPath(mailer.Session.Folders, "/Öffentliche Ordner/Alle Öffentlichen Ordner/EDV/plugin_test", 0)
+        Set contactsFolder = getFolderByPath(mailer.Session.Folders, MapiFolderPath, 0)
+        If contactsFolder Is Nothing Then
+            MsgBox _
+                "Problem: Could not open MAPI folder '" & MapiFolderPath & "'." & vbCrLf & _
+                "Please configure properly in port settings dialog or registry:" & vbCrLf & vbCrLf & _
+                "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _
+                vbOKOnly, "ERROR"
+            End
+        End If
+    End If
+    
+    ' read contacts from MAPI folder into array of dictionaries
+    Dim entries As Variant, entry As Variant
+    entries = readMapiFolderToArray(contactsFolder)
+    
+'    ' debugging: output results to gui
+'    For Each entry In entries
+'        MsgBox entry("label") & ": " & entry("faxnumber"), vbOKOnly, "Fax-Contact"
+'    Next
+    
+    ' write results to addressbook files
+    Dim count As Integer
+    If writeAddressbook(entries, AddressBookType, AddressBookPath, count) = True Then
+        MsgBox "Addressbook refreshed successfully (" & count & " entries).", vbInformation + vbOKOnly, "OK"
+    Else
+        MsgBox "Addressbook refresh failed.", vbExclamation + vbOKOnly, "ERROR"
+    End If
+    
 End Sub
+
+Private Function getFolderByPath(ByVal rootFolders As Outlook.Folders, folderPath As String, partsIndex As Integer) As Outlook.MAPIFolder
+    
+    ' split path into parts
+    Dim parts As Variant, part As Variant
+    parts = Split(folderPath, "/")
+    
+    partsIndex = partsIndex + 1
+    Dim entry As Outlook.MAPIFolder
+
+    For Each part In parts
+        If part <> "" Then
+            'MsgBox "part: " & part
+            On Error Resume Next
+            Set entry = rootFolders.Item(part)
+            If Err.Number <> 0 Then
+                MsgBox Err.Description & vbCrLf & vbCrLf & "Problem bei der Verwendung des Ordners '" & part & "', " & vbCrLf & "kompletter Pfad war '" & folderPath & "'.", vbOKOnly, "Error"
+                Exit Function
+            End If
+            On Error GoTo 0
+            'MsgBox "name: " & entry.Name
+            Set rootFolders = entry.Folders
+        End If
+    Next
+
+    Set getFolderByPath = entry
+    
+End Function
+
+Private Function readMapiFolderToBuffer(myFolder As Outlook.MAPIFolder) As Variant
+    Dim contactItem As Outlook.contactItem
+    Dim objAttribute As Variant
+    'myfolder.Items.Item(
+    Dim buffer As String
+    For Each contactItem In myFolder.Items
+        'MsgBox contactItem.NickName
+        'contactItem.us
+        'MsgBox contactItem.l
+        'Text1.Text = Text1.Text & contactItem.LastName & vbCrLf
+        buffer = buffer & _
+            "firstname: " & contactItem.FirstName & vbCrLf & _
+            "lastname: " & contactItem.LastName & vbCrLf & _
+            "business fax: " & contactItem.BusinessFaxNumber & vbCrLf & _
+            "email: " & contactItem.Email1DisplayName & " <" & contactItem.Email1Address & ">" & vbCrLf
+    Next
+    readMapiFolderToBuffer = buffer
+End Function
+
+Private Function readMapiFolderToArray(myFolder As Outlook.MAPIFolder) As Variant
+    
+    Dim buffer() As Dictionary
+    Dim x As Integer
+    
+    Dim contactItem As Outlook.contactItem
+    For Each contactItem In myFolder.Items
+        
+        ' just use contacts with fax number
+        If contactItem.BusinessFaxNumber <> "" Then
+            
+            ' create new dictionary and append to dynamic array
+            ReDim Preserve buffer(x)
+            Set buffer(x) = New Dictionary
+            buffer(x)("label") = contactItem.LastName & " " & contactItem.FirstName
+            buffer(x)("faxnumber") = contactItem.BusinessFaxNumber
+            x = x + 1
+            
+        End If
+        
+    Next
+    readMapiFolderToArray = buffer
+    
+End Function
+
+Private Function getRegistrySetting(portName As String, subKey As String) As String
+    getRegistrySetting = regQuery_A_Key(HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control\Print\Monitors\Winprint Hylafax\Ports\" & portName, subKey)
+End Function
+
+Private Function writeAddressbook(ByRef entries As Variant, abFormat As String, abPath As String, ByRef count As Integer) As Boolean
+    
+    writeAddressbook = False
+    
+    If abFormat = "Two Text Files" Then
+    
+        If MsgBox("names.txt and numbers.txt in '" & abPath & "' will be overwritten. Continue?", vbQuestion + vbYesNo, "Overwrite files?") = vbYes Then
+    
+            Dim fh_names As Integer, fh_numbers As Integer
+            
+            fh_names = FreeFile
+            Open abPath & "\" & "names.txt" For Output As #fh_names
+            
+            fh_numbers = FreeFile
+            Open abPath & "\" & "numbers.txt" For Output As #fh_numbers
+            
+            Dim entry As Variant
+            For Each entry In entries
+                'MsgBox entry("label") & ": " & entry("faxnumber"), vbOKOnly, "Fax-Contact"
+                Print #fh_names, entry("label")
+                Print #fh_numbers, entry("faxnumber")
+                count = count + 1
+            Next
+            
+            Close #fh_names
+            Close #fh_numbers
+            
+            writeAddressbook = True
+        
+        End If
+        
+    ElseIf abFormat = "CSV" Then
+        MsgBox "Addressbook format 'CSV' not supported yet.", vbExclamation + vbOKOnly, "ERROR"
+    
+    Else
+        MsgBox "Unknown addressbook format '" & abFormat & "'.", vbExclamation + vbOKOnly, "ERROR"
+    End If
+    
+End Function