我最近在VB 2010中创建了一个应用程序，为了使其独立于.Net Framework，我开始在VB 6.0中重新构建应用程序。表格上应该有一个按钮，按下后会打开默认的电子邮件客户端。然后它会打开一个新的电子邮件，并将文本框上的应用程序生成的文本复制到其正文中。它的问题在于，正文中复制的文本被粘贴了错误的编码，并且完全不同于它应该如何。我在VB 2010中也遇到了这个问题，但是我能够通过像这样使用System.Uri.EscapeDataString来解决这个问题
public <T extends CopyInterface<T>> void testMethod() {
T target = ...; //initialize the variable
T source = ...; //initialize the variable
target.copyFrom(source);
}
有没有办法在vb 6.0中做这样的事情？
Process.Start("mailto:test@email.com?subject= &body=" & System.Uri.EscapeDataString(TextBox1.Text))
P.S我尝试过URL编码，但只要有空格，就会粘贴十字（“+”）。
答案 0 :(得分：0)
行。以下是应该行为的大部分代码System.Uri.EscapeUriString和System.Uri.EscapeDataString分别使用列表中提供的名为EscapeURI()和EscapeURIData()的方法下面。像任何随机代码一样，考虑它是按原样提供的，并在您考虑使用它之前对其进行彻底测试。
我提供的代码有两（2）个原因：
所以，这是代码。它基本上是在UTF-8编码例程之上的RFC 3986中描述的字符转义的实现。代码未经过优化，但经过评论以便于理解。此外，它不支持国际化域名（RFC 3987）。
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal cb As Long)
Private Declare Function MultiByteToWideChar Lib "Kernel32.dll" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cbMultiByte As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long _
) As Long
Private Declare Function WideCharToMultiByte Lib "Kernel32.dll" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cbMultiByte As Long, _
ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long _
) As Long
Private Enum VbStrConv2
vbUpperCase = VbStrConv.vbUpperCase
vbLowerCase = VbStrConv.vbLowerCase
vbProperCase = VbStrConv.vbProperCase
vbWide = VbStrConv.vbWide
vbNarrow = VbStrConv.vbNarrow
vbHiragana = VbStrConv.vbHiragana
vbUnicode = VbStrConv.vbUnicode
vbFromUnicode = VbStrConv.vbFromUnicode
vbUTF8 = &H100&
vbFromUTF8 = &H200&
End Enum
Private Const CP_ACP As Long = 0 ' Default ANSI code page.
Private Const CP_UTF8 As Long = 65001 ' UTF8.
Private Const CP_UTF16_LE As Long = 1200 ' UTF16 - little endian.
Private Const CP_UTF16_BE As Long = 1201 ' UTF16 - big endian.
Private Const CP_UTF32_LE As Long = 12000 ' UTF32 - little endian.
Private Const CP_UTF32_BE As Long = 12001 ' UTF32 - big endian.
Public Function EscapeURI(ByVal URI As String, Optional ByVal JSCompatible As Boolean = False) As String
' As per "RFC 1738: Uniform Resource Locators (URL) specification"
' 21-06-2010: Modified to conform to "RFC 3986: Uniform Resource Identifier (URI): Generic Syntax"
Dim i As Long
Dim bAnsi() As Byte
Dim iAscii As Integer
Dim sEscapedUri As String
bAnsi = StrConv2(URI, VbStrConv2.vbUTF8)
sEscapedUri = vbNullString
For i = LBound(bAnsi) To UBound(bAnsi)
iAscii = bAnsi(i)
Select Case iAscii
' ASCII control caracters, always escape
Case 0 To 31, 127
If iAscii < 16 Then
sEscapedUri = sEscapedUri & "%0" & Hex$(iAscii)
Else
sEscapedUri = sEscapedUri & "%" & Hex$(iAscii)
End If
' Non-ASCII characters, always escape
Case 128 To 255
sEscapedUri = sEscapedUri & "%" & Hex$(iAscii)
' Reserved characters, don't escape with an URI
' RFC 3986 section 2.2 Reserved Characters (January 2005)
' ! # $ & ' ( ) * + , / : ; = ? @ [ ]
Case 33, 35, 36, 38, 39, 40, 41, 42, 43, 44, 47, 58, 59, 61, 63, 64, 91, 93
If JSCompatible Then
Select Case iAscii
' [ ]
Case 91, 93
' ECMAScript's encodeURI() escapes those
' (since IPv6, hosts can be e.g. [::1/128] so we want to preserve them unescaped)
sEscapedUri = sEscapedUri & "%" & Hex$(iAscii)
Case Else
sEscapedUri = sEscapedUri & Chr$(iAscii)
End Select
Else
sEscapedUri = sEscapedUri & Chr$(iAscii)
End If
' Unreserved characters, never escape
' RFC 3986 section 2.3 Unreserved Characters (January 2005)
' - . 0 ... 9 A ... Z a .... z _ ~
Case 45, 46, 48 To 57, 65 To 90, 97 To 122, 95, 126
sEscapedUri = sEscapedUri & Chr$(iAscii)
' Unsafe characters, always escape
' " % < > \ ^ ` { | }
Case 34, 37, 60, 62, 92, 94, 96, 123, 124, 125
sEscapedUri = sEscapedUri & "%" & Hex$(iAscii)
' Space, escaped
Case 32
sEscapedUri = sEscapedUri & "%20"
Case Else
sEscapedUri = sEscapedUri & "%" & Hex$(iAscii)
End Select
Next i
EscapeURI = sEscapedUri
End Function
Public Function EscapeURIData(ByVal URIData As String, Optional ByVal JSCompatible As Boolean = False) As String
' As per "RFC 1738: Uniform Resource Locators (URL) specification"
' 21-06-2010: Modified to conform to "RFC 3986: Uniform Resource Identifier (URI): Generic Syntax"
Dim i As Long
Dim bAnsi() As Byte
Dim iAscii As Integer
Dim sEscapedData As String
bAnsi = StrConv2(URIData, VbStrConv2.vbUTF8)
sEscapedData = vbNullString
For i = LBound(bAnsi) To UBound(bAnsi)
iAscii = bAnsi(i)
Select Case iAscii
' ASCII control caracters, always escape
Case 0 To 31, 127
If iAscii < 16 Then
sEscapedData = sEscapedData & "%0" & Hex$(iAscii)
Else
sEscapedData = sEscapedData & "%" & Hex$(iAscii)
End If
' Non-ASCII characters, always escape
Case 128 To 255
sEscapedData = sEscapedData & "%" & Hex$(iAscii)
' Reserved characters, always escape when treated as data
' RFC 3986 section 2.2 Reserved Characters (January 2005)
' ! # $ & ' ( ) * + , / : ; = ? @ [ ]
Case 33, 35, 36, 38, 39, 40, 41, 42, 43, 44, 47, 58, 59, 61, 63, 64, 91, 93
If JSCompatible Then
Select Case iAscii
' ! ' ( ) *
Case 33, 39, 40, 41, 42
' ECMAScript's encodeURIComponent() doesn't escape those
sEscapedData = sEscapedData & Chr$(iAscii)
Case Else
sEscapedData = sEscapedData & "%" & Hex$(iAscii)
End Select
Else
sEscapedData = sEscapedData & "%" & Hex$(iAscii)
End If
' Unreserved characters, never escape
' RFC 3986 section 2.3 Unreserved Characters (January 2005)
' - . 0 ... 9 A ... Z a .... z _ ~
Case 45, 46, 48 To 57, 65 To 90, 97 To 122, 95, 126
sEscapedData = sEscapedData & Chr$(iAscii)
' Unsafe characters, always escape
' " % < > \ ^ ` { | }
Case 34, 37, 60, 62, 92, 94, 96, 123, 124, 125
sEscapedData = sEscapedData & "%" & Hex$(iAscii)
' Space, escaped
Case 32
sEscapedData = sEscapedData & "%20"
Case Else
sEscapedData = sEscapedData & "%" & Hex$(iAscii)
End Select
Next i
EscapeURIData = sEscapedData
End Function
'
' Utilities
'
Private Function StrConv2(Expr As Variant, Conversion As VbStrConv2, Optional LocaleID As Long = 0)
Const METHOD_NAME = "StrConv2"
Dim sExpr As String, arr_bytInput() As Byte, lLBound As Long
Select Case Conversion
Case VbStrConv2.vbUTF8 ' LocaleID not used (no case changing, no code page mapping)
Dim lInputChars As Long
Dim lOutputBytes As Long, arr_bytOutputBytes() As Byte
' Expected input: Unicode (UCS-2)
Select Case VarType(Expr)
Case vbString
sExpr = CStr(Expr)
' Get length of input, in *characters*
lInputChars = Len(sExpr)
' Copy input string as-is
arr_bytInput = sExpr
Case (vbArray + vbByte)
' Get length of input, in *characters*
lInputChars = (UBound(Expr) - LBound(Expr) + 1) \ 2
' Copy array (same type)
arr_bytInput = Expr
Case Else
Err.Raise 13, METHOD_NAME, "Expr: Type mismatch (in " & METHOD_NAME & "())"
End Select
' Get size of output strings, in *bytes*
lOutputBytes = WideCharToMultiByte(CP_UTF8, 0, VarPtr(arr_bytInput(0)), lInputChars, 0, 0, 0, 0)
' Size appropriately
ReDim arr_bytOutputBytes(lOutputBytes - 1)
' Second call
lOutputBytes = WideCharToMultiByte(CP_UTF8, 0, VarPtr(arr_bytInput(0)), lInputChars, VarPtr(arr_bytOutputBytes(0)), lOutputBytes, 0, 0)
' Return as array of bytes
StrConv2 = arr_bytOutputBytes
Case VbStrConv2.vbFromUTF8 ' LocaleID not used (no case changing, no code page mapping)
Dim lInputBytes As Long
Dim lOutputChars As Long, arr_bytOutputChars() As Byte
' Expected input: UTF-8
Select Case VarType(Expr)
Case vbString
arr_bytInput = StrConv(Expr, vbFromUnicode)
' Get length of input, in *bytes*
lInputBytes = (UBound(arr_bytInput) - LBound(arr_bytInput) + 1)
Case (vbArray + vbByte)
' Copy array (same type)
arr_bytInput = Expr
' Get length of input, in *bytes*
lInputBytes = (UBound(arr_bytInput) - LBound(arr_bytInput) + 1)
Case Else
Err.Raise 13, METHOD_NAME, "Expr: Type mismatch (in " & METHOD_NAME & "())"
End Select
' Get size of output strings, in *chars*
lOutputChars = MultiByteToWideChar(CP_UTF8, 0, VarPtr(arr_bytInput(0)), lInputBytes, 0, 0)
' Size appropriately
ReDim arr_bytOutputChars(lOutputChars * 2 - 1)
' Second call
lOutputChars = MultiByteToWideChar(CP_UTF8, 0, VarPtr(arr_bytInput(0)), lInputBytes, VarPtr(arr_bytOutputChars(0)), lOutputChars)
' Return as string
sExpr = arr_bytOutputChars
StrConv2 = Left$(sExpr, lOutputChars)
Case Else
StrConv2 = StrConv(Expr, Conversion, LocaleID)
End Select
End Function