frmselectfolder.frm

智能邮件管理信息系统

VERSION 5.00
Object = "{A53B1012-EE23-4D8E-8205-2EC7B0C076A5}#1.0#0"; "XpTreeView.ocx"
Object = "{94BA71ED-FEE7-4684-AB28-3B630F70A94C}#1.0#0"; "ImageListControl.ocx"
Begin VB.Form frmSelectFolder 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   3915
   ClientLeft      =   4890
   ClientTop       =   3990
   ClientWidth     =   5220
   Icon            =   "frmSelectFolder.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3915
   ScaleWidth      =   5220
   StartUpPosition =   2  '屏幕中心
   Begin XPTreeViewControl.XpTreeView ctlTreeTab 
      Height          =   3135
      Left            =   240
      TabIndex        =   3
      Top             =   480
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   5530
      Lines           =   0   'False
      LabelEditing    =   0   'False
      PlusMinus       =   0   'False
      RootLines       =   0   'False
      ToolTips        =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      MaxScrollTime   =   0
   End
   Begin VB.CommandButton cmdCancel 
      Height          =   350
      Left            =   3600
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   720
      UseMaskColor    =   -1  'True
      Width           =   1400
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Left            =   3600
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   240
      UseMaskColor    =   -1  'True
      Width           =   1400
   End
   Begin ImageListCtrl.ImageListControl imgTreeView 
      Left            =   0
      Top             =   0
      _ExtentX        =   953
      _ExtentY        =   953
      ColourDepth     =   24
      Size            =   33292
      Images          =   "frmSelectFolder.frx":0ECA
      Version         =   131203
      KeyCount        =   29
      Keys            =   $"frmSelectFolder.frx":90F6
   End
   Begin VB.Label lblNote 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   540
   End
End
Attribute VB_Name = "frmSelectFolder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mlngMailID() As Long
Private mblnCopyMail As Boolean
Private lngMailCounter As Long

Private mclsMailCreator As MailDll.Mail
Dim m_MailType As MailDll.MailType
Dim m_MailTypes As MailDll.Mails

Dim mLngOwnDefineTreeID As Long

Private BlnShowCard As Boolean
'调用的外部接口，
'blnMove 是移动还是复制

