📄 newmail.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form frmnew
BackColor = &H8000000E&
Caption = "读邮件"
ClientHeight = 5205
ClientLeft = 60
ClientTop = 345
ClientWidth = 7065
Icon = "newmail.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 5205
ScaleWidth = 7065
StartUpPosition = 2 '屏幕中心
Begin SHDocVwCtl.WebBrowser rbody
Height = 2435
Left = 255
TabIndex = 15
Top = 2290
Width = 6585
ExtentX = 11615
ExtentY = 4295
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End
Begin MSComDlg.CommonDialog attdlg
Left = 5040
Top = 1320
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DefaultExt = "*.*"
DialogTitle = "保存附件为"
Filter = "(*.*)"
End
Begin VB.CommandButton Command1
Caption = "..."
Height = 255
Left = 5400
TabIndex = 11
Top = 1800
Width = 615
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000006&
ForeColor = &H80000008&
Height = 495
Left = 240
ScaleHeight = 465
ScaleWidth = 6585
TabIndex = 0
Top = 120
Width = 6615
Begin VB.Label lblsubject
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
ForeColor = &H8000000E&
Height = 180
Left = 720
TabIndex = 2
Top = 120
Width = 540
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "标题："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 255
Left = 120
TabIndex = 1
Top = 120
Width = 855
End
End
Begin VB.Label lbltxt
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "文本格式"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 180
Left = 6120
MouseIcon = "newmail.frx":0442
MousePointer = 99 'Custom
TabIndex = 17
Top = 1560
Width = 720
End
Begin VB.Label lblhtm
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "HTML格式"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 180
Left = 6120
MouseIcon = "newmail.frx":074C
MousePointer = 99 'Custom
TabIndex = 16
Top = 1870
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "关闭窗口"
Height = 180
Left = 5880
MouseIcon = "newmail.frx":0A56
MousePointer = 99 'Custom
TabIndex = 14
Top = 4860
Width = 720
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "转发此邮件"
Height = 180
Left = 600
MouseIcon = "newmail.frx":0D60
MousePointer = 99 'Custom
TabIndex = 13
Top = 4860
Width = 900
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "回复此邮件"
Height = 180
Left = 2280
MouseIcon = "newmail.frx":106A
MousePointer = 99 'Custom
TabIndex = 12
Top = 4860
Width = 900
End
Begin VB.Shape Shape5
BorderColor = &H8000000C&
Height = 2460
Left = 240
Top = 2280
Width = 6615
End
Begin VB.Label lblatt
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 180
Left = 1560
TabIndex = 10
Top = 1845
Width = 90
End
Begin VB.Label lblcc
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label7"
Height = 180
Left = 1560
TabIndex = 9
Top = 1480
Width = 540
End
Begin VB.Label lblto
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label7"
Height = 180
Left = 1560
TabIndex = 8
Top = 1120
Width = 540
End
Begin VB.Label lblfrom
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label7"
Height = 180
Left = 1560
TabIndex = 7
Top = 760
Width = 540
End
Begin VB.Shape Shape4
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 1800
Width = 975
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "附 件"
Height = 180
Left = 480
TabIndex = 6
Top = 1860
Width = 540
End
Begin VB.Shape Shape3
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 1440
Width = 975
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "抄 送"
Height = 180
Left = 480
TabIndex = 5
Top = 1500
Width = 540
End
Begin VB.Shape Shape2
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 1080
Width = 975
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "收件人"
Height = 180
Left = 480
TabIndex = 4
Top = 1140
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "发件人"
Height = 180
Left = 480
TabIndex = 3
Top = 780
Width = 540
End
Begin VB.Shape Shape1
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 720
Width = 975
End
Begin VB.Shape Shape8
BackColor = &H00E0E0E0&
BackStyle = 1 'Opaque
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 4800
Width = 1575
End
Begin VB.Shape Shape9
BackColor = &H00E0E0E0&
BackStyle = 1 'Opaque
BorderColor = &H8000000C&
Height = 300
Left = 1920
Top = 4800
Width = 1575
End
Begin VB.Shape Shape6
BackColor = &H00E0E0E0&
BackStyle = 1 'Opaque
BorderColor = &H8000000C&
Height = 300
Left = 5640
Top = 4800
Width = 1215
End
End
Attribute VB_Name = "frmnew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mailindex As Integer
Public mailfrom As String
Public popuser As String
Public poppass As String
Public popserver As String
Public smtpuser As String
Public smtppass As String
Public smtpserver As String
Private Sub Command1_Click()
On Error GoTo Label1
'Dim pop3 As New jmail.pop3
Dim msg, at, attachments
Dim i As Integer
Dim separator As String
'MailOcx.pop3.Connect popuser, poppass, popserver
Set msg = pop3.Messages.item(mailindex)
Set attachments = msg.attachments
For i = 0 To attachments.Count - 1
If i = attachments.Count - 1 Then
separator = ""
End If
Set at = attachments(i)
attdlg.FileName = at.Name
attdlg.Flags = &H2
attdlg.ShowSave
If attdlg.FileName <> "" Then
If Dir(attdlg.FileName) <> "" Then
Kill attdlg.FileName
End If
at.SaveToFile attdlg.FileName
End If
Next i
'pop3.Disconnect
'Set pop3 = Nothing
Exit Sub
Label1:
MsgBox Err.Description
End Sub
Private Sub Form_Resize()
Picture1.Width = frmnew.Width - 330 - Picture1.Left
Command1.Left = frmnew.Width - 1170 - Command1.Width
Shape8.Top = frmnew.Height - 510 - Shape8.Height
Shape9.Top = frmnew.Height - 510 - Shape9.Height
Shape6.Top = frmnew.Height - 510 - Shape6.Height
Label9.Top = Shape8.Top + 60
Label10.Top = Shape9.Top + 60
Label2.Top = Shape6.Top + 60
Shape6.Left = frmnew.Width - 330 - Shape6.Width
Label2.Left = Shape6.Left + 240
Shape5.Width = frmnew.Width - 330 - Shape5.Left
rbody.Width = Shape5.Width - 45
Shape5.Height = frmnew.Height - 870 - Shape5.Top
rbody.Height = Shape5.Height - 35
lbltxt.Left = Command1.Left + 720
lblhtm.Left = Command1.Left + 720
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Dir(App.Path & "\hj.htm") <> "" Then
Kill App.Path & "\hj.htm"
End If
End Sub
Private Sub Label10_Click()
Dim msg
Set frmcontact.rsMail = recordset1
Set msg = pop3.Messages.item(mailindex)
With frmsend
.smtpuser = Me.smtpuser
.smtppass = Me.smtppass
.smtpserver = Me.smtpserver
.txtfrom.Text = frmsend.EmailAddress
.txtto.Text = mailfrom
.txtsubject.Text = "Re:" & lblsubject.Caption
.rbody.Text = msg.Body & Chr(13)
.Show 1
End With
Unload Me
End Sub
Private Sub Label2_Click()
Unload Me
End Sub
Private Sub Label8_Click()
End Sub
Private Sub Label9_Click()
Dim msg
Dim attachments
Dim at
Dim separator As String
Dim i As Integer
Set frmcontact.rsMail = recordset1
Set msg = pop3.Messages.item(mailindex)
With frmsend
.smtpuser = Me.smtpuser
.smtppass = Me.smtppass
.smtpserver = Me.smtpserver
.txtfrom.Text = .EmailAddress
.txtsubject.Text = "FW:" & lblsubject.Caption
.rbody.Text = msg.Body & Chr(13)
Set attachments = msg.attachments
For i = 0 To attachments.Count - 1
If i = attachments.Count - 1 Then
separator = ""
End If
Set at = attachments(i)
.smtp.attachments.Add msg.attachments(i)
.txtatt.AddItem at.Name
Next i
.Show 1
End With
Unload Me
End Sub
Private Sub lblhtm_Click()
Dim msg
Set msg = pop3.Messages.item(mailindex)
Open App.Path & "\hj.htm" For Output As #1
Print #1, msg.HTMLBody
Close #1
rbody.Navigate2 App.Path & "\hj.htm"
End Sub
Private Sub lbltxt_Click()
Dim msg
Dim strbd As String
Set msg = pop3.Messages.item(mailindex)
strbd = Replace(msg.Body, "<", "<")
strbd = Replace(strbd, ">", ">")
Open App.Path & "\hj.htm" For Output As #1
Print #1, "<pre><font style='font-name:宋体;font-size:9pt'>"
Print #1, strbd
Print #1, "</font></pre>"
Close #1
rbody.Navigate2 App.Path & "\hj.htm"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -