mkbo_webmaster
پنج شنبه 31 فروردین 1385, 01:30 صبح
من یه تابع به زبان VB6 نوشتم که میتونه با بکار گیری توابع API تشخیص بده که آیا سیستم عامل شما بطور کامل فارسی رو پشتیبانی میکنه یا نه ؟
که با Windows me به بالا کار میکنه.
لازم به ذکره که بخاطر نوشتن این کد سه تا برنامه جداگانه نوشتم که کدهای فارسی رو پیدا کنم و حسابی جونم در اومد. امیدوارم که برای توسعه نرم افزارهای دوستان مفید واقع بشه.
Public Function Is_Your_OS_Full_Farsi_Support() As Boolean
Dim Buffer As String, Retval As String
Dim GetInfo As String
Dim CYINFO As Integer
Dim Info As Long
For CYINFO = 1 To 11
Select Case CYINFO
Case 1
Info = LOCALE_SENGLANGUAGE
Case 2
Info = LOCALE_SABBREVLANGNAME
Case 3
Info = LOCALE_IDEFAULTLANGUAGE
Case 4
Info = LOCALE_IDEFAULTCOUNTRY
Case 5
Info = LOCALE_IDEFAULTCODEPAGE
Case 6
Info = LOCALE_SENGCOUNTRY
Case 7
Info = LOCALE_SABBREVCTRYNAME
Case 8
Info = LOCALE_ILANGUAGE
Case 9
Info = LOCALE_SLANGUAGE
Case 10
Info = LOCALE_ICOUNTRY
Case 11
Info = LOCALE_SCOUNTRY
End Select
Buffer = String$(255, 0)
Retval = GetLocaleInfo(LOCALE_USER_DEFAULT, Info, Buffer, Len(Buffer))
If Retval > 0 Then
GetInfo = Left$(Buffer, Retval - 1)
Else
GetInfo = ""
End If
Select Case CYINFO
Case 1
If GetInfo <> "Farsi" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 2
If GetInfo <> "FAR" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 3
If GetInfo <> "0429" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 4
If GetInfo <> "981" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 5
If GetInfo <> "720" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 6
If GetInfo <> "Iran" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 7
If GetInfo <> "IRN" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 8
If GetInfo <> "0429" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 9
If GetInfo <> "Farsi" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 10
If GetInfo <> "981" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 11
If GetInfo <> "Iran" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
End Select
Next CYINFO
Is_Your_OS_Full_Farsi_Support = True
End Function
/
که با Windows me به بالا کار میکنه.
لازم به ذکره که بخاطر نوشتن این کد سه تا برنامه جداگانه نوشتم که کدهای فارسی رو پیدا کنم و حسابی جونم در اومد. امیدوارم که برای توسعه نرم افزارهای دوستان مفید واقع بشه.
Public Function Is_Your_OS_Full_Farsi_Support() As Boolean
Dim Buffer As String, Retval As String
Dim GetInfo As String
Dim CYINFO As Integer
Dim Info As Long
For CYINFO = 1 To 11
Select Case CYINFO
Case 1
Info = LOCALE_SENGLANGUAGE
Case 2
Info = LOCALE_SABBREVLANGNAME
Case 3
Info = LOCALE_IDEFAULTLANGUAGE
Case 4
Info = LOCALE_IDEFAULTCOUNTRY
Case 5
Info = LOCALE_IDEFAULTCODEPAGE
Case 6
Info = LOCALE_SENGCOUNTRY
Case 7
Info = LOCALE_SABBREVCTRYNAME
Case 8
Info = LOCALE_ILANGUAGE
Case 9
Info = LOCALE_SLANGUAGE
Case 10
Info = LOCALE_ICOUNTRY
Case 11
Info = LOCALE_SCOUNTRY
End Select
Buffer = String$(255, 0)
Retval = GetLocaleInfo(LOCALE_USER_DEFAULT, Info, Buffer, Len(Buffer))
If Retval > 0 Then
GetInfo = Left$(Buffer, Retval - 1)
Else
GetInfo = ""
End If
Select Case CYINFO
Case 1
If GetInfo <> "Farsi" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 2
If GetInfo <> "FAR" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 3
If GetInfo <> "0429" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 4
If GetInfo <> "981" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 5
If GetInfo <> "720" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 6
If GetInfo <> "Iran" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 7
If GetInfo <> "IRN" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 8
If GetInfo <> "0429" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 9
If GetInfo <> "Farsi" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 10
If GetInfo <> "981" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
Case 11
If GetInfo <> "Iran" Then
Is_Your_OS_Full_Farsi_Support = False
Exit Function
End If
End Select
Next CYINFO
Is_Your_OS_Full_Farsi_Support = True
End Function
/