Public Function ShowCard(lngMailID() As Long, Optional blnMove As Boolean) As Boolean
    ReDim mlngMailID(0)
    mlngMailID = lngMailID
    mblnCopyMail = Not blnMove
    Me.Caption = IIf(blnMove, "移动", "复制")
    lblNote.Caption = "将邮件" & Me.Caption & "指定的文件夹："
    Me.Show vbModal
    
    ShowCard = BlnShowCard
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function:创建OUTLOOK模式TREEVIEW
'Author:[e-mail]
'Create Date:2004-03-27
'Last Modify:2004-03-28
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub pCreateOutLookTreeView()
'    m_E_TreeViewType = E_TreeViewType.m_OutlookTreeView
    
    Dim Send As Long, Receive As Long, Sended As Long, Delete As Long
    
    Dim strsql As String
    
    'system node
    If BlnOneUser Then '帐户信箱只保留“收件箱”，“垃圾箱”两个.
        strsql = "select * from OwnDefineTree where strFormName='frmMain' and BlnIsSystem=1" & IIf(m_E_ViewMode = m_ServerMode, " and lngOwnDefineTreeID in (2,3,6) ", "") & " and strKey in ('PERSONAL','InMailBox','OutMailBox','SendMail','DeletedMail','WriteBox','TRACKMAIL')  order by BytOrder"
    Else
        strsql = "select * from OwnDefineTree where strFormName='frmMain' and BlnIsSystem=1  and strKey in ('PERSONAL','InMailBox','OutMailBox','SendMail','DeletedMail','WriteBox','TRACKMAIL')   order by BytOrder"
        
    End If
    
    MOwnDefineTree.GetOwnDefineTrees strsql, MOwnDefineTree.m_OwnDefineTrees
    Dim lngNodeIndex As Long
    
    With ctlTreeTab
        .hImageList = Me.imgTreeView.hIml
        .ClearAllItems
        .ExplorerBar = False
        .RootLines = False
        .Lines = True
        .PlusMinus = True
        .FullRowSelect = False
        .SingleExpand = False
        .ShowNumber = True
        .InternalBorderX = 0
        .InternalBorderY = 0
        Dim lngMailCount As Long
        Dim lngNotReadCount As Long
        
        If MOwnDefineTree.m_OwnDefineTrees.Count > 0 Then
            For lngNodeIndex = 0 To MOwnDefineTree.m_OwnDefineTrees.Count - 1
                LSet MOwnDefineTree.m_OwnDefineTree = m_OwnDefineTrees.OwnDefineTree(lngNodeIndex)
                If MOwnDefineTree.m_OwnDefineTree.strText <> "" Then
                    Call .AddItem(m_OwnDefineTree.strParentKey, IIf(UCase(m_OwnDefineTree.strTypeString) = UCase("firstChild"), xpTreeViewControl.RelationConstants.firstChild, xpTreeViewControl.RelationConstants.lastChild), m_OwnDefineTree.strKey, IIf(BlnEnglishVersion, m_OwnDefineTree.strEnglishText, m_OwnDefineTree.strText), imgTreeView.ImageItemIndex(m_OwnDefineTree.strImageKey) - 1)
                    .lngOwnDefineTreeID(m_OwnDefineTree.strKey) = m_OwnDefineTree.lngOwnDefineTreeID
                End If
            Next
            
            For lngNodeIndex = 0 To MOwnDefineTree.m_OwnDefineTrees.Count - 1
                LSet MOwnDefineTree.m_OwnDefineTree = m_OwnDefineTrees.OwnDefineTree(lngNodeIndex)
                .ItemExpanded(m_OwnDefineTree.strKey) = IIf(m_OwnDefineTree.BlnExpend = 1, True, False)
            Next
        End If
        
        
        If Not BlnOneUser Then
            'Contract's owndefine Treeview
            strsql = "select * from OwnDefineTree where strFormName='frmMain' and BlnIsSystem=0 " & IIf(m_E_ViewMode = m_CliendMode, " and LngEmployeeID=" & gLngEmployeeID1, "") & " order by BytOrder"
            MOwnDefineTree.GetOwnDefineTrees strsql, MOwnDefineTree.m_OwnDefineTreeContsContract
            If MOwnDefineTree.m_OwnDefineTreeContsContract.Count > 0 Then
                For lngNodeIndex = 0 To MOwnDefineTree.m_OwnDefineTreeContsContract.Count - 1
                    LSet MOwnDefineTree.m_OwnDefineTree = m_OwnDefineTreeContsContract.OwnDefineTree(lngNodeIndex)
                    If MOwnDefineTree.m_OwnDefineTree.strText <> "" Then
                        Call .AddItem(m_OwnDefineTree.strParentKey, IIf(UCase(m_OwnDefineTree.strTypeString) = UCase("firstChild"), xpTreeViewControl.RelationConstants.firstChild, xpTreeViewControl.RelationConstants.lastChild), m_OwnDefineTree.strKey, IIf(BlnEnglishVersion, m_OwnDefineTree.strEnglishText, m_OwnDefineTree.strText), imgTreeView.ImageItemIndex(m_OwnDefineTree.strImageKey) - 1)
                        .lngOwnDefineTreeID(m_OwnDefineTree.strKey) = m_OwnDefineTree.lngOwnDefineTreeID
                    End If
                Next
                
                For lngNodeIndex = 0 To MOwnDefineTree.m_OwnDefineTreeContsContract.Count - 1
                    LSet MOwnDefineTree.m_OwnDefineTree = m_OwnDefineTreeContsContract.OwnDefineTree(lngNodeIndex)
                    .ItemExpanded(m_OwnDefineTree.strKey) = IIf(m_OwnDefineTree.BlnExpend = 1, True, False)
                Next
            End If
        Else
            'Contract's owndefine Treeview
            strsql = "select * from OwnDefineTree where strFormName='frmMain' and BlnIsSystem=0 " & IIf(m_E_ViewMode = m_CliendMode, " and lngEmployeeID=" & gLngEmployeeID1, " and lngEmployeeID=0") & " order by BytOrder"
            MOwnDefineTree.GetOwnDefineTrees strsql, MOwnDefineTree.m_OwnDefineTreeContsContract
            If MOwnDefineTree.m_OwnDefineTreeContsContract.Count > 0 Then
                For lngNodeIndex = 0 To MOwnDefineTree.m_OwnDefineTreeContsContract.Count - 1
                    LSet MOwnDefineTree.m_OwnDefineTree = m_OwnDefineTreeContsContract.OwnDefineTree(lngNodeIndex)
                    If MOwnDefineTree.m_OwnDefineTree.strText <> "" Then
                        Call .AddItem(m_OwnDefineTree.strParentKey, IIf(UCase(m_OwnDefineTree.strTypeString) = UCase("firstChild"), xpTreeViewControl.RelationConstants.firstChild, xpTreeViewControl.RelationConstants.lastChild), m_OwnDefineTree.strKey, IIf(BlnEnglishVersion, m_OwnDefineTree.strEnglishText, m_OwnDefineTree.strText), imgTreeView.ImageItemIndex(m_OwnDefineTree.strImageKey) - 1)
                        .lngOwnDefineTreeID(m_OwnDefineTree.strKey) = m_OwnDefineTree.lngOwnDefineTreeID
                    End If
                Next
                
                For lngNodeIndex = 0 To MOwnDefineTree.m_OwnDefineTreeContsContract.Count - 1
                    LSet MOwnDefineTree.m_OwnDefineTree = m_OwnDefineTreeContsContract.OwnDefineTree(lngNodeIndex)
                    .ItemExpanded(m_OwnDefineTree.strKey) = IIf(m_OwnDefineTree.BlnExpend = 1, True, False)
                Next
            End If
        End If
        
        
        
    End With
    
End Sub




Private Sub cmdCancel_Click()
    BlnShowCard = False
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim i As Long
    
    If UBound(mlngMailID) > 0 Then
        For lngMailCounter = 0 To UBound(mlngMailID)
            mclsMailCreator.GetMail mlngMailID(lngMailCounter), m_MailType, True, True, True, True
            If m_MailType.lngMailID > 0 Then
                '供应商 ID   strParentKey    strText strKey  strFormName BytOrder    BlnIsSystem LngEmployeeID   strImageKey strTypeString   BlnExpend   strEnglishText
    '            1   0&  跟踪    TRACKMAIL   frmMain -1  1   0   PERSONAL FOLDERS    firstChild  1   Track
    '            2   0&  本地文件夹  PERSONAL    frmMain 0   1   0   PERSONAL FOLDERS    firstChild  1   Folders
    '            3   PERSONAL    收件箱  InMailBox   frmMain 1   1   0   INBOX   lastChild   0   InBox
    '            4   PERSONAL    发件箱  OutMailBox  frmMain 2   1   0   OUTBOX  lastChild   0   OutBox
    '            5   PERSONAL    已发送邮件  SendMail    frmMain 3   1   0   SENT ITEMS  lastChild   0   SendBox
    '            6   PERSONAL    废件箱  DeletedMail frmMain 4   1   0   DELETED ITEMS   lastChild   0   Deleted Items
    '            7   PERSONAL    草稿    WriteBox    frmMain 5   1   0   INBOX   lastChild   0   Drafts
                Select Case mLngOwnDefineTreeID
                    Case 3 ' UCase("InMailBox")
                        m_MailType.strMailBoxTag = "ReceptBox" '现在的邮箱
                        m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.InMailBox
                        
                        m_MailType.StrFromMailBoxTag = "" '转移或复制的源文件夹
                    Case 4 'UCase("OutMailBox")
                        m_MailType.strMailBoxTag = "SendBox" '现在的邮箱
                        m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.OutMailBox
                        
                        m_MailType.StrFromMailBoxTag = "" '转移或复制的源文件夹
                    Case 5 'UCase("SendMail")
                        m_MailType.strMailBoxTag = "SendedBox" '现在的邮箱
                        m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.SendMail
                        
                        m_MailType.StrFromMailBoxTag = "" '转移或复制的源文件夹
                    Case 6 'UCase("DeletedMail")
                        m_MailType.strMailBoxTag = "DeletedBox" '现在的邮箱
                        m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.DeletedMail
                        
                        m_MailType.StrFromMailBoxTag = "" '转移或复制的源文件夹
                    Case 7 ' UCase("WRITEBOX")
                        m_MailType.strMailBoxTag = "WriteBox" '现在的邮箱
                        m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.WriteBox
                        
                        m_MailType.StrFromMailBoxTag = "" '转移或复制的源文件夹
                    Case Else
                        m_MailType.strMailBoxTag = ""
                        m_MailType.lngOwnDefineTreeID = mLngOwnDefineTreeID
                End Select
                
                If BlnOneUser Then
                    m_MailType.LngCustomerID = 0
                End If
                            
                If mblnCopyMail Then
                    LSet m_MailType = m_MailType
                    m_MailType.lngMailID = 0
                    For i = 0 To UBound(m_MailType.strMailAttach)
                        m_MailType.strMailAttach(i).lngMailAttachId = 0
                    Next i
                    
                    For i = 0 To UBound(m_MailType.strMailImage)
                        m_MailType.strMailImage(i).lngMailImageID = 0
                    Next i
                    
                    BlnShowCard = mclsMailCreator.SaveMail(m_MailType, True, True, True, True)
                Else
                    BlnShowCard = mclsMailCreator.SaveMail(m_MailType, False, False, False, False)
                End If
            End If
         Next
    End If
    Unload Me
End Sub


Private Sub ctlTreeTab_ItemClick(hItem As Long, RightButton As Boolean)
    mLngOwnDefineTreeID = ctlTreeTab.lngOwnDefineTreeID(ctlTreeTab.ItemKey(hItem))
    '点击个人文件夹时不可移动和复制
    If mLngOwnDefineTreeID = 2 Then '"PERSONAL"
        cmdOK.Enabled = False
    Else
        cmdOK.Enabled = True
    End If
End Sub


Private Sub Form_Load()
    cmdOK.Enabled = False
                                                                                                                            
    cmdOK.Picture = LoadResPicture(1001, vbResBitmap)
    cmdCancel.Picture = LoadResPicture(1002, vbResBitmap)
    
    Me.Icon = LoadResPicture(3004, vbResIcon)
    
    Set mclsMailCreator = New MailDll.Mail
    mclsMailCreator.Init gdbCurrentDB, m_E_ViewMode
    pCreateOutLookTreeView
End Sub