frmsaveattach.frm

智能邮件管理信息系统

VERSION 5.00
Object = "{1BC49EFF-D892-4CC6-813F-D905FE4CDEC8}#1.0#0"; "ComboListDrawing.ocx"
Begin VB.Form FrmSaveAttach 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "保存附件"
   ClientHeight    =   3510
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7680
   Icon            =   "FrmSaveAttach.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3510
   ScaleWidth      =   7680
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdSelectAll 
      Caption         =   "全选(&A)"
      Height          =   345
      Left            =   6420
      TabIndex        =   8
      Top             =   2310
      Width           =   1095
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "取消"
      Height          =   345
      Left            =   6420
      TabIndex        =   7
      Top             =   990
      Width           =   1095
   End
   Begin VB.CommandButton CmdSave 
      Caption         =   "保存(&S)"
      Height          =   345
      Left            =   6420
      TabIndex        =   6
      Top             =   360
      Width           =   1095
   End
   Begin VB.CommandButton CmdBrowser 
      Caption         =   "浏览(&B)..."
      Height          =   345
      Left            =   5250
      TabIndex        =   5
      Top             =   2970
      Width           =   1095
   End
   Begin VB.TextBox strPath 
      Height          =   270
      Left            =   150
      Locked          =   -1  'True
      TabIndex        =   4
      Top             =   3030
      Width           =   5025
   End
   Begin VB.PictureBox ctlFrame1 
      Height          =   30
      Left            =   780
      ScaleHeight     =   30
      ScaleWidth      =   6765
      TabIndex        =   3
      Top             =   2850
      Width           =   6765
   End
   Begin ComboListDrawing.ComboListDraw ComboListDraw1 
      Height          =   2355
      Left            =   150
      TabIndex        =   1
      Top             =   300
      Width           =   6195
      _ExtentX        =   10927
      _ExtentY        =   4154
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483630
      Style           =   6
      MaxLength       =   0
   End
   Begin VB.Label Label2 
      Caption         =   "保存为"
      Height          =   165
      Left            =   150
      TabIndex        =   2
      Top             =   2790
      Width           =   645
   End
   Begin VB.Label Label1 
      Caption         =   "要保存的附件(&H):"
      Height          =   195
      Left            =   150
      TabIndex        =   0
      Top             =   60
      Width           =   2565
   End
End
Attribute VB_Name = "FrmSaveAttach"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'外部引用:BrowseForFolder
'ComboListDrawing.ocx

Private lngMailID As Long

Private m_cSysIls As ImageListClass.cSysImageList
Dim m_MailAttachs As MailDll.MailAttachs
Dim mCMail As New MailDll.Mail


Private Sub CmdBrowser_Click()
    Dim BrowseForFolder As cBrowseForFolder
    Set BrowseForFolder = New cBrowseForFolder
    BrowseForFolder.hwndOwner = Me.hwnd
    BrowseForFolder.InitialDir = strPath.Text
    BrowseForFolder.FileSystemOnly = True
    BrowseForFolder.Title = "选择文件夹"
    BrowseForFolder.StatusText = True
    BrowseForFolder.EditBox = True
    BrowseForFolder.UseNewUI = True
    strPath.Text = BrowseForFolder.BrowseForFolder
End Sub

Public Sub ShowDialog(m_MailType As MailDll.MailType)
    Dim i As Long
    Dim ObjFileSystem As New FileSystemObject
    Dim strFileName As String
    Dim strFileExtend As String
    Set m_cSysIls = New ImageListClass.cSysImageList
    m_cSysIls.ImageListIconSizeX = 16
    m_cSysIls.ImageListIconSizeY = 16
    m_cSysIls.CreateImageList
    ComboListDraw1.ImageList = m_cSysIls.hIml
    ComboListDraw1.Clear
    
    Dim strsql As String
    Dim m_MailAttachs As MailDll.MailAttachs
    strsql = "select * from mailattach where lngmailid=" & m_MailType.lngMailID
    lngMailID = m_MailType.lngMailID
    Dim m_clsMailAttach As New MailDll.clsMailAttach
    m_clsMailAttach.Init gdbCurrentDB
    m_clsMailAttach.GetMailAttachs strsql, m_MailAttachs
    
    ComboListDraw1.FullRowSelect = True
    
    mCMail.Init gdbCurrentDB, m_E_ViewMode
    If m_MailType.lngMailID > 0 Then
        For i = 0 To m_MailAttachs.Count - 1
            If ObjFileSystem.FileExists(m_MailAttachs.MailAttach(i).strAttachFile) Then
                strFileName = ObjFileSystem.GetFileName(m_MailAttachs.MailAttach(i).strAttachFile)
                strFileExtend = ObjFileSystem.GetExtensionName(m_MailAttachs.MailAttach(i).strAttachFile)
                '将文件ID,保存到ITEMDATA中
                Call ComboListDraw1.AddItemAndData(strFileName, m_cSysIls.ImageItemIndex("*." & strFileExtend), , , , m_MailAttachs.MailAttach(i).lngMailAttachId)
            End If
        Next i
    Me.Show
    End If
    
    
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdSave_Click()
    Dim i As Long, lngMailAttachId As Long
    Dim m_MailAttach As MailDll.MailAttach
    Dim m_clsMailAttach As New MailDll.clsMailAttach
    Dim ObjFileSystem As New FileSystemObject
    
    Dim strFileName As String, blnSave As Boolean
    
    
    
    
    If Not ObjFileSystem.FolderExists(Trim(strPath.Text)) Then
        ShowMessageBoxEx "目标路径不存在！", vbCritical + vbInformation + vbOKOnly, "提示"
        Exit Sub
    End If
    m_clsMailAttach.Init gdbCurrentDB
    blnSave = False
    For i = 0 To ComboListDraw1.ListCount - 1
        If ComboListDraw1.Selected(i) Then
            lngMailAttachId = ComboListDraw1.ItemData(i)
            m_clsMailAttach.GetMailAttach lngMailAttachId, m_MailAttach
            If Not ObjFileSystem.FileExists(m_MailAttach.strAttachFile) Then
                Debug.Assert False
                blnSave = False
                Exit For
            Else
                strFileName = Trim(strPath.Text) & "\" & ObjFileSystem.GetFileName(m_MailAttach.strAttachFile) '& "." & ObjFileSystem.GetExtensionName(m_MailAttach.strAttachFile)
                If ObjFileSystem.FileExists(strFileName) Then
                    If ShowMessageBoxEx(strFileName & "文件存在，是否覆盖该文件？", vbInformation + vbOKCancel, "提示") = vbOK Then
                        ObjFileSystem.CopyFile m_MailAttach.strAttachFile, strFileName, True
                        blnSave = True
                    End If
                Else
                    ObjFileSystem.CopyFile m_MailAttach.strAttachFile, strFileName
                    blnSave = True
                End If
            End If
        End If
    Next i
    If blnSave Then
        ShowMessageBoxEx "保存成功！", vbInformation + vbOKOnly, "提示"
    Else
        ShowMessageBoxEx "保存失败！", vbInformation + vbOKOnly, "提示"
    End If
    Unload Me
    'pSaveMailAs strPath & "dd.eml", Me.hwnd
End Sub

Private Sub CmdSelectAll_Click()
    Dim i As Long
    
    For i = 0 To ComboListDraw1.ListCount - 1
        ComboListDraw1.Selected(i) = True
    Next i
End Sub