А коды кончились :-(((( Присылайте, если что есть...
Читайте!

Книги

		Переход на VB .NET. Стратегии, концепции, код (цена ~ 158 руб.) Эта книга была задумана как одна из первых книг о .NET, которая ознакомит читателя с основными идеями новой архитектуры и подготовит его к знакомству с более детальной литературой, например документацией Microsoft и ее толкованиями, которая неизбежно появится на рынке. Она поможет вам взглянуть на эту технологию с позиций ваших собственных рабочих планов и быстро освоить те концепции, которые покажутся необычными для большинства прогр...
		Автор(ы): Дан Эпплман, Издательство: Питер, 2002 г.
		Программирование на VB.NET. Учебный курс (цена ~ 119 руб.) Эта книга является вводным курсом по изучению языка программирования Visual Basic .NET. Даны основные принципы объектно-ориентированного программирования в контексте языка VB .NET, поскольку без хорошей подготовки в этой области невозможно в полной мере пользоваться всеми преимуществами VB .NET. Изложены азы всех аспектов языка, которыми должен владеть любой профессиональный разработчик VB .NET
		Автор(ы): Г. Корнелл, Дж. Моррисон, Издательство: Питер, 2002 г.
		VB.NET для разработчиков (цена ~ 125 руб.) Основная задача книги - быстро ознакомить разработчиков Visual Basic с изменениями в .NET Framework. Программисты, использующие Java, C++, Delphi или другие инструменты разработки приложений и интересующиеся Visual Basic или технологией .NET Framework, также найдут эту книгу полезной. Хотя книга посвящена Visual Basic.NET, ее основная цель - продемонстрировать взаимодействие Visual Basic и ...
		Автор(ы): Кит Франклин, Издательство: Вильямс, 2002 г.

Остальные книги о VB можно найти здесь.

наверх

---

Исправление бага ЭУ SSTab

Пример иллюстрирует исправление известного бага ЭУ SSTab (подтверждённого Microsoft - см. http://support.microsoft.com:80/support/kb/articles/q193/0/21.asp&NoWebContent=1), заключающегося в возможности ухода "фокуса" (в частности - по нажатию клавиши TAB) на элементы управления, расположенные на неактивной вкладке ЭУ SSTab, - что может привести к неприятным эффектам.
Для исправления этого бага используем принцип работы ЭУ SSTab, заключающийся в том, что у тех элементов, которые относятся к неактивным вкладкам, он устанавливает свойство Left в здоровенную отрицательную величину, тем самым "убирая их за пределы экрана".
Сначала "наступим на грабли" - смоделируем тот самый "неприятный эффект":

Расположите на форме ЭУ SSTab1. Сделайте у него 2 вкладки. На первой расположите TextBox "Text1", CommandButton "Command1" и Frame "Frame1", внутри Frame1 - OptionButton "Option1". На второй вкладке - всё то же самое (только вместо 1 будет 2, разумеется). Ну и на самой форме (не на SSTab1) расположите пару кнопок, к примеру, - Command3 и Command4.
Затем вставьте это в код формы:

Private Sub Option1_GotFocus()
     Me.Caption = "Option1"
End Sub

Private Sub Option2_GotFocus()
     Me.Caption = "Option2"
End Sub

Теперь, запустив форму, "походите" по её контролам с помощью клавиши TAB: вы обнаружите, что при открытой вкладке ?1, когда видна только Option1, у вас заголовок формы в определённый момент установится в "Option2", хотя ЭУ Option2 находится на неактивной в этот момент вкладке ?2.
Вот такой вот неприятный эффект. То же самое будет, если вместо фреймов использовать PictureBox - ещё один контрол, который умеет быть "контейнером". А вот если вы удалите из примера выше оба фрейма, и OptionButton-ы посадите прямо на соотв. вкладки SSTab, то всё будет тип-топ.
Исправляем ситуацию, добавляя в код формы следующее:

Private Sub Form_Load()
     SSTab1.Tab = 0
     Call SSTab1_Click(0)
End Sub

Private Sub Option1_GotFocus()
     Me.Caption = "Option1"
End Sub

Private Sub Option2_GotFocus()
     Me.Caption = "Option2"
End Sub

Private Sub PreventTab()
     Dim ctl As Control, ctl2 As Control

     On Error Resume Next
     For Each ctl In Me.Controls
         If TypeOf ctl.Container Is SSTab Then
             If (TypeOf ctl Is Frame) Or (TypeOf ctl Is PictureBox) Then
                 ' нужно установить TabStop для всех контролов внутри ctl:
                 For Each ctl2 In Me.Controls
                     If ctl2.Container.Name = ctl.Name Then
                         ctl2.TabStop = (ctl.Left > 0)
' If ctl.Left < 0 Then Debug.Print ctl2.Name
                     End If
                 Next ctl2
             Else
                 ' Свойство TabStop есть не у всех контролов, поэтому
следующий
                 ' оператор может дать ошибку - для этого и нужен On Error.
                 ctl.TabStop = (ctl.Left > 0)
             End If
         End If
     Next ctl
     On Error GoTo 0
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
     Call PreventTab
End Sub

объяснение работы Sub PreventTab:

При каждом щелчке на вкладке ЭУ SSTab1, процедура PreventTab устанавливает свойство TabStop в False у тех контролов, которые находятся в этот момент "за пределами экрана" - т.е. которые относятся к неактивным вкладкам.
Оператор "If (TypeOf ctl Is Frame) Or (TypeOf ctl Is PictureBox)" нужен для того, чтобы обрабатывать ситуации, когда на ЭУ SSTab расположен контрол, который САМ является контейнером (это м.б. или Frame, или PictureBox). Т.к. свойство Left любого ЭУ исчисляется от левой границы его контейнера, то у всех ЭУ, находящихся внутри такого фрейма или картинки, Left будет > 0 даже если их вкладка НЕактивна, в то время как у самого фрейма (картинки) Left будет < 0; поэтому без данного оператора IF контролы, лежащие внутри фрейма (картинки), не попали бы в число тех, у которых свойство TabStop установливалось в False при деактивации вкладки, - а это было бы неверно!
Код необходимо модифицировать, если нужно обрабатывать более сложную ситуацию - с бОльшим числом вложенности контейнеров: например, на SSTab лежит Frame, а внутри этого фрейма - есть ещё и PictureBox, и только внутри этого PictureBox-а расположены какие-то контролы. Для неограниченного уровня вложенностей нужно, наверное, использовать рекурсию.

Полезные примечания:

Баг наблюдается не обязательно при наличии на вкладках ЭУ SSTab каких-либо контейнеров. В Сети есть "жалобы" программистов, что баг проявляется и просто при размещении на вкладках SSTab какого-либо ActiveX-компонента, вроде обычного MS Rich Textbox, а также в случаях, когда на всех вкладках суммарно расположено МНОГО различных контролов (это, увы, я знаю по себе).
Если вы используете предложенный код для ликвидации этого бага, то при большом числе контролов на всей форме (т.е. при большом размере коллекции Me.Controls) лучше сначала (например, в событии Form_Load) прочитать имена контролов и их контейнеров (хотя бы первого уровня) плюс типы контролов в многомерный строковый массив(-ы), а затем использовать в Sub PreventTab обращение не к коллекции, а к этому массиву: так будет однозначно быстрее.

Автор: Юмашин Алексей

наверх

---

Создадим письмо с вложением и поместим его в TheBat!

Ставим Dir1, Text5(0).Text, Text5(1).Text, Text3.Text

Prog = "C:\Program Files\The Bat!\thebat.exe" '' в роде бы у ламера
                                                 '' всегда TheBat лежит там
If Dir$(Prog$, vbNormal) = "" Then '' если нет (не ламер)

On Error Goto PRNT
Dir1.Path = "C:\Program Files\" '' стандартная прогр. папа
For e = 0 To Dir1.ListCount - 1 '' шерстим все папки в Pr.Files
   '' если файл найден
   If Dir(Dir1.List(e) & "\thebat.exe", vbNormal) <> "" Then
   '' фильтр на признак слеша (есть/нет) приготавливаем полный путь для
   '' запуска батона
     If Right$(Dir1.List(e), 1) = "\" Then Prog = Dir1.List(e) + "thebat.exe" Else Prog = Dir1.List(e) + "\thebat.exe"
     '' идем на вызов бата
     GoTo GoLetter
   Else
   '' смотрим и видим, что все папки прошерстили, файл бат не найден,
   '' ну и всё, на что способен этот код... гуляй вася...
     If e = Dir1.ListCount - 1 Then
         If MsgBox("Программа TheBat! не найдена. Если все-таки почта установлена создать ли пустой бланк письма?", vbCritical + vbYesNo) = vbYes Then ShellProgramm ("mailto:" & Text5(0).Text & "?Subject=" & Text5(1).Text)
         Exit Sub
     End If
   End If
Next e

Else
GoLetter:
'' ну теперь самое сладкое и непостижимое для многих!
'' Chr$(34) - это ковычки, они необходимы при использовании пробелов в
'' команде.
'' Prog - команда бата "c:\Program Files\The Batonchik\Thebat.exe" например.
'' ну и далее всякие ключи...
'' Text5(0).Text - адрес получателя
'' Text5(1).Text - тема письма
'' Text3.Text - полный путь к файлу, который приклеиваем (можно с пробелами)
maill = Chr$(34) & Prog & Chr$(34) & " /mailto=" & Chr$(34) & Text5(0).Text & Chr$(34) & ";Subject=" & Chr$(34) & Text5(1).Text & Chr$(34) & ";A=" & Chr$(34) & Text3.Text & Chr$(34)
'' переменная готова, теперь вызываем!
Call Shell(maill)
'' готовое письмо можно найти в том ящике (если их больше одного),
'' который имеет приемущество (создавался первым). Как засунуть в
'' другой, не зная его имя пока не знаю, в след версиях, ха,ха.
End If

Exit Sub
'' тут я думаю, понятно!
PRNT:
Msgbox "Error: " & Err.Description
End Sub

наверх

---

Получение размера диска больше 2Gb

Этот код получает емкость и свободное место на диске в байтах при размере диска > 2Гбайт. В качесте sRoot строка с именем диска ("C:\").

Option Explicit
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
(ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As LARGE_INTEGER, _
  lpTotalNumberOfBytes As LARGE_INTEGER, lpTotalNumberOfFreeBytes As LARGE_INTEGER) As Long
Dim DiskTotalSize As Currency
Dim DiskFreeSize As Currency
Private Type LARGE_INTEGER
     bSize(1 To 8) As Byte
End Type
  
Private Sub Size(sRoot As String)
Dim DiskSizeByte As LARGE_INTEGER
Dim DiskFreeByte As LARGE_INTEGER
Dim DiskCallByte As LARGE_INTEGER
Dim j As Double, i As Integer
If GetDiskFreeSpaceEx(sRoot, DiskCallByte, DiskSizeByte, DiskFreeByte) Then
' Общий размер диска
j = 1: DiskTotalSize = 0
For i = 1 To 8
     DiskTotalSize = DiskTotalSize + CCur(DiskSizeByte.bSize(i) * j)
     j = j * 256
Next i
' Свободный размер
j = 1: DiskFreeSize = 0
For i = 1 To 8
     DiskFreeSize = DiskFreeSize + CCur(DiskFreeByte.bSize(i) * j)
     j = j * 256
Next i
Else
' Ошибка - Диск недоступен
DiskFreeSize = 0
DiskTotalSize = 0
End If
End Sub

наверх

---

Шифрование методом RC4

Алгоритм синхронного шифрования RC4. Работает очень просто... Использование: функция EnDeCrypt. Ей передаётся текст и пароль. Dim s(0 To 255) As Integer
Dim kep(0 To 255) As Integer

Public Function EnDeCrypt(plaintxt As String, Password As String) As String
     Dim temp As Integer
     Dim a As Integer
     Dim b As Integer
     Dim cipherby As Byte
     Dim cipher As String

     'Инициализация
     'Создание ключа
     b = 0

     For a = 0 To 255
         b = b + 1
         If b > Len(Password) Then
             b = 1
         End If
         kep(a) = Asc(Mid$(Password, b, 1))
     Next a

     For a = 0 To 255
         s(a) = a
     Next a
     
     b = 0

     For a = 0 To 255
         b = (b + s(a) + kep(a)) Mod 256
         temp = s(a)
         s(a) = s(b)
         s(b) = temp
     Next a

     'Побайтное шифрование
     For a = 1 To Len(plaintxt)
         cipherby = EnDeCryptSingle(Asc(Mid$(plaintxt, a, 1)))
         cipher = cipher & Chr(cipherby)
     Next
     EnDeCrypt = cipher
End Function

Public Function EnDeCryptSingle(plainbyte As Byte) As Byte
     Dim i As Integer
     Dim j As Integer
     Dim temp As Integer
     Dim k As Integer
     Dim cipherby As Byte
     
     'Шифрование одного байта
     i = (i + 1) Mod 256
     j = (j + s(i)) Mod 256
     temp = s(i)
     s(i) = s(j)
     s(j) = temp
     k = s((s(i) + s(j)) Mod 256)
     cipherby = plainbyte Xor k
     EnDeCryptSingle = cipherby
End Function

наверх

---

Мои программы

BalloonMessage for MS Agent


Автора: Шатрыкин Иван и Павел Сурменок.

наверх

---

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

Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.

Вопросы:

---

Автор вопроса: Korik

Ответ ожидается по этому адресу

   Вопросик есть небольшой по ASP. Как можно с компа пользователя загнать на сервак в нужную директорию файл, который выбрал пользователь через <INPUT TYPE="file">?

---

Автор вопроса: SERG.IO

Ответ ожидается по этому адресу

   В предыдущих номерах писали, как определеить текущую раскладку клавиатуры. А как отследить событие смены раскладки? Вариант с таймером - это не красиво. Можно конечно отлавливать нажатие клавиш Ctrl-Shift и Alt-Shift, но в этом случае остается вариант поменять раскладку на панели задач. Жду ответов

---

Автор вопроса: Саша

Ответ ожидается по этому адресу

   Как узнать URL IE ?
дискриптор (хендл) знаю.
  
Кто что знает шлите, буду очень рад

---

Автор вопроса: Anatol

Ответ ожидается по этому адресу

   Разработал базу данных (.mdb) с интерфейсом на VB6, ADO 2.5 SP1. Структура базы создана средствами MS Access 2000. На моей машине с VB6,MS Access и Win98SE программа работает прекрасно. Проблемы возникли после установки программы на ПК пользователей также с Win98SE. Установка проходит нормально. Предварительно установил на ПК пользователей mdac_type.exe версии 2.5 SP1. MS Access на ПК пользователей не было установлено. При выполнении установленного файла (.exe) стала появляться ошибка с сообщением:

ADO error #-2147467259
Operation must use an updateable query.
Sourse: Microsoft JET Database Engine.

Как выяснилось, ошибка появляется при попытке редактирования или добавления записи программными средствами объекта Recordset:

  rst.Fields("Name")="Nina"
  rst.Update

Чтение из баэы данных проходит нормально.
В чем же дело?

---

Автор вопроса: Владимир

Ответ ожидается по этому адресу

   Как на VB6 послать объявление на электронную доску объявлений.
Я новичок в этом деле. Где можно об этом узнать,или что нужно сделать.
В интернете ничего не нашел.

---

Автор вопроса: Алексей

Ответ ожидается по этому адресу

   Я использую ADO, для выполнения запросов к БД (СУБД Ms SQL-Server) из Excel. Возникла следующая проблема:

При выполнении запроса к БД, Excel блокируется. А т.к. приходится делать сложные запросы и получать объемные выборки данных, то не очень приятно сидеть и ждать несколько минут, пока пройдет запрос, чтоб возобновить работу с Excel.

Использование потоков (CreateThread и пр.) дало временное облегчение. Дело в том, что при их использовании Excel начинает "жрать" системные дескрипторы. В результате по прошествию некоторого периода времени он зависает.

Каким образом можно решить данную проблему? Да, еще: как корректно(!) прервать выполнение запроса в ADO?

В Интернете много различной информации на тему ADO, но ничего мне полезного я не нашел. Буду очень признателен за помощь.

---

Автор вопроса: Виталик

Ответ ожидается по этому адресу

   Подскажите как пользоваться API функциями OpenProcess, ReadProcessMemory, WriteProcessMemory?

---

Автор вопроса: Вова

Ответ ожидается по этому адресу

   Как сделать так, чтобы программа, прописалась в реестре винды (где нбудь в Run)?

---

Автор вопроса: Игорь

Ответ ожидается по этому адресу

   Может кто знает как передать по локальной сети голос с микрофона средствами WINSOCK. Подскажите как хотя бы это можно проделать или ссылку какую нить киньте.

---

Ответы:

---

Вопрос:

   Подскажите где можно взять примеры с браузером файлов (типа панели FAR или Windows Commander - имеется в виду одну панель) ???

Ответ:

Автор ответа: ∙Creator∙

Могу дать контрол'чик eJ_Explorer.ocx
просите у ∙Creator∙

---

Вопрос:

   Подскажите, пожалуйста, как узнать все процессы в системе и отключить любой ия них.

Ответ:

Автор ответа: ∙Creator∙

Видел такое на vb.kiev.ua.

---

Вопрос:

   Подскажите если кто знает как отправить на принтер содержимое PictureBox?

Ответ:

Автор ответа: Николай

По-моему надо использовать Printer.PaintPicture.

---

Вопрос:

   Как в VB6 нарисовать амплитудно-частотную характеристику звукового .WAV файла (как например у Windows Sound Recorder)?

Ответ:

Автор ответа: Akulakov

Я применил бы пакет SwiftSoft (http://www.swiftsoft.de/).
К сожалению он стОит ОООчень больших денег ($499)

---

Вопрос:

   Подскажите, пожалуйста, можно ли восстановить из EXEшника исходник?

Ответ:

Автор ответа: Vlasenko

Ага, можно – тока дебагером – если шаришь в асме - дерзай

---

---

Можете заполнить эту форму, либо отослать вопрос СЮДА

Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.

Текст сообщения:

Ваше имя
E-mail для ответа

наверх