VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 10841|回复: 6

[转帖] SSLSocket类

[复制链接]
 楼主| 发表于 2011-4-28 23:15:55 | 显示全部楼层 |阅读模式
  1. Option Explicit
  2. '********************************************
  3. '*          SSL code by GioRock 2009        *
  4. '********************************************
  5. '*         Assembled by GioRock 2009        *
  6. '*              giorock@libero.it           *
  7. '********************************************
  8. '*  Thanks to two Authors having published  *
  9. '*    SSL https HTML connections VB code    *
  10. '*              Jason K. Resch              *
  11. '*                 Anonimous                *
  12. '********************************************

  13. 'ReadMe:
  14. '       This program is created and tested on HOTMAIL server where configuration
  15. '       is about so:
  16. '       SMTP: smtp.live.com
  17. '       PORT: 587
  18. '       ACCESS: USERNAME + PASSWORD
  19. '       AUTHENTICATE: Need authentication of Server
  20. '       SSL: Need a protected connection
  21. '       For other Server I'don't know but HOTMAIL working fine and faster.
  22. '-----------------------------------------------------------------------------
  23. '       Do not use this program to SPAM messages or other abuse sending eMail
  24. '-----------------------------------------------------------------------------

  25. 'PS: Not a Visual Basic example on the World I have found
  26. '    about SSL Mailer, so after 3 days of full immersion work
  27. '    this is a functional program.
  28. '    Only 2 sample with SSL https HTML connections (out of date) and
  29. '    not fully explained and good working.
  30. '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  31. '    --This is my first time writing a program to send eMail--    ^
  32. '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

  33. 'SSL is based on public key cryptography, it works in the following manner:
  34. '
  35. 'client-hello         C -> S: challenge, cipher_specs
  36. 'server-hello         S -> C: connection-id,server_certificate,cipher_specs
  37. 'client-master-key    C -> S: {master_key}server_public_key
  38. 'client-finish        C -> S: {connection-id}client_write_key
  39. 'server-verify        S -> C: {challenge}server_write_key
  40. 'server-finish        S -> C: {new_session_id}server_write_key
  41. '
  42. 'First the Client sends some random data known as the CHALLENGE, along with a list of ciphers it can use, for simplicity we will only use 128-bit RC4 with MD5
  43. 'The Server responds with a random data, known as the CONNECTION-ID, and the Server's Certificate and list of cipher specs
  44. 'The Client extracts the Public Key from the Server's Certificate then uses it to Encrypt a randomly generated Master Key, this Key then sent to the Server
  45. 'The Client and Server both generate 2 keys each by hashing the Master Key with other values, and the client sends a finish message, encrypted with the client write key
  46. 'The Server Responds by returning the CHALLENGE encrypted using the Client Read Key, this proves to the Clinet that the Server is who it says its is
  47. 'The Server sends its finish message, which consists of a randomly generated value, this value can be used to re-create the session in a new connection, but that is not supported in this example

  48. 'You can take a look on Wikipedia for an exaustive explanation about SSL connections

  49. 'TODO:
  50. 're-create the session in a new connection
  51. 'trap all error
  52. 'add POP3 connection to receive messages
  53. 'simplify and ameliorate all code and routines
  54. 'and much more....

  55. 'YOU CAN SEND ME SUGGESTIONS AND CRITICS TO: giorock@libero.it
  56. 'OR DIRECTLY ON PSC PAGE

  57. 'CryptoAPI Functions
  58. Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
  59. Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
  60. Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hSessionKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
  61. Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
  62. Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
  63. Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
  64. Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, ByRef hSessionKey As Long) As Long
  65. Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
  66. Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
  67. Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hSessionKey As Long) As Long
  68. Private Declare Function CryptImportKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal hPubKey As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
  69. Private Declare Function CryptExportKey Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hExpKey As Long, ByVal dwBlobType As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
  70. Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwLen As Long, ByVal pbBuffer As String) As Long

  71. 'CryptoAPI Constants
  72. Private Const SERVICE_PROVIDER As String = "Microsoft Enhanced Cryptographic Provider v1.0" & vbNullChar
  73. Private Const KEY_CONTAINER As String = "GCN SSL Container" & vbNullChar
  74. Private Const PROV_RSA_FULL As Long = 1
  75. Private Const CRYPT_NEWKEYSET As Long = 8
  76. Private Const CRYPT_EXPORTABLE As Long = 1
  77. Private Const ALG_CLASS_HASH = (4 * 2 ^ 13)
  78. Private Const ALG_SID_MD5 = 3
  79. Private Const ALG_TYPE_ANY = 0
  80. Private Const CALG_MD5 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
  81. Private Const ALG_CLASS_DATA_ENCRYPT = (3 * 2 ^ 13)
  82. Private Const ALG_SID_RC4 = 1
  83. Private Const ALG_TYPE_STREAM = (4 * 2 ^ 9)
  84. Private Const CALG_RC4 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4)
  85. Private Const HP_HASHVAL As Long = 2
  86. Private Const SIMPLEBLOB As Long = 1
  87. Private Const GEN_KEY_BITS As Long = &H800000

  88. 'Class Variables
  89. Private hCryptProv As Long
  90. Private hClientWriteKey As Long
  91. Private hClientReadKey As Long
  92. Private hMasterKey As Long
  93. Private lngType As Long

  94. 'Variables for Parsing
  95. Private Layer As Integer
  96. Private InBuffer As String
  97. Private Processing As Boolean
  98. Private SeekLen As Integer

  99. 'Encryption Keys
  100. Private MASTER_KEY As String
  101. Private CLIENT_READ_KEY As String
  102. Private CLIENT_WRITE_KEY As String

  103. 'Server Attributes
  104. Private Private_KEY As String
  105. Private ENCODED_CERT As String
  106. Private CONNECTION_ID As String

  107. 'Counters
  108. Private SEND_SEQUENCE_NUMBER As Double
  109. Private RECV_SEQUENCE_NUMBER As Double

  110. 'Hand Shake Variables
  111. Private CLIENT_HELLO As String
  112. Private CHALLENGE_DATA As String
  113. Private PUBLIC_KEY As String

  114. Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  115. Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long


  116. ''SENDING VARIABLES
  117. Private gstrServerName As String
  118. Private glngPort As Long
  119. Private gblnSSL As Boolean
  120. Private gstrFromAddress As String
  121. Private gstrDomainName As String
  122. Private gstrUserID As String
  123. Private gstrUserPass As String
  124. Private gintSent As Integer

  125. ''MESSAGE VARIABLES
  126. Private gstrSubject As String
  127. Private gstrFromName As String
  128. Private gstrMessage As String
  129. Private gstrToAddress() As String
  130. Private gblnDone As Boolean
  131. Private gblnBCCMode As Boolean
  132. Private gstrBCC() As String
  133. Private gstrCC() As String
  134. Private gblnBCC As Boolean
  135. Private gstrFileNames() As String
  136. Private gblnAttachments As Boolean
  137. Private gstrData() As String
  138. Private gstrMessageFileName As String
  139. Private gstrAllAddresses() As String
  140. ''OTHER VARIABLES
  141. Private gblnConnected As Boolean
  142. Private ProgBar As ProgressBar
  143. Private gintTransfer As Integer
  144. Private Enum EState
  145.     Connect
  146.     helo
  147.     MailFrom
  148.     SendTo
  149.     Data
  150.     MessageData
  151.     EndMessage
  152. End Enum

  153. Private Type FileInfo
  154.     Filename As String
  155.     Code As String
  156.     Send As Boolean
  157. End Type
  158. Private State As EState

  159. Private gintsentTo As Integer
  160. Private gintsentCC As Integer
  161. Private pintSend As Integer
  162. Private pintSent As Integer

  163. Private Const MAX_LINELENGTH As Long = 76 ' Must be a multiple of 4
  164. Private Const CHAR_EQUAL As Byte = 61
  165. Private Const CHAR_CR As Byte = 13
  166. Private Const CHAR_LF As Byte = 10


  167. Private m_Index1(0 To 255) As Byte
  168. Private m_Index2(0 To 255) As Byte
  169. Private m_Index3(0 To 255) As Byte
  170. Private m_Index4(0 To 63) As Byte
  171. Private m_ReverseIndex1(0 To 255) As Byte
  172. Private m_ReverseIndex2(0 To 255, 0 To 1) As Byte
  173. Private m_ReverseIndex3(0 To 255, 0 To 1) As Byte
  174. Private m_ReverseIndex4(0 To 255) As Byte

  175. Private FileCode() As FileInfo
  176. Private Const conBoundary = "SendNextMIME_121_32"

  177. Private Enum DecodeType
  178.     base64
  179.     uu
  180. End Enum

  181. Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (dst As Any, src As Any, ByVal cb As Long)

  182. Public Event DecodeProgress(ByVal Percent As Single, ByVal Total As Long)
  183. Public Event EncodeProgress(ByVal Percent As Single, ByVal Total As Long)

  184. Private Const PortionSize As Integer = 45
  185. Private Const BufLen As Integer = 1024

  186. Private DestFileName As String
  187. Private mstrOutFile

  188. Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
  189.     (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, _
  190.     ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
  191.      
  192. Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
  193.     (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, _
  194.     ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

  195. Private Declare Function InternetCloseHandle Lib "wininet.dll" _
  196.     (ByVal hInet As Long) As Long

  197. Private Declare Function InternetDial Lib "wininet.dll" Alias "InternetOpenUrlA" _
  198.     (ByVal hwndParent As Long, ByVal strConnection As String, ByVal dwFlags As Long, _
  199.     ByRef dwConnection As Long, ByVal dwReserved As Long) As Long

  200. Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
  201. Private Const INTERNET_FLAG_RELOAD = &H80000000
  202. Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
  203. Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
  204. Private Const INTERNET_DIAL_FORCE_PROMPT = &H2000
  205. Private Const INTERNET_DIAL_SHOW_OFFLINE = &H4000
  206. Private Const INTERNET_DIAL_UNATTENDED = &H8000

  207. Private WithEvents SocketSSL As Winsock
  208. Private RTBX As RichTextBox

  209. Private Function GetDomainName(ByVal pstrFromAddress As String) As String
  210.     Dim pintInstr As Integer
  211.      
  212.     pintInstr = InStr(pstrFromAddress, "@")
  213.     GetDomainName = Mid(pstrFromAddress, pintInstr + 1)
  214. End Function

  215. Private Function CheckAddressFrom(pstrAddy) As String
  216.     Dim pintC As Integer
  217.      
  218.     If Left(pstrAddy, 1) <> "<" Then
  219.         pstrAddy = "<" & pstrAddy
  220.     End If
  221.      
  222.     If Right(pstrAddy, 1) <> ">" Then
  223.         pstrAddy = pstrAddy & ">"
  224.     End If

  225.     CheckAddressFrom = pstrAddy
  226. End Function

  227. Private Function GetMIME(MIMEBoundary As String) As String
  228.     Dim strMIMEMessageContent As String
  229.     Dim strMIMEVersion As String
  230.     Dim strMIMEContent As String
  231.      
  232.      
  233.      
  234.     strMIMEContent = "Content-Type: multipart/mixed; " _
  235.                      & "boundary=" & """" & MIMEBoundary & """"
  236.      
  237.     strMIMEMessageContent = "--" & MIMEBoundary & vbCrLf & _
  238.                             "Content-Type: text/plain; " & "charset=" & """" & "iso-8859-1" & """" & vbCrLf & _
  239.                             "Content-Transfer-Encoding: 8bit"
  240.     GetMIME = strMIMEContent & vbCrLf & vbCrLf & vbCrLf & strMIMEMessageContent

  241. End Function


  242. Private Function ProcessHeader(sTo As String, sFrom As String, sCC As String, sSubject As String) As String

  243.     Dim strMIMEMessage          As String
  244.     Dim strMIMEContent          As String
  245.     Dim strMIMEMessageContent   As String
  246.     Dim strMIMEClient           As String
  247.     Dim strMIMEMailInfo         As String
  248.     Dim strMIMEVersion          As String
  249.      
  250.     strMIMEMailInfo = "DATE: " & Format(Now, "dd mmm yy ttttt") & vbCrLf & _
  251.                       "FROM: " & Trim$(sFrom) & vbCrLf & _
  252.                       "TO: " & Trim$(sTo) & vbCrLf & _
  253.                       "CC: " & Trim$(sCC) & vbCrLf & _
  254.                       "SUBJECT: " & sSubject
  255.                  
  256.     strMIMEClient = "X-Mailer: " & App.ProductName & vbCrLf & _
  257.                     "X-Version: " & App.Major & "." & App.Minor & vbCrLf & _
  258.                     "X-CompanyName: " & App.CompanyName
  259.                      
  260.     strMIMEVersion = "MIME-Version: 1.0"
  261.      
  262.     ProcessHeader = strMIMEMailInfo & vbCrLf & _
  263.                     strMIMEVersion & vbCrLf & _
  264.                     strMIMEClient
  265.                   
  266.      
  267.                      
  268. End Function
  269.      

  270. Private Function GetTo(pstrGroup() As String) As String
  271.     Dim pintC
  272.      
  273.     For pintC = 0 To UBound(pstrGroup)
  274.         GetTo = GetTo & ", " & pstrGroup(pintC)
  275.     Next pintC
  276.      
  277.     GetTo = Mid(GetTo, 3)
  278. End Function


  279. Private Sub CreateDocToSend()
  280.     Dim pstrHeader As String
  281.     Dim pstrTMPFile As String
  282.     Dim pintFF As Integer
  283.     Dim pstrMIMEInfo As String
  284.     Dim pstrBuffer As String
  285.     Dim pstrTo As String
  286.     Dim pstrCC As String
  287.     Dim pstrFrom As String
  288.     Dim pstrTotal As String
  289.      
  290.     pstrTo = GetTo(gstrToAddress)
  291.     pstrCC = GetTo(gstrCC)
  292.     If pstrTo = "" Then
  293.         pstrTo = "Undisclosed"
  294.     Else
  295.         pstrTo = Replace(pstrTo, "<", "")
  296.         pstrTo = Replace(pstrTo, ">", "")
  297.     End If
  298.      
  299.     If pstrCC <> "" Then
  300.         pstrCC = Replace(pstrCC, "<", "")
  301.         pstrCC = Replace(pstrCC, ">", "")
  302.     End If
  303.      
  304.     pstrFrom = gstrFromAddress
  305.     pstrHeader = ProcessHeader(pstrTo, Chr(34) & gstrFromName & Chr(34) & " " & pstrFrom, pstrCC, gstrSubject)
  306.     pstrTMPFile = GetTmpFile
  307.     pintFF = FreeFile
  308.     pstrHeader = pstrHeader & vbCrLf
  309.      
  310.     If gblnAttachments = True Then
  311.         pstrMIMEInfo = GetMIME(conBoundary)
  312.         pstrHeader = pstrHeader & pstrMIMEInfo & vbCrLf
  313.     End If
  314.      
  315.     ''WRITE
  316.     Open pstrTMPFile For Output As #pintFF
  317.         Print #pintFF, pstrHeader
  318.         Print #pintFF, gstrMessage
  319.         If gblnAttachments = True Then
  320.             Dim pintC As Integer
  321.             For pintC = 0 To UBound(FileCode)
  322.                 If FileCode(pintC).Send = True Then
  323.                     Print #pintFF, FileCode(pintC).Code
  324.                     If pintC = UBound(FileCode) Then
  325.                         Print #pintFF, "--" & conBoundary & "--"
  326.                     End If
  327.                 End If
  328.             Next pintC
  329.         End If
  330.          
  331.     Close #pintFF
  332.     gstrMessageFileName = pstrTMPFile
  333. End Sub


  334. Private Sub CheckAddress()
  335.     Dim pintC As Integer
  336.      
  337.     On Error Resume Next
  338.      
  339.     For pintC = 0 To UBound(gstrToAddress)
  340.         If Left(gstrToAddress(pintC), 1) <> "<" Then
  341.             gstrToAddress(pintC) = "<" & gstrToAddress(pintC)
  342.         End If
  343.          
  344.         If Right(gstrToAddress(pintC), 1) <> ">" Then
  345.             gstrToAddress(pintC) = gstrToAddress(pintC) & ">"
  346.         End If
  347.     Next pintC
  348.      
  349.     For pintC = 0 To UBound(gstrCC)
  350.         If Left(gstrCC(pintC), 1) <> "<" Then
  351.             gstrCC(pintC) = "<" & gstrCC(pintC)
  352.         End If
  353.          
  354.         If Right(gstrCC(pintC), 1) <> ">" Then
  355.             gstrCC(pintC) = gstrCC(pintC) & ">"
  356.         End If
  357.     Next pintC
  358.      
  359.     For pintC = 0 To UBound(gstrBCC)
  360.         If Left(gstrBCC(pintC), 1) <> "<" Then
  361.             gstrBCC(pintC) = "<" & gstrBCC(pintC)
  362.         End If
  363.          
  364.         If Right(gstrBCC(pintC), 1) <> ">" Then
  365.             gstrBCC(pintC) = gstrBCC(pintC) & ">"
  366.         End If
  367.     Next pintC
  368.      
  369. End Sub


  370. Private Function CheckConnectionPing() As Boolean
  371.    Dim sTmp As String
  372.    Dim hInet As Long
  373.    Dim hUrl As Long
  374.    Dim Flags As Long
  375.    Dim url As Variant
  376.    hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
  377.    If hInet Then
  378.       Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
  379.       hUrl = InternetOpenUrl(hInet, "http://www.yahoo.com", vbNullString, 0, Flags, 0)
  380.       If hUrl Then
  381.          CheckConnectionPing = True
  382.          Call InternetCloseHandle(hUrl)
  383.     Else
  384.          hUrl = InternetOpenUrl(hInet, "http://www.google.com", vbNullString, 0, Flags, 0)
  385.          If hUrl Then
  386.             CheckConnectionPing = True
  387.             Call InternetCloseHandle(hUrl)
  388.          End If
  389.       End If
  390.    End If
  391.    Call InternetCloseHandle(hInet)
  392. End Function


  393. Private Function StartConnection() As Long
  394.     Dim pintRes As Integer
  395.     pintRes = InternetDial(0, "", INTERNET_DIAL_FORCE_PROMPT, 0, 0)
  396.     StartConnection = pintRes
  397. End Function
  398. Public Function ConnectToInternet() As Long
  399.     ConnectToInternet = StartConnection
  400. End Function


  401. Public Function SendEmail(FromName As String, Subject As String, Message As String, arrToAddresses() As String, arrBCCAddresses() As String, arrCCAddresses() As String, WSock As Winsock, RichText As RichTextBox, Optional ProgsBar As ProgressBar) As Integer
  402.     Dim pintC As Integer
  403.     Dim pintRec As Integer
  404.     Dim pblnConnected As Boolean
  405.      
  406.     pblnConnected = CheckConnectionPing
  407.     If pblnConnected = False Then
  408.         SendEmail = 1
  409.         Exit Function
  410.     End If
  411.      
  412.     Set SocketSSL = WSock
  413.     Set RTBX = RichText

  414.     gstrFromName = FromName
  415.     gstrSubject = Subject
  416.     gstrMessage = Message
  417.     gstrToAddress = arrToAddresses
  418.     gstrCC = arrCCAddresses
  419.     gstrBCC = arrBCCAddresses
  420.     gblnDone = False
  421.     gblnConnected = False
  422.     gintTransfer = 0
  423.     gintSent = 0
  424.      
  425.     Call CheckAddress
  426.      
  427.     For pintC = 0 To UBound(gstrCC)
  428.         If gstrCC(pintC) = "" Or gstrCC(pintC) = "<>" Then Exit For
  429.         ReDim Preserve gstrAllAddresses(pintRec)
  430.         gstrAllAddresses(pintRec) = gstrCC(pintC)
  431.         pintRec = pintRec + 1
  432.     Next pintC
  433.      
  434.     For pintC = 0 To UBound(gstrToAddress)
  435.         If gstrToAddress(pintC) = "" Or gstrToAddress(pintC) = "<>" Then Exit For
  436.         ReDim Preserve gstrAllAddresses(pintRec)
  437.         gstrAllAddresses(pintRec) = gstrToAddress(pintC)
  438.         pintRec = pintRec + 1
  439.     Next pintC
  440.      
  441.     On Error GoTo AllAddressError
  442.     If gstrAllAddresses(0) = "" Then
  443.         ReDim gstrAllAddresses(0)
  444.     End If
  445.      
  446.     On Error Resume Next
  447.     Set ProgBar = ProgsBar
  448.      
  449.     Call CreateDocToSend
  450.          
  451.     If gblnSSL = True Then
  452.         Call ConnectSSLSocket
  453.     Else
  454. '        Here you can add a not SSL eMail procedure
  455. '        Dim Soc As New RegSocket
  456. '        Call Soc.ConnectRegSocket
  457.     End If
  458.       
  459.     Kill gstrMessageFileName
  460.     Call Reset
  461.      
  462.     Set ProgBar = Nothing
  463.      
  464.     SendEmail = 0
  465.     Exit Function

  466. AllAddressError:
  467.     If Err.Number = 9 Then
  468.         ReDim gstrAllAddresses(0)
  469.         Resume Next
  470.     End If
  471.      
  472. End Function


  473. Public Sub SetUp(ServerName As String, Port As Long, FromAddress As String, SSL As Boolean, UserID As String, UserPass As String)

  474.     gstrServerName = ServerName
  475.     glngPort = Port
  476.     gblnSSL = SSL
  477.     gstrFromAddress = CheckAddressFrom(FromAddress)
  478.     gstrDomainName = GetDomainName(gstrFromAddress)
  479.     gstrUserID = UserID
  480.     gstrUserPass = UserPass
  481.      
  482. End Sub
  483. Private Function SelectExt(ByVal vsFullPathname As String) As String
  484.      
  485.     Dim extension As String
  486.     extension = StrReverse(LCase$(Left(StrReverse(vsFullPathname), InStr(1, StrReverse(vsFullPathname), "."))))
  487.     If Len(extension) = 0 Then extension = vsFullPathname
  488.      
  489.     Select Case extension
  490.      
  491.         Case ".323"
  492.             SelectExt = "text/h323"
  493.      
  494.         Case ".aab"
  495.             SelectExt = "application/x-authorware-bin"
  496.      
  497.         Case ".aam"
  498.             SelectExt = "application/x-authorware-map"
  499.      
  500.         Case ".ace"
  501.             SelectExt = "application/x-compressed"
  502.      
  503.         Case ".acp"
  504.             SelectExt = "audio/x-mei-aac"
  505.      
  506.         Case ".ai"
  507.             SelectExt = "application/postscript"
  508.      
  509.         Case ".aif"
  510.             SelectExt = "audio/aiff"
  511.      
  512.         Case ".aifc"
  513.             SelectExt = "audio/aiff"
  514.      
  515.         Case ".aiff"
  516.             SelectExt = "audio/aiff"
  517.      
  518.         Case ".aip"
  519.             SelectExt = "text/x-audiosoft-intra"
  520.      
  521.         Case ".ARJ"
  522.             SelectExt = "application/x-compressed"
  523.      
  524.         Case ".art"
  525.             SelectExt = "image/x-jg"
  526.      
  527.         Case ".asa"
  528.             SelectExt = "text/asa"
  529.      
  530.         Case ".asf"
  531.             SelectExt = "video/x-ms-asf"
  532.      
  533.         Case ".asp"
  534.             SelectExt = "text/asp"
  535.      
  536.         Case ".asx"
  537.             SelectExt = "video/x-ms-asf"
  538.      
  539.         Case ".asx"
  540.             SelectExt = "video/x-ms-asx"
  541.      
  542.         Case ".au"
  543.             SelectExt = "audio/basic"
  544.      
  545.         Case ".aut"
  546.             SelectExt = "application/pbautomation"
  547.      
  548.         Case ".avi"
  549.             SelectExt = "video/avi"
  550.      
  551.         Case ".avi"
  552.             SelectExt = "video/x-msvideo"
  553.      
  554.         Case ".bmo"
  555.             SelectExt = "audio/blue-matter-offer"
  556.      
  557.         Case ".bmp"
  558.             SelectExt = "image/bmp"
  559.      
  560.         Case ".bmp"
  561.             SelectExt = "image/x-bmp"
  562.      
  563.         Case ".bmr"
  564.             SelectExt = "text/blue-matter-content-ref"
  565.      
  566.         Case ".bmt"
  567.             SelectExt = "audio/blue-matter-song"
  568.      
  569.         Case ".bub"
  570.             SelectExt = "application/photobubble"
  571.      
  572.         Case ".cat"
  573.             SelectExt = "application/vnd.ms-pki.seccat"
  574.      
  575.         Case ".cdf"
  576.             SelectExt = "application/x-cdf"
  577.      
  578.         Case ".cel"
  579.             SelectExt = "video/flc"
  580.      
  581.         Case ".cer"
  582.             SelectExt = "application/pkix-cert"
  583.      
  584.         Case ".cer"
  585.             SelectExt = "application/x-x509-ca-cert"
  586.      
  587.         Case ".class"
  588.             SelectExt = "java/*"
  589.      
  590.         Case ".crl"
  591.             SelectExt = "application/pkix-crl"
  592.      
  593.         Case ".crt"
  594.             SelectExt = "application/pkix-cert"
  595.      
  596.         Case ".crt"
  597.             SelectExt = "application/x-x509-ca-cert"
  598.      
  599.         Case ".css"
  600.             SelectExt = "text/css"
  601.      
  602.         Case ".dcr"
  603.             SelectExt = "application/x-director"
  604.      
  605.         Case ".der"
  606.             SelectExt = "application/pkix-cert"
  607.      
  608.         Case ".der"
  609.             SelectExt = "application/x-x509-ca-cert"
  610.      
  611.         Case ".dib"
  612.             SelectExt = "image/bmp"
  613.      
  614.         Case ".dib"
  615.             SelectExt = "image/x-bmp"
  616.      
  617.         Case ".dif"
  618.             SelectExt = "video/x-dv"
  619.      
  620.         Case ".dir"
  621.             SelectExt = "application/x-director"
  622.      
  623.         Case ".dll"
  624.             SelectExt = "application/x-msdownload"
  625.      
  626.         Case ".doc"
  627.             SelectExt = "application/msword"
  628.      
  629.         Case ".dot"
  630.             SelectExt = "application/msword"
  631.      
  632.         Case ".dpg"
  633.             SelectExt = "application/vnd.dpgraph"
  634.      
  635.         Case ".dpgraph"
  636.             SelectExt = "application/vnd.dpgraph"
  637.      
  638.         Case ".dv"
  639.             SelectExt = "video/x-dv"
  640.      
  641.         Case ".dxr"
  642.             SelectExt = "application/x-director"
  643.      
  644.         Case ".eml"
  645.             SelectExt = "message/rfc822"
  646.      
  647.         Case ".emm"
  648.             SelectExt = "application/x-emms-content"
  649.      
  650.         Case ".eps"
  651.             SelectExt = "application/postscript"
  652.      
  653.         Case ".exe"
  654.             SelectExt = "application/x-msdownload"
  655.      
  656.         Case ".fdf"
  657.             SelectExt = "application/vnd.fdf"
  658.      
  659.         Case ".fif"
  660.             SelectExt = "application/fractals"
  661.      
  662.         Case ".flc"
  663.             SelectExt = "video/flc"
  664.      
  665.         Case ".fli"
  666.             SelectExt = "video/flc"
  667.      
  668.         Case ".fml"
  669.             SelectExt = "application/file-mirror-list"
  670.      
  671.         Case ".fpx"
  672.             SelectExt = "image/x-xbitmap"
  673.      
  674.         Case ".gif"
  675.             SelectExt = "image/gif"
  676.      
  677.         Case ".grv"
  678.             SelectExt = "application/vnd.groove-injector"
  679.      
  680.         Case ".gz"
  681.             SelectExt = "application/x-compressed"
  682.      
  683.         Case ".gz"
  684.             SelectExt = "application/x-gzip"
  685.      
  686.         Case ".hpf"
  687.             SelectExt = "application/x-icq-hpf"
  688.      
  689.         Case ".hqx"
  690.             SelectExt = "application/mac-binhex40"
  691.      
  692.         Case ".hta"
  693.             SelectExt = "application/hta"
  694.      
  695.         Case ".htc"
  696.             SelectExt = "text/x-component"
  697.      
  698.         Case ".htm"
  699.             SelectExt = "text/html"
  700.      
  701.         Case ".html"
  702.             SelectExt = "text/html"
  703.      
  704.         Case ".htt"
  705.             SelectExt = "text/webviewhtml"
  706.      
  707.         Case ".htx"
  708.             SelectExt = "text/html"
  709.      
  710.         Case ".ico"
  711.             SelectExt = "image/x-icon"
  712.      
  713.         Case ".iii"
  714.             SelectExt = "application/x-iphone"
  715.      
  716.         Case ".ins"
  717.             SelectExt = "application/x-internet-signup"
  718.      
  719.         Case ".ips"
  720.             SelectExt = "application/x-ipscript"
  721.      
  722.         Case ".ipx"
  723.             SelectExt = "application/x-ipix"
  724.      
  725.         Case ".isp"
  726.             SelectExt = "application/x-internet-signup"
  727.      
  728.         Case ".IVF"
  729.             SelectExt = "video/x-ivf"
  730.      
  731.         Case ".ivr"
  732.             SelectExt = "i-world/i-vrml"
  733.      
  734.         Case ".java"
  735.             SelectExt = "java/*"
  736.      
  737.         Case ".java"
  738.             SelectExt = "text/java"
  739.      
  740.         Case ".jfif"
  741.             SelectExt = "image/pjpeg"
  742.      
  743.         Case ".jpe"
  744.             SelectExt = "image/jpeg"
  745.      
  746.         Case ".jpeg"
  747.             SelectExt = "image/jpeg"
  748.      
  749.         Case ".jpg"
  750.             SelectExt = "image/jpeg"
  751.      
  752.         Case ".JS"
  753.             SelectExt = "application/x-javascript"
  754.      
  755.         Case ".la1"
  756.             SelectExt = "audio/x-liquid-file"
  757.      
  758.         Case ".lar"
  759.             SelectExt = "application/x-laplayer-reg"
  760.      
  761.         Case ".latex"
  762.             SelectExt = "application/x-latex"
  763.      
  764.         Case ".lav"
  765.             SelectExt = "audio/x-liquid"
  766.      
  767.         Case ".lavs"
  768.             SelectExt = "audio/x-liquid-secure"
  769.      
  770.         Case ".lha"
  771.             SelectExt = "application/x-compressed"
  772.      
  773.         Case ".lks"
  774.             SelectExt = "application/x-lk-rlestream"
  775.      
  776.         Case ".lmsff"
  777.             SelectExt = "audio/x-la-lms"
  778.      
  779.         Case ".lqt"
  780.             SelectExt = "audio/x-liquid-file"
  781.      
  782.         Case ".ls"
  783.             SelectExt = "application/x-javascript"
  784.      
  785.         Case ".lsf"
  786.             SelectExt = "video/x-la-asf"
  787.      
  788.         Case ".lsx"
  789.             SelectExt = "video/x-la-asf"
  790.      
  791.         Case ".LZH"
  792.             SelectExt = "application/x-compressed"
  793.      
  794.         Case ".m1v"
  795.             SelectExt = "video/mpeg"
  796.      
  797.         Case ".m3u"
  798.             SelectExt = "audio/mpegurl"
  799.      
  800.         Case ".m3u"
  801.             SelectExt = "audio/x-mpegurl"
  802.      
  803.         Case ".mac"
  804.             SelectExt = "image/x-macpaint"
  805.      
  806.         Case ".man"
  807.             SelectExt = "application/x-troff-man"
  808.      
  809.         Case ".mbc"
  810.             SelectExt = "application/x-pn-virtualink"
  811.      
  812.         Case ".mbo"
  813.             SelectExt = "application/x-previewsystems-vbox-music"
  814.      
  815.         Case ".mbox"
  816.             SelectExt = "application/x-previewsystems-vbox-music"
  817.      
  818.         Case ".mdb"
  819.             SelectExt = "application/msaccess"
  820.      
  821.         Case ".med"
  822.             SelectExt = "application/x-att-a2bmusic-purchase"
  823.      
  824.         Case ".mes"
  825.             SelectExt = "application/x-att-a2bmusic"
  826.      
  827.         Case ".mht"
  828.             SelectExt = "message/rfc822"
  829.      
  830.         Case ".mhtml"
  831.             SelectExt = "message/rfc822"
  832.      
  833.         Case ".mid"
  834.             SelectExt = "audio/mid"
  835.      
  836.         Case ".midi"
  837.             SelectExt = "audio/mid"
  838.      
  839.         Case ".mix"
  840.             SelectExt = "image/x-xbitmap"
  841.      
  842.         Case ".mjf"
  843.             SelectExt = "audio/x-vnd.AudioExplosion.MjuiceMediaFile"
  844.      
  845.         Case ".mjv"
  846.             SelectExt = "audio/audio/mjuice_voucher"
  847.      
  848.         Case ".mmjb_mime"
  849.             SelectExt = "application/x-musicmatch-mmjb5.20detect"
  850.      
  851.         Case ".mmz"
  852.             SelectExt = "application/x-mmjb-mmz"
  853.      
  854.         Case ".mocha"
  855.             SelectExt = "application/x-javascript"
  856.      
  857.         Case ".mov"
  858.             SelectExt = "video/quicktime"
  859.      
  860.         Case ".movie"
  861.             SelectExt = "video/x-sgi-movie"
  862.      
  863.         Case ".mp1"
  864.             SelectExt = "audio/mpeg"
  865.      
  866.         Case ".mp2"
  867.             SelectExt = "video/mpeg"
  868.      
  869.         Case ".mp2v"
  870.             SelectExt = "video/mpeg"
  871.      
  872.         Case ".mp3"
  873.             SelectExt = "audio/mpeg"
  874.      
  875.         Case ".mpa"
  876.             SelectExt = "video/mpeg"
  877.      
  878.         Case ".mpe"
  879.             SelectExt = "video/mpeg"
  880.      
  881.         Case ".mpeg"
  882.             SelectExt = "video/mpeg"
  883.      
  884.         Case ".mpg"
  885.             SelectExt = "video/mpeg"
  886.      
  887.         Case ".mpga"
  888.             SelectExt = "audio/mpeg"
  889.      
  890.         Case ".mpv"
  891.             SelectExt = "video/mpg"
  892.      
  893.         Case ".mpv2"
  894.             SelectExt = "video/mpeg"
  895.      
  896.         Case ".mwc"
  897.             SelectExt = "application/vnd.dpgraph"
  898.      
  899.         Case ".mxp"
  900.             SelectExt = "application/x-mmxp"
  901.      
  902.         Case ".npi"
  903.             SelectExt = "application/x-pn-npistream"
  904.      
  905.         Case ".nws"
  906.             SelectExt = "message/rfc822"
  907.      
  908.         Case ".p10"
  909.             SelectExt = "application/pkcs10"
  910.      
  911.         Case ".p12"
  912.             SelectExt = "application/x-pkcs12"
  913.      
  914.         Case ".p7b"
  915.             SelectExt = "application/x-pkcs7-certificates"
  916.      
  917.         Case ".p7c"
  918.             SelectExt = "application/pkcs7-mime"
  919.      
  920.         Case ".p7m"
  921.             SelectExt = "application/pkcs7-mime"
  922.      
  923.         Case ".p7r"
  924.             SelectExt = "application/x-pkcs7-certreqresp"
  925.      
  926.         Case ".p7s"
  927.             SelectExt = "application/pkcs7-signature"
  928.      
  929.         Case ".pct"
  930.             SelectExt = "image/pict"
  931.      
  932.         Case ".pdf"
  933.             SelectExt = "application/pdf"
  934.      
  935.         Case ".pfx"
  936.             SelectExt = "application/x-pkcs12"
  937.      
  938.         Case ".pic"
  939.             SelectExt = "image/pict"
  940.      
  941.         Case ".pict"
  942.             SelectExt = "image/pict"
  943.      
  944.         Case ".pko"
  945.             SelectExt = "application/vnd.ms-pki.pko"
  946.      
  947.         Case ".pl"
  948.             SelectExt = "application/x-perl"
  949.      
  950.         Case ".plg"
  951.             SelectExt = "text/html"
  952.      
  953.         Case ".pls"
  954.             SelectExt = "audio/scpls"
  955.      
  956.         Case ".pls"
  957.             SelectExt = "audio/x-scpls"
  958.      
  959.         Case ".png"
  960.             SelectExt = "image/png"
  961.      
  962.         Case ".pnq"
  963.             SelectExt = "application/x-icq-pnq"
  964.      
  965.         Case ".pntg"
  966.             SelectExt = "image/x-macpaint"
  967.      
  968.         Case ".POT"
  969.             SelectExt = "application/vnd.ms-powerpoint"
  970.      
  971.         Case ".ppa"
  972.             SelectExt = "application/vnd.ms-powerpoint"
  973.      
  974.         Case ".pps"
  975.             SelectExt = "application/vnd.ms-powerpoint"
  976.      
  977.         Case ".ppt"
  978.             SelectExt = "application/x-mspowerpoint"
  979.      
  980.         Case ".prf"
  981.             SelectExt = "application/pics-rules"
  982.      
  983.         Case ".ps"
  984.             SelectExt = "application/postscript"
  985.      
  986.         Case ".pwz"
  987.             SelectExt = "application/vnd.ms-powerpoint"
  988.      
  989.         Case ".py"
  990.             SelectExt = "text/plain"
  991.      
  992.         Case ".pyw"
  993.             SelectExt = "text/plain"
  994.      
  995.         Case ".qht"
  996.             SelectExt = "text/x-html-insertion"
  997.      
  998.         Case ".qhtm"
  999.             SelectExt = "text/x-html-insertion"
  1000.      
  1001.         Case ".qt"
  1002.             SelectExt = "video/quicktime"
  1003.      
  1004.         Case ".qti"
  1005.             SelectExt = "image/x-quicktime"
  1006.      
  1007.         Case ".qtif"
  1008.             SelectExt = "image/x-quicktime"
  1009.      
  1010.         Case ".qtl"
  1011.             SelectExt = "application/x-quicktimeplayer"
  1012.      
  1013.         Case ".r00"
  1014.             SelectExt = "application/x-rar-compressed"
  1015.      
  1016.         Case ".r01"
  1017.             SelectExt = "application/x-rar-compressed"
  1018.      
  1019.         Case ".r02"
  1020.             SelectExt = "application/x-rar-compressed"
  1021.      
  1022.         Case ".r03"
  1023.             SelectExt = "application/x-rar-compressed"
  1024.      
  1025.         Case ".r04"
  1026.             SelectExt = "application/x-rar-compressed"
  1027.      
  1028.         Case ".r05"
  1029.             SelectExt = "application/x-rar-compressed"
  1030.      
  1031.         Case ".r06"
  1032.             SelectExt = "application/x-rar-compressed"
  1033.      
  1034.         Case ".r07"
  1035.             SelectExt = "application/x-rar-compressed"
  1036.      
  1037.         Case ".r08"
  1038.             SelectExt = "application/x-rar-compressed"
  1039.      
  1040.         Case ".r09"
  1041.             SelectExt = "application/x-rar-compressed"
  1042.      
  1043.         Case ".r10"
  1044.             SelectExt = "application/x-rar-compressed"
  1045.      
  1046.         Case ".r11"
  1047.             SelectExt = "application/x-rar-compressed"
  1048.      
  1049.         Case ".r12"
  1050.             SelectExt = "application/x-rar-compressed"
  1051.      
  1052.         Case ".r13"
  1053.             SelectExt = "application/x-rar-compressed"
  1054.      
  1055.         Case ".r14"
  1056.             SelectExt = "application/x-rar-compressed"
  1057.      
  1058.         Case ".r15"
  1059.             SelectExt = "application/x-rar-compressed"
  1060.      
  1061.         Case ".r16"
  1062.             SelectExt = "application/x-rar-compressed"
  1063.      
  1064.         Case ".r17"
  1065.             SelectExt = "application/x-rar-compressed"
  1066.      
  1067.         Case ".r18"
  1068.             SelectExt = "application/x-rar-compressed"
  1069.      
  1070.         Case ".r19"
  1071.             SelectExt = "application/x-rar-compressed"
  1072.      
  1073.         Case ".r20"
  1074.             SelectExt = "application/x-rar-compressed"
  1075.      
  1076.         Case ".r21"
  1077.             SelectExt = "application/x-rar-compressed"
  1078.      
  1079.         Case ".r22"
  1080.             SelectExt = "application/x-rar-compressed"
  1081.      
  1082.         Case ".r23"
  1083.             SelectExt = "application/x-rar-compressed"
  1084.      
  1085.         Case ".r24"
  1086.             SelectExt = "application/x-rar-compressed"
  1087.      
  1088.         Case ".r25"
  1089.             SelectExt = "application/x-rar-compressed"
  1090.      
  1091.         Case ".r26"
  1092.             SelectExt = "application/x-rar-compressed"
  1093.      
  1094.         Case ".r27"
  1095.             SelectExt = "application/x-rar-compressed"
  1096.      
  1097.         Case ".r28"
  1098.             SelectExt = "application/x-rar-compressed"
  1099.      
  1100.         Case ".r29"
  1101.             SelectExt = "application/x-rar-compressed"
  1102.      
  1103.         Case ".r30"
  1104.             SelectExt = "application/x-rar-compressed"
  1105.      
  1106.         Case ".r31"
  1107.             SelectExt = "application/x-rar-compressed"
  1108.      
  1109.         Case ".r32"
  1110.             SelectExt = "application/x-rar-compressed"
  1111.      
  1112.         Case ".r33"
  1113.             SelectExt = "application/x-rar-compressed"
  1114.      
  1115.         Case ".r34"
  1116.             SelectExt = "application/x-rar-compressed"
  1117.      
  1118.         Case ".r35"
  1119.             SelectExt = "application/x-rar-compressed"
  1120.      
  1121.         Case ".r36"
  1122.             SelectExt = "application/x-rar-compressed"
  1123.      
  1124.         Case ".r37"
  1125.             SelectExt = "application/x-rar-compressed"
  1126.      
  1127.         Case ".r38"
  1128.             SelectExt = "application/x-rar-compressed"
  1129.      
  1130.         Case ".r39"
  1131.             SelectExt = "application/x-rar-compressed"
  1132.      
  1133.         Case ".r3t"
  1134.             SelectExt = "text/vnd.rn-realtext3d"
  1135.      
  1136.         Case ".r40"
  1137.             SelectExt = "application/x-rar-compressed"
  1138.      
  1139.         Case ".r41"
  1140.             SelectExt = "application/x-rar-compressed"
  1141.      
  1142.         Case ".r42"
  1143.             SelectExt = "application/x-rar-compressed"
  1144.      
  1145.         Case ".r43"
  1146.             SelectExt = "application/x-rar-compressed"
  1147.      
  1148.         Case ".r44"
  1149.             SelectExt = "application/x-rar-compressed"
  1150.      
  1151.         Case ".r45"
  1152.             SelectExt = "application/x-rar-compressed"
  1153.      
  1154.         Case ".r46"
  1155.             SelectExt = "application/x-rar-compressed"
  1156.      
  1157.         Case ".r47"
  1158.             SelectExt = "application/x-rar-compressed"
  1159.      
  1160.         Case ".r48"
  1161.             SelectExt = "application/x-rar-compressed"
  1162.      
  1163.         Case ".r49"
  1164.             SelectExt = "application/x-rar-compressed"
  1165.      
  1166.         Case ".r50"
  1167.             SelectExt = "application/x-rar-compressed"
  1168.      
  1169.         Case ".r51"
  1170.             SelectExt = "application/x-rar-compressed"
  1171.      
  1172.         Case ".r52"
  1173.             SelectExt = "application/x-rar-compressed"
  1174.      
  1175.         Case ".r53"
  1176.             SelectExt = "application/x-rar-compressed"
  1177.      
  1178.         Case ".r54"
  1179.             SelectExt = "application/x-rar-compressed"
  1180.      
  1181.         Case ".r55"
  1182.             SelectExt = "application/x-rar-compressed"
  1183.      
  1184.         Case ".r56"
  1185.             SelectExt = "application/x-rar-compressed"
  1186.      
  1187.         Case ".r57"
  1188.             SelectExt = "application/x-rar-compressed"
  1189.      
  1190.         Case ".r58"
  1191.             SelectExt = "application/x-rar-compressed"
  1192.      
  1193.         Case ".r59"
  1194.             SelectExt = "application/x-rar-compressed"
  1195.      
  1196.         Case ".r60"
  1197.             SelectExt = "application/x-rar-compressed"
  1198.      
  1199.         Case ".r61"
  1200.             SelectExt = "application/x-rar-compressed"
  1201.      
  1202.         Case ".r62"
  1203.             SelectExt = "application/x-rar-compressed"
  1204.      
  1205.         Case ".r63"
  1206.             SelectExt = "application/x-rar-compressed"
  1207.      
  1208.         Case ".r64"
  1209.             SelectExt = "application/x-rar-compressed"
  1210.      
  1211.         Case ".r65"
  1212.             SelectExt = "application/x-rar-compressed"
  1213.      
  1214.         Case ".r66"
  1215.             SelectExt = "application/x-rar-compressed"
  1216.      
  1217.         Case ".r67"
  1218.             SelectExt = "application/x-rar-compressed"
  1219.      
  1220.         Case ".r68"
  1221.             SelectExt = "application/x-rar-compressed"
  1222.      
  1223.         Case ".r69"
  1224.             SelectExt = "application/x-rar-compressed"
  1225.      
  1226.         Case ".r70"
  1227.             SelectExt = "application/x-rar-compressed"
  1228.      
  1229.         Case ".r71"
  1230.             SelectExt = "application/x-rar-compressed"
  1231.      
  1232.         Case ".r72"
  1233.             SelectExt = "application/x-rar-compressed"
  1234.      
  1235.         Case ".r73"
  1236.             SelectExt = "application/x-rar-compressed"
  1237.      
  1238.         Case ".r74"
  1239.             SelectExt = "application/x-rar-compressed"
  1240.      
  1241.         Case ".r75"
  1242.             SelectExt = "application/x-rar-compressed"
  1243.      
  1244.         Case ".r76"
  1245.             SelectExt = "application/x-rar-compressed"
  1246.      
  1247.         Case ".r77"
  1248.             SelectExt = "application/x-rar-compressed"
  1249.      
  1250.         Case ".r78"
  1251.             SelectExt = "application/x-rar-compressed"
  1252.      
  1253.         Case ".r79"
  1254.             SelectExt = "application/x-rar-compressed"
  1255.      
  1256.         Case ".r80"
  1257.             SelectExt = "application/x-rar-compressed"
  1258.      
  1259.         Case ".r81"
  1260.             SelectExt = "application/x-rar-compressed"
  1261.      
  1262.         Case ".r82"
  1263.             SelectExt = "application/x-rar-compressed"
  1264.      
  1265.         Case ".r83"
  1266.             SelectExt = "application/x-rar-compressed"
  1267.      
  1268.         Case ".r84"
  1269.             SelectExt = "application/x-rar-compressed"
  1270.      
  1271.         Case ".r85"
  1272.             SelectExt = "application/x-rar-compressed"
  1273.      
  1274.         Case ".r86"
  1275.             SelectExt = "application/x-rar-compressed"
  1276.      
  1277.         Case ".r87"
  1278.             SelectExt = "application/x-rar-compressed"
  1279.      
  1280.         Case ".r88"
  1281.             SelectExt = "application/x-rar-compressed"
  1282.      
  1283.         Case ".r89"
  1284.             SelectExt = "application/x-rar-compressed"
  1285.      
  1286.         Case ".r90"
  1287.             SelectExt = "application/x-rar-compressed"
  1288.      
  1289.         Case ".r91"
  1290.             SelectExt = "application/x-rar-compressed"
  1291.      
  1292.         Case ".r92"
  1293.             SelectExt = "application/x-rar-compressed"
  1294.      
  1295.         Case ".r93"
  1296.             SelectExt = "application/x-rar-compressed"
  1297.      
  1298.         Case ".r94"
  1299.             SelectExt = "application/x-rar-compressed"
  1300.      
  1301.         Case ".r95"
  1302.             SelectExt = "application/x-rar-compressed"
  1303.      
  1304.         Case ".r96"
  1305.             SelectExt = "application/x-rar-compressed"
  1306.      
  1307.         Case ".r97"
  1308.             SelectExt = "application/x-rar-compressed"
  1309.      
  1310.         Case ".r98"
  1311.             SelectExt = "application/x-rar-compressed"
  1312.      
  1313.         Case ".r99"
  1314.             SelectExt = "application/x-rar-compressed"
  1315.      
  1316.         Case ".ra"
  1317.             SelectExt = "audio/vnd.rn-realaudio"
  1318.      
  1319.         Case ".ram"
  1320.             SelectExt = "audio/x-pn-realaudio"
  1321.      
  1322.         Case ".rar"
  1323.             SelectExt = "application/x-rar-compressed"
  1324.      
  1325.         Case ".rat"
  1326.             SelectExt = "application/rat-file"
  1327.      
  1328.         Case ".rf"
  1329.             SelectExt = "image/vnd.rn-realflash"
  1330.      
  1331.         Case ".rjs"
  1332.             SelectExt = "application/vnd.rn-realsystem-rjs"
  1333.      
  1334.         Case ".rjt"
  1335.             SelectExt = "application/vnd.rn-realsystem-rjt"
  1336.      
  1337.         Case ".rm"
  1338.             SelectExt = "application/vnd.rn-realmedia"
  1339.      
  1340.         Case ".rmi"
  1341.             SelectExt = "audio/mid"
  1342.      
  1343.         Case ".rmj"
  1344.             SelectExt = "application/vnd.rn-realsystem-rmj"
  1345.      
  1346.         Case ".rmm"
  1347.             SelectExt = "audio/x-pn-realaudio"
  1348.      
  1349.         Case ".rmp"
  1350.             SelectExt = "application/vnd.rn-rn_music_package"
  1351.      
  1352.         Case ".rmx"
  1353.             SelectExt = "application/vnd.rn-realsystem-rmx"
  1354.      
  1355.         Case ".rnx"
  1356.             SelectExt = "application/vnd.rn-realplayer"
  1357.      
  1358.         Case ".rob"
  1359.             SelectExt = "application/vnd.rn-objects"
  1360.      
  1361.         Case ".rp"
  1362.             SelectExt = "image/vnd.rn-realpix"
  1363.      
  1364.         Case ".rpm"
  1365.             SelectExt = "audio/x-pn-realaudio-plugin"
  1366.      
  1367.         Case ".rsml"
  1368.             SelectExt = "application/vnd.rn-rsml"
  1369.      
  1370.         Case ".rt"
  1371.             SelectExt = "text/vnd.rn-realtext"
  1372.      
  1373.         Case ".rtf"
  1374.             SelectExt = "application/msword"
  1375.      
  1376.         Case ".rtsp"
  1377.             SelectExt = "application/x-rtsp"
  1378.      
  1379.         Case ".rv"
  1380.             SelectExt = "video/vnd.rn-realvideo"
  1381.      
  1382.         Case ".sc"
  1383.             SelectExt = "application/vnd.optx-screenwatch"
  1384.      
  1385.         Case ".scm"
  1386.             SelectExt = "application/x-icq-scm"
  1387.      
  1388.         Case ".sct"
  1389.             SelectExt = "text/scriptlet"
  1390.      
  1391.         Case ".sd2"
  1392.             SelectExt = "audio/x-sd2"
  1393.      
  1394.         Case ".sdf"
  1395.             SelectExt = "application/x-server-launch"
  1396.      
  1397.         Case ".sdp"
  1398.             SelectExt = "application/sdp"
  1399.      
  1400.         Case ".sgi"
  1401.             SelectExt = "image/x-sgi"
  1402.      
  1403.         Case ".sit"
  1404.             SelectExt = "application/x-stuffit"
  1405.      
  1406.         Case ".sma"
  1407.             SelectExt = "application/x-smb-directive"
  1408.      
  1409.         Case ".smi"
  1410.             SelectExt = "application/smil"
  1411.      
  1412.         Case ".smil"
  1413.             SelectExt = "application/smil"
  1414.      
  1415.         Case ".snd"
  1416.             SelectExt = "audio/basic"
  1417.      
  1418.         Case ".spc"
  1419.             SelectExt = "application/x-pkcs7-certificates"
  1420.      
  1421.         Case ".spl"
  1422.             SelectExt = "application/futuresplash"
  1423.      
  1424.         Case ".spn"
  1425.             SelectExt = "application/vnd.spinnerplus"
  1426.      
  1427.         Case ".ssm"
  1428.             SelectExt = "application/streamingmedia"
  1429.      
  1430.         Case ".sst"
  1431.             SelectExt = "application/vnd.ms-pki.certstore"
  1432.      
  1433.         Case ".stl"
  1434.             SelectExt = "application/vnd.ms-pki.stl"
  1435.      
  1436.         Case ".stm"
  1437.             SelectExt = "text/html"
  1438.      
  1439.         Case ".svg"
  1440.             SelectExt = "image/svg+xml"
  1441.      
  1442.         Case ".svg"
  1443.             SelectExt = "image/svg-xml"
  1444.      
  1445.         Case ".svgz"
  1446.             SelectExt = "image/svg+xml"
  1447.      
  1448.         Case ".svgz"
  1449.             SelectExt = "image/svg-xml"
  1450.      
  1451.         Case ".swf"
  1452.             SelectExt = "application/x-shockwave-flash"
  1453.      
  1454.         Case ".tar"
  1455.             SelectExt = "application/x-compressed"
  1456.      
  1457.         Case ".tar"
  1458.             SelectExt = "application/x-tar"
  1459.      
  1460.         Case ".tga"
  1461.             SelectExt = "image/x-targa"
  1462.      
  1463.         Case ".tgz"
  1464.             SelectExt = "application/x-compressed"
  1465.      
  1466.         Case ".tif"
  1467.             SelectExt = "image/tiff"
  1468.      
  1469.         Case ".tiff"
  1470.             SelectExt = "image/tiff"
  1471.      
  1472.         Case ".txt"
  1473.             SelectExt = "text/plain"
  1474.      
  1475.         Case ".uin"
  1476.             SelectExt = "application/x-icq"
  1477.      
  1478.         Case ".uls"
  1479.             SelectExt = "text/iuls"
  1480.      
  1481.         Case ".ultact"
  1482.             SelectExt = "application/x-UltimateAction"
  1483.      
  1484.         Case ".ulw"
  1485.             SelectExt = "audio/basic"
  1486.      
  1487.         Case ".urls"
  1488.             SelectExt = "application/x-url-list"
  1489.      
  1490.         Case ".UU"
  1491.             SelectExt = "application/x-compressed"
  1492.      
  1493.         Case ".UUE"
  1494.             SelectExt = "application/x-compressed"
  1495.      
  1496.         Case ".vcf"
  1497.             SelectExt = "text/x-vcard"
  1498.      
  1499.         Case ".vcg"
  1500.             SelectExt = "application/vnd.groove-vcard"
  1501.      
  1502.         Case ".vcl"
  1503.             SelectExt = "text/html"
  1504.      
  1505.         Case ".vfw"
  1506.             SelectExt = "video/x-msvideo"
  1507.      
  1508.         Case ".vpg"
  1509.             SelectExt = "application/x-vpeg"
  1510.      
  1511.         Case ".vsl"
  1512.             SelectExt = "application/x-cnet-vsl"
  1513.      
  1514.         Case ".wav"
  1515.             SelectExt = "audio/wav"
  1516.      
  1517.         Case ".wax"
  1518.             SelectExt = "audio/x-ms-wax"
  1519.      
  1520.         Case ".wiz"
  1521.             SelectExt = "application/msword"
  1522.      
  1523.         Case ".wm"
  1524.             SelectExt = "video/x-ms-wm"
  1525.      
  1526.         Case ".wma"
  1527.             SelectExt = "audio/x-ms-wma"
  1528.      
  1529.         Case ".wmd"
  1530.             SelectExt = "application/x-ms-wmd"
  1531.      
  1532.         Case ".wme"
  1533.             SelectExt = "text/xml"
  1534.      
  1535.         Case ".wmp"
  1536.             SelectExt = "video/x-ms-wmp"
  1537.      
  1538.         Case ".wms"
  1539.             SelectExt = "application/x-ms-wms"
  1540.      
  1541.         Case ".wmv"
  1542.             SelectExt = "video/x-ms-wmv"
  1543.      
  1544.         Case ".wmx"
  1545.             SelectExt = "video/x-ms-wmx"
  1546.      
  1547.         Case ".wmz"
  1548.             SelectExt = "application/x-ms-wmz"
  1549.      
  1550.         Case ".wsc"
  1551.             SelectExt = "text/scriptlet"
  1552.      
  1553.         Case ".wvx"
  1554.             SelectExt = "video/x-ms-wvx"
  1555.      
  1556.         Case ".xbm"
  1557.             SelectExt = "image/x-xbitmap"
  1558.      
  1559.         Case ".xls"
  1560.             SelectExt = "application/vnd.ms-excel"
  1561.      
  1562.         Case ".xls"
  1563.             SelectExt = "application/x-msexcel"
  1564.      
  1565.         Case ".xml"
  1566.             SelectExt = "text/xml"
  1567.      
  1568.         Case ".xpl"
  1569.             SelectExt = "audio/mpegurl"
  1570.      
  1571.         Case ".xsl"
  1572.             SelectExt = "text/xml"
  1573.      
  1574.         Case ".XXE"
  1575.             SelectExt = "application/x-compressed"
  1576.      
  1577.         Case ".ymg"
  1578.             SelectExt = "application/ymsgr"
  1579.      
  1580.         Case ".yps"
  1581.             SelectExt = "application/ymsgr"
  1582.      
  1583.         Case ".z"
  1584.             SelectExt = "application/x-compress"
  1585.      
  1586.         Case ".zip"
  1587.             SelectExt = "application/x-zip-compressed"
  1588.      
  1589.         Case "ratfile"
  1590.             SelectExt = "application/rat-file"
  1591.      
  1592.         Case "smafile"
  1593.             SelectExt = "application/x-smb-directive"
  1594.          
  1595.         Case Else
  1596.             SelectExt = "application/octet-stream"
  1597.     End Select

  1598. End Function

  1599. Private Function MIMEFileHeader(MIMEBoundary As String, FilePath As String)
  1600.     Dim sResult As String
  1601.     Dim sFileName As String
  1602.     Dim pintC
  1603.      
  1604.     pintC = InStrRev(FilePath, "")
  1605.     sFileName = Mid(FilePath, pintC + 1)
  1606.      
  1607.     sResult = vbCrLf & "--" & MIMEBoundary & vbCrLf
  1608.     sResult = sResult & "Content-Type: " & SelectExt(FilePath) & "; " & "name=" & Chr(34) & sFileName & Chr(34) & vbNewLine
  1609.     sResult = sResult & "Content-Transfer-Encoding: base64" & vbCrLf
  1610.     sResult = sResult & "Content-Disposition: attachment; filename=" & Chr(34) & sFileName & Chr(34) & vbCrLf
  1611.      
  1612.     MIMEFileHeader = sResult
  1613. End Function

  1614. Public Function Base64EncodeFile(sInputFile As String, sOutputFile As String, Optional PrgBar As ProgressBar) As Byte()
  1615.     Dim bTemp() As Byte
  1616.     Dim fh As Long
  1617.      
  1618.     fh = FreeFile(0)
  1619.     Open sInputFile For Binary Access Read As fh
  1620.         ReDim bTemp(0 To LOF(fh) - 1)
  1621.         Get fh, , bTemp
  1622.     Close fh
  1623.      
  1624.     bTemp = EncodeArr(bTemp, PrgBar)
  1625.     Open sOutputFile For Binary Access Write As fh
  1626.         Put fh, , bTemp
  1627.     Close fh
  1628.      
  1629.     Base64EncodeFile = bTemp
  1630. End Function

  1631. 'Converts an array of bytes to a string.
  1632. Private Sub ByteArrayToString(ByteArray() As Byte, StringOut As String)
  1633.   Dim lBytes As Long

  1634.   If LBound(ByteArray) > 0 Then Exit Sub 'lBound MUST be 0
  1635.   lBytes = UBound(ByteArray) + 1
  1636.   StringOut = String$(lBytes, 0)
  1637.    
  1638.   RtlMoveMemory ByVal StringOut, ByteArray(0), lBytes
  1639. End Sub


  1640. 'Converts a string to an array of bytes. Just like Asc() on every character.
  1641. Private Sub StringToByteArray(ByVal StringIn As String, ByteArray() As Byte)
  1642.     Dim lBytes As Long
  1643.      
  1644.     If Len(StringIn) = 0 Then Exit Sub
  1645.     lBytes = Len(StringIn)
  1646.     ReDim ByteArray(lBytes - 1)
  1647.      
  1648.     RtlMoveMemory ByteArray(0), ByVal StringIn, lBytes
  1649. End Sub


  1650. 'Takes sets of 3 characters (binary) and returns sets of 4 characters (ASCII)
  1651. Private Function EncodeString(ByVal InString As String) As String
  1652.     Dim OutString As String
  1653.     Dim i As Integer
  1654.     Dim UnCodedArray() As Byte
  1655.     Dim CodedArray() As Byte
  1656.      
  1657.     'Pad will null characters if necessary
  1658.     If Len(InString) Mod 3 <> 0 Then
  1659.         InString = InString & String(3 - Len(InString) Mod 3, Chr$(0))
  1660.     End If
  1661.      
  1662.     'Convert string to a byte array. This is MUCH faster than the Asc/Chr combo.
  1663.     StringToByteArray InString, UnCodedArray()
  1664.      
  1665.     'Make sure our output array is the correct size
  1666.     ReDim CodedArray(((Len(InString) / 3) * 4) - 1)
  1667.      
  1668.     For i = 0 To (Len(InString) / 3) - 1
  1669.         'Encode 4 bytes at a time
  1670.         CodedArray(i * 4 + 0) = UnCodedArray(i * 3 + 0) \ 4 + 32
  1671.         CodedArray(i * 4 + 1) = ((UnCodedArray(i * 3 + 0) Mod 4) * 16) + (UnCodedArray(i * 3 + 1) \ 16 + 32)
  1672.         CodedArray(i * 4 + 2) = ((UnCodedArray(i * 3 + 1) Mod 16) * 4) + (UnCodedArray(i * 3 + 2) \ 64 + 32)
  1673.         CodedArray(i * 4 + 3) = (UnCodedArray(i * 3 + 2) Mod 64) + 32
  1674.          
  1675.         'Check for spaces and eliminate them
  1676.         If CodedArray(i * 4 + 0) = 32 Then CodedArray(i * 4 + 0) = 96
  1677.         If CodedArray(i * 4 + 1) = 32 Then CodedArray(i * 4 + 1) = 96
  1678.         If CodedArray(i * 4 + 2) = 32 Then CodedArray(i * 4 + 2) = 96
  1679.         If CodedArray(i * 4 + 3) = 32 Then CodedArray(i * 4 + 3) = 96
  1680.     Next i
  1681.     ByteArrayToString CodedArray(), OutString
  1682.     EncodeString = OutString
  1683. End Function


  1684. 'Gives a character representing the number of bytes to be decoded from a line. "M" is a full line (45 bytes)
  1685. Private Function ENC(ByVal i As Integer) As String
  1686.     If i = 0 Then
  1687.         ENC = "`"
  1688.     Else
  1689.         i = i + 32
  1690.         ENC = Chr(i)
  1691.     End If
  1692. End Function


  1693. 'Returns the filename part from a full filename.
  1694. Private Function StripFilename(ByVal Filename As String) As String
  1695.     While InStr(Filename, "") <> 0
  1696.         Filename = Right(Filename, Len(Filename) - InStr(Filename, ""))
  1697.     Wend
  1698.     StripFilename = Filename
  1699. End Function


  1700. Private Function UUEncodeFile(ByVal InputFilename As String, ByVal OutputFileName As String) As Boolean
  1701.     Dim TotalParts As Long
  1702.     Dim Remain As Long
  1703.     Dim InString As String
  1704.     Dim CurrentPos As Long
  1705.     Dim i As Long
  1706.     Dim FNumIn As Long
  1707.     Dim FNumOut As Long
  1708.      
  1709.     On Error GoTo ErrorHandler
  1710.      
  1711.     'Open the original file as binary read
  1712.     FNumIn = FreeFile
  1713.     Open InputFilename For Binary Access Read Shared As #FNumIn
  1714.      
  1715.     'Open the target file as binary write
  1716.     FNumOut = FreeFile
  1717.     Open OutputFileName For Binary Access Write As #FNumOut
  1718.      
  1719.     'Write the standard uuencode file header
  1720.     Put #FNumOut, , "begin 644 " + StripFilename(InputFilename) + vbCrLf

  1721.     'TotalParts equals the number of full sized chunks of "PortionSize" bytes.
  1722.     TotalParts = LOF(1) \ PortionSize

  1723.     'Remainder equals how many remaining bytes are at the end of the file.
  1724.     Remain = LOF(1) Mod PortionSize

  1725.     'CurrentPos is the current file position
  1726.     CurrentPos = 1

  1727.     'Set up InString as a buffer the size of PortionSize
  1728.     InString = String(PortionSize, 0)

  1729.     'For loop to read the portions one by one
  1730.     For i = 1 To TotalParts
  1731.         Get #FNumIn, CurrentPos, InString
  1732.         'use the ENC() for standard uuencode compatibility, pad "M"
  1733.         Put #FNumOut, , ENC(PortionSize) + EncodeString(InString) + vbCrLf
  1734.         CurrentPos = CurrentPos + PortionSize
  1735.         RaiseEvent EncodeProgress(CurrentPos / LOF(1), CurrentPos)
  1736.     Next
  1737.          
  1738.     'Set up InString again as a buffer the size of the remaining bytes
  1739.     InString = String(Remain, 0)
  1740.         
  1741.     'get the remaining bytes toward end of the file
  1742.     Get #FNumIn, CurrentPos, InString
  1743.          
  1744.     'get the remaining bytes size and calculate ENC() for the last line
  1745.     Put #FNumOut, , ENC(LOF(1) - CurrentPos + 1) + EncodeString(InString) + vbCrLf
  1746.      
  1747.     'put "end" for standard uuencode compatibility
  1748.     Put #FNumOut, , ENC(0) + vbCrLf + "end" + vbCrLf
  1749.      
  1750.     'All Done!
  1751.     Close #FNumIn
  1752.     Close #FNumOut
  1753.     UUEncodeFile = True
  1754.     Exit Function
  1755.      
  1756. ErrorHandler:
  1757.     Close #FNumIn
  1758.     Close #FNumOut
  1759.     UUEncodeFile = False
  1760. End Function


  1761. Private Function EncodeFile(sFileInput As String, dType As DecodeType, sFileOutput As String, Optional PrgBar As ProgressBar) As Byte()
  1762.     Dim pint As Integer
  1763.     Select Case dType
  1764.         Case uu
  1765.             Call UUEncodeFile(sFileInput, sFileOutput)
  1766.         Case base64
  1767.             EncodeFile = Base64EncodeFile(sFileInput, sFileOutput, PrgBar)
  1768.     End Select
  1769. End Function

  1770. Private Function GetTmpFile() As String
  1771.     Dim pstrTmpPath As String
  1772.     Dim pstrTmpFileName As String
  1773.      
  1774.     pstrTmpPath = String(100, Chr$(0))
  1775.     Call GetTempPath(100, pstrTmpPath)
  1776.     pstrTmpPath = Left$(pstrTmpPath, InStr(pstrTmpPath, Chr$(0)) - 1)
  1777.     pstrTmpFileName = String(260, 0)
  1778.     Call GetTempFileName(pstrTmpPath, "NPD", 0, pstrTmpFileName)
  1779.      
  1780.     GetTmpFile = Left$(pstrTmpFileName, InStr(pstrTmpFileName, Chr$(0)) - 1)

  1781. End Function


  1782. Public Sub AddAttachment(Filename As String, Optional PrgBar As ProgressBar)
  1783.     Static pintC As Integer
  1784.     Dim pintFF As Integer
  1785.     Dim pstrTMPFile As String
  1786.     Dim pstrBuffer() As Byte
  1787.     Dim pstrTotal As String
  1788.     Dim pstrHeader As String
  1789.      
  1790.     pintC = pintC + 1
  1791.     ReDim Preserve gstrFileNames(pintC)
  1792.     gstrFileNames(pintC) = Filename
  1793.     gblnAttachments = True
  1794.     pintFF = FreeFile
  1795.     ReDim Preserve FileCode(pintC)
  1796.     pstrTMPFile = GetTmpFile
  1797.      
  1798.     pstrBuffer = EncodeFile(gstrFileNames(pintC), base64, pstrTMPFile, PrgBar)
  1799.      
  1800.      
  1801.     pstrTotal = StrConv(pstrBuffer(), vbUnicode)
  1802.      
  1803.     pstrHeader = MIMEFileHeader(conBoundary, gstrFileNames(pintC))
  1804.     FileCode(pintC).Code = pstrHeader _
  1805.             & vbCrLf & pstrTotal & vbCrLf
  1806.     FileCode(pintC).Filename = gstrFileNames(pintC)
  1807.     FileCode(pintC).Send = True
  1808.     Kill pstrTMPFile
  1809.          
  1810. End Sub


  1811. Private Function EncodeArr(bInput() As Byte, Optional PrgBar As ProgressBar) As Byte()
  1812.    Dim bOutput() As Byte
  1813.    Dim k As Long
  1814.    Dim l As Long
  1815.    Dim i As Long
  1816.    Dim evenBound As Long
  1817.    Dim CurrentOut As Long
  1818.    Dim b As Byte
  1819.    Dim c As Byte
  1820.    Dim d As Byte
  1821.    Dim LineLength As Long
  1822.    
  1823.    k = LBound(bInput)
  1824.    l = UBound(bInput)
  1825.    
  1826.    'Calculate the input size
  1827.    i = l - k + 1
  1828.    
  1829.    'Calculate the output size
  1830.    Select Case i Mod 3
  1831.       Case 0:
  1832.          i = (i \ 3) * 4
  1833.          evenBound = l
  1834.       Case 1:
  1835.          i = ((i \ 3) * 4) + 4
  1836.          evenBound = l - 1
  1837.       Case 2:
  1838.          i = ((i \ 3) * 4) + 4
  1839.          evenBound = l - 2
  1840.       Case 3:
  1841.          i = ((i \ 3) * 4) + 4
  1842.          evenBound = l - 3
  1843.    End Select
  1844.    
  1845.    'Add in the line feeds.
  1846.    If i Mod MAX_LINELENGTH = 0 Then
  1847.       i = i + (i \ MAX_LINELENGTH) * 2 - 2
  1848.    Else
  1849.       i = i + (i \ MAX_LINELENGTH) * 2
  1850.    End If
  1851.    
  1852.    'Size the output array
  1853.    ReDim bOutput(0 To i - 1)
  1854.       
  1855.    CurrentOut = 0
  1856.    LineLength = 0
  1857.    
  1858.    On Error Resume Next
  1859.    PrgBar.Max = evenBound
  1860.    On Error GoTo 0
  1861.    
  1862.    For i = k To evenBound Step 3
  1863.       b = bInput(i)
  1864.       c = bInput(i + 1)
  1865.       d = bInput(i + 2)
  1866.       bOutput(CurrentOut) = m_Index1(b And &HFC)
  1867.       bOutput(CurrentOut + 1) = m_Index2((b And &H3) Or (c And &HF0))
  1868.       bOutput(CurrentOut + 2) = m_Index3((c And &HF) Or (d And &HC0))
  1869.       bOutput(CurrentOut + 3) = m_Index4(d And &H3F)
  1870.       CurrentOut = CurrentOut + 4
  1871.       LineLength = LineLength + 4
  1872.       
  1873.       If LineLength >= MAX_LINELENGTH Then
  1874.          If i <> l - 2 Then  ' If this is the last line, don't add crlf
  1875.             bOutput(CurrentOut) = CHAR_CR
  1876.             bOutput(CurrentOut + 1) = CHAR_LF
  1877.          End If
  1878.          CurrentOut = CurrentOut + 2
  1879.          LineLength = 0
  1880.       End If
  1881.       On Error Resume Next
  1882.       PrgBar.Value = i
  1883.       On Error GoTo 0
  1884.    Next i
  1885.    
  1886.    Select Case l - i
  1887.       Case 1:
  1888.          b = bInput(i)
  1889.          c = bInput(i + 1)
  1890.          d = 0
  1891.          bOutput(CurrentOut) = m_Index1(b And &HFC)
  1892.          bOutput(CurrentOut + 1) = m_Index2((b And &H3) Or (c And &HF0))
  1893.          bOutput(CurrentOut + 2) = m_Index3((c And &HF) Or (d And &HC0))
  1894.          bOutput(CurrentOut + 3) = CHAR_EQUAL
  1895.          CurrentOut = CurrentOut + 4
  1896.          LineLength = LineLength + 4
  1897.       Case 0:
  1898.          b = bInput(i)
  1899.          c = 0
  1900.          bOutput(CurrentOut) = m_Index1(b And &HFC)
  1901.          bOutput(CurrentOut + 1) = m_Index2((b And &H3) Or (c And &HF0))
  1902.          bOutput(CurrentOut + 2) = CHAR_EQUAL
  1903.          bOutput(CurrentOut + 3) = CHAR_EQUAL
  1904.          CurrentOut = CurrentOut + 4
  1905.          LineLength = LineLength + 4
  1906.    End Select
  1907.    
  1908.    EncodeArr = bOutput
  1909. End Function



  1910. ' Encode a string to a string.
  1911. Private Function Encode(sInput As String) As String
  1912.    Dim bTemp() As Byte
  1913.    
  1914.    'Convert to a byte array then convert.
  1915.    'This is faster the repetitive calls to asc() or chr$()
  1916.    bTemp = StrConv(sInput, vbFromUnicode)
  1917.    Encode = StrConv(EncodeArr(bTemp), vbUnicode)
  1918. End Function

  1919. Public Function EncodeStringBase64(pstrString) As String
  1920.      
  1921.     EncodeStringBase64 = Encode(Trim(pstrString))
  1922.    
  1923. End Function


  1924. Private Function Base64String(ByVal pstrCode As String) As String
  1925.      
  1926.     Base64String = Decode(Trim(pstrCode))
  1927.      
  1928. End Function

  1929. Private Function DecodeArr(bInput() As Byte) As Byte()
  1930.    Dim bOutput() As Byte
  1931.    Dim OutLength As Long
  1932.    Dim CurrentOut As Long
  1933.    
  1934.    Dim k As Long
  1935.    Dim l As Long
  1936.    Dim i As Long
  1937.    Dim j As Long
  1938.    
  1939.    Dim b As Byte
  1940.    Dim c As Byte
  1941.    Dim d As Byte
  1942.    Dim e As Byte
  1943.    
  1944.    On Error GoTo ErrorHandler
  1945.    
  1946.    k = LBound(bInput)
  1947.    l = UBound(bInput)
  1948.    
  1949.    'Calculate the length of the input
  1950.    i = l - k + 1
  1951.    
  1952.    'Calculate the expected length of the output
  1953.    'It should be no more (but may possible be less)
  1954.    j = i Mod (MAX_LINELENGTH + 2)
  1955.    If j = 0 Then
  1956.       OutLength = (i \ (MAX_LINELENGTH + 2)) * (MAX_LINELENGTH \ 4) * 3
  1957.    Else
  1958.       j = (j / 4) * 3
  1959.       If bInput(l) = CHAR_EQUAL Then j = j - 1
  1960.       If bInput(l - 1) = CHAR_EQUAL Then j = j - 1
  1961.       OutLength = (i \ (MAX_LINELENGTH + 2)) * (MAX_LINELENGTH \ 4) * 3 + j
  1962.    End If
  1963.    
  1964.    'Allocate the output
  1965.    ReDim bOutput(0 To OutLength - 1)
  1966.    
  1967.    CurrentOut = 0
  1968.    
  1969.    For i = k To l
  1970.       Select Case bInput(i)
  1971.          Case CHAR_CR
  1972.             'Do nothing
  1973.          Case CHAR_LF
  1974.             'Do nothing
  1975.          Case Else
  1976.             If l - i >= 3 Then
  1977.                b = bInput(i)
  1978.                c = bInput(i + 1)
  1979.                d = bInput(i + 2)
  1980.                e = bInput(i + 3)
  1981.                
  1982.                If e <> CHAR_EQUAL Then
  1983.                   
  1984.                   bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
  1985.                   bOutput(CurrentOut + 1) = m_ReverseIndex2(c, 1) Or m_ReverseIndex3(d, 0)
  1986.                   bOutput(CurrentOut + 2) = m_ReverseIndex3(d, 1) Or m_ReverseIndex4(e)
  1987.                   CurrentOut = CurrentOut + 3
  1988.                   i = i + 3
  1989.                ElseIf d <> CHAR_EQUAL Then
  1990.                   bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
  1991.                   bOutput(CurrentOut + 1) = m_ReverseIndex2(c, 1) Or m_ReverseIndex3(d, 0)
  1992.                   CurrentOut = CurrentOut + 2
  1993.                   i = i + 3
  1994.                Else
  1995.                   bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
  1996.                   CurrentOut = CurrentOut + 1
  1997.                   i = i + 3
  1998.                End If
  1999.                
  2000.             Else
  2001.                'Possible input code error, but may also be
  2002.                'an extra CrLf, so we will ignore it.
  2003.             End If
  2004.       End Select
  2005.    Next i
  2006.    
  2007.    'On properly formed input we should have to do this.
  2008.    If OutLength <> CurrentOut + 1 Then
  2009.       ReDim Preserve bOutput(0 To CurrentOut - 1)
  2010.    End If
  2011.    
  2012.    DecodeArr = bOutput
  2013.    
  2014.    Exit Function
  2015. ErrorHandler:
  2016.     If Err.Number = 9 Then
  2017.         Exit Function
  2018.     End If
  2019. End Function



  2020. 'Decode a string to a string.
  2021. Private Function Decode(sInput As String) As String
  2022.    Dim bTemp() As Byte
  2023.    
  2024.    'Convert to a byte array then convert.
  2025.    'This is faster the repetitive calls to asc() or chr$()
  2026.    bTemp = StrConv(sInput, vbFromUnicode)
  2027.    Decode = StrConv(DecodeArr(bTemp), vbUnicode)
  2028. End Function


  2029. Private Sub SocketSend(Socket As Winsock, Data As String)
  2030.     If gblnSSL Then
  2031.         Call SSLSend(Socket, Data)
  2032.     Else
  2033.         Socket.SendData Data
  2034.     End If
  2035. End Sub

  2036. Private Sub CertificateToPublicKey()

  2037.     'Create CryptoAPI Blob from Certificate
  2038.     Const lPbkLen As Long = 1024
  2039.     Dim lOffset As Long
  2040.     Dim lStart As Long
  2041.     Dim sBlkLen As String
  2042.     Dim sRevKey As String
  2043.     Dim ASNStart As Long
  2044.     Dim ASNKEY As String

  2045.     lOffset = CLng(lPbkLen \ 8)
  2046.     lStart = 5 + (lOffset \ 128) * 2

  2047.     ASNStart = InStr(1, ENCODED_CERT, Chr(48) & Chr(129) & Chr(137) & Chr(2) & Chr(129) & Chr(129) & Chr(0)) + lStart
  2048.     ASNKEY = Mid(ENCODED_CERT, ASNStart, 128)

  2049.     sRevKey = ReverseString(ASNKEY)

  2050.     sBlkLen = CStr(Hex(lPbkLen \ 256))
  2051.     If Len(sBlkLen) = 1 Then sBlkLen = "0" & sBlkLen

  2052.     PUBLIC_KEY = (HexToBin( _
  2053.             "06020000" & _
  2054.             "00A40000" & _
  2055.             "52534131" & _
  2056.             "00" & sBlkLen & "0000" & _
  2057.             "01000100") & sRevKey)

  2058. End Sub



  2059. Private Function VerifyMAC(ByVal DecryptedRecord As String) As Boolean

  2060.     'Verify the Message Authentication Code
  2061.     Dim PrependedMAC As String
  2062.     Dim RecordData As String
  2063.     Dim CalculatedMAC As String
  2064.      
  2065.     PrependedMAC = Mid(DecryptedRecord, 1, 16)
  2066.     RecordData = Mid(DecryptedRecord, 17)
  2067.      
  2068.     CalculatedMAC = MD5_Hash(CLIENT_READ_KEY & RecordData & RecvSequence)
  2069.      
  2070.     Call IncrementRecv

  2071.     If CalculatedMAC = PrependedMAC Then
  2072.         VerifyMAC = True
  2073.     Else
  2074.         VerifyMAC = False
  2075.     End If

  2076. End Function

  2077. Private Function SendSequence() As String
  2078.     'Convert Send Counter to a String
  2079.     Dim TempString As String
  2080.     Dim TempSequence As Double
  2081.     Dim TempByte As Double
  2082.     Dim i As Integer
  2083.      
  2084.     TempSequence = SEND_SEQUENCE_NUMBER
  2085.      
  2086.     For i = 1 To 4
  2087.         TempByte = 256 * ((TempSequence / 256) - Int(TempSequence / 256))
  2088.         TempSequence = Int(TempSequence / 256)
  2089.         TempString = Chr(TempByte) & TempString
  2090.     Next
  2091.      
  2092.     SendSequence = TempString

  2093. End Function

  2094. Private Function RecvSequence() As String
  2095. Dim i As Integer

  2096.     'Convert Receive Counter to a String
  2097.     Dim TempString As String
  2098.     Dim TempSequence As Double
  2099.     Dim TempByte As Double
  2100.      
  2101.     TempSequence = RECV_SEQUENCE_NUMBER
  2102.      
  2103.     For i = 1 To 4
  2104.         TempByte = 256 * ((TempSequence / 256) - Int(TempSequence / 256))
  2105.         TempSequence = Int(TempSequence / 256)
  2106.         TempString = Chr(TempByte) & TempString
  2107.     Next
  2108.      
  2109.     RecvSequence = TempString

  2110. End Function

  2111. Private Sub SendClientHello(ByRef Socket As Winsock)

  2112.     'Send Client Hello
  2113.     Layer = 0
  2114.      
  2115.     Call GenerateRandomBytes(16, CHALLENGE_DATA)
  2116.      
  2117.     SEND_SEQUENCE_NUMBER = 0
  2118.     RECV_SEQUENCE_NUMBER = 0
  2119.      
  2120.     CLIENT_HELLO = Chr(1) & _
  2121.                     Chr(0) & Chr(2) & _
  2122.                     Chr(0) & Chr(3) & _
  2123.                     Chr(0) & Chr(0) & _
  2124.                     Chr(0) & Chr(Len(CHALLENGE_DATA)) & _
  2125.                     Chr(1) & Chr(0) & Chr(128) & _
  2126.                     CHALLENGE_DATA

  2127.     If Socket.State = 7 Then Socket.SendData AddRecordHeader(CLIENT_HELLO)

  2128. End Sub

  2129. Private Sub SendMasterKey(ByRef Socket As Winsock)

  2130.     'Send Master Key
  2131.     Layer = 1
  2132.      
  2133.     Call GenerateRandomBytes(32, MASTER_KEY)

  2134.     Call CertificateToPublicKey

  2135.     Socket.SendData AddRecordHeader(Chr(2) & _
  2136.                                     Chr(1) & Chr(0) & Chr(128) & _
  2137.                                     Chr(0) & Chr(0) & _
  2138.                                     Chr(0) & Chr(128) & _
  2139.                                     Chr(0) & Chr(0) & _
  2140.                                     ExportKeyBlob(MASTER_KEY, CLIENT_READ_KEY, CLIENT_WRITE_KEY, CHALLENGE_DATA, CONNECTION_ID, PUBLIC_KEY))

  2141. End Sub

  2142. Private Sub SendClientFinish(ByRef Socket As Winsock)

  2143.     'Send ClientFinished Message
  2144.     Layer = 2
  2145.     Call SSLSend(Socket, Chr(3) & CONNECTION_ID)

  2146. End Sub

  2147. Private Sub SSLSend(ByRef Socket As Winsock, ByVal Plaintext As String)

  2148.     'Send Plaintext as an Encrypted SSL Record
  2149.     Dim SSLRecord As String
  2150.     Dim OtherPart As String
  2151.     Dim SendAnother As Boolean
  2152.      
  2153.     If Len(Plaintext) > 32751 Then
  2154.         SendAnother = True
  2155.         Plaintext = Mid(Plaintext, 1, 32751)
  2156.         OtherPart = Mid(Plaintext, 32752)
  2157.     Else
  2158.         SendAnother = False
  2159.     End If
  2160.      
  2161.     SSLRecord = AddMACData(Plaintext)
  2162.     SSLRecord = RC4_Encrypt(SSLRecord)
  2163.     SSLRecord = AddRecordHeader(SSLRecord)
  2164.      
  2165.     Socket.SendData SSLRecord
  2166.      
  2167.     If SendAnother = True Then
  2168.         Call SSLSend(Socket, OtherPart)
  2169.     End If

  2170. End Sub

  2171. Private Function AddMACData(ByVal Plaintext As String) As String

  2172.     'Prepend MAC Data to the Plaintext
  2173.     AddMACData = MD5_Hash(CLIENT_WRITE_KEY & Plaintext & SendSequence) & Plaintext

  2174. End Function

  2175. Private Function AddRecordHeader(ByVal RecordData As String) As String

  2176.     'Prepend SLL Record Header to the Data Record
  2177.     Dim FirstChar As String
  2178.     Dim LastChar As String
  2179.     Dim TheLen As Long
  2180.          
  2181.     TheLen = Len(RecordData)
  2182.      
  2183.     FirstChar = Chr(128 + (TheLen \ 256))
  2184.     LastChar = Chr(TheLen Mod 256)

  2185.     AddRecordHeader = FirstChar & LastChar & RecordData
  2186.      
  2187.     Call IncrementSend

  2188. End Function

  2189. Private Sub IncrementSend()

  2190.     'Increment Counter for Each Record Sent
  2191.     SEND_SEQUENCE_NUMBER = SEND_SEQUENCE_NUMBER + 1
  2192.     If SEND_SEQUENCE_NUMBER = 4294967296# Then SEND_SEQUENCE_NUMBER = 0

  2193. End Sub

  2194. Private Sub IncrementRecv()

  2195.     'Increment Counter for Each Record Received
  2196.     RECV_SEQUENCE_NUMBER = RECV_SEQUENCE_NUMBER + 1
  2197.     If RECV_SEQUENCE_NUMBER = 4294967296# Then RECV_SEQUENCE_NUMBER = 0

  2198. End Sub

  2199. Private Function BytesToLen(ByVal TwoBytes As String) As Long

  2200.     'Convert Byte Pair to Packet Length
  2201.     Dim FirstByteVal As Long
  2202.     FirstByteVal = Asc(Left(TwoBytes, 1))
  2203.     If FirstByteVal >= 128 Then FirstByteVal = FirstByteVal - 128
  2204.      
  2205.     BytesToLen = 256 * FirstByteVal + Asc(Right(TwoBytes, 1))

  2206. End Function

  2207. Private Function HexToBin(ByVal HexString As String) As String

  2208.     'Convert a Hexadecimal String to characters
  2209.     Dim BinString As String
  2210.     Dim i As Integer

  2211.     For i = 1 To Len(HexString) Step 2
  2212.         BinString = BinString & Chr(Val("&H" & Mid(HexString, i, 2)))
  2213.     Next i
  2214.      
  2215.     HexToBin = BinString

  2216. End Function

  2217. Private Function ReverseString(ByVal TheString As String) As String

  2218.     'Reverse String
  2219.     Dim Reversed As String
  2220.     Dim i As Integer

  2221.     For i = Len(TheString) To 1 Step -1
  2222.         Reversed = Reversed & Mid(TheString, i, 1)
  2223.     Next i
  2224.     ReverseString = Reversed

  2225. End Function

  2226. Private Sub ProcessData(ByVal TheData As String, Socket As Winsock)
  2227.     Dim pblnStatus As Boolean
  2228.      
  2229.     Debug.Print TheData
  2230.      
  2231.     Select Case State
  2232.         Case Connect
  2233.             pblnStatus = CheckResponse(TheData, "220", Socket)
  2234.             Call SocketSend(Socket, "HELO" & gstrDomainName & vbCrLf)
  2235.             If pblnStatus = True Then
  2236.                 State = State + 1
  2237.             Else
  2238.                 Socket.Close
  2239.                 State = 0
  2240.                 gblnDone = True
  2241.             End If
  2242.         Case helo
  2243.             pblnStatus = CheckResponse(TheData, "250", Socket)
  2244.             If pblnStatus = True Then
  2245.                 Call SocketSend(Socket, "MAIL FROM: " & gstrFromAddress & vbCrLf)
  2246.                 State = State + 1
  2247.             Else
  2248.                 Socket.Close
  2249.                 State = 0
  2250.                 gblnDone = True
  2251.                 Exit Sub
  2252.             End If
  2253.         Case MailFrom
  2254.             pblnStatus = CheckResponse(TheData, "250", Socket)
  2255.             If pblnStatus = True Then
  2256.                 If gintSent > UBound(gstrAllAddresses) And gblnBCCMode = False And gstrAllAddresses(0) <> "" Then
  2257.                     gintsentTo = 0
  2258.                     gintsentCC = 0
  2259.                     State = State + 1
  2260.                     Call ProcessData("250 ", Socket)
  2261.                 Else
  2262.                     If gstrAllAddresses(0) = "" Then
  2263.                         gblnDone = True
  2264.                         Exit Sub
  2265.                     End If
  2266.                     If gblnBCCMode = True Then
  2267.                         pintSend = 0
  2268.                         gintSent = 0
  2269.                     End If
  2270.                     Call SocketSend(Socket, "RCPT TO:" & gstrAllAddresses(gintSent) & vbCrLf)
  2271.                 End If
  2272.                 If gblnBCCMode Then
  2273.                     State = State + 1
  2274.                     gintSent = 0
  2275.                 Else
  2276.                     gintSent = gintSent + 1
  2277.                 End If
  2278.             Else
  2279.                 If Left(TheData, 3) = "530" Then
  2280.                     Call SocketSend(Socket, "AUTH LOGIN" & vbCrLf)
  2281.                 ElseIf Left(TheData, 3) = "334" Then
  2282.                     Dim pstrIn As String
  2283.                     Dim pstrAnswer As String
  2284.                     pstrIn = Mid(TheData, 4)
  2285.                     pstrIn = Left(pstrIn, Len(pstrIn) - 2)
  2286.                     pstrIn = Base64String(Trim(pstrIn))
  2287.                     If InStr(LCase(pstrIn), "user") Then
  2288.                         pstrAnswer = gstrUserID
  2289.                         pstrAnswer = EncodeStringBase64(gstrUserID)
  2290.                     ElseIf InStr(LCase(pstrIn), "pass") Then
  2291.                         pstrAnswer = gstrUserPass
  2292.                         pstrAnswer = EncodeStringBase64(pstrAnswer)
  2293.                     End If
  2294.                     Call SocketSend(Socket, pstrAnswer & vbCrLf)
  2295.                     ElseIf Left(TheData, 3) = "501" Then
  2296.                         gblnDone = True
  2297.                     ElseIf Left(TheData, 3) = "235" Then
  2298.                         Call SocketSend(Socket, "MAIL FROM: " & gstrFromAddress & vbCrLf)
  2299.                         State = MailFrom
  2300.                     End If
  2301.                 End If
  2302.         Case SendTo
  2303.             Call SocketSend(Socket, "DATA" & vbCrLf)
  2304.             State = State + 1
  2305.         Case Data
  2306.             Call RTBX.LoadFile(gstrMessageFileName, rtfText)
  2307.             If gblnBCCMode = True Then
  2308.                 Dim pintLine As Integer
  2309.                 Dim pintPos As Integer
  2310.                 Dim pintStringStart As Integer
  2311.                 Dim pintStringEnd As Integer
  2312.                 With RTBX
  2313.                     pintPos = .Find("CC: ")
  2314.                     pintLine = .GetLineFromChar(pintPos)
  2315.                     pintStringEnd = InStr(pintPos, .Text, vbCrLf)
  2316.                     .SelStart = pintPos
  2317.                     .SelLength = pintStringEnd - pintPos
  2318.                     .SelText = "CC: "
  2319.                     pintPos = .Find("TO: ")
  2320.                     pintLine = .GetLineFromChar(pintPos)
  2321.                     pintStringEnd = InStr(pintPos, .Text, vbCrLf)
  2322.                     .SelStart = pintPos
  2323.                     .SelLength = pintStringEnd - pintPos
  2324.                     .SelText = "TO: " & gstrAllAddresses(0)
  2325.                 End With
  2326.             End If
  2327.             gstrData = Split(RTBX.Text, vbCrLf)
  2328.             If gstrBCC(0) <> "" Then
  2329.                 ProgBar.Max = (UBound(gstrData) * (UBound(gstrBCC) + 1))
  2330.             Else
  2331.                 ProgBar.Max = UBound(gstrData)
  2332.             End If
  2333.             For pintSend = 0 To UBound(gstrData)
  2334.                 Call SocketSend(Socket, gstrData(pintSend) & vbCrLf)
  2335.                 On Error Resume Next
  2336.                 ProgBar.Value = gintTransfer
  2337.                 gintTransfer = gintTransfer + 1
  2338.                 On Error GoTo 0
  2339.                 DoEvents
  2340.             Next pintSend
  2341.             State = State + 1
  2342.             Call SocketSend(Socket, vbCrLf & "." & vbCrLf)
  2343.         Case MessageData
  2344.             gblnDone = True
  2345.             State = State + 1
  2346.      
  2347.     End Select
  2348.             
  2349. End Sub

  2350. Private Function CheckResponse(pstrGot, PstrExpect, Socket As Winsock) As Boolean
  2351.     Dim pstrResp As String
  2352.      
  2353.     pstrResp = Mid(pstrGot, 1, 3)
  2354.      
  2355.     If StrComp(pstrResp, PstrExpect) = 0 Then
  2356.         CheckResponse = True
  2357.     Else
  2358.         CheckResponse = False
  2359.     End If

  2360. End Function

  2361. Private Function RC4_Encrypt(ByVal Plaintext As String) As String

  2362.     'Encrypt with Client Write Key
  2363.     Dim lngLength As Long
  2364.     Dim lngReturnValue As Long
  2365.      
  2366.     lngLength = Len(Plaintext)
  2367.     lngReturnValue = CryptEncrypt(hClientWriteKey, 0, False, 0, Plaintext, lngLength, lngLength)

  2368.     RC4_Encrypt = Plaintext

  2369. End Function


  2370. Private Function RC4_Decrypt(ByVal Ciphertext As String) As String

  2371.     'Decrypt with Client Read Key
  2372.     Dim lngLength As Long
  2373.     Dim lngReturnValue As Long
  2374.      
  2375.     lngLength = Len(Ciphertext)
  2376.     lngReturnValue = CryptDecrypt(hClientReadKey, 0, False, 0, Ciphertext, lngLength)

  2377.     RC4_Decrypt = Ciphertext

  2378. End Function


  2379. Private Function MD5_Hash(ByVal TheString As String) As String

  2380.     'Digest a String using MD5
  2381.     Dim lngReturnValue As Long
  2382.     Dim strHash As String
  2383.     Dim hHash As Long
  2384.     Dim lngHashLen As Long
  2385.      
  2386.     lngReturnValue = CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash)
  2387.     lngReturnValue = CryptHashData(hHash, TheString, Len(TheString), 0)
  2388.     lngReturnValue = CryptGetHashParam(hHash, HP_HASHVAL, vbNull, lngHashLen, 0)
  2389.     strHash = String(lngHashLen, vbNullChar)
  2390.     lngReturnValue = CryptGetHashParam(hHash, HP_HASHVAL, strHash, lngHashLen, 0)
  2391.      
  2392.     If hHash <> 0 Then CryptDestroyHash hHash
  2393.      
  2394.     MD5_Hash = strHash

  2395. End Function

  2396. Private Function GenerateRandomBytes(ByVal Length As Long, ByRef TheString As String) As Boolean

  2397.     'Generate Random Bytes
  2398.     Dim i As Integer

  2399.     Randomize
  2400.     TheString = ""
  2401.     For i = 1 To Length
  2402.         TheString = TheString & Chr(Int(Rnd * 256))
  2403.     Next
  2404.      
  2405.     GenerateRandomBytes = CryptGenRandom(hCryptProv, Length, TheString)

  2406. End Function


  2407. Private Function ExportKeyBlob(ByRef StrMasterKey As String, ByRef StrReadKey As String, ByRef StrWriteKey As String, ByVal StrChallenge As String, ByVal StrConnectionID As String, ByVal StrPublicKey As String) As String

  2408.     'Create Keys and Return PKCS Block
  2409.     Dim lngReturnValue As Long
  2410.     Dim lngLength As Long
  2411.     Dim rgbBlob As String
  2412.     Dim hPublicKey As Long
  2413.      
  2414.     Call CreateKey(hMasterKey, StrMasterKey)
  2415.     StrMasterKey = MD5_Hash(StrMasterKey)
  2416.      
  2417.     Call CreateKey(hClientReadKey, StrMasterKey & "0" & StrChallenge & StrConnectionID)
  2418.     Call CreateKey(hClientWriteKey, StrMasterKey & "1" & StrChallenge & StrConnectionID)
  2419.      
  2420.     StrReadKey = MD5_Hash(StrMasterKey & "0" & StrChallenge & StrConnectionID)
  2421.     StrWriteKey = MD5_Hash(StrMasterKey & "1" & StrChallenge & StrConnectionID)

  2422.     lngReturnValue = CryptImportKey(hCryptProv, StrPublicKey, Len(StrPublicKey), 0, 0, hPublicKey)

  2423.     lngReturnValue = CryptExportKey(hMasterKey, hPublicKey, SIMPLEBLOB, 0, vbNull, lngLength)
  2424.     rgbBlob = String(lngLength, 0)
  2425.     lngReturnValue = CryptExportKey(hMasterKey, hPublicKey, SIMPLEBLOB, 0, rgbBlob, lngLength)
  2426.      
  2427.     If hPublicKey <> 0 Then CryptDestroyKey hPublicKey
  2428.     If hMasterKey <> 0 Then CryptDestroyKey hMasterKey

  2429.     ExportKeyBlob = StrReverse(Right(rgbBlob, 128))

  2430. End Function


  2431. Private Sub CreateKey(ByRef KeyName As Long, ByVal HashData As String)

  2432.     'Create a Session Key from a Hash
  2433.     Dim lngParams As Long
  2434.     Dim lngReturnValue As Long
  2435.     Dim lngHashLen As Long
  2436.     Dim hHash As Long
  2437.      
  2438.     lngReturnValue = CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash)
  2439.     If lngReturnValue = 0 Then Err.Raise Err.LastDllError, , "Could not create a Hash Object (CryptCreateHash API)"
  2440.      
  2441.     lngReturnValue = CryptHashData(hHash, HashData, Len(HashData), 0)
  2442.     If lngReturnValue = 0 Then Err.Raise Err.LastDllError, , "Could not calculate a Hash Value (CryptHashData API)"
  2443.      
  2444.     lngParams = GEN_KEY_BITS Or CRYPT_EXPORTABLE
  2445.     lngReturnValue = CryptDeriveKey(hCryptProv, CALG_RC4, hHash, lngParams, KeyName)
  2446.     If lngReturnValue = 0 Then Err.Raise Err.LastDllError, , "Could not create a session key (CryptDeriveKey API)"
  2447.      
  2448.     If hHash <> 0 Then CryptDestroyHash hHash
  2449.      
  2450. End Sub

  2451. Private Sub Class_Initialize()

  2452.     'Initiate Secure Session
  2453.     Dim lngReturnValue As Long
  2454.     Dim TheAnswer As Long
  2455.      
  2456.     lngReturnValue = CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, CRYPT_NEWKEYSET) 'try to make a new key container
  2457.      
  2458.     If lngReturnValue = 0 Then
  2459.         lngReturnValue = CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, 0) 'try to get a handle to a key container that already exists, and if it fails...
  2460.         If lngReturnValue = 0 Then TheAnswer = MsgBox("GCN has detected that you do not have the required High Encryption Pack installed." & vbCrLf & "Would like to download this pack from Microsoft's website?", 16 + vbYesNo)
  2461.     End If
  2462.      
  2463. '    If TheAnswer = vbYes Then
  2464. '        Call Shell("START http://www.microsoft.com/windows/ie/downloads/recommended/128bit/default.asp", vbHide)
  2465. '        SocketSSL_Close
  2466. '    End If
  2467. '
  2468. '    If TheAnswer = vbNo Then
  2469. '        SocketSSL_Close
  2470. '    End If

  2471.    Dim i As Long
  2472.    
  2473.    'Setup the encodeing and decoding lookup arrays.
  2474.    'Essentially we speed up the routine by pre-shifting
  2475.    'the data so it only needs combined with And and Or.
  2476.    m_Index4(0) = 65 'Asc("A")
  2477.    m_Index4(1) = 66 'Asc("B")
  2478.    m_Index4(2) = 67 'Asc("C")
  2479.    m_Index4(3) = 68 'Asc("D")
  2480.    m_Index4(4) = 69 'Asc("E")
  2481.    m_Index4(5) = 70 'Asc("F")
  2482.    m_Index4(6) = 71 'Asc("G")
  2483.    m_Index4(7) = 72 'Asc("H")
  2484.    m_Index4(8) = 73 'Asc("I")
  2485.    m_Index4(9) = 74 'Asc("J")
  2486.    m_Index4(10) = 75 'Asc("K")
  2487.    m_Index4(11) = 76 'Asc("L")
  2488.    m_Index4(12) = 77 'Asc("M")
  2489.    m_Index4(13) = 78 'Asc("N")
  2490.    m_Index4(14) = 79 'Asc("O")
  2491.    m_Index4(15) = 80 'Asc("P")
  2492.    m_Index4(16) = 81 'Asc("Q")
  2493.    m_Index4(17) = 82 'Asc("R")
  2494.    m_Index4(18) = 83 'Asc("S")
  2495.    m_Index4(19) = 84 'Asc("T")
  2496.    m_Index4(20) = 85 'Asc("U")
  2497.    m_Index4(21) = 86 'Asc("V")
  2498.    m_Index4(22) = 87 'Asc("W")
  2499.    m_Index4(23) = 88 'Asc("X")
  2500.    m_Index4(24) = 89 'Asc("Y")
  2501.    m_Index4(25) = 90 'Asc("Z")
  2502.    m_Index4(26) = 97 'Asc("a")
  2503.    m_Index4(27) = 98 'Asc("b")
  2504.    m_Index4(28) = 99 'Asc("c")
  2505.    m_Index4(29) = 100 'Asc("d")
  2506.    m_Index4(30) = 101 'Asc("e")
  2507.    m_Index4(31) = 102 'Asc("f")
  2508.    m_Index4(32) = 103 'Asc("g")
  2509.    m_Index4(33) = 104 'Asc("h")
  2510.    m_Index4(34) = 105 'Asc("i")
  2511.    m_Index4(35) = 106 'Asc("j")
  2512.    m_Index4(36) = 107 'Asc("k")
  2513.    m_Index4(37) = 108 'Asc("l")
  2514.    m_Index4(38) = 109 'Asc("m")
  2515.    m_Index4(39) = 110 'Asc("n")
  2516.    m_Index4(40) = 111 'Asc("o")
  2517.    m_Index4(41) = 112 'Asc("p")
  2518.    m_Index4(42) = 113 'Asc("q")
  2519.    m_Index4(43) = 114 'Asc("r")
  2520.    m_Index4(44) = 115 'Asc("s")
  2521.    m_Index4(45) = 116 'Asc("t")
  2522.    m_Index4(46) = 117 'Asc("u")
  2523.    m_Index4(47) = 118 'Asc("v")
  2524.    m_Index4(48) = 119 'Asc("w")
  2525.    m_Index4(49) = 120 'Asc("x")
  2526.    m_Index4(50) = 121 'Asc("y")
  2527.    m_Index4(51) = 122 'Asc("z")
  2528.    m_Index4(52) = 48 'Asc("0")
  2529.    m_Index4(53) = 49 'Asc("1")
  2530.    m_Index4(54) = 50 'Asc("2")
  2531.    m_Index4(55) = 51 'Asc("3")
  2532.    m_Index4(56) = 52 'Asc("4")
  2533.    m_Index4(57) = 53 'Asc("5")
  2534.    m_Index4(58) = 54 'Asc("6")
  2535.    m_Index4(59) = 55 'Asc("7")
  2536.    m_Index4(60) = 56 'Asc("8")
  2537.    m_Index4(61) = 57 'Asc("9")
  2538.    m_Index4(62) = 43 'Asc("+")
  2539.    m_Index4(63) = 47 'Asc("/")
  2540.    
  2541.    'Calculate the other Arrays
  2542.    For i = 0 To 63
  2543.       m_Index1((i * 4) And &HFC) = m_Index4(i)
  2544.       m_Index2(((i And &HF) * 16) Or ((i And &H30) \ 16)) = m_Index4(i)
  2545.       m_Index3((i \ 4 And &HF) Or ((i And &H3) * 64)) = m_Index4(i)
  2546.    Next i
  2547.    
  2548.    
  2549.    m_ReverseIndex4(65) = 0 'Asc("A")
  2550.    m_ReverseIndex4(66) = 1 'Asc("B")
  2551.    m_ReverseIndex4(67) = 2 'Asc("C")
  2552.    m_ReverseIndex4(68) = 3 'Asc("D")
  2553.    m_ReverseIndex4(69) = 4 'Asc("E")
  2554.    m_ReverseIndex4(70) = 5 'Asc("F")
  2555.    m_ReverseIndex4(71) = 6 'Asc("G")
  2556.    m_ReverseIndex4(72) = 7 'Asc("H")
  2557.    m_ReverseIndex4(73) = 8 'Asc("I")
  2558.    m_ReverseIndex4(74) = 9 'Asc("J")
  2559.    m_ReverseIndex4(75) = 10 'Asc("K")
  2560.    m_ReverseIndex4(76) = 11 'Asc("L")
  2561.    m_ReverseIndex4(77) = 12 'Asc("M")
  2562.    m_ReverseIndex4(78) = 13 'Asc("N")
  2563.    m_ReverseIndex4(79) = 14 'Asc("O")
  2564.    m_ReverseIndex4(80) = 15 'Asc("P")
  2565.    m_ReverseIndex4(81) = 16 'Asc("Q")
  2566.    m_ReverseIndex4(82) = 17 'Asc("R")
  2567.    m_ReverseIndex4(83) = 18 'Asc("S")
  2568.    m_ReverseIndex4(84) = 19 'Asc("T")
  2569.    m_ReverseIndex4(85) = 20 'Asc("U")
  2570.    m_ReverseIndex4(86) = 21 'Asc("V")
  2571.    m_ReverseIndex4(87) = 22 'Asc("W")
  2572.    m_ReverseIndex4(88) = 23 'Asc("X")
  2573.    m_ReverseIndex4(89) = 24 'Asc("Y")
  2574.    m_ReverseIndex4(90) = 25 'Asc("Z")
  2575.    m_ReverseIndex4(97) = 26 'Asc("a")
  2576.    m_ReverseIndex4(98) = 27 'Asc("b")
  2577.    m_ReverseIndex4(99) = 28 'Asc("c")
  2578.    m_ReverseIndex4(100) = 29 'Asc("d")
  2579.    m_ReverseIndex4(101) = 30 'Asc("e")
  2580.    m_ReverseIndex4(102) = 31 'Asc("f")
  2581.    m_ReverseIndex4(103) = 32 'Asc("g")
  2582.    m_ReverseIndex4(104) = 33 'Asc("h")
  2583.    m_ReverseIndex4(105) = 34 'Asc("i")
  2584.    m_ReverseIndex4(106) = 35 'Asc("j")
  2585.    m_ReverseIndex4(107) = 36 'Asc("k")
  2586.    m_ReverseIndex4(108) = 37 'Asc("l")
  2587.    m_ReverseIndex4(109) = 38 'Asc("m")
  2588.    m_ReverseIndex4(110) = 39 'Asc("n")
  2589.    m_ReverseIndex4(111) = 40 'Asc("o")
  2590.    m_ReverseIndex4(112) = 41 'Asc("p")
  2591.    m_ReverseIndex4(113) = 42 'Asc("q")
  2592.    m_ReverseIndex4(114) = 43 'Asc("r")
  2593.    m_ReverseIndex4(115) = 44 'Asc("s")
  2594.    m_ReverseIndex4(116) = 45 'Asc("t")
  2595.    m_ReverseIndex4(117) = 46 'Asc("u")
  2596.    m_ReverseIndex4(118) = 47 'Asc("v")
  2597.    m_ReverseIndex4(119) = 48 'Asc("w")
  2598.    m_ReverseIndex4(120) = 49 'Asc("x")
  2599.    m_ReverseIndex4(121) = 50 'Asc("y")
  2600.    m_ReverseIndex4(122) = 51 'Asc("z")
  2601.    m_ReverseIndex4(48) = 52 'Asc("0")
  2602.    m_ReverseIndex4(49) = 53 'Asc("1")
  2603.    m_ReverseIndex4(50) = 54 'Asc("2")
  2604.    m_ReverseIndex4(51) = 55 'Asc("3")
  2605.    m_ReverseIndex4(52) = 56 'Asc("4")
  2606.    m_ReverseIndex4(53) = 57 'Asc("5")
  2607.    m_ReverseIndex4(54) = 58 'Asc("6")
  2608.    m_ReverseIndex4(55) = 59 'Asc("7")
  2609.    m_ReverseIndex4(56) = 60 'Asc("8")
  2610.    m_ReverseIndex4(57) = 61 'Asc("9")
  2611.    m_ReverseIndex4(43) = 62 'Asc("+")
  2612.    m_ReverseIndex4(47) = 63 'Asc("/")
  2613.    
  2614.    'Calculate the other arrays.
  2615.    For i = 0 To 255
  2616.       If m_ReverseIndex4(i) <> 0 Then
  2617.          m_ReverseIndex1(i) = m_ReverseIndex4(i) * 4
  2618.          
  2619.          m_ReverseIndex2(i, 0) = m_ReverseIndex4(i) \ 16
  2620.          m_ReverseIndex2(i, 1) = (m_ReverseIndex4(i) And &HF) * 16
  2621.          
  2622.          m_ReverseIndex3(i, 0) = m_ReverseIndex4(i) \ 4
  2623.          m_ReverseIndex3(i, 1) = (m_ReverseIndex4(i) And &H3) * 64
  2624.       End If
  2625.    Next i
  2626.    
  2627. End Sub

  2628. Private Sub Class_Terminate()

  2629.     'Free up Memory
  2630.     If hClientWriteKey <> 0 Then CryptDestroyKey hClientWriteKey
  2631.     If hClientReadKey <> 0 Then CryptDestroyKey hClientReadKey
  2632.     If hCryptProv <> 0 Then CryptReleaseContext hCryptProv, 0
  2633.      
  2634.     Set SocketSSL = Nothing
  2635.     Set RTBX = Nothing
  2636.      
  2637. End Sub


  2638. Private Sub SocketSSL_Close()

  2639.     'Close Socket
  2640.     Layer = 0
  2641.     SocketSSL.Close
  2642.     gblnConnected = False
  2643.      
  2644. End Sub

  2645. Private Sub SocketSSL_Connect()
  2646. Dim strHello As String

  2647.     State = Connect
  2648.      
  2649. ' Added by GioRock
  2650. '--------------------------------------------------------------'
  2651.     If InStr(gstrUserID, "@") <> 0 Then
  2652.         strHello = Left$(gstrUserID, InStr(gstrUserID, "@") - 1)
  2653.     Else
  2654.         strHello = gstrUserID
  2655.     End If
  2656.      
  2657.     SocketSSL.SendData "EHLO " + strHello + vbCrLf
  2658. '--------------------------------------------------------------'
  2659.      
  2660.     gblnConnected = True
  2661.      
  2662. End Sub

  2663. Public Function ConnectSSLSocket() As Integer
  2664.     Dim pintC As Integer
  2665.      
  2666.     With SocketSSL
  2667.         .Close
  2668.         .Protocol = sckTCPProtocol
  2669.         .Connect gstrServerName, glngPort
  2670.     End With
  2671.      
  2672.     Do
  2673.         DoEvents
  2674.         If gblnConnected = True Then Exit Do
  2675.     Loop
  2676.      
  2677.     Do
  2678.         DoEvents
  2679.         If gblnDone = True Then Exit Do
  2680.     Loop
  2681.      
  2682.     ReDim gstrCC(0)
  2683.     ReDim gstrToAddress(0)
  2684.     ReDim gstrAllAddresses(0)
  2685.      
  2686.     pintC = 0
  2687.      
  2688.     On Error Resume Next
  2689.      
  2690.     On Error GoTo 0
  2691.      
  2692.     Do Until pintC > UBound(gstrBCC)
  2693.         gblnBCCMode = True
  2694.         If gstrBCC(pintC) = "" Or gstrBCC(pintC) = "<>" Then
  2695.             Exit Do
  2696.         End If
  2697.         gstrAllAddresses(0) = gstrBCC(pintC)
  2698.         gblnDone = False
  2699.         State = helo
  2700.         Call ProcessData("250", SocketSSL)
  2701.         Do
  2702.             DoEvents
  2703.         Loop Until gblnDone = True
  2704.         pintC = pintC + 1
  2705.     Loop
  2706.      
  2707.     SocketSSL.Close
  2708.      
  2709.     gblnBCCMode = False
  2710.      
  2711. End Function

  2712. Private Sub SocketSSL_ConnectionRequest(ByVal requestID As Long)

  2713. End Sub

  2714. Private Sub SocketSSL_DataArrival(ByVal bytesTotal As Long)

  2715.     'Parse each SSL Record
  2716.     Dim TheData As String
  2717.     Static lCMDSequence As Long

  2718. ' Added by Giorock
  2719. '---------------------------------------------------------'
  2720.     ' Starting a Secure Socket Layer connection
  2721.     If lCMDSequence <> 3 Then
  2722.         Select Case lCMDSequence
  2723.             Case 0
  2724.                 SocketSSL.GetData TheData, vbString
  2725. '                wsSSL.SendData "EHLO giorock" + vbCrLf
  2726. '                Send on Connect Event
  2727.             Case 1
  2728.                 SocketSSL.GetData TheData, vbString
  2729.                 SocketSSL.SendData "STARTTLS" + vbCrLf
  2730.             Case 2
  2731.                 SocketSSL.GetData TheData, vbString
  2732.                 SendClientHello SocketSSL
  2733.         End Select
  2734.         lCMDSequence = lCMDSequence + 1
  2735.         Debug.Print TheData
  2736.         Exit Sub
  2737.     End If
  2738. '---------------------------------------------------------'
  2739.      
  2740.     Do
  2741.      
  2742.         If SeekLen = 0 Then
  2743.             If bytesTotal >= 2 Then
  2744.                 SocketSSL.GetData TheData, vbString, 2
  2745.                 SeekLen = BytesToLen(TheData)
  2746.                 bytesTotal = bytesTotal - 2
  2747.             Else
  2748.                 Exit Sub
  2749.             End If
  2750.         End If
  2751.          
  2752.         If bytesTotal >= SeekLen Then
  2753.             SocketSSL.GetData TheData, vbString, SeekLen
  2754.             bytesTotal = bytesTotal - SeekLen
  2755.         Else
  2756.             Exit Sub
  2757.         End If
  2758.          
  2759.         Debug.Print "Layer -> " & Layer
  2760.          
  2761.         Select Case Layer
  2762.             Case 0:
  2763.                 ENCODED_CERT = Mid(TheData, 12, BytesToLen(Mid(TheData, 6, 2)))
  2764.                 CONNECTION_ID = Right(TheData, BytesToLen(Mid(TheData, 10, 2)))
  2765.                 Call IncrementRecv
  2766.                 Call SendMasterKey(SocketSSL)
  2767.             Case 1:
  2768.                 TheData = RC4_Decrypt(TheData)
  2769.                 If Right(TheData, Len(CHALLENGE_DATA)) = CHALLENGE_DATA Then
  2770.                     If VerifyMAC(TheData) Then Call SendClientFinish(SocketSSL)
  2771.                 Else
  2772.                     SocketSSL.Close
  2773.                 End If
  2774.              Case 2:
  2775.                 TheData = RC4_Decrypt(TheData)
  2776.                 If VerifyMAC(TheData) = False Then
  2777.                     SocketSSL.Close
  2778.                 Else
  2779. ' Added by Giorock
  2780. '-----------------------------------------------------------'
  2781.                     State = MailFrom
  2782.                     SSLSend SocketSSL, "AUTH LOGIN" + vbCrLf
  2783. '-----------------------------------------------------------'
  2784.                 End If
  2785.                 Layer = 3
  2786.              Case 3
  2787.                 TheData = RC4_Decrypt(TheData)
  2788.                 If VerifyMAC(TheData) Then
  2789.                     Call ProcessData(Mid(TheData, 17), SocketSSL)
  2790.                 End If
  2791.         End Select
  2792.      
  2793.         SeekLen = 0

  2794.     Loop Until bytesTotal = 0

  2795. End Sub

  2796. Private Sub SocketSSL_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  2797.     MsgBox Number & " " & Description, vbCritical
  2798.     SocketSSL_Close
  2799. End Sub

  2800. Private Sub SocketSSL_SendComplete()

  2801. End Sub

  2802. Private Sub SocketSSL_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)

  2803. End Sub
复制代码

点评

挖塞,这么多行……  发表于 2011-5-1 11:31

评分

参与人数 1金钱 +4 人气 +1 收起 理由
yimins + 4 + 1 Mark

查看全部评分

发表于 2011-4-30 08:20:29 | 显示全部楼层
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=71899&lngWId=1

SSL eMail Sender
Submitted on: 3/27/2009 8:34:49 AM
By: GioRock  
回复 支持 反对

使用道具 举报

发表于 2011-5-1 06:12:04 | 显示全部楼层
不知道支不支持 SSL3.0,等有时间研究一下
回复 支持 反对

使用道具 举报

发表于 2011-5-2 12:57:11 | 显示全部楼层
本帖最后由 a8888123 于 2011-5-2 13:01 编辑

有示例就好,不知道怎么用。

怎么还要添加控作RichTextBox,winsock,等。
回复 支持 反对

使用道具 举报

发表于 2011-5-9 08:58:34 | 显示全部楼层
回复 a8888123 的帖子


http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=71899&lngWId=1

SSL eMail Sender
Submitted on: 3/27/2009 8:34:49 AM
By: GioRock  
回复 支持 反对

使用道具 举报

发表于 2011-6-14 08:51:50 | 显示全部楼层
干嘛使得
回复 支持 反对

使用道具 举报

发表于 2012-3-7 19:34:57 | 显示全部楼层
是不是SSL邮件服务更新了,怎么用不了了。
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2020-6-6 15:24

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表