form1.vb

清华大学出版社出版的 移动应用开发宝典 张大威（2008）的附书源代码

Imports Microsoft.WindowsMobile.PocketOutlook
Imports Microsoft.WindowsMobile.Status
Imports Microsoft.WindowsMobile.Forms
Imports System.IO
Imports System.data
Imports System.Reflection
Imports System.ComponentModel

Public Class Form1

    Private session As New OutlookSession
    Private sort As Integer
    Private oic As PimItemCollection

    Private Class Item

        Public name As String
        Public value As Object

        Public Sub New(ByVal name As String, ByVal value As Object)
            Me.name = name
            Me.value = value
        End Sub

    End Class


    Private Sub AddExampleContacts()
        'Me.session.Contacts.Items.Clear()
        Dim c As Contact = Me.session.Contacts.Items.AddNew
        c.FirstName = "Michael"
        c.LastName = "Allen"
        c.Email1Address = "[e-mail]"
        c.MobileTelephoneNumber = "555-0132"
        c.CompanyName = "Contoso Pharmaceuticals"
        c.Properties.Add("LastInvoice", GetType(Integer))
        c.Properties.Item("LastInvoice") = &HC34
        c.Update()
        c = Me.session.Contacts.Items.AddNew
        c.FirstName = "Kevin"
        c.LastName = "Liu"
        c.Email1Address = "[e-mail]"
        c.MobileTelephoneNumber = "555-0167"
        c.CompanyName = "Tailspin Toys"
        c.Properties.Item("LastInvoice") = &HE54
        c.Update()
        c = Me.session.Contacts.Items.AddNew
        c.FirstName = "Elisabetta"
        c.LastName = "Scotti"
        c.Email1Address = "[e-mail]"
        c.MobileTelephoneNumber = "555-0122"
        c.CompanyName = "Fourth Coffee"
        c.Update()
        c = Me.session.Contacts.Items.AddNew
        c.FirstName = "Andrey"
        c.LastName = "Gavrilov"
        c.MobileTelephoneNumber = "555-0171"
        c.CompanyName = "Lucerne Publishing"
        c.Update()
        c = Me.session.Contacts.Items.AddNew
        c.FirstName = "Iris"
        c.LastName = "Rodgers"
        c.Email1Address = "[e-mail]"
        c.CompanyName = "Adventure Works"
        c.Update()
    End Sub


    Private Sub AppointmentWithReminder(ByVal start As DateTime, ByVal duration As TimeSpan, ByVal subject As String)
        Dim a As New Appointment
        a.Start = start
        a.Duration = duration
        a.Subject = subject
        a.BusyStatus = BusyStatus.Busy
        a.Categories = "Samples"
        a.ReminderMinutesBeforeStart = 60
        a.ReminderDialog = True
        a.ReminderLed = True
        a.ReminderSound = True
        a.ReminderRepeat = True
        a.ReminderSoundFile = "\Windows\Alarm3.wav"
        a.Update()
    End Sub

    Private Function DayOfWeekToDaysOfWeek(ByVal dow As DayOfWeek) As DaysOfWeek
        Select Case dow
            Case DayOfWeek.Sunday
                Return DaysOfWeek.Sunday
            Case DayOfWeek.Monday
                Return DaysOfWeek.Monday
            Case DayOfWeek.Tuesday
                Return DaysOfWeek.Tuesday
            Case DayOfWeek.Wednesday
                Return DaysOfWeek.Wednesday
            Case DayOfWeek.Thursday
                Return DaysOfWeek.Thursday
            Case DayOfWeek.Friday
                Return DaysOfWeek.Friday
            Case DayOfWeek.Saturday
                Return DaysOfWeek.Saturday
        End Select
        Return 0
    End Function

    Private Function GetSystemState() As DataTable
        Dim dt As New DataTable
        dt.Columns.Add("Name", GetType(String))
        dt.Columns.Add("Value", GetType(Object))
        Dim pis As PropertyInfo() = GetType(SystemState).GetProperties((BindingFlags.Public Or BindingFlags.Static))
        Dim pi As PropertyInfo
        For Each pi In pis
            dt.Rows.Add(New Object() {pi.Name, pi.GetValue(Nothing, Nothing)})
        Next
        Return dt
    End Function

    Private Function GetWeekOfMonth(ByVal dt As DateTime) As WeekOfMonth
        Dim week As Integer = ((dt.Day / 7) + 1)
        Return DirectCast(week, WeekOfMonth)
    End Function

    Private Sub SaveTask(ByVal customerid As String, ByVal jobNumber As Integer, ByVal description As String)
        Dim t As New Task
        t.Subject = (jobNumber.ToString & ": " & description)
        t.StartDate = DateTime.Now
        t.DueDate = DateTime.Today.AddDays(7)
        t.Properties.Add("CustomerId", GetType(String))
        t.Properties.Add("JobNumber", GetType(Integer))
        t.Properties.Item("CustomerID") = customerid
        t.Properties.Item("JobNumber") = jobNumber
        t.Categories = "Maintenance"
        t.Update()
    End Sub

    Private Sub SendGenericEmail()
        Dim m As New EmailMessage
        Dim r As New Recipient("Elisabetta Scotti", "[e-mail]")
        m.To.Add(r)
        m.Subject = "Important customer update"
        m.BodyText = "This is an automatically generated email"
        m.Importance = Importance.High
        Dim a As New Attachment(Me.openFileDialog1.FileName)
        m.Attachments.Add(a)
        m.Send(Me.session.EmailAccounts.Item(0))
    End Sub

    Private Sub SendGenericSms()
        Dim s As New SmsMessage
        Dim r As New Recipient("Andrey Gladkikh", "555-0171")
        s.To.Add(r)
        s.Body = "This is an automatically generated SMS"
        s.RequestDeliveryReport = True
        s.Send()
    End Sub

    Private Sub OutlookForm_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
        Me.oic = Me.session.Appointments.Items
        Me.DataGrid1.DataSource = Me.oic
    End Sub





    Private Sub OutlookForm_Closing(ByVal sender As Object, ByVal e As CancelEventArgs) Handles Me.Closing
        Me.session.Dispose()
        Me.DataGrid1.DataSource = Nothing
        If Not oic Is Nothing Then
            Me.oic.Dispose()
        End If
        Me.oic = Nothing
    End Sub





    Private Sub radTasks_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles radTasks.CheckedChanged
        If Me.radTasks.Checked Then
            If Not oic Is Nothing Then
                Me.oic.Dispose()
            End If
            Me.oic = Me.session.Tasks.Items.Restrict("[Complete] = FALSE")
            Me.DataGrid1.DataSource = Me.oic
        End If
    End Sub

    Private Sub btnChange_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnChange.Click
        Dim o As Object = Me.BindingContext.Item(Me.dataGrid1.DataSource).Current
        If TypeOf o Is PimItem Then
            DirectCast(o, PimItem).ShowDialog()
        End If
    End Sub


    Private Sub btnRemove_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnRemove.Click
        Dim o As Object = Me.BindingContext.Item(Me.DataGrid1.DataSource).Current
        If TypeOf o Is Appointment Then
            DirectCast(o, Appointment).Delete()
        End If
        If TypeOf o Is Contact Then
            DirectCast(o, Contact).Delete()
        End If
        If TypeOf o Is Task Then
            DirectCast(o, Task).Delete()
        End If
    End Sub

    Private Sub btnAttach_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnAttach.Click
        Me.openFileDialog1.ShowDialog()
    End Sub


    Private Sub rbStatus_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles rbStatus.CheckedChanged
        If Me.rbStatus.Checked Then
            Me.DataGrid1.DataSource = Me.GetSystemState
        End If
    End Sub

    Private Sub btnSync_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnSync.Click
        MessagingApplication.Synchronize(Me.session.EmailAccounts.Item(0))
    End Sub

    Private Sub btnCompose_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnCompose.Click
        Dim attachments As String() = New String(0 - 1) {}
        If File.Exists(Me.openFileDialog1.FileName) Then
            attachments = New String() {Me.openFileDialog1.FileName}
        End If
        MessagingApplication.DisplayComposeForm(Me.session.EmailAccounts.Item(0).Name, Me.txtEmailAddr.Text, "Populated Compose Form", Me.txtBody.Text, attachments)
    End Sub

    Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click
        MyBase.Close()
    End Sub

    Private Sub btnLookupEmail_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnLookupEmail.Click
        Dim ccd As New ChooseContactDialog
        ccd.ChoosePropertyText = "Select an email address:"
        ccd.ChooseContactOnly = False
        'ccd.Owner = Me
        ccd.Title = "Choose an email recipient"
        ccd.RequiredProperties = New ContactProperty() {ContactProperty.AllEmail}
        If (ccd.ShowDialog = DialogResult.OK) Then
            Me.txtEmailAddr.Text = ccd.SelectedPropertyValue
        End If
    End Sub

    Private Sub btnLookupSms_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnLookupSms.Click
        Dim ccd As New ChooseContactDialog
        'ccd.Owner = Me
        ccd.RequiredProperties = New ContactProperty() {ContactProperty.Sms}
        ccd.Title = "Choose an SMS recipient"
        If (ccd.ShowDialog = DialogResult.OK) Then
            Me.txtNumber.Text = ccd.SelectedPropertyValue
        End If
    End Sub

    Private Sub radContacts_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles radContacts.CheckedChanged
        If Me.radContacts.Checked Then
            If Not oic Is Nothing Then
                Me.oic.Dispose()
            End If
            Me.oic = Me.session.Contacts.Items
            Me.DataGrid1.DataSource = Me.oic
        End If
    End Sub


    Private Sub radCalendar_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles radCalendar.CheckedChanged
        If Me.radCalendar.Checked Then
            If Not oic Is Nothing Then
                Me.oic.Dispose()
            End If

            Me.oic = Me.session.Appointments.Items
            Me.DataGrid1.DataSource = Me.oic
        End If
    End Sub

    Private Sub mnuAddSample_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAddSample.Click
        Me.AddExampleContacts()

    End Sub

    Private Sub btnNew_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnNew.Click
        DirectCast(Me.oic.AddNew, PimItem).ShowDialog()
    End Sub

    Private Sub btnSms_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSms.Click
        Dim s As New SmsMessage(Me.txtNumber.Text, Me.txtBody.Text)
        s.Send()
    End Sub

    Private Sub btnEmail_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEmail.Click
        Dim em As New EmailMessage
        em.To.Add(New Recipient(Me.txtEmailAddr.Text))
        em.Subject = "Test Email"
        em.BodyText = Me.txtBody.Text
        If Not String.IsNullOrEmpty(Me.openFileDialog1.FileName) Then
            em.Attachments.Add(New Attachment(Me.openFileDialog1.FileName))
        End If
        em.Send(Me.session.EmailAccounts.Item(0))
        MessagingApplication.Synchronize()

    End Sub

    Private Sub btnRecurring_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRecurring.Click
        Dim a As Appointment = Me.session.Appointments.Items.AddNew
        a.Subject = "Test Recurrence"
        a.Start = DateTime.Now
        Dim ar As AppointmentRecurrence = a.RecurrencePattern
        If Me.rbDaily.Checked Then
            ar.RecurrenceType = RecurrenceType.Daily
            ar.Interval = Convert.ToInt32(Me.udInterval.Value)
        ElseIf Me.rbWeekly.Checked Then
            ar.RecurrenceType = RecurrenceType.Weekly
            ar.DaysOfWeekMask = Me.DayOfWeekToDaysOfWeek(Me.dtpStart.Value.DayOfWeek)
            ar.Interval = Convert.ToInt32(Me.udInterval.Value)
        ElseIf Me.rbMonthly.Checked Then
            ar.RecurrenceType = RecurrenceType.Monthly
            ar.DayOfMonth = Me.dtpStart.Value.Day
            ar.Interval = Convert.ToInt32(Me.udInterval.Value)
        ElseIf Me.rbMonthNum.Checked Then
            ar.RecurrenceType = RecurrenceType.MonthByNumber
            ar.DaysOfWeekMask = Me.DayOfWeekToDaysOfWeek(Me.dtpStart.Value.DayOfWeek)
            ar.Interval = Convert.ToInt32(Me.udInterval.Value)
            ar.Instance = Me.GetWeekOfMonth(Me.dtpStart.Value)
        ElseIf Me.rbYearly.Checked Then
            ar.RecurrenceType = RecurrenceType.Yearly
            ar.MonthOfYear = DirectCast(Me.dtpStart.Value.Month, Month)
            ar.DayOfMonth = Me.dtpStart.Value.Day
        ElseIf Me.rbYearByNum.Checked Then
            ar.RecurrenceType = RecurrenceType.YearByNumber
            ar.DaysOfWeekMask = Me.DayOfWeekToDaysOfWeek(Me.dtpStart.Value.DayOfWeek)
            ar.MonthOfYear = DirectCast(Me.dtpStart.Value.Month, Month)
            ar.Instance = Me.GetWeekOfMonth(Me.dtpStart.Value)
        End If
        ar.PatternStartDate = Me.dtpStart.Value
        ar.Occurrences = Convert.ToInt32(Me.udOccurences.Value)
        a.Update()
        Me.treeView1.BeginUpdate()
        Dim tnRoot As TreeNode = Me.treeView1.Nodes.Add((a.Subject & " " & a.Start.ToShortDateString))
        Dim i As Integer = 0
        Do While (i < ar.Occurrences)
            Dim dt As DateTime = DateTime.Today
            Select Case ar.RecurrenceType
                Case RecurrenceType.Daily
                    dt = ar.PatternStartDate.AddDays(CDbl((i * ar.Interval)))
                    Exit Select
                Case RecurrenceType.Weekly
                    dt = ar.PatternStartDate.AddDays(CDbl(((7 * i) * ar.Interval)))
                    Exit Select
                Case RecurrenceType.Monthly
                    dt = ar.PatternStartDate.AddMonths((i * ar.Interval))
                    Exit Select
                Case RecurrenceType.MonthByNumber
                    dt = ar.PatternStartDate.AddMonths((i * ar.Interval))
                    Exit Select
                Case RecurrenceType.Yearly
                    dt = ar.PatternStartDate.AddYears(i)
                    Exit Select
                Case RecurrenceType.YearByNumber
                    dt = ar.PatternStartDate.AddYears(i)
                    Exit Select
            End Select
            Dim aOccurrence As Appointment = ar.GetOccurrence(dt)
            If (Not aOccurrence Is Nothing) Then
                tnRoot.Nodes.Add((aOccurrence.Subject & " " & aOccurrence.Start.ToShortDateString))
            End If
            i += 1
        Loop
        Me.treeView1.EndUpdate()

    End Sub
End Class