那位高手帮我看看下面代码
这是vb做的一个简单邮件收发系统，界面如图：http://hi.csdn.net/space-2969731-do-album-picid-702235.html
代码如下，有兴趣的高手给小弟指点一下，最好详细的说一下重要一点的代码，谢了。
界面代码
Option Explicit
Private Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Const RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceName = 128
Const RAS_MaxDeviceType = 16
Private Type RASCONN95
'set dwsize to 412
dwSize As Long
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Dim nodX As Node
Dim iIndex, i, j, LineCount, nodi, m As Integer
Dim moDragNode As Object
Dim finame, linetex, S As String
Dim Get_File As String
Dim oldname(1 To 100) As String
Dim Response As Integer
Dim lngRetCode As Long
Dim lpcb As Long
Dim lpcConnections As Long
Dim intArraySize As Integer
Dim intLooper As Integer
Dim ti
Private Sub addtools_Click()
nodi = nodi + 1
add_tools
End Sub
Private Sub deltools_Click()
nodi = nodi - 1
TreeView1.Nodes.Remove iIndex
End Sub
Private Sub exit_Click()
Unload Form1
End Sub
Private Sub faso_Click()
EmailTo
End Sub
Private Sub Form_Load()
For i = 0 To 3
Text1(i).Visible = False
Next
Set nodX = TreeView1.Nodes.Add(, , , "基本设置 ", 1)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "发信内容 ", 2)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "收信人地址", 3)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "附件", 4)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "信息提示 ", 5)
Text1(1).Text = "请在这里输入信件的内容" + vbCrLf + vbCrLf + "您好！"
Text1(2).Text = "请在这里输入你要发送的Email的地址"
Text1(0).Text = "记录时间：" + Str(Time) + vbCrLf
End Sub
Private Sub new_Click()
newfile
End Sub
Private Sub open_Click()
openfile
End Sub
Private Sub save_Click()
savefile
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyA And Shift = vbCtrlMask Then
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index).Text)
End If
End Sub
Private Sub TreeView1_Click()
On Error Resume Next
iIndex = TreeView1.SelectedItem.Index
Select Case iIndex
Case 1
For i = 0 To 3
Text1(i).Visible = False
Next
Case 2
For i = 0 To 3
Text1(i).Visible = False
Next
Text1(1).Visible = True
Text1(3).Visible = True
Case 3
For i = 0 To 3
Text1(i).Visible = False
Next
Text1(2).Visible = True
Case 5
For i = 0 To 3
Text1(i).Visible = False
Next
Text1(0).Visible = True
End Select
End Sub
Sub add_tools()
Dim i, j As Integer
i = 1
j = 1
On Error GoTo err
CommonDialog1.ShowOpen
finame = CommonDialog1.FileName
oldname(nodi) = finame
If finame <> "" Then
While i <> 0
i = InStr(i + 1, finame, "")
If i <> 0 Then
j = i
End If
Wend
finame = Right(finame, Len(finame) - j)
Set nodX = TreeView1.Nodes.Add(4, tvwChild, , finame, 11)
finame = ""
End If
Exit Sub
err:
finame = ""
End Sub
Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nod As Node
If Button = vbRightButton Then '检测鼠标的点击
Set nod = TreeView1.HitTest(x, y) '返回你所点击的Node对象的坐标
On Error GoTo EmptyNode
nod.Selected = True ' 设置你所点击的Node对象被选中
On Error GoTo 0
'<<下面是你的自定义菜单>>
'If iIndex > 5 Then deltools.Visible = True
'Me.PopupMenu mymenu
'deltools.Visible = False
EmptyNode:
On Error GoTo 0
End If
End Sub
Sub EmailTo()
Text1(0).Text = Text1(0).Text + "邮件发送时间：" + Str(Time) + vbCrLf
MAPISession1.LogonUI = True
MAPISession1.DownLoadMail = False
'test
'If lpcConnections <> 0 Then
On Error GoTo error1
On Error GoTo error1
MAPISession1.SignOn
GetText
For i = 0 To LineCount
Call GetLine(Text1(2).hWnd, i, S)
j = InStr(1, S, "@")
If j = 0 Then S = ""
If S <> "" Then
Debug.Print S
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Compose
MAPIMessages1.RecipAddress = S '收信人地址
MAPIMessages1.ResolveName
MAPIMessages1.MsgSubject = Text1(3).Text
MAPIMessages1.MsgNoteText = Text1(1).Text
For m = 1 To nodi
MAPIMessages1.AttachmentIndex = m - 1
MAPIMessages1.AttachmentPathName = oldname(m)
Next
MAPIMessages1.Send
End If
Next
Text1(0).Text = Text1(0).Text + "邮件信息：发信人名称 " + MAPIMessages1.MsgOrigDisplayName + vbCrLf
Text1(0).Text = Text1(0).Text + "邮件信息：发信人地址 " + MAPIMessages1.MsgOrigAddress + vbCrLf
Text1(0).Text = Text1(0).Text + "邮件信息：发送对象共有" + Str(LineCount) + "人" + vbCrLf
'End If
ti = Timer
Me.Enabled = False
MsgBox "邮件准备发送,请等待12秒"
Do While Timer < ti + 12 '这个语句的意义在于，让MAPI控件有足够处理信息的时间
DoEvents ' 将控制让给其他程序。
Loop
Me.Enabled = True
MsgBox "邮件开始发送"
Me.Caption = "邮件"
MAPISession1.SignOff
'End If
Exit Sub
error1:
If err = 48389 Then
MsgBox "MAPI错误，请不要把FoxMail设为IE的默认邮件发送程序", 48
Text1(0).Text = Text1(0) + "发送错误：把FoxMail设置为IE的默认邮件程序" + vbCrLf
Else
MsgBox err & Error(err)
Text1(0).Text = Text1(0) + "发送错误：" + Error(err) + vbCrLf
End If
End Sub
Sub GetText()
LineCount = SendMessageLong(Text1(2).hWnd, EM_GETLINECOUNT, 0&, 0&)
End Sub
Sub newfile()
'ynsave
'If Response = 6 Then
'savefile
'Else
TreeView1.Nodes.Remove 1
For i = 1 To 3
Text1(i).Visible = False
Next
Set nodX = TreeView1.Nodes.Add(, , , "基本设置 ", 1)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "信件内容 ", 2)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "收信人地址", 3)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "附件", 4)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "错误提示 ", 5)
Text1(1).Text = "请在这里输入信件的内容" + vbCrLf + vbCrLf + "您好！"
Text1(2).Text = " 请在这里输入你要发送的Email的地址"
Text1(3).Text = "请在这里输入信件的主题"
'End If
End Sub
Sub savefile()
On Error GoTo err
CommonDialog1.Flags = &H2
CommonDialog1.Filter = "Text(*.txt)|*.txt"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
Dim savefile(1 To 4) As String
For i = 1 To nodi
savefile(1) = savefile(1) + "◎◎" + oldname(i) + "◎◎" + vbCrLf
Next
savefile(2) = "○○" + Text1(3).Text + "○○"
savefile(3) = "●●" + Text1(1).Text + "●●"
savefile(4) = "◇◇" + Text1(2).Text + "◇◇"
Open CommonDialog1.FileName For Output As #1
Print #1, "□□□□□" + vbCrLf + savefile(1) + vbCrLf + savefile(2) + vbCrLf + savefile(3) + vbCrLf + savefile(4)
Close #1
End If
Exit Sub
err:
CommonDialog1.FileName = ""
End Sub
Sub openfile()
ynsave
If Response = 6 Then
savefile
End If
Dim StrName, StrTe, LenStrTe As String
On Error GoTo err
CommonDialog1.Filter = "Text(*.txt)|*.txt"
CommonDialog1.ShowOpen
StrName = CommonDialog1.FileName
Open StrName For Input As #1
On Error GoTo errfi
Line Input #1, StrTe
Close #1
If StrTe <> "□□□□□" Then
MsgBox "文件格式错误"
Exit Sub
Else
StrTe = ""
Open StrName For Input As #1
StrTe = Input(LOF(1), #1)
Close #1
End If
Exit Sub
err:
StrName = ""
Exit Sub
errfi:
Close #1
Open StrName For Input As #1
Do While Not EOF(1)
Line Input #1, StrTe
LenStrTe = LenStrTe + StrTe + vbCrLf
Loop
Close #1
Call GetFile("○○", LenStrTe, Get_File)
Text1(3).Text = Get_File
Call GetFile("●●", LenStrTe, Get_File)
Text1(1).Text = Get_File
Call GetFile("◇◇", LenStrTe, Get_File)
Text1(2).Text = Get_File
End Sub
Sub GetFile(GetStr As String, FullStr As String, GetStrAl As String)
Dim Inte, InTem(1 To 2) As Integer
'Dim GetStrAl As String
Inte = InStr(Inte + 1, FullStr, GetStr)
InTem(1) = Inte
Inte = InStr(Inte + 1, FullStr, GetStr)
InTem(2) = Inte
GetStrAl = Mid(FullStr, InTem(1) + Len(GetStr), InTem(2) - InTem(1) - Len(GetStr))
End Sub
Sub ynsave()
Response = MsgBox("是否保存当前文件?", 5 + 43)
End Sub
Sub test()
ReDim lprasconn95(intArraySize) As RASCONN95
lprasconn95(0).dwSize = 412
lpcb = 256 * lprasconn95(0).dwSize
lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
If lpcConnections = 0 Then
MsgBox "没有拨号网络连接！", vbInformation
Text1(0).Text = Text1(0).Text + "发送错误：没有拨号网络连接" + vbCrLf
End If
End Sub
模块代码：
Public Declare Function SendMessageLong Lib _
"user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const EM_GETLINECOUNT = "&HBA"
Public Const EM_GETLINE = &HC4
Public Const EM_LINELENGTH = &HC1
Public Const EM_LINEINDEX = &HBB
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal _
cbCopy As Long)
Sub GetLine(ByVal hWnd As Long, ByVal whichLine As Long, Line As String)
Dim length As Long, bArr() As Byte, bArr2() As Byte, lc As Long
lc = SendMessage(hWnd, EM_LINEINDEX, whichLine, ByVal 0&)
length = SendMessage(hWnd, EM_LINELENGTH, lc, ByVal 0&)
If length > 0 Then
ReDim bArr(length + 1) As Byte, bArr2(length - 1) As Byte
Call RtlMoveMemory(bArr(0), length, 2)
Call SendMessage(hWnd, EM_GETLINE, whichLine, bArr(0))
Call RtlMoveMemory(bArr2(0), bArr(0), length)
Line = StrConv(bArr2, vbUnicode)
Else
Line = ""
End If
End Sub
