نوشته شده توسط
ab1234
متشکرم آقا احسان
ولی من با متن انگلیسی هیچ مشکلی ندارم . یعنی انگلیسی نیاز به کد شدن نداره؟
حالا چجوری باید متن رو کد کنم؟؟ اگه ممکنه بیشتر توضیح بدید چون این چیزی که شما می فرماید رو من تا حالا نشنیده بودم
اگه یه نمونه هم بزارید که حسابی شرمندم کردید دیگه!!
بازم ممنون
دوست عزیز بازهم نمی دونم شما الان می خواین به چه جایی اطلاعات رو بفرستین ولی امید وارم نمونه ای که می زارم به کارتون بیاد .
دوست عزیز کدهای زیر رو در داخل یه Module کپی کنید .
Option Compare Binary
Public sCodePage As Long
Public cnvUni2 As String
Public cnvUni As String
Public Const CP_ACP = 0
Public Const CP_NONE = 0
Public Const CP_OEMCP = 1
Public Const CP_WINANSI = 1004
Public Const CP_WINUNICODE = 1200
Public Const MB_PRECOMPOSED = &H1
Public Const MB_COMPOSITE = &H2
Public Const MB_USEGLYPHCHARS = &H4
' //Arabic
Public Const CP_AWIN = 101
Public Const CP_709 = 102
Public Const CP_720 = 103
Public Const CP_A708 = 104
Public Const CP_A449 = 105
Public Const CP_TARB = 106
Public Const CP_NAE = 107
Public Const CP_V4 = 108
Public Const CP_MA2 = 109
Public Const CP_I864 = 110
Public Const CP_A437 = 111
Public Const CP_AMAC = 112
' //Hebrew
Public Const CP_HWIN = 201
Public Const CP_862I = 202
Public Const CP_7BIT = 203
Public Const CP_ISO = 204
Public Const CP_H437 = 205
Public Const CP_HMAC = 206
' /************************************************** ***********************
' Code Pages
' ************************************************** ***********************/
Public Const CP_OEM_437 = 437
Public Const CP_ARABICDOS = 708
Public Const CP_DOS720 = 720
Public Const CP_IBM850 = 850
Public Const CP_IBM852 = 852
Public Const CP_DOS862 = 862
Public Const CP_IBM866 = 866
Public Const CP_THAI = 874
Public Const CP_JAPAN = 932
Public Const CP_CHINA = 936
Public Const CP_KOREA = 949
Public Const CP_TAIWAN = 950
Public Const CP_EASTEUROPE = 1250
Public Const CP_RUSSIAN = 1251
Public Const CP_WESTEUROPE = 1252
Public Const CP_GREEK = 1253
Public Const CP_TURKISH = 1254
Public Const CP_HEBREW = 1255
Public Const CP_ARABIC = 1256
Public Const CP_BALTIC = 1257
Public Const CP_VIETNAMESE = 1258
Public Const CP_ASCII = 20127
Public Const CP_RUSSIANKOI8R = 20866
Public Const CP_RUSSIANKOI8U = 21866
Public Const CP_ISOLATIN1 = 28591
Public Const CP_ISOEASTEUROPE = 28592
Public Const CP_ISOTURKISH = 28593
Public Const CP_ISOBALTIC = 28594
Public Const CP_ISORUSSIAN = 28595
Public Const CP_ISOARABIC = 28596
Public Const CP_ISOGREEK = 28597
Public Const CP_ISOHEBREW = 28598
Public Const CP_ISOTURKISH2 = 28599
Public Const CP_ISOLATIN9 = 28605
Public Const CP_HEBREWLOG = 38598
Public Const CP_USER = 50000
Public Const CP_AUTOALL = 50001
Public Const CP_JAPANNHK = 50220
Public Const CP_JAPANESC = 50221
Public Const CP_JAPANSIO = 50222
Public Const CP_KOREAISO = 50225
Public Const CP_TAIWANISO = 50227
Public Const CP_CHINAISO = 50229
Public Const CP_AUTOJAPAN = 50932
Public Const CP_AUTOCHINA = 50936
Public Const CP_AUTOKOREA = 50949
Public Const CP_AUTOTAIWAN = 50950
Public Const CP_AUTORUSSIAN = 51251
Public Const CP_AUTOGREEK = 51253
Public Const CP_AUTOARABIC = 51256
Public Const CP_JAPANEUC = 51932
Public Const CP_CHINAEUC = 51936
Public Const CP_KOREAEUC = 51949
Public Const CP_TAIWANEUC = 51950
Public Const CP_CHINAHZ = 52936
Public Const CP_MAC_ROMAN = 10000
Public Const CP_MAC_JAPAN = 10001
Public Const CP_MAC_ARABIC = 10004
Public Const CP_MAC_GREEK = 10006
Public Const CP_MAC_CYRILLIC = 10007
Public Const CP_MAC_LATIN2 = 10029
Public Const CP_MAC_TURKISH = 10081
#If Mac Then
Public Const CP_DEFAULT = CP_MACCP
#Else
Public Const CP_DEFAULT = CP_ACP
#End If
Public Const CP_JOHAB = 1361
Public Const CP_SYMBOL = 42
Public Const CP_UTF8 = 65001
Public Const CP_UTF7 = 65000
Public Const CP_UNICODELITTLE = 1200
Public Const CP_UNICODEBIG = 1201
Public Const CP_UNKNOWN = -1
Public Const MB_ERR_INVALID_CHARS = &H8
Public Const WC_DEFAULTCHECK = &H100
Public Const WC_COMPOSITECHECK = &H200
Public Const WC_DISCARDNS = &H10
Public Const WC_SEPCHARS = &H20
Public Const WC_DEFAULTCHAR = &H40
Private Type FONTSIGNATURE
fsUsb(4) As Long
fsCsb(2) As Long
End Type
Private Type CHARSETINFO
ciCharset As Long
ciACP As Long
fs As FONTSIGNATURE
End Type
Private Const LOCALE_IDEFAULTCODEPAGE = &HB
Private Const LOCALE_IDEFAULTANSICODEPAGE = &H1004
Private Const TCI_SRCCODEPAGE = 2
Private Declare Function GetACP Lib "Kernel32" () As Long
Private Declare Function GetLocaleInfoA _
Lib "Kernel32" (ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "Kernel32" () As Long
Private Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function TranslateCharsetInfo _
Lib "gdi32" (lpSrc As Long, _
lpcs As CHARSETINFO, _
ByVal dwFlags As Long) As Long
Private Declare Function MultiByteToWideChar _
Lib "Kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte _
Lib "Kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As Long, _
lpUsedDefaultChar As Long) As Long
'Private Declare Function MsoCpgFromLid Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#307" (ByVal lid As Long) As Long
'Private Declare Function MsoCpgFromLid Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#307" (ByVal lid As Long) As Long
Private Declare Function MsoCpgFromLid _
Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" _
Alias "#307" (ByVal lid As Long) As Long
'Private Declare Function MsoMultiByteToWideChar Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#778" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
'Private Declare Function MsoMultiByteToWideChar Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#778" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function MsoMultiByteToWideChar _
Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" _
Alias "#778" (ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long) As Long
'Private Declare Function MsoWideCharToMultiByte Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#915" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
'Private Declare Function MsoWideCharToMultiByte Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#915" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
Private Declare Function MsoWideCharToMultiByte _
Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" _
Alias "#915" (ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As Long, _
lpUsedDefaultChar As Long) As Long
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : ChsFromLocaleEx
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:09
'
' Parameters : lcid (Long)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function ChsFromLocaleEx(lcid As Long) As Long
ChsFromLocaleEx = MsoCpgFromLid(lcid)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : AToW
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:09
'
' Parameters : st (String)
' cpg (Long = -1)
' lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function AToW(ByVal st As String, _
Optional ByVal cpg As Long = -1, _
Optional lFlags As Long = 0) As String
Dim stBuffer As String
Dim cwch As Long
Dim pwz As Long
Dim pwzBuffer As Long
If cpg = -1 Then cpg = GetACP()
pwz = StrPtr(st)
cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
stBuffer = String$(cwch + 1, vbNullChar)
pwzBuffer = StrPtr(stBuffer)
cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
AToW = Left$(stBuffer, cwch - 1)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : AToWEx
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:09
'
' Parameters : st (String)
' lcid (Long = -1)
' lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function AToWEx(ByVal st As String, _
Optional ByVal lcid As Long = -1, _
Optional lFlags As Long = 0) As String
Dim cpg As Long
Dim lpUsedDefaultChar As Long
If lcid = -1 Then lcid = GetSystemDefaultLCID()
cpg = ChsFromLocaleEx(lcid)
AToWEx = AToW(st, cpg, lFlags)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : WToA
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:08
'
' Parameters : st (String)
' cpg (Long = -1)
' lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function WToA(ByVal st As String, _
Optional ByVal cpg As Long = -1, _
Optional lFlags As Long = 0) As String
Dim stBuffer As String
Dim cwch As Long
Dim pwz As Long
Dim pwzBuffer As Long
Dim lpUsedDefaultChar As Long
If cpg = -1 Then cpg = GetACP()
pwz = StrPtr(st)
cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
stBuffer = String$(cwch + 1, vbNullChar)
pwzBuffer = StrPtr(stBuffer)
cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
WToA = Left$(stBuffer, cwch - 1)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : WToAEx
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:08
'
' Parameters : st (String)
' lcid (Long = -1)
' lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function WToAEx(ByVal st As String, _
Optional ByVal lcid As Long = -1, _
Optional lFlags As Long = 0) As String
Dim cpg As Long
Dim lpUsedDefaultChar As Long
If lcid = -1 Then lcid = GetSystemDefaultLCID()
cpg = ChsFromLocaleEx(lcid)
WToAEx = WToA(st, cpg, lFlags)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : FStringInCpg
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:08
'
' Parameters : st (String)
' cpg (Long = -1)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function FStringInCpg(ByVal st As String, _
Optional ByVal cpg As Long = -1) As Boolean
Dim cwch As Long
Dim lpUsedDefaultChar As Long
If cpg = -1 Then cpg = GetACP()
cwch = MsoWideCharToMultiByte(cpg, 0&, StrPtr(st), -1, 0&, 0&, ByVal 0&, lpUsedDefaultChar)
FStringInCpg = (CBool(lpUsedDefaultChar) = False)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : FStringInCpgEx
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:08
'
' Parameters : st (String)
' lcid (Long = -1)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function FStringInCpgEx(ByVal st As String, _
Optional ByVal lcid As Long = -1) As Boolean
Dim cwch As Long
Dim cpg As Long
Dim lpUsedDefaultChar As Long
If lcid = -1 Then lcid = GetSystemDefaultLCID()
cpg = ChsFromLocaleEx(lcid)
FStringInCpgEx = FStringInCpg(st, cpg)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : ChsFromLocale
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:08
'
' Parameters : lcid (Long)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function ChsFromLocale(lcid As Long) As Long
Dim cwc As Long
Dim cpg As Long
Dim stBuffer As String
Dim cs As CHARSETINFO
stBuffer = String$(10, vbNullChar)
cwc = GetLocaleInfoA(lcid, LOCALE_IDEFAULTANSICODEPAGE, stBuffer, Len(stBuffer))
If cwc > 0 Then
cpg = Val(Left$(stBuffer, cwc - 1))
If TranslateCharsetInfo(ByVal cpg, cs, TCI_SRCCODEPAGE) Then
ChsFromLocale = cs.ciCharset
End If
End If
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : DecodeUTF8
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:08
'
' Parameters : cnvUni (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function DecodeUTF8(ByVal cnvUni As String)
If cnvUni = vbNullString Then Exit Function
cnvUni2 = WToA(cnvUni, CP_ACP)
DecodeUTF8 = AToW(cnvUni2, CP_UTF8)
End Function
'<CSCM>
'--------------------------------------------------------------------------------
' Project : Project1
' Procedure : UTF8_Encode
' Description: [type_description_here]
' Created by : Project Administrator
' Machine : EHSAN-AD91DAD44
' Date-Time : 9/17/2008-16:31:08
'
' Parameters : sStr (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function UTF8_Encode(ByVal sStr As String)
For l& = 1 To Len(sStr)
lChar& = AscW(Mid(sStr, l&, 1))
If lChar& < 128 Then
sUtf8$ = sUtf8$ + Mid(sStr, l&, 1)
ElseIf ((lChar& > 127) And (lChar& < 2048)) Then
sUtf8$ = sUtf8$ + Chr(((lChar& \ 64) Or 192))
sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
Else
sUtf8$ = sUtf8$ + Chr(((lChar& \ 144) Or 234))
sUtf8$ = sUtf8$ + Chr((((lChar& \ 64) And 63) Or 128))
sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
End If
Next l&
UTF8_Encode = sUtf8$
End Function
و این خط هم برای کد کردن و طرز استفاده از این Module :
MsgBox UTF8_Encode("احسان تو دنیا همیشه هست")
باتشکر احسان
نقل قول: مرجع حل مشکلات زبان فارسی و سورسهای مربوطه
نقل قول: مرجع حل مشکلات زبان فارسی و سورسهای مربوطه
نقل قول: مرجع حل مشکلات زبان فارسی و سورسهای مربوطه
پاسخ با نقل قول
