30.htm

vb功能实例介绍。详细、很好的实例说明。

<p>发送电子邮件附件</p>
<p></p>
<p></p>
<p></p>
<p>只有在用户选择保存附件的情况下，才需要进行解码工作。此时用户需要先选定要保存的文件，然后按Save As按钮。代码如下：</p>
<p></p>
<p>Private Sub cmdSave_Click()</p>
<p></p>
<p>Dim strFileName As String</p>
<p>Dim strMessage As String</p>
<p>Dim strAttachment As String</p>
<p>Dim lngPosA As Long</p>
<p>Dim lngPosB As Long</p>
<p></p>
<p>'Extract full text of the message</p>
<p>strMessage = m_colMessages(lvMessages.SelectedItem.Key).MessageText</p>
<p>'Extract name of the file</p>
<p>strFileName = lvAttachments.SelectedItem.Key</p>
<p>'</p>
<p>Do Until lngPosA = 0</p>
<p>   'Looking for the file's name in the message's text</p>
<p>   lngPosA = InStr(lngPosA + 1, strMessage, " " & strFileName)</p>
<p>   If lngPosA > 0 Then</p>
<p>      'End of string with the file's name</p>
<p>      lngPosB = InStrRev(strMessage, vbCrLf, lngPosA) + 2</p>
<p>      If lngPosB > 2 Then</p>
<p>         'Check whether the string with the file's name </p>
<p>         'is the part of the "begin" marker</p>
<p>         If (Mid$(strMessage, lngPosB, lngPosA - lngPosB _</p>
<p>            + Len(strFileName) + 1)) Like _</p>
<p>            ("begin ### " & strFileName) Then</p>
<p>            'Position of the end marker</p>
<p>            lngPosA = InStr(lngPosA, strMessage, "'" & _</p>
<p>                      vbCrLf & "end" & vbCrLf)</p>
<p>            If lngPosA > 0 Then</p>
<p>               With ComDialog</p>
<p>                  'Bring up the file selection dialog</p>
<p>                  .FileName = strFileName</p>
<p>                  .ShowSave</p>
<p>                  If Err = 0 Then</p>
<p>                     'Encoding data save to the strAttachment</p>
<p>                     'variable</p>
<p>                     strAttachment = Mid$(strMessage, lngPosB, _</p>
<p>                                     lngPosA + 8 - lngPosB)</p>
<p>                     'Pass it to the UUDecodeToFile routine</p>
<p>                     'in order to decode and save as file</p>
<p>                     UUDecodeToFile strAttachment, .FileName</p>
<p>                  End If</p>
<p>               End With</p>
<p>            End If</p>
<p>         End If</p>
<p>      End If</p>
<p>   End If</p>
<p>Loop</p>
<p>End Sub</p>
<p></p>
<p>最后是UUDecodeToFile函数的代码： </p>
<p></p>
<p>Public Function UUDecodeToFile(strUUCodeData As String,  strFilePath As String)</p>
<p></p>
<p>Dim vDataLine   As Variant</p>
<p>Dim vDataLines  As Variant</p>
<p>Dim strDataLine As String</p>
<p>Dim intSymbols  As Integer</p>
<p>Dim intFile     As Integer</p>
<p>Dim strTemp     As String</p>
<p>'</p>
<p>'Remove first marker</p>
<p>If Left$(strUUCodeData, 6) = "begin " Then</p>
<p>   strUUCodeData = Mid$(strUUCodeData,  InStr(1, strUUCodeData, vbLf) + 1)</p>
<p>End If</p>
<p>'</p>
<p>'Remove marker of the attachment's end</p>
<p>If Right$(strUUCodeData, 5) = "end" + vbCrLf Then</p>
<p>   strUUCodeData = Left$(strUUCodeData, Len(strUUCodeData) - 10)</p>
<p>End If</p>
<p>intFile = FreeFile</p>
<p>Open strFilePath For Binary As intFile</p>
<p>'Break decoded data to the strings</p>
<p>'From now each member of the array vDataLines contains</p>
<p>'one line of the encoded data</p>
<p>vDataLines = Split(strUUCodeData, vbCrLf)</p>
<p>For Each vDataLine In vDataLines</p>
<p>   'Decode data line by line</p>
<p>   '</p>
<p>strDataLine = CStr(vDataLine)</p>
<p>   'Extract the number of characters in the string</p>
<p>   'We can figure it out by means of the first string character</p>
<p>intSymbols = Asc(Left$(strDataLine, 1))</p>
<p>   'which we delete because of its uselessness</p>
<p>strDataLine = Mid$(strDataLine, 2, intSymbols)</p>
<p>   'Decode the string by 4 bytes portion. </p>
<p>   'From each byte remove two oldest bits.</p>
<p>   'From remain 24 bits make 3 bytes</p>
<p>For i = 1 To Len(strDataLine) Step 4</p>
<p>      '1 byte</p>
<p>      strTemp = strTemp + Chr((Asc(Mid(strDataLine, i, 1)) _</p>
<p>                - 32) * 4 + (Asc(Mid(strDataLine, i + 1, 1)) _</p>
<p>                - 32) \ 16)</p>
<p>      '2 byte</p>
<p>      strTemp = strTemp + Chr((Asc(Mid(strDataLine, i + 1, 1))_</p>
<p>                Mod 16) * 16 + (Asc(Mid(strDataLine, i + 2, 1))_</p>
<p>                - 32) \ 4)</p>
<p>      '3 byte</p>
<p>      strTemp = strTemp + Chr((Asc(Mid(strDataLine, i + 2, 1)) _</p>
<p>                Mod 4) * 64 + Asc(Mid(strDataLine, i + 3, 1)) - 32)</p>
<p>   Next i</p>
<p>   'Write decoded string to the file</p>
<p>   Put intFile, , strTemp</p>
<p>   'Clear the buffer in order to receive the next _</p>
<p>   'line of the encoded data</p>
<p>   strTemp = ""</p>
<p>Next</p>
<p>Close intFile</p>
<p>End Function </p>
<p>看上去似乎就这么多了。其实不然。要想编写出现代电子邮件程序，你必须了解Base 64和MIME用的Quoted-Printalbe算法。不过你放心，本站介绍的算法大多数的邮件程序还是能识别的。只不过它的年纪比较老，现在的电子邮件程序往往是最后才用这种算法。 </p>
<p></p>