تشخیص حرف فارسی

[aleas2]

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

[m.4.r.m]

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

این کد ها برای تشخیص اعداد و حروف در رشته رو مشخص می کنند

Function GetNumbers(Value As String) As String
Dim Index As Long
Dim Final As String

For Index = 1 To Len(Value)
If Mid(Value, Index, 1) Like "[0-9]" Then
Final = Final & Mid(Value, Index, 1)
End If
Next

GetNumbers = Final
End Function

Function GetString(Value As String) As String
Dim Index As Long
Dim Final As String

For Index = 1 To Len(Value)
If Mid(Value, Index, 1) Like "[a-z]" Then
Final = Final & Mid(Value, Index, 1)
End If
Next

GetString = Final
End Function

Private Sub Form_Load()
MsgBox GetNumbers("1gg4345hh45353")
MsgBox GetString("1gg4345hh45353")
End Sub

[aleas2]

ممنون این کدی شما گذاشتین برای حروف انگلیسی شرمنده فقط کد اسکی حروف فارسی از چند تا چنده؟!(فقط حروف فارسی نه اعداد فارسی!)

[m.4.r.m]

کارت رو راحت کردم اینو تست کن ببین جواب میگیری

Function GetString(Value As String) As String
Dim Index As Long
Dim Final As String

For Index = 1 To Len(Value)
If Mid(Value, Index, 1) Like "[آ-ي]" Then
Final = Final & Mid(Value, Index, 1)
End If
Next

GetString = Final
End Function


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

&#1570 آ
&#1574 ئ
&#1575 ا
&#1576 ب
&#1578 ت
&#1579 ث
&#1580 ج
&#1581 ح
&#1582 خ
&#1583 د
&#1584 ذ
&#1585 ر
&#1586 ز
&#1587 س
&#1588 ش
&#1589 ص
&#1590 ض
&#1591 ط
&#1592 ظ
&#1593 ع
&#1594 غ
&#1601 ف
&#1602 ق
&#1604 ل
&#1605 م
&#1606 ن
&#1607 ه
&#1608 و
&#1662 پ
&#1670 چ
&#1688 ژ
&#1705 ک
&#1711 گ
&#1740 ی

[miladatashin]

الگوریتمی که m.4.r.m عزیز گفتن اصلا برای متن های طولانی مناسب نیست و مرتبه زمانی برنامه خیلی زیاد میشه. اگه متن طولانی هست پیشنهاد میکنم به جای اینکه تک تک حروف رو چک کنید تو یک حلقه 32 تا حروف فارسی رو توی رشته با تابع instr جستجو کنید. در بدترین شرایط بعد از اینکه 32 بار تابع instr اجرا بشه خروجی مشخص میشه.

[m.4.r.m]

کاش یک تست می کردی دوست عزیز شما این متن رو بده به تکست باکس بعد خروجی بگیر ببین چند ثانیه طول میکشه ؟

{
\rtf1\fbidis\ansi\deff0{\fonttbl{\f0\fnil\fcharset 0 Tahoma;}{\f1\fnil\fcharset178 Tahoma;}{\f2\fnil\fcharset238 Tahoma;}}
\viewkind4\uc1\pard\ltrpar\lang1065\f0\fs17 |^uxk7cnksou\'80jp~\'84\{oxz|\}H\rdblquote v\f1\rtlch\'81\'8b\'8b\rquote\ldblquote\'82\'8d\'9 d\f0\ltrch \f1\rtlch\'8a\f0\ltrch U\'82\f1\rtlch\'8d\endash\rquote\endash\'87\rquote \'90\endash\'90\f0\ltrch\'a2\'a4\emdash\'a7dU\f1\r tlch\'8a\'98\f0\ltrch\~\'a8\'a7\'9cw\f1\rtlch\'ba\ 'b9\f0\ltrch\'9b\'a6r\u8205?\'a9\'b2\'ae\'b2\'a3\' ae\'ac\'b2\'ac\'be\f1\rtlch\'c0\'b3\'c3\'81\'88\'8 a\f0\ltrch s\'a8\'b6\'be\f1\rtlch\'c6\'c5\'ba\bullet\'d8\'d9\ f0\ltrch jh\'bb\f1\rtlch\'d6\'ca\'c7\'da\'cf\'ce\'d4\'cb\f2 \ltrch\u339?\f1\rtlch\'c5\'df\'ce\'9d\'c9\'de\'d0\ f0\ltrch\'e2\f1\rtlch\'d5\'ce\'df\f0\ltrch\'e8\'e7 \f1\rtlch\'e6\'d8\f0\ltrch\'ea\f1\rtlch\'d5\'e6\'d c\f0\ltrch\'ea\f1\rtlch\'e4\'af\'af\'b6\'b6\'de\f0 \ltrch\'e9\'b4\f1\rtlch\'e1\'ec\'fa\'b9\'c0\'aa\'e 6\'d5\f0\ltrch\'fb\'02\'04\u1612?\u8206?\f1\rtlch\ 'fe\'e6\f0\ltrch\'fc\f1\rtlch\'fe\f0\ltrch\'fb\'04 \'fc\'b9\f1\rtlch\'ed\f0\ltrch\'05\tab\'03
\par \'14\u8206?\'ae\'ac\f1\rtlch\'ff\f0\ltrch\'15\'07\ '19\f1\rtlch\'c7\'fe\f0\ltrch\'0f\'1d\'1f\'16\'1d\ '1d\f1\rtlch\'ec'\'e3\f0\ltrch\'e0\f1\rtlch\'e5\'e 4\'e3\'e6\f0\ltrch\'e7\'e8\f1\rtlch\'c6\'c4\f0\ltr ch\'18-\'1f\f1\rtlch 1\'df\f0\ltrch\'07+/)\'02\'12\f1\rtlch 6\f0\ltrch /\'e8\'10482\f1\rtlch\'da\'d8\f0\ltrch ,A3E\u1614?0\'17GHEC>=QGNN>\'ee\f1\rtlch\'ec\f0\ltrch @UGY\'087KXQ*20?\u8206?\'fbOdVh\'17N^lnell<3/7\'10\'0eavhz)Mzy\}o\}\'89N_|w\'87\'85\f1\rtlch\'8 a\f0\ltrch\'87\f1\rtlch\'8e\f0\ltrch (&y\f1\rtlch\'8e\f0\ltrch\'80\rquote A\}u\'89\f1\rtlch\'98\f0\ltrch\endash\endash\endas h\'9c\f1\rtlch\'8f\}\lquote\~\'a3\'9b\'a4\'8e?=\'9 0\f0\ltrch\'a5\emdash\'a9X\'8b\f1\rtlch\'9f\'ae\'b 1\'a9\'b2\f0\ltrch\'82\'af\'a5\'a7\'80qvxTR\'a5\f1 \rtlch\'ba\f0\ltrch\'ac\'bem\f1\rtlch\'a1\f0\ltrch \'b4\'b3\f1\rtlch\'c5\'bb\'c2\'c2\rquote\'a3\'bc\' cb\'cc\'bb\'c2\'c1\'9f\'cd\'d7\'8d\f0\ltrch\lquote om\f1\rtlch\'c0\'d5\'c7\'d9\'88\'b4\'cf\'e4\f0\ltr ch\'a9zx\f1\rtlch\'cb\f0\ltrch\'e0\f1\rtlch\'d2\'e 4\ldblquote\'c8\f0\ltrch\'ee\f1\rtlch\'e6\'dc\f0\l trch\'b5\'a9\'87\'85\f1\rtlch\'d8\'ed\'df\'f1\~\'d d\f0\ltrch\'e8\'b4\'e0\'f7\u1618?\u1614?\'eb\u1612 ?\f1\rtlch\'aa\'98\f0\ltrch\endash\'e9\f1\rtlch\'f e\'f0\f0\ltrch\'03\'b1\'10\~\u8205?
\par }


یادمون نره Cpu های امروزی Core I7 هستند و رم هامون 4 گیگ به بالا سرعت پردازش بر اساس میلیارد بر ثانیه هستند دیگه دوران بدبختی با سیستم های اهل تیر کمون سنگی تموم شد . بازم هم خوشحالم که انتقاد کردین ممنون از شما دوست عزیز

[miladatashin]

امیدوارم نارحت نشده باشن من خیلی از پست های شما رو دیدم و میدونم برنامه نویس خوبی هستید. لازم به تست نیست معلومه به هزارم ثانیه نمیرسه. ولی شما فرض کنید قراره صد هزار فایل بزرگ جستجو بشه بازم مهم نیست؟ در مورد بحث cpu های امروزی هم به نظر من اشتباه میکنید.با قوی تر شدن پردازنده ها برنامه ها هم سنگین تر میشن و همیشه بهینه کد زدن باید رعایت بشه. من و خیلی ها وقتی رم کامپیوترمون 32 مگ بود(خیلی پیش ها) فکر میکردم با این همه حافظه هیچ وقت برنامه هامون حافظه کم نمیاره !!!

[m.4.r.m]

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

[mmssoft]

جدا از مسئله بهینه بودن، میشه با یه تغییر کوچیک، کد آقای m.4.r.m رو به شکل زیر تغییر داد که استفاده ازش راحت تره. تنها مشکلی که این کد داره اینه که حرکت رو جز حروف فارسی محاسبه نمیکنه ؛ یعنی اگر توی متن " ُ " و ... باشه، مقدار False رو بر میگردونه :

Function isFarsi(Value As String) As Boolean

Dim Index As Long
Dim Final As String

For Index = 1 To Len(Value)

If Mid(Value, Index, 1) Like "[آ-ی]" Then
Final = Final & Mid(Value, Index, 1)
End If
Next

If Trim(Final) = "" Then isFarsi = False Else isFarsi = True

End Function

Private Sub Command1_Click()
If isFarsi(Text1.Text) = True Then Msgbox "Don't use farsi words!"
End Sub

[as987498749874]

یه الگوریتم درست کردم ! معرکههههههههههههه
تکست رو قفل کن و توی keyascii بنویس

Convert keyascii,Text1,Farsi

تشکر رو فراموش نکنی
فقط من از FlatEdit استفاده میکنم توی ماژول تکستش کن

اگه بجای فارسی Other بزنی میتونی توی قسمت بعد هر کانورت چند حرف خاص یا ... وارد کنی

[mehran901]

یه الگوریتم درست کردم ! معرکههههههههههههه

الگوریتمو انگار خیلی خوب درست نکردین ، فانکشن To_Hejri رو یادتون رفته بود بنویسین!! :لبخند: و البته آرگمان سوم تو بخش enum ها اصلا farsi ای وجود نداره بلکه باید با عبارت _ بیارین Farsi_

ولی درکل لایک داشت

[vbhamed]

سلام
اينم تست وجود حروف فارسي به همراه اعراب و ...
Public Sub Check(ByVal txt As String)

Dim f$, i%

f = "اآبپتثجچحخدرزژسشصضطظعغفقک گلمنوهيئؤىًٌٍةةَُِّْـءأإي"

For i = 1 To Len(txt)

If InStr(f, Mid$(txt, i, 1)) Then Exit For

Next

If i <= Len(txt) Then MsgBox "Error"

End Sub

[vbhamed]

سلام
اينم تست وجود حروف فارسي به همراه اعراب و ...، هر حرفي هم خواستيد مي‌تونيد اضافه كنيد
البته چون ممكنه بعضي حروف اينجا درست نشون داده نشن فايل ضميمه رو دانلود كنيد
Public Sub Check(ByVal txt As String)

Dim f$, i%

f = "اآبپتثجچحخدرزژسشصضطظعغفقک گلمنوهيئؤىًٌٍةةَُِّْـءأإي"

For i = 1 To Len(txt)

If InStr(f, Mid$(txt, i, 1)) Then Exit For

Next

If i <= Len(txt) Then MsgBox "Error"

End Sub