Warning: This file has been marked up for HTML
VERSION 4.00
Begin VB.Form frmMessage
BorderStyle = 1 'Fixed Single
Caption = "Message Find"
ClientHeight = 6615
ClientLeft = 1095
ClientTop = 1515
ClientWidth = 9390
Height = 7020
Icon = "MsgFind.frx":0000
Left = 1035
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 6615
ScaleWidth = 9390
Top = 1170
Width = 9510
Begin VB.ListBox lstFound
Enabled = 0 'False
Height = 3795
IntegralHeight = 0 'False
Left = 7680
TabIndex = 8
Top = 2280
Width = 1575
End
Begin VB.ComboBox cboFolders
Enabled = 0 'False
Height = 315
Left = 120
Style = 2 'Dropdown List
TabIndex = 4
Top = 1620
Width = 9135
End
Begin VB.CommandButton cmdLogin
Caption = "&Login"
Default = -1 'True
Height = 315
Left = 120
TabIndex = 2
Top = 120
Width = 3435
End
Begin VB.TextBox txtParameters
Height = 315
Left = 120
TabIndex = 1
Text = "/ph-"
Top = 840
Width = 3435
End
Begin VB.TextBox txtUserID
Height = 315
Left = 120
TabIndex = 0
Text = "UserID"
Top = 480
Width = 3435
End
Begin VB.TextBox txtFilter
Enabled = 0 'False
Height = 315
Left = 120
TabIndex = 9
Top = 6120
Width = 8295
End
Begin VB.CommandButton cmdFind
Caption = "F&ind"
Enabled = 0 'False
Height = 315
Left = 8460
TabIndex = 10
Top = 6120
Width = 795
End
Begin VB.Frame Frame1
Caption = "Account Information"
Height = 1035
Left = 3660
TabIndex = 11
Top = 120
Width = 5595
Begin VB.Label lblTCPIPPort
Height = 255
Left = 1440
TabIndex = 17
Top = 720
Width = 1815
End
Begin VB.Label lblTCPIPAddress
Height = 255
Left = 1440
TabIndex = 16
Top = 480
Width = 1815
End
Begin VB.Label lblPathToHost
Height = 255
Left = 1440
TabIndex = 15
Top = 240
Width = 1815
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "TCP/IP Port:"
Height = 255
Index = 4
Left = 60
TabIndex = 14
Top = 720
Width = 1275
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "TCP/IP Address:"
Height = 255
Index = 3
Left = 60
TabIndex = 13
Top = 480
Width = 1275
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Path to Host:"
Height = 255
Index = 0
Left = 60
TabIndex = 12
Top = 240
Width = 1275
End
End
Begin VB.Label Label2
Caption = "F&ound"
Enabled = 0 'False
Height = 195
Index = 2
Left = 7680
TabIndex = 7
Top = 2040
Width = 1575
End
Begin ComctlLib.ProgressBar pbProgress
Align = 2 'Align Bottom
Height = 135
Left = 0
TabIndex = 18
Top = 6480
Width = 9390
_ExtentX = 16563
_ExtentY = 238
_Version = 327680
Appearance = 1
MouseIcon = "MsgFind.frx":000C
End
Begin ComctlLib.ListView lvMessages
Height = 3795
Left = 120
TabIndex = 6
Top = 2280
Width = 7515
_ExtentX = 13256
_ExtentY = 6694
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
_Version = 327680
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
Enabled = 0 'False
MouseIcon = "MsgFind.frx":0028
NumItems = 7
BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = "Subject"
Object.Tag = ""
Text = "Subject"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = "From"
Object.Tag = ""
Text = "From"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = "Date"
Object.Tag = ""
Text = "Date"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(4) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = "Box Type"
Object.Tag = ""
Text = "Box Type"
Object.Width = 1270
EndProperty
BeginProperty ColumnHeader(5) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = "Class Name"
Object.Tag = ""
Text = "Class Name"
Object.Width = 4410
EndProperty
BeginProperty ColumnHeader(6) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = "View Name"
Object.Tag = ""
Text = "View Name"
Object.Width = 4410
EndProperty
BeginProperty ColumnHeader(7) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = "Message ID"
Object.Tag = ""
Text = "Message ID"
Object.Width = 7056
EndProperty
End
Begin VB.Line Line1
X1 = 120
X2 = 9240
Y1 = 1260
Y2 = 1260
End
Begin VB.Label Label2
Caption = "&Folders"
Enabled = 0 'False
Height = 195
Index = 0
Left = 120
TabIndex = 3
Top = 1380
Width = 9135
End
Begin VB.Label Label2
Caption = "&Messages"
Enabled = 0 'False
Height = 195
Index = 1
Left = 120
TabIndex = 5
Top = 2040
Width = 7515
End
End
Attribute VB_Name = "frmMessage"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
'/***************************************************************************
'$name: MSGFIND.FRM
'$version: 1.0
'$date_modified: 121298
'$description: This app allows you to find messages using
' Messages.Find("Filter Expression")
'
' Example of a filter expression: (SUBJECT CONTAINS "IMPORTANT:")
' Make sure you include the parenthesis.
'$owner: GroupWise SDK Team Lead
'Copyright (c) 1998 Novell, Inc. All Rights Reserved.
'
'THIS WORK IS SUBJECT TO U.S. AND INTERNATIONAL COPYRIGHT LAWS AND TREATIES.
'USE AND REDISTRIBUTION OF THIS WORK IS SUBJECT TO THE LICENSE AGREEMENT
'ACCOMPANYING THE SOFTWARE DEVELOPMENT KIT (SDK) THAT CONTAINS THIS WORK.
'PURSUANT TO THE SDK LICENSE AGREEMENT, NOVELL HEREBY GRANTS TO DEVELOPER A
'ROYALTY-FREE, NON-EXCLUSIVE LICENSE TO INCLUDE NOVELL'S SAMPLE CODE IN ITS
'PRODUCT. NOVELL GRANTS DEVELOPER WORLDWIDE DISTRIBUTION RIGHTS TO MARKET,
'DISTRIBUTE, OR SELL NOVELL'S SAMPLE CODE AS A COMPONENT OF DEVELOPER'S
'PRODUCTS. NOVELL SHALL HAVE NO OBLIGATIONS TO DEVELOPER OR DEVELOPER'S
'CUSTOMERS WITH RESPECT TO THIS CODE.
'****************************************************************************/
Option Explicit
' Array of enumerations
Private MessageBoxTypeConstants(5) As String
' GroupWise Object API variables
Private GWRootAccount As Account
Private GWFolders As Folders
Private GWMessages As Object
Private GWFoundMessages As MessageList
Private Sub cboFolders_Click()
'Get Address Book Entries
Call GetMessages
End Sub
Private Sub cmdFind_Click()
' Populate a ListBox with messages return with the "Messages.Find" method
Call GetFoundMessages
End Sub
Private Sub cmdLogin_Click()
Dim GWApp As Object
Dim sMsg As String
Screen.MousePointer = vbHourglass
'Disable controls
Call EnableControls(False)
' Dereference global objects
Set GWFoundMessages = Nothing
Set GWMessages = Nothing
Set GWFolders = Nothing
Set GWRootAccount = Nothing
On Error GoTo cmdLogin_Click_Err
Me.Caption = "Creating GroupWare Session...": DoEvents
Set GWApp = CreateObject("NovellGroupWareSession")
Me.Caption = "Logging In...": DoEvents
Set GWRootAccount = GWApp.Login(txtUserID, txtParameters)
' Display Account properties
lblPathToHost = GWRootAccount.PathToHost
lblTCPIPAddress = GWRootAccount.TCPIPAddress
lblTCPIPPort = GWRootAccount.TCPIPPort
'Get Folders
Call GetFolders
'Enable controls
Call EnableControls(True)
Me.Caption = "Message Find": DoEvents
Screen.MousePointer = vbDefault
Exit Sub
cmdLogin_Click_Err:
Screen.MousePointer = vbDefault
sMsg = "In: Sub cmdLogin_Click()" & Chr(10) & _
"Err.Number: " & Err & Chr(10) & _
"Err.Description: " & Err.Description
MsgBox sMsg, vbExclamation
End Sub
Private Sub Form_Load()
'Assign MessageBoxTypeConstants
MessageBoxTypeConstants(1) = "Incoming"
MessageBoxTypeConstants(2) = "Outgoing"
MessageBoxTypeConstants(3) = "Personal"
MessageBoxTypeConstants(4) = "Draft"
End Sub
Private Sub GetMessages()
Dim objMessage As Message
Dim sKey As String
Dim itmX As ListItem
Dim iCount As Integer
Dim iUpdate As Integer
Dim sMsg As String
Dim bAllMessages As Boolean
Screen.MousePointer = vbArrowHourglass
' Control initialization
lvMessages.ListItems.Clear
lstFound.Clear
' If there are folders to select
If cboFolders.ListIndex > 0 Then
' Disable controls
Me.Caption = "Getting Messages"
cmdLogin.Enabled = False
cmdFind.Enabled = False
cboFolders.Enabled = False
lstFound.Enabled = False
DoEvents
On Error GoTo GetMessages_Err
If cboFolders.List(cboFolders.ListIndex) = "<All Messages>" Then
' Get the AllMessages collection
bAllMessages = True
Set GWMessages = GWRootAccount.AllMessages
Else
' Get the Messages collection of the selected folder
bAllMessages = False
Set GWMessages = GWFolders(cboFolders.ListIndex).Messages
Label2(1) = "&Messages (" & GWMessages.Count & ")": Label2(1).Refresh
If GWMessages.Count Then pbProgress.Max = GWMessages.Count
End If
' On Error Resume Next
For Each objMessage In GWMessages
' Add messages to a ListView control
sKey = objMessage.MessageID
Set itmX = lvMessages.ListItems.Add(, sKey, objMessage.Subject.PlainText)
' ' If "Key is not unique in collection"
' If Err = 35602 Then
' Set itmX = lvMessages.ListItems.Add(, , objMessage.Subject)
' End If
With itmX
.SubItems(1) = objMessage.FromText
.SubItems(2) = objMessage.CreationDate
.SubItems(3) = MessageBoxTypeConstants(objMessage.BoxType)
.SubItems(4) = objMessage.ClassName
.SubItems(5) = objMessage.ViewName
.SubItems(6) = objMessage.MessageID
End With
' A count can be obtained from a Messages collection
' but not from an AllMessages collection
If bAllMessages = False Then
iCount = iCount + 1
pbProgress = iCount
End If
Next
If bAllMessages Then
Label2(1) = "&Messages (" & lvMessages.ListItems.Count & ")": Label2(1).Refresh
End If
pbProgress = 0
' Enable appropriate controls
Me.Caption = "Message Find": DoEvents
cmdLogin.Enabled = True
cmdFind.Enabled = True
cboFolders.Enabled = True
lstFound.Enabled = True
End If
Screen.MousePointer = vbDefault
Exit Sub
GetMessages_Err:
Screen.MousePointer = vbDefault
sMsg = "In: Sub GetMessages()" & Chr(10) & _
"Err.Number: " & Err & Chr(10) & _
"Err.Description: " & Err.Description
MsgBox sMsg, vbExclamation
Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Cleanup
Set GWFoundMessages = Nothing
Set GWMessages = Nothing
Set GWFolders = Nothing
Set GWRootAccount = Nothing
End
End Sub
Private Sub GetFolders()
Dim objFolder As Folder
Dim iCount As Integer
Dim sMsg As String
' Control initialization
cboFolders.Clear
lvMessages.ListItems.Clear
lstFound.Clear
Me.Caption = "Getting Folders...": DoEvents
On Error GoTo GetFolders_Err
'Get Folders
Set GWFolders = GWRootAccount.AllFolders
' Display progress
Label2(0) = "&Folders (" & GWFolders.Count & ")": Label2(0).Refresh
If GWFolders.Count Then
pbProgress.Max = GWFolders.Count
cboFolders.AddItem "<Select Folder>"
End If
' Populate a ComboBox with folder names
For Each objFolder In GWFolders
cboFolders.AddItem objFolder.Name
iCount = iCount + 1
pbProgress = iCount
Next
' Add a prompt item
cboFolders.AddItem "<All Messages>"
If cboFolders.ListCount Then cboFolders.ListIndex = 0
pbProgress = 0
Me.Caption = "Message Find": DoEvents
Exit Sub
GetFolders_Err:
Screen.MousePointer = vbDefault
sMsg = "In: Sub GetFolders()" & Chr(10) & _
"Err.Number: " & Err & Chr(10) & _
"Err.Description: " & Err.Description
MsgBox sMsg, vbExclamation
Resume Next
End Sub
Private Sub txtFilter_GotFocus()
cmdFind.Default = True
End Sub
Private Sub txtFilter_LostFocus()
cmdFind.Default = False
End Sub
Private Sub lstFound_Click()
Dim sMsg As String
Dim sKey As String
On Error GoTo lstFound_Click_Err
' When a found item is selected, select the corresponding ListView item
sKey = GWFoundMessages(lstFound.ListIndex + 1).MessageID
Set lvMessages.SelectedItem = lvMessages.ListItems(sKey)
lvMessages.SelectedItem.EnsureVisible
Exit Sub
lstFound_Click_Err:
Screen.MousePointer = vbDefault
sMsg = "In: Sub lstFound_Click()" & Chr(10) & _
"Err.Number: " & Err & Chr(10) & _
"Err.Description: " & Err.Description
MsgBox sMsg, vbExclamation
Resume Next
End Sub
Private Sub txtParameters_GotFocus()
txtParameters.SelStart = Len(txtParameters)
cmdLogin.Default = True
End Sub
Private Sub txtUserID_GotFocus()
If txtUserID.SelStart = 0 Then txtUserID.SelLength = Len(txtUserID)
cmdLogin.Default = True
End Sub
Private Sub EnableControls(bSet As Boolean)
Label2(0).Enabled = bSet
cboFolders.Enabled = bSet
Label2(1).Enabled = bSet
lvMessages.Enabled = bSet
Label2(2).Enabled = bSet
lstFound.Enabled = bSet
txtFilter.Enabled = bSet
cmdFind.Enabled = bSet
End Sub
Private Sub GetFoundMessages()
Dim sMsg As String
Dim objMessage As Message
Dim iCount As Integer
Screen.MousePointer = vbHourglass
Me.Caption = "Finding: " & txtFilter: DoEvents
lstFound.Clear
On Error GoTo GetFoundMessages_Err
' Get a found Messages collection from a Find method
Set GWFoundMessages = GWMessages.Find(txtFilter.Text)
' Show progress
Label2(2) = "F&ound (" & GWFoundMessages.Count & ")": Label2(2).Refresh
If GWFoundMessages.Count Then pbProgress.Max = GWFoundMessages.Count
' Add found Message.Subject to a ListBox
For Each objMessage In GWFoundMessages
lstFound.AddItem objMessage.Subject
iCount = iCount + 1
pbProgress = iCount
Next
pbProgress = 0
Me.Caption = "Message Find": DoEvents
Screen.MousePointer = vbDefault
Exit Sub
GetFoundMessages_Err:
Screen.MousePointer = vbDefault
sMsg = "In: Sub GetFoundMessages()" & Chr(10) & _
"Err.Number: " & Err & Chr(10) & _
"Err.Description: " & Err.Description
MsgBox sMsg, vbExclamation
Resume Next
End Sub