زبان برنامه نویسی Delphi 7
سلام به دوستان قبلا این موضوع مطرح شده ولی به جایی نرسیده مشکل وقتی فارسی ارسال می شود به صورت ؟؟؟؟؟؟؟؟؟؟؟ نمایش داده می شود لطفا کمک کنید که این موضوع به یه جایی خوبی برسه
Printable View
زبان برنامه نویسی Delphi 7
سلام به دوستان قبلا این موضوع مطرح شده ولی به جایی نرسیده مشکل وقتی فارسی ارسال می شود به صورت ؟؟؟؟؟؟؟؟؟؟؟ نمایش داده می شود لطفا کمک کنید که این موضوع به یه جایی خوبی برسه
نقل قول:
نوشته شده توسط saeidsg
ازهمه دوستان تقاضای کمک فوری دارم
از نسخه های جدید دلفی استفاده کنید.
' تابع تبدیل به هگز
Public Function ToHex(ByRef Bytes() As Byte) As String
Dim lngInLen As Long
Dim lngOutLen As Long
'Find out how much room we need for the formatted String.
lngInLen = UBound(Bytes) - LBound(Bytes) + 1
CryptBinaryToString VarPtr(Bytes(0)), _
lngInLen, _
CRYPT_STRING_HEX, _
NULLPTR, _
lngOutLen
'Allocate this space.
ToHex = Space$(lngOutLen)
'Now get the formatted String.
If CryptBinaryToString(VarPtr(Bytes(0)), _
lngInLen, _
CRYPT_STRING_HEX, _
StrPtr(ToHex), _
lngOutLen) = 0 Then
Err.Raise vbObjectError Or &H6000, _
"ToHex", _
"System error " & CStr(Err.LastDllError)
End If
End Function
' تابع تبدیل به UTF
Public Function ToUTF8(ByRef Text As String) As Byte()
'Returns a Byte array, because VB6 Strings cannot hold UTF-8
'encoded text without special care. UTF-8 text is effectively
'binary data to a VB6 program, not text at all!
Dim Bytes() As Byte
Dim lngInLen As Long
Dim lngOutLen As Long
'Find out how much room we need for the encoded String.
lngInLen = Len(Text)
lngOutLen = WideCharToMultiByte(CP_UTF8, _
0, _
StrPtr(Text), _
lngInLen, _
NULLPTR, _
0, _
NULLPTR, _
NULLPTR)
'Allocate this space.
ReDim Bytes(lngOutLen - 1)
'Now get the encoded text.
If WideCharToMultiByte(CP_UTF8, _
0, _
StrPtr(Text), _
lngInLen, _
VarPtr(Bytes(0)), _
lngOutLen, _
NULLPTR, _
NULLPTR) = 0 Then
Err.Raise vbObjectError Or &H6002, _
"StringToUTF8", _
"System error " & CStr(Err.LastDllError)
Else
ToUTF8 = Bytes
End If
End Function
' تبدیل رشته به Unicode
Function FindUnicode(TextFa As String) As String
If TextFa = "" Then FindUnicode = TextFa: Exit Function
CountCahr = 0
Dim DarsadAdded As Boolean
DarsadAdded = True
FindUnicode = ""
TextFa = Trim$(TextFa)
If Len(TextFa) = 0 Then
Exit Function
End If
txtUTF8.Text = ToHex(ToUTF8(TextFa))
txtUTF8.Text = Replace(txtUTF8.Text, vbNewLine, "")
txtUTF8.Text = Replace(txtUTF8.Text, vbCrLf, "")
txtUTF8.Text = Replace(txtUTF8.Text, Chr$(9), "")
txtUTF8.Text = Replace(txtUTF8.Text, Chr$(10), "")
txtUTF8.Text = Replace(txtUTF8.Text, Chr$(13), "")
txtUTF8.Text = Replace(txtUTF8.Text, Chr$(32), "")
For i = 1 To Len(txtUTF8.Text)
Character = Mid$(txtUTF8.Text, i, 1)
If Character = " " And DarsadAdded = False Then
FindUnicode = FindUnicode & "%"
DarsadAdded = True
CountCahr = 0
End If
If Character <> " " And Asc(Character) <> 13 And Asc(Character) <> 10 And Asc(Character) <> 32 Then
If CountCahr = 2 Then FindUnicode = FindUnicode & "%": CountCahr = 0
FindUnicode = FindUnicode & Character
CountCahr = CountCahr + 1
DarsadAdded = False
End If
Next i
If Left$(FindUnicode, 1) <> "%" Then
FindUnicode = "%" + FindUnicode
End If
FindUnicode = Replace(FindUnicode, "%%", "%")
End Function
این کد vb هست کسی می تونه به delph7 تبدیل کنه
از دوستان خواهش می کنم اگه کسی این کد vb رو بلد هست تبدیل به دلفی 7 کنه یه کمکی به من بکنه کارم روی هواست ممنون میشم
نقل قول:
نوشته شده توسط saeidsg