frmmain.frm

获得加密销内容,并导出文件及库文件,我这是个了结号

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX"
Begin VB.Form Frmmain 
   Caption         =   "邮件接收"
   ClientHeight    =   3540
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7935
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3540
   ScaleWidth      =   7935
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command4 
      Caption         =   "Command4"
      Height          =   375
      Left            =   240
      TabIndex        =   9
      Top             =   2760
      Width           =   1095
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   8
      Top             =   3165
      Width           =   7935
      _ExtentX        =   13996
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   8819
            MinWidth        =   8819
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   5292
            MinWidth        =   5292
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton Command3 
      Caption         =   "保存附件"
      Height          =   375
      Left            =   3720
      TabIndex        =   7
      Top             =   6360
      Visible         =   0   'False
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "下一封"
      Height          =   375
      Left            =   1920
      TabIndex        =   6
      Top             =   6360
      Visible         =   0   'False
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "上一封"
      Height          =   375
      Left            =   480
      TabIndex        =   5
      Top             =   6360
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.TextBox Text4 
      Height          =   270
      Left            =   1800
      TabIndex        =   4
      Text            =   "Text4"
      Top             =   0
      Visible         =   0   'False
      Width           =   3615
   End
   Begin VB.TextBox Text3 
      Height          =   270
      Left            =   1800
      TabIndex        =   3
      Text            =   "Text3"
      Top             =   0
      Visible         =   0   'False
      Width           =   3615
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   1800
      TabIndex        =   2
      Text            =   "Text2"
      Top             =   0
      Visible         =   0   'False
      Width           =   3615
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   1800
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   0
      Visible         =   0   'False
      Width           =   3615
   End
   Begin VB.TextBox TxtPost 
      BackColor       =   &H80000018&
      Height          =   2295
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   360
      Width           =   7335
   End
   Begin VB.Timer Tmrmain 
      Interval        =   1000
      Left            =   0
      Top             =   0
   End
   Begin MSMAPI.MAPISession MAPISen 
      Left            =   240
      Top             =   840
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DownloadMail    =   -1  'True
      LogonUI         =   -1  'True
      NewSession      =   0   'False
   End
   Begin MSMAPI.MAPIMessages MApIMsg 
      Left            =   240
      Top             =   120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      AddressEditFieldCount=   1
      AddressModifiable=   0   'False
      AddressResolveUI=   0   'False
      FetchSorted     =   0   'False
      FetchUnreadOnly =   0   'False
   End
End
Attribute VB_Name = "Frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub FetchNewMail()
  'MApIMsg.FetchUnreadOnly = True
  MApIMsg.Fetch
End Sub

Private Sub Command1_Click()
 If MApIMsg.MsgIndex > 0 Then
    MApIMsg.MsgIndex = MApIMsg.MsgIndex - 1
    DisplayMsg
 End If
End Sub

Private Sub Command2_Click()
 If MApIMsg.MsgIndex < MApIMsg.MsgCount - 1 Then
    MApIMsg.MsgIndex = MApIMsg.MsgIndex + 1
    DisplayMsg
 End If
End Sub

Private Sub Command3_Click()
 If MApIMsg.AttachmentCount > 0 Then
    If MApIMsg.AttachmentType = mapData Then
      SaveTo MApIMsg.AttachmentPathName, MApIMsg.AttachmentName
    End If
  End If
End Sub

Private Sub Command4_Click()
Dim aa() As Byte
Dim i As Integer
Dim j As Integer
PubStatus aa(), "C:\Documents and Settings\administrator\桌面\300001001464870_0006107.sbd", , True
j = UBound(aa)
For i = 1 To j
  
Next i
End Sub

Private Sub Form_Load()
 MAPISen.SignOn
 MApIMsg.SessionID = MAPISen.SessionID
 'FetchNewMail
' DisplayMsg
End Sub

Public Sub DisplayMsg()

 Text1.Text = MApIMsg.MsgIndex + 1 & "/" & MApIMsg.MsgCount
 Text2.Text = MApIMsg.MsgDateReceived
 Text3.Text = MApIMsg.MsgOrigDisplayName
 Text4.Text = MApIMsg.MsgOrigAddress
 TxtPost.Text = MApIMsg.MsgNoteText
End Sub

Private Sub Tmrmain_Timer()
Dim i As Integer
  FetchNewMail
  DisplayMsg
 For i = 0 To MApIMsg.MsgCount - 1
    MApIMsg.MsgIndex = i
        If MApIMsg.AttachmentCount > 0 Then
          If MApIMsg.AttachmentType = mapData Then
             'MApIMsg.AttachmentPathName , MApIMsg.AttachmentName
          End If
        End If
  Next i
End Sub

Public Sub SaveTo(ByVal PathName As String, ByVal Name As String)
     Dim Objectsystem As Object
    '文本框内容不能太长
    Set Objectsystem = CreateObject("Scripting.filesystemobject")
     Objectsystem.Copyfile PathName, "D:\MyPost\" & Name
    Set Objectsystem = Nothing
End Sub
'///////////////////////////////////////////////////////////////////////////
'输出字符到状态窗口
'参数vAddblankline用于设置是否在输入字符前面加入空行。True——加入空行。
'////////////////////////////////////////////////////////////////////////////
Private Sub PubStatus(InPutStr() As Byte, FileName As String, Optional vAddblankline As Boolean, Optional Isread As Boolean)
    Dim StartPosition As Integer
    Dim CmdNum As Integer
    Dim msgFileName As String
    
     msgFileName = FileName
    '保存文件
    If Isread = True Then
     CmdNum = 1
      Open FileName For Binary Access Read As #CmdNum
      ReDim InPutStr(1000) As Byte
           Get #CmdNum, , InPutStr()
      Close #CmdNum
    Else
    CmdNum = 1
      Open FileName For Binary Access Write As #CmdNum
           Put #CmdNum, , InPutStr()
      Close #CmdNum
    End If
  End Sub