تبدیل متن فارسی به یونی کد

[star_star]

سورسی رو می خوام که متن های فارسی رو به یونیکد تبدیل کنه

یعنی به یونی کد از نوع URL Encoder

به طور مثال : کلمه "سلام" رو به "%D8%B3%D9%84%D8%A7%D9%" تبدیل کنه !!!

ببینم کی میتونه جواب بده ! هرکی جواب بده کارش درسته !!

[just4froum]

یک ساعت وقتمو گرفت.البته بگم که این unicode نیست بلکه utf-8 هست.

دوتا تکست و یک کامند بگذار روی فرمت توی اولی فارسی بنویس توی دومی encode تحویل بگیر به همین راحتی:گیج:

اینم از کد :

Private Sub Command1_Click()
Dim s As String, x As Long

Text2.Text = Empty
For x = 1 To Len(Text1.Text)
Text2.Text = Text2.Text & Calculate(CLng(AscW(Mid(Text1.Text, x, 1))))
Next x

End Sub


Private Function Calculate(UTF As Long) As String
Dim x As Byte, y As Long, FB As Byte, SB As Byte ' FB = FirstByte ; SB = SecondByte


For x = 216 To 219
y = (x - 194) * 64
If (UTF - y) >= 128 And (UTF - y) <= 191 Then FB = x: SB = CByte(UTF - y): Exit For
Next x

Calculate = "%" & Num2Hex(Int(FB \ 16)) & Num2Hex(FB Mod 16) & "%" & Num2Hex(Int(SB \ 16)) & Num2Hex(SB Mod 16)

End Function


Private Function Num2Hex(Num As Byte) As String

If IsNumeric(Num) = True Then
If Num <= 9 And Num >= 0 Then Num2Hex = CStr(Num): Exit Function
End If

Select Case Num

Case 10
Num2Hex = "A"
Case 11
Num2Hex = "B"
Case 12
Num2Hex = "C"
Case 13
Num2Hex = "D"
Case 14
Num2Hex = "E"
Case 15
Num2Hex = "F"
End Select

End Function

[star_star]

آقا ممنون اما اونی نیست که من می خوام :(

ببین من می خوام مثل این Encode کنه : http://www.opinionatedgeek.com/dotnet/tools/urlencode/Encode.aspx

[star_star]

خودم اینو پیدا کردم اما نمیدونم اونه یانه ! ازشم بلد نیستم استفاده کنم
کسی میتونه یه برنامه با این بسازه واسم بذاره ؟

Public Function URLEncode(StringToEncode As String, Optional _
UsePlusRatherThanHexForSpace As Boolean = False) As String

Dim TempAns As String
Dim CurChr As Integer
CurChr = 1
Do Until CurChr - 1 = Len(StringToEncode)
Select Case Asc(Mid(StringToEncode, CurChr, 1))
Case 48 To 57, 65 To 90, 97 To 122
TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
Case 32
If UsePlusRatherThanHexForSpace = True Then
TempAns = TempAns & "+"
Else
TempAns = TempAns & "%" & Hex(32)
End If
Case Else
TempAns = TempAns & "%" & _
Format(Hex(Asc(Mid(StringToEncode, _
CurChr, 1))), "00")
End Select

CurChr = CurChr + 1
Loop

URLEncode = TempAns
End Function


Public Function URLDecode(StringToDecode As String) As String

Dim TempAns As String
Dim CurChr As Integer

CurChr = 1

Do Until CurChr - 1 = Len(StringToDecode)
Select Case Mid(StringToDecode, CurChr, 1)
Case "+"
TempAns = TempAns & " "
Case "%"
TempAns = TempAns & Chr(Val("&h" & _
Mid(StringToDecode, CurChr + 1, 2)))
CurChr = CurChr + 2
Case Else
TempAns = TempAns & Mid(StringToDecode, CurChr, 1)
End Select

CurChr = CurChr + 1
Loop

URLDecode = TempAns
End Function


' URLDecode function in Perl for reference
' both VB and Perl versions must return same
'
' sub urldecode{
' local($val)=@_;
' $val=~s/\+/ /g;
' $val=~s/%([0-9A-H]{2})/pack('C',hex($1))/ge;
' return $val;
' }

[star_star]

اینم یه نمونه دیگه اینم پیدا کردم اما بلد نیستم ازش استفاده کنم :
Function UrlEncode(ByVal urlText As String) As String

Dim i As Long
Dim ansi() As Byte
Dim ascii As Integer
Dim encText As String

ansi = StrConv(urlText, vbFromUnicode)
encText = ""

For i = 0 To UBound(ansi)
ascii = ansi(i)

Select Case ascii

Case 48 To 57, 65 To 90, 97 To 122

encText = encText & Chr(ascii)

Case 32

encText = encText & "+"

Case Else

If ascii < 16 Then

encText = encText & "%0" & Hex(ascii)

Else

encText = encText & "%" & Hex(ascii)

End If

End Select

Next

UrlEncode = encText

End Function

[just4froum]

آقا ممنون اما اونی نیست که من می خوام :(

ببین من می خوام مثل این Encode کنه : http://www.opinionatedgeek.com/dotnet/tools/urlencode/Encode.aspx

آقا مارو گرفتی اینا که هر دو یک جور encode می کنند :متعجب:

سلام توی هر دو یک جور هست. توی هردو %D8%B3%D9%84%D8%A7%D9%85 میشه سلام که شما بالا اشتباه نوشتی .

[star_star]

آره فقط سلام رو مثل هم اینکد میکنه داداش گلم
مثلا با برنامه خودت "پوریا حسینی" رو اینکد کن بعد برو تو اون سایته که بهت دادام Decode کن !!
میبینی که چیزی بهت نمیده :(

حاصل "پوریا حسینی" با برنامه ی شما : %D9%BE%D9%88%D8%B1%D9%8A%D8%A7%00%00%D8%AD%D8%B3%D 9%8A%D9%86%D9%8A
حاصل "پوریا حسینی" با سایت : %d9%be%d9%88%d8%b1%db%8c%d8%a7+%d8%ad%d8%b3%db%8c% d9%86%db%8c

[meys34]

آره فقط سلام رو مثل هم اینکد میکنه داداش گلم
مثلا با برنامه خودت "پوریا حسینی" رو اینکد کن بعد برو تو اون سایته که بهت دادام Decode کن !!
میبینی که چیزی بهت نمیده :(

حاصل "پوریا حسینی" با برنامه ی شما : %D9%BE%D9%88%D8%B1%D9%8A%D8%A7%00%00%D8%AD%D8%B3%D 9%8A%D9%86%D9%8A
حاصل "پوریا حسینی" با سایت : %d9%be%d9%88%d8%b1%db%8c%d8%a7+%d8%ad%d8%b3%db%8c% d9%86%db%8c


یک ساعت وقتمو گرفت.البته بگم که این unicode نیست بلکه utf-8 هست.

دوتا تکست و یک کامند بگذار روی فرمت توی اولی فارسی بنویس توی دومی encode تحویل بگیر به همین راحتی:گیج:

اینم از کد :



بفرمایید
:قلب::قلب::قلب::قلب::قلب:
یکم کد Just4Forum رو تغییر دادم درست شد:


Private Sub Command1_Click()
Dim s As String, x As Long

Text2.Text = Empty
Dim temp As String
temp = Replace$(Text1.Text, " ", "+")

For x = 1 To Len(temp)
If Asc(Mid(temp, x, 1)) = AscW(Mid(temp, x, 1)) Then
Text2.Text = Text2.Text & Mid(temp, x, 1)
Else
Text2.Text = Text2.Text & Calculate(CLng(AscW(Mid(temp, x, 1))))
End If
Next x

End Sub


Private Function Calculate(UTF As Long) As String
Dim x As Byte, y As Long, FB As Byte, SB As Byte ' FB = FirstByte ; SB = SecondByte


For x = 216 To 219
y = (x - 194) * 64
If (UTF - y) >= 128 And (UTF - y) <= 191 Then FB = x: SB = CByte(UTF - y): Exit For
Next x

Calculate = "%" & Num2Hex(Int(FB \ 16)) & Num2Hex(FB Mod 16) & "%" & Num2Hex(Int(SB \ 16)) & Num2Hex(SB Mod 16)

End Function


Private Function Num2Hex(Num As Byte) As String

If IsNumeric(Num) = True Then
If Num <= 9 And Num >= 0 Then Num2Hex = CStr(Num): Exit Function
End If

Select Case Num

Case 10
Num2Hex = "A"
Case 11
Num2Hex = "B"
Case 12
Num2Hex = "C"
Case 13
Num2Hex = "D"
Case 14
Num2Hex = "E"
Case 15
Num2Hex = "F"
End Select

End Function

[just4froum]

سورس من برای کلمات فارسیه یعنی اونایی که در محدوده 216 تا 219 هستند به عنوان مثلا بسیاری از حروف یا حرف از 3 بایت تشکیل میشه ( در utf-8 ) به همین دلیل در پوریا حسینی که وستش فاصله هست دوتا %00 میندازه چون فاصله جزو utf-8 از حروف فارسی نیست.

همانطور که میبینید جناب meys34 اومده اونایی رو که در utf-8 به همان حالت ascii ذخیره میشن جداگونه در text2 قرار داده.

البته این روش درستی است ولی سورس من کامل نیست و بسیاری از علامت هایی رو که دارای 3 بایت هستند رو پشتیبانی نمیکنه هنچنین زبان های غیر از فارسی که بایت اول در محدوده 216 تا 219 نیست

[star_star]

آقا پس یکی سورس کامل رو اگه داره بذاره
خیلی واسم حیاتیه !

ممنونم ازتون

[just4froum]

اینارو من چند وقت پیش کلی زیر و رو کردم تا پیدا کردم.

ولی دیگه خسته شدم و ولش کردم حالا اینو میگم شاید به درد بعضی ها بخوره.

در فرمت utf-8 سه بایت اول نشان دهنده ی utf-8 بودن فایل هست که عبارت اند از 239 - 187 - 191.

بایت چهارم 1 یا 2 بایت پایینی خودش رو توجیه می کند و همینطور ادامه پیدا می کند.

اگر بایتی که 1 یا 2 بایت زیرین خود را توجیه می کند به نام بایت آغازگر نامگذاری کنیم 3 حالت ممکن است پیش بیاید.

1 - بعد از آن یک بایت آغازگر دیگر بیاید یعنی خود اون نشان دهنده ی یک کارکتر باشد که زیاد یادم نیست ولی نشانه خاضی داشت فکر کنم از یک عدد کوچکتر بود کوچکتر بود و همان کد اسکی بود.

2-بعد از بایت آغازگر یک بایت می آید که با بایت آغازگر نشاندهنده ی یک کارکتر هستند. اگر بایت آغازگر را FB و بایت دوم را SB بنامیم فرمولی که تابع chrw آن کارکتر را به ما می دهد میشود :

(FB - 194) * 64 + SB

تذکر : مردم تا این فرمولو کشف کردم :گریه:

3 - بعد از بایت آغازگر 2 بایت دیگر میاید که معمولا نشان دهنده ی یک علامت هست. اونم یه فرمول داشت ولی روی یه کاغذ نوشته بودم که نمی دونم کجاست.:گیج:

تذکر : همه اینارو خودم فهمیدم و در جایی نخوندم پس حتما توش باید اشتباه زیاد داشته باشم اگر کسی اشتباهی دید لطفا بگه. پیشاپیش ممنون.

[star_star]

آقا این کدی که خودم پیدا کردمو چطوری می تونم ازش استفاده کنم ؟
میخوام دوتا تکست باکس داشته باشه که یکی جمله فارسی رو بگیره و دیگری UTF-8 رو نشون بده


Function URLEncode(EncodeStr As String) As String
Dim i As Integer
Dim erg As String

erg = EncodeStr

' *** First replace '%' chr
erg = Replace(erg, "%", Chr(1))

' *** then '+' chr
erg = Replace(erg, "+", Chr(2))

For i = 0 To 255
Select Case i
' *** Allowed 'regular' characters
Case 37, 43, 48 To 57, 65 To 90, 97 To 122

Case 1 ' *** Replace original %
erg = Replace(erg, Chr(i), "%25")

Case 2 ' *** Replace original +
erg = Replace(erg, Chr(i), "%2B")

Case 32
erg = Replace(erg, Chr(i), "+")

Case 3 To 15
erg = Replace(erg, Chr(i), "%0" & Hex(i))

Case Else
erg = Replace(erg, Chr(i), "%" & Hex(i))

End Select
Next

URLEncode = erg

End Function

[meys34]

آقا این کدی که خودم پیدا کردمو چطوری می تونم ازش استفاده کنم ؟
میخوام دوتا تکست باکس داشته باشه که یکی جمله فارسی رو بگیره و دیگری UTF-8 رو نشون بده



آقا این کد شما و کد هایی که صفحه قبل نوشتی مربوط به safe کردن آدرس URL هست
ببین یه سری کاراکتر هستند که توی URL اجازه استفاده از اونا رو نداریم
پس به جای اون کاراکتر ها از معادل HEX استفاده میشه


Dollar ("$") 24
Ampersand ("&") 26
Plus ("+") 2B
Comma (",") 2C
Forward slash/Virgule ("/") 2F
Colon (":") 3A
Semi-colon (";") 3B
Equals ("=") 3D
Question mark ("?") 3F
'At' symbol ("@") 40


شما باید این موضوع رو هم در نظر بگیرید ها یعنی در آخر Safe بودن رو چک کنید... اما سوال شما مربوط به کاراکتر های فارسی میشد که جناب Just4Forum عزیز به خوبی پاسخ دادند
البته به نظر میرسه کاملا کار خوشون هم بوده چون تو نت پیدا نکردم کد هاشون رو ... از این بایت ممنونیم ازشون....

حالا چه اصراریه از کد خودتون استقاده کنید؟....

هرچند از کاراکتر های یونیکد 3 بایتی چیزی سر در نیاوردم چون فکی میکردم که فقط 2 بایت خواهد بود
بعنی همونطور که خودشون گفتن FB و SB

در ضمن utf-8 مگه مربوط به فرمت ذخیره فایل نمیشه؟؟؟ پس به اینجا چه ربطی داره
مثلا Unicode هنگام ذخیره فایل FF FE رو اول کاراکتر ها میذاره...
UTF-8 هم EF BB BF رو...

[star_star]

ماله جناب Just4Forum مشکل داره
یکی پیدا کردم که وصل میشه به یه فایل PHP و ENCODE میکنه ببیند ازش سر در میارید ؟

http://www.ic0de.org/archive/index.php/t-9051.html

[just4froum]

در ضمن utf-8 مگه مربوط به فرمت ذخیره فایل نمیشه؟؟؟ پس به اینجا چه ربطی داره


خوب اینم دقیقا همونه فقط بایت ها به صورت Hex در آمدن و با % از هم جدا شدن.
مثلا بایت های حرف س در utf-8 میشه 216 - 179 در url مرورگر ها میشود

%D8%B3


ماله جناب Just4Forum مشکل داره


میشه مشکلشو بگید ؟

اصلا فردا کاملشو میگذارم (ولی باید دوباره 5 ساعت وقت بگذارم تا حالت های کلیش رو دوباره پیدا کنم :متفکر:)

[star_star]

خدا خیرت بده

والا یه برنامه ارسال اس ام اس دارم درس می کنم که توی اون حتما باید متن به صورت UNICOD باشه

نمیگم برنامه شما ایراد داره ، هر متنی رو که با ماله شما encode میکنم بعد با اون سایته decode میکنم درسته و ایرادی نداره
اما برنامه ی ارسال اس ام اس متن Encode شده توسط برنامه شما رو ارسال نمی کنه اما ماله سایت رو بدونه هیچ Error ی ارسال می کنه تفائت کد ها رو ببینید :

متن مورد نظر : "به وب سايت برنامه نويسي برنامه نويس خوش آمديد . با تشکر از شما ، شما شامله 20 % تخفيف شده ايد"

اینکد برنامه شما :

%D8%A8%D9%87+%D9%88%D8%A8+%D8%B3%D8%A7%D9%8A%D8%AA +%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D9%87+%D9%86%D9%88 %D9%8A%D8%B3%D9%8A+%D8%A8%D8%B1%D9%86%D8%A7%D9%85% D9%87+%D9%86%D9%88%D9%8A%D8%B3+%D8%AE%D9%88%D8%B4+ %D8%A2%D9%85%D8%AF%D9%8A%D8%AF+.+%D8%A8%D8%A7+%D8% AA%D8%B4%DA%A9%D8%B1+%D8%A7%D8%B2+%D8%B4%D9%85%D8% A7+%D8%8C+%D8%B4%D9%85%D8%A7+%D8%B4%D8%A7%D9%85%D9 %84%D9%87+20+%+%D8%AA%D8%AE%D9%81%D9%8A%D9%81+%D8% B4%D8%AF%D9%87+%D8%A7%D9%8A%D8%AF

اینکد سایت :

%d8%a8%d9%87+%d9%88%d8%a8+%d8%b3%d8%a7%d9%8a%d8%aa +%d8%a8%d8%b1%d9%86%d8%a7%d9%85%d9%87+%d9%86%d9%88 %d9%8a%d8%b3%d9%8a+%d8%a8%d8%b1%d9%86%d8%a7%d9%85% d9%87+%d9%86%d9%88%d9%8a%d8%b3+%d8%ae%d9%88%d8%b4+ %d8%a2%d9%85%d8%af%d9%8a%d8%af+.+%d8%a8%d8%a7+%d8% aa%d8%b4%da%a9%d8%b1+%d8%a7%d8%b2+%d8%b4%d9%85%d8% a7+%d8%8c+%d8%b4%d9%85%d8%a7+%d8%b4%d8%a7%d9%85%d9 %84%d9%87+20+%25+%d8%aa%d8%ae%d9%81%d9%8a%d9%81+%d 8%b4%d8%af%d9%87+%d8%a7%d9%8a%d8%af



خیلی نگا کردم که ببینم فرقشون چه !! فرقشون مثله اینکه توی اون عدد 25 هستش
که توی پایینی هست اما توی بالایی نیست

[meys34]

خدا خیرت بده

والا یه برنامه ارسال اس ام اس دارم درس می کنم که توی اون حتما باید متن به صورت UNICOD باشه

نمیگم برنامه شما ایراد داره ، هر متنی رو که با ماله شما encode میکنم بعد با اون سایته decode میکنم درسته و ایرادی نداره
اما برنامه ی ارسال اس ام اس متن Encode شده توسط برنامه شما رو ارسال نمی کنه اما ماله سایت رو بدونه هیچ Error ی ارسال می کنه تفائت کد ها رو ببینید :

متن مورد نظر : "به وب سايت برنامه نويسي برنامه نويس خوش آمديد . با تشکر از شما ، شما شامله 20 % تخفيف شده ايد"

اینکد برنامه شما :

%D8%A8%D9%87+%D9%88%D8%A8+%D8%B3%D8%A7%D9%8A%D8%AA +%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D9%87+%D9%86%D9%88 %D9%8A%D8%B3%D9%8A+%D8%A8%D8%B1%D9%86%D8%A7%D9%85% D9%87+%D9%86%D9%88%D9%8A%D8%B3+%D8%AE%D9%88%D8%B4+ %D8%A2%D9%85%D8%AF%D9%8A%D8%AF+.+%D8%A8%D8%A7+%D8% AA%D8%B4%DA%A9%D8%B1+%D8%A7%D8%B2+%D8%B4%D9%85%D8% A7+%D8%8C+%D8%B4%D9%85%D8%A7+%D8%B4%D8%A7%D9%85%D9 %84%D9%87+20+%+%D8%AA%D8%AE%D9%81%D9%8A%D9%81+%D8% B4%D8%AF%D9%87+%D8%A7%D9%8A%D8%AF

اینکد سایت :

%d8%a8%d9%87+%d9%88%d8%a8+%d8%b3%d8%a7%d9%8a%d8%aa +%d8%a8%d8%b1%d9%86%d8%a7%d9%85%d9%87+%d9%86%d9%88 %d9%8a%d8%b3%d9%8a+%d8%a8%d8%b1%d9%86%d8%a7%d9%85% d9%87+%d9%86%d9%88%d9%8a%d8%b3+%d8%ae%d9%88%d8%b4+ %d8%a2%d9%85%d8%af%d9%8a%d8%af+.+%d8%a8%d8%a7+%d8% aa%d8%b4%da%a9%d8%b1+%d8%a7%d8%b2+%d8%b4%d9%85%d8% a7+%d8%8c+%d8%b4%d9%85%d8%a7+%d8%b4%d8%a7%d9%85%d9 %84%d9%87+20+%25+%d8%aa%d8%ae%d9%81%d9%8a%d9%81+%d 8%b4%d8%af%d9%87+%d8%a7%d9%8a%d8%af



خیلی نگا کردم که ببینم فرقشون چه !! فرقشون مثله اینکه توی اون عدد 25 هستش
که توی پایینی هست اما توی بالایی نیست

این قضیه هم مربوط میشه به چیزی که من هی دارم میگم و شما گوش نمیدی

شما باید این موضوع رو هم در نظر بگیرید ها یعنی در آخر Safe بودن رو چک کنید...
کاراکتر % اگر توی متن باشه باید به کد هگز تبدیل بشه برادر من...

temp = Replace$(temp, "%", "%25")
همینطور کاراکتر Space که اینجوری شد
temp = Replace$(Text1.Text, " ", "+")
و کاراکتر ، که میشه
temp = Replace$(temp, ",", "%" & Chr(",")))
و کاراکتر .....



اصلا اینایی که گفتم رو در نظر نگیر...
یه کار دیگه کردم...

برای تمام کاراکتر ها این تبدیل رو انجام دادم ... بعید میدونم دیگه مشکلی داشته باشه.... شک داشتی برو به قسمت دیکد:
http://www.opinionatedgeek.com/dotnet/tools/urlencode/Decode.aspx

فقط این قسمت عوض شد بقیه جاها همونه که بود
Private Sub Command1_Click()
Dim s As String, x As Long

Text2.Text = Empty
Dim temp As String
temp = Text1
'temp = Replace$(Text1.Text, " ", "+")
'temp = Replace$(temp, "%", "%25")
'temp = Replace$(temp, ",", "%2C")


For x = 1 To Len(temp)
If Asc(Mid(temp, x, 1)) = AscW(Mid(temp, x, 1)) Then
Text2.Text = Text2.Text & "%" & Hex(Asc(Mid(temp, x, 1)))
Else
Text2.Text = Text2.Text & Calculate(CLng(AscW(Mid(temp, x, 1))))
End If
Next x

End Sub

[star_star]

حاصل "سلام
چطوری"
با سایت : %d8%b3%d9%84%d8%a7%d9%85+%0d%0a%da%86%d8%b7%d9%88% d8%b1%db%8c
با برنامه : %d8%b3%d9%84%d8%a7%d9%85%D%A%da%86%d8%b7%d9%88%d8% b1%d9%8a

کلا با این ایده شما بهم ریخت !!!!!

آقای just4froum (http://barnamenevis.org/member.php?211054-just4froum) مثل اینکه باید خودتون دست به کار بشید به داد من برسید (ممنون)

[star_star]

UTF-8 هم یونی کد است !
یونی کدی برای فارسی و عربی نویسی در URL است

[سید حمید حق پرست]

سلام علیکم
دوست عزیز یک روش دیگر در زهن دارم
که با سایت مورد نظر شما یکی میشه
فقط وقت زیاد میبره . اگر فقط واسه متن بالا میخواید بگو تا شروع کنم و اگر همه نوعه که:گیج:

موفق باشید


یا علی(ع)

[just4froum]

با سلام .

می خواستم امروز مجموع کامل utf-8 رو بگذارم اما بسیار سرم شلوغ بود نرسیدم. (گفته بودم زیاد یادم نیست 5 ساعت وقت می خواد)

جناب star_star کد زیر کار شما رو راه می اندازد ولی از نظر من یک جور ماستمالی کردنه. انشاالله وقت آوردم حتما کل utf-8 رو میگذارم.

Const adSaveCreateOverWrite = 2
Const ForReading = 1

Private Function WriteFile(sFile, sText)
With CreateObject("ADODB.Stream")
.open
.Charset = "UTF-8"
.WriteText sText
.SaveToFile sFile, adSaveCreateOverWrite
End With
End Function

Private Sub Command1_Click()
If Dir("C:\utf8.txt", vbHidden Or vbReadOnly Or vbSystem) <> Empty Then Call SetAttr("C:\UTF8.txt", vbNormal): Kill "C:\UTF8.txt": Pause 1
Call WriteFile("C:\UTF8.txt", Text1.Text): Pause 1

Dim File() As Byte
ReDim File(1 To FileLen("C:\UTF8.txt"))

Open "C:\UTF8.txt" For Binary As 1
Get #1, , File
Close #1

Text2.Text = Empty

For x = 4 To UBound(File)
If File(x) <= 127 And File(x) >= 33 Then
Text2.Text = Text2.Text & Chr(File(x))
Else
Text2.Text = Text2.Text & "%" & Num2Hex(Int(CLng(File(x)) / 16)) & Num2Hex(CLng(File(x)) Mod 16)
End If
Next x

Text2.Text = Replace(Text2.Text, "%20", "+")
Text2.Text = Replace(Text2.Text, "%D9%8A", "%DB%8C") ' Replace ye farsi (Farghi nadare)

MsgBox "Done!", vbInformation
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)

End Sub


Private Function Num2Hex(Num As Byte) As String

If IsNumeric(Num) = True Then
If Num <= 9 And Num >= 0 Then Num2Hex = CStr(Num): Exit Function
End If

Select Case Num

Case 10
Num2Hex = "A"
Case 11
Num2Hex = "B"
Case 12
Num2Hex = "C"
Case 13
Num2Hex = "D"
Case 14
Num2Hex = "E"
Case 15
Num2Hex = "F"
End Select

End Function

Private Sub Pause(Num As Long)
Dim m As Long
m = Timer

Do While m + Num <> Timer
DoEvents
Loop
End Sub

[star_star]

آقا خودم مثله اینکه باید دست به کار بشم . کسی هست که کمک کنه ؟؟؟

:ناراحت::ناراحت::ناراحت::نار� �حت::ناراحت::ناراحت::ناراحت::� �اراحت::ناراحت::ناراحت::نارا� �ت::ناراحت::ناراحت::ناراحت::ن� �راحت::ناراحت::ناراحت::ناراح� �::ناراحت::ناراحت::ناراحت::نا� �احت::ناراحت:

[just4froum]

آقا خودم مثله اینکه باید دست به کار بشم . کسی هست که کمک کنه ؟؟؟

:ناراحت::ناراحت::ناراحت::نار� �حت::ناراحت::ناراحت::ناراحت::� �اراحت::ناراحت::ناراحت::نارا� �ت::ناراحت::ناراحت::ناراحت::ن� �راحت::ناراحت::ناراحت::ناراح� �::ناراحت::ناراحت::ناراحت::نا� �احت::ناراحت:

ببخشید کد بالا که کامله مشکل شما الان چیه ؟

[سید حمید حق پرست]

سلام علیکم

اخرش نوشتم . فقط یک ساعت وقت برد . میشه گفت دقیقا مثل سایت هست:لبخند:
حتی علامتهای : @ # $ % ^ a & * ' " ? ؟ , و غیره
که سرعتشم برای ENCODE مثل باد هست
این exe ببین درسته . اگر اره بگو سورسشو میزارم
خودم امتحان کردم و مثل سایت که دادید کار میکنه

موفق باشید


یا علی (ع)

[star_star]

شما اومدید 20% رو ماست مالی کردی خیلی از پارامترای دیگه کار نمیکنه مثلا "&" و......
همچنین کد شما یکم طول میکشه تا اینکد کنه !!!!!

خودم نشستم حلش کردم ، با افتخار تقدیم می کنم URL Encoder هم فارسی هم انگلیسی رو اینکد می کنه

هرکی استفاده کرد مارو هم دعا کنه :لبخندساده::لبخندساده:

یا علی مدد


88741

[star_star]

سلام علیکم

اخرش نوشتم . فقط یک ساعت وقت برد . میشه گفت دقیقا مثل سایت هست:لبخند:
این exe ببین درسته . اگر اره بگو سورسشو میزارم
خودم امتحان کردم و مثل سایت که دادید کار میکنه

موفق باشید


یا علی (ع)



داداش خودم حلش کردم

[سید حمید حق پرست]

سلام علیکم


داداش خودم حلش کردمدوست عزیز اول پیغام خصوصی میدید که جواب اون تاپیک رو بدید بعد من میرم مینویسم و یک ساعت وقت خودمو تلف میکنم و شما الان میای میگی خودم نوشتم
والا دیگه نوبرشه . بیای یک ساعت وقت بزاری بعد هم بگه خودم نوشتم

اینم سورس کد
به نظرم این راه سریعترین و بهترین راهه
خیلی هم اسونه ولی برای نوشتنش وقت و حوصله میخواد و فکر نکنم کسی حوصله نوشتنشو نداشته باشه
به هر صورت من میزارمش هرکی خواست استفاده کنه

اول کدش :

Private Sub Command1_Click()
Dim r As String
r = Text1.Textr = Replace(r, "%", "%25")
r = Replace(r, "ا", "%d8%a7")
r = Replace(r, "آ", "%d8%a2")
r = Replace(r, "ب", "%d8%a8")
r = Replace(r, "پ", "%d9%be")
r = Replace(r, "ت", "%d8%aa")
r = Replace(r, "ث", "%d8%ab")
r = Replace(r, "ج", "%d8%ac")
r = Replace(r, "چ", "%da%86")
r = Replace(r, "ح", "%d8%ad")
r = Replace(r, "خ", "%d8%ae")
r = Replace(r, "د", "%d8%af")
r = Replace(r, "ذ", "%d8%b0")
r = Replace(r, "ر", "%d8%b1")
r = Replace(r, "ز", "%d8%b2")
r = Replace(r, "ژ", "%da%98")
r = Replace(r, "س", "%d8%b3")
r = Replace(r, "ش", "%d8%b4")
r = Replace(r, "ص", "%d8%b5")
r = Replace(r, "ض", "%d8%b6")
r = Replace(r, "ط", "%d8%b7")
r = Replace(r, "ظ", "%d8%b8")
r = Replace(r, "ع", "%d8%b9")
r = Replace(r, "غ", "%d8%ba")
r = Replace(r, "ف", "%d9%81")
r = Replace(r, "ق", "%d9%82")
r = Replace(r, "ک", "%da%a9")
r = Replace(r, "گ", "%da%af")
r = Replace(r, "ل", "%d9%84")
r = Replace(r, "م", "%d9%85")
r = Replace(r, "ن", "%d9%86")
r = Replace(r, "و", "%d9%88")
r = Replace(r, "ه", "%d9%87")
r = Replace(r, "ي", "%d9%8a")
r = Replace(r, "ئ", "%d8%a6")
r = Replace(r, "ء", "%d8%a1")
r = Replace(r, "ة", "%d8%a9")
r = Replace(r, "ؤ", "%d8%a4")
r = Replace(r, "إ", "%d8%a5")
r = Replace(r, "أ", "%d8%a3")
r = Replace(r, "؟", "%d8%9f")
r = Replace(r, "،", "%d8%8c")
r = Replace(r, "؛", "%d8%9b")
r = Replace(r, "ـ", "%d9%80")
r = Replace(r, "«", "%c2%ab")
r = Replace(r, "»", "%c2%bb")
r = Replace(r, "َ", "%d9%8e")
r = Replace(r, "ً", "%d9%8b")
r = Replace(r, "ٌ", "%d9%8c")
r = Replace(r, "ٍ", "%d9%8d")
r = Replace(r, "ُ", "%d9%8f")
r = Replace(r, "ِ", "%d9%90")
r = Replace(r, "ّ", "%d9%91")
r = Replace(r, ",", "%2c")
r = Replace(r, "]", "%5d")
r = Replace(r, "[", "%5b")
r = Replace(r, "\", "%5c")
r = Replace(r, "}", "%7d")
r = Replace(r, "{", "%7b")
r = Replace(r, ":", "%3a")
r = Replace(r, "|", "%7c")
r = Replace(r, "?", "%3f")
r = Replace(r, ";", "%3b")
r = Replace(r, "<", "%3c")
r = Replace(r, ">", "%3e")
r = Replace(r, "@", "%40")
r = Replace(r, "#", "%23")
r = Replace(r, "$", "%24")
r = Replace(r, "^", "%5e")
r = Replace(r, "&", "%26")
r = Replace(r, "=", "%3d")
r = Replace(r, "'", "%27")
r = Replace(r, "+", "+")
r = Replace(r, L1.Caption, "%22")
r = Replace(r, " ", "+")
Text2.Text = r
End Sub




سورسشم دانلود کنید

موفق باشید


یا علی (ع)

[just4froum]

شما اومدید 20% رو ماست مالی کردی خیلی از پارامترای دیگه کار نمیکنه مثلا "&" و......
همچنین کد شما یکم طول میکشه تا اینکد کنه !!!!!

خودم نشستم حلش کردم ، با افتخار تقدیم می کنم URL Encoder هم فارسی هم انگلیسی رو اینکد می کنه



آقای حق پرست شما خودتو ناراحت نکن . من و شما و جناب meys34 این همه وقت گذاشتیم و روی این مسئله کار کردیم اونوقت جناب star_star رفته از اینترنت یه سورس پیدا کرده و حتی وقت نگذاشته بیاد سورسشو امتحان کنه بعد بیاد با افتخار تقدیم کنه.

شما برو توی همون سایتی که گفتی بزن a بیا توی برنامه خودت هم بزن ببین چی میشه؟

درسته سورس من علامت هایی رو که شیفت رو میگیرید و اعداد رو میزنید ساپورت نمیکنه اونم حواسم نبود وگرنه درست می کردم اگر بالا بخونید گفتم سرم شلوغ بود و ماستمالی کردم وقت آوردم کاملشو می گذارم. سورس ماله شما تمامی اعداد و حروف انگلیسی رو درست نمیزنه اونوقت گیرداده به چهار تا علامت هایی که هیچوقت توی sms استفاده نمیشه.:گیج::گیج::گیج:

[star_star]

دوستان قصد توهین به کسی رو ندارم بابت انجام برنامه هاتون هم بارها از همتون تشکر کردم
اما بخدا من خودم وقت نداشتم باید سریعتر حلش می کردم ، سورسی که من گذاشتم از همه کامل تر هستش چون هم فارسی رو ساپورت میکنه هم انگلیسی رو .
اصلان نیازی به جایگزین کردن نیست اونطوری سرعت میاد پایین ، این Encoding توی توابع API ویندوز موجود هستش

از همگی ممنون اما خوبیش اینه که این مساله کاملا حل شد و حالا سایت برنامه نویسه که فقط راه حل کامل این مشکل رو داره

اینم به افتخار همه درستتون درد نکنه :تشویق::تشویق::تشویق::تشویق::� �شویق::تشویق:


آقای just4froum (http://barnamenevis.org/member.php?211054-just4froum) از اینترنت پیدا نکردم ، چند تا کتاب دارم رفتم فهمیدم باید چکار کنم ، هر کسی تونست ایراد بگیره بهش جایزه میدم اون موقعه ایراد از مایکروسافت گرفته
سورس های شما می اومد فقط جایگزین می کرد اما ماله من میاد از API ویندوز که هستش می خونه

بگرد توی اینترنت اگه پیدا می شد که مزاحم شما عزیزان نمی شدم

[سید حمید حق پرست]

سلا علیکم

سورسی که من گذاشتم از همه کامل تر هستش چون هم فارسی رو ساپورت میکنه هم انگلیسی رو .بیخودی به سورس ما و سورس just4froum (http://barnamenevis.org/member.php?211054-just4froum) گیر نده . سورستون اصلا درست کار نمیکنه:قهقهه:


آقای just4froum (http://barnamenevis.org/member.php?211054-just4froum) از اینترنت پیدا نکردم ، چند تا کتاب دارم رفتم فهمیدم باید چکار کنم ، هر کسی تونست ایراد بگیره بهش جایزه میدم اون موقعه ایراد از مایکروسافت گرفته
خودتو با مایکروسافت مقایسه نکن . مایکروسافت کجا و تو کجا!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!:متعجب:
اینم ایراد :بامزه: :
حرف "ی" با برنامه شما :
%D9%8A
با سایت :
%db%8c
دیگه بیخودی نگو کاملتره
مال اقای just4froum (http://barnamenevis.org/member.php?211054-just4froum) و بعد بنده کاملتره .

یا علی

[just4froum]

آقا بسه دیگه صلح کنید :قلب:
این دفه دومه که دارم این متنو می نویسم دفعه اول برقا رفت شانسو میبینی :عصبانی++:

در باره ماست مالی خودم بگم اول :خجالت: : منظور من از ماست مالی این نبود که اومدم %20 رو با + جایگزین کردم چون شما هم باید دقیقا این کارو بکنید پایین میگم. منظور من این بود که میام یه فایل متنی با فرمت utf8 ایجاد می کنم بعد متن شمارو میریزم توش و بعد بایت های اونو تک تک می خونم که مجبورم 1 ثانیه صبر کنم تا فایل ساخته بشه (Pause 1).

در مورد API ممنون من واقعا این API رو نمی دونستم ولی این API هم میاد کار منو می کنه یعنی بایت یا بایت های یک حرف رو به شما میده که شما هم اومدین همه رو به صورت Hex در آوردین که این غلط هست.
در URL Encoder شما باید حروف انگلیسی و اعداد و نماد های جمع و ضرب و .. و علامت هایی مانند ! @ # $ % و .. رو به Hex تبدیل نکنید و همینجوری در متن به کار ببرید و مشکل سورس شما هم همینه جناب star_star . شما اگر یک حرف انگلیسی مانند a رو در سورس خود بزنید نتیجه میشود %61 درصورتی که باید به صورت همون a به کار ببرید.

و برخی نیز نماد های مخصوص به خود را دارند یعنی %20 نماد hex فاصله هست که باید با + جایگیزین شود

در مورد "ی" نیز هر دو درست هستند ما در utf8 دقیق نمیدونم ولی فکر کنم 5-6 تا "ی" داریم ولی جناب star_star بهتر هست با هر کدام تست کنید ببینید با کدام "ی" در اس ام اس جواب میده.

[star_star]

من که با ماله خودم مشکلی ندارم !!
جناب حق پرست برو توی قسمت Decode سایت اینو بزن "%D9%8A" ببین چی تحویلت میده !!!! "ی"
در هر صورت هم از just4froum هم از آقای حق پرست ممنونم

یا علی

[frosh99@gmail.com]

دمت گرم خیلس به دردم خورد