Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Eudora 5.1 Automation VFP sample code
Message
General information
Forum:
Visual FoxPro
Category:
Third party products
Miscellaneous
Thread ID:
00587846
Message ID:
00588345
Views:
29
Thanks Sergey
Here is the code
Option Explicit

' This is the Eudora application object
Public WithEvents app As EuApplication

' Common variables used in main form
Dim MyCaption$
Dim bConnected As Boolean
Dim CurrentFolder As EuFolder
Dim CurrentMessageID As Long

' Test objects for general use when program is
' stopped and in "immediate mode"
Dim tf As EuFolder
Dim tm As EuMessage

' Asynchronous flags for updating lists
Dim bBusy As Boolean
Dim bUpdateTree As Boolean
Dim bUpdateContents As Boolean
Dim bUpdateMessage As Boolean

Function ConnectToEudora() As Boolean
    ' Return value is true if result is connected
    On Error Resume Next
    MousePointer = vbHourglass
    Dim EudoraServerName$
    EudoraServerName$ = "Eudora.EuApplication.1"
    If app Is Nothing Then
        ' Connect to an already running server if possible
        Set app = GetObject(, EudoraServerName)
        If Err.Number <> 0 Then
            Err.Clear
        End If
    End If
    If app Is Nothing Then
        ' No server is running; let's try to create one
        Set app = CreateObject(EudoraServerName)
        If Err.Number <> 0 Then
            Err.Clear
        End If
    End If
    MousePointer = vbDefault
    ConnectToEudora = Not (app Is Nothing)
End Function

Function GetKey(ByVal ID As Long) As String
    Dim k$
    k$ = "Key" + CStr(ID)
    GetKey = k$
End Function

Private Sub SetConnected(b As Boolean)
    On Error Resume Next
    If b = False Then
        picConnected.BackColor = RGB(0, 0, 0)
        labConnected = "not connected"
        bConnected = False
    Else
        picConnected.BackColor = RGB(0, 255, 0)
        labConnected = "connected"
        bConnected = True
    End If
End Sub

Private Sub UpdateTree()
    On Error Resume Next
    MousePointer = vbHourglass
    MailTree.ImageList = ImageList1
    MailTree.LineStyle = tvwTreeLines
    MailTree.Indentation = 10
    MailTree.Nodes.Clear
    Dim nodX As Node
    Set nodX = MailTree.Nodes.Add(, , GetKey(app.RootFolder.ID), "RootFolder")
    UpdateTreeRecursive app.RootFolder
    nodX.Image = 1
    MailTree.SelectedItem = 1
    MousePointer = vbDefault
End Sub

Private Sub UpdateContents()
    ' update table of contents
    On Error Resume Next
    MousePointer = vbHourglass
    Dim Message As EuMessage
    Dim Index As Long
    MailTocName.Caption = CurrentFolder.Name
    MailToc.Clear
    If CurrentFolder.bCanContainMessages Then
        ' update mail folder's table of contents
        Index = 0
        For Each Message In CurrentFolder.Messages
            MailToc.AddItem Message.Subject, Index
            MailToc.ItemData(Index) = Message.ID
            Index = Index + 1
        Next
        If MailToc.ListCount = 0 Then
                MailMessage.Text = "No messages available to view in this folder"
        Else
            MailToc.ListIndex = 0
        End If
    Else
        MailToc.AddItem "This folder cannot contain messages"
        MailMessage.Text = "No message selected"
    End If
    MousePointer = vbDefault
End Sub

Sub UpdateMessage()
    Dim Message As EuMessage
    MousePointer = vbHourglass
    If (CurrentMessageID <> 0) Then
        Set Message = CurrentFolder.Messages.ItemByID(CurrentMessageID)
        If optBody(0) = True Then
            MailMessage.Text = Message.Body
        Else
            If optBody(1) = True Then
                MailMessage.Text = Message.BodyAsSimpleText
            Else
                If optBody(2) = True Then
                    MailMessage.Text = Message.BodyAsHTML
                End If
            End If
        End If
    End If
    MousePointer = vbDefault
End Sub

Private Sub UpdateTreeRecursive(ByVal ParentFolder As EuFolder)
    On Error Resume Next
    Dim PicIndex%
    Dim nodX As Node
    Dim ChildFolder As EuFolder
    Dim keyParent$
    Dim keyChild$
    MousePointer = vbHourglass
    For Each ChildFolder In ParentFolder.Folders
        Select Case ChildFolder.Name
            Case "In"
                PicIndex = 6
            Case "Out"
                PicIndex = 7
            Case "Trash"
                PicIndex = 9
            Case Else
                If ChildFolder.bCanContainMessages Then
                    PicIndex = 4
                Else
                    PicIndex = 2
                End If
        End Select
        keyParent = GetKey(ParentFolder.ID)
        keyChild = GetKey(ChildFolder.ID)
        Set nodX = MailTree.Nodes.Add(keyParent, tvwChild, keyChild, ChildFolder.Name)
        nodX.Image = PicIndex
        nodX.EnsureVisible
        If ChildFolder.Folders.Count > 0 Then
            UpdateTreeRecursive ChildFolder
        End If
    Next
    MousePointer = vbDefault
End Sub

Private Sub app_OnCheckMailComplete()
    StatusBar1.Panels.Item(1).Text = "Check mail complete"
End Sub

Private Sub app_OnClose()
    On Error Resume Next
    SetConnected False
    Set app = Nothing
End Sub

Private Sub app_OnEmptyTrashComplete()
    StatusBar1.Panels.Item(1).Text = "Empty trash complete"
End Sub

Private Sub app_OnCompactFoldersComplete()
    StatusBar1.Panels.Item(1).Text = "Compact folders complete"
End Sub

Private Sub app_OnFolderChange()
    On Error Resume Next
    ' Called when folder hierarchy has changed
    bUpdateTree = True
End Sub

Private Sub app_OnSendMailComplete()
    StatusBar1.Panels.Item(1).Text = "Send mail complete"
End Sub

Private Sub BtnCheckMail_Click()
    Dim p$
    On Error Resume Next
    p$ = InputBox("Enter password for checking mail", "Password")
    app.CheckMail p$
End Sub

Private Sub BtnCompactMailFolders_Click()
    app.CompactFolders
End Sub

Private Sub BtnConnect_Click()
    On Error Resume Next
    SetConnected (ConnectToEudora())
    If Not (app Is Nothing) Then
        Set CurrentFolder = app.InBox
        bUpdateTree = True
        bUpdateContents = True
        bUpdateMessage = True
    End If
End Sub

Private Sub BtnEmptyTrash_Click()
    app.EmptyTrash
End Sub

Private Sub BtnQueueMessage_Click()
    On Error Resume Next
    FrmCompose.Show 1
    If ComposeOk = True Then
        app.QueueMessage ComposeTo, ComposeSubject, ComposeCc, ComposeBcc, ComposeAttach, ComposeBody
    End If
End Sub

Private Sub BtnStop_Click()
    Stop
End Sub

Private Sub BtnSendQueuedMessages_Click()
    On Error Resume Next
    app.SendQueuedMessages
End Sub

Private Sub BtnShutdownEudora_Click()
    On Error Resume Next
    If bConnected = False Then Exit Sub
    app.CloseEudora
End Sub

Private Sub Form_Load()
    On Error Resume Next
    SetConnected False
    StatusBar1.Panels(1).Width = StatusBar1.Width
    bBusy = False
    bUpdateTree = False
    bUpdateContents = False
    bUpdateMessage = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    SetConnected False
    Set app = Nothing
End Sub

Private Sub MailToc_Click()
    Dim MessageID As Long
    CurrentMessageID = MailToc.ItemData(MailToc.ListIndex)
    bUpdateMessage = True
End Sub

Private Sub MailTree_Click()
    On Error Resume Next
    Dim f As EuFolder
    Dim n As Node
    Dim ID As Long
    Set n = MailTree.SelectedItem
    ID = Val(Right$(n.Key, Len(n.Key) - 3))
    Set f = app.FolderByID(ID, 1)
    Set CurrentFolder = f
    UpdateContents
End Sub

Private Sub Timer1_Timer()
    If (bBusy) Then Exit Sub
    If (bConnected = False) Then Exit Sub
    bBusy = True
    If (bUpdateTree) Then
        UpdateTree
        bUpdateTree = False
    End If
    If (bUpdateContents) Then
        UpdateContents
        bUpdateContents = False
    End If
    If (bUpdateMessage) Then
        UpdateMessage
        bUpdateMessage = False
    End If
    bBusy = False
End Sub

Private Sub optBody_Click(Index As Integer)
    bUpdateMessage = True
End Sub
>>Hi all,
>>
>>Does anyone have an automation code for Eudora 5.1 automation, there is a sample at http://www.eudora.com/developers but it is in VB.
>>
>
>If you post VB code maybe somebody'll help you with converting it to VFP.
Regards
Bhavbhuti
___________________________________________
Softwares for Indian Businesses at:
http://venussoftop.tripod.com
___________________________________________
venussoftop@gmail.com
___________________________________________
Previous
Reply
Map
View

Click here to load this message in the networking platform