Голосование:
Голосования сайта VBNet.Ru. Результаты голосований передаются на сайт. Проследите, что есть соединение с интернетом.
Ссылки:
Несколько слов от автора:
А коды кончились :-(((( Присылайте, если что есть...
Читайте!
Читайте!
Содержание выпуска
- Книги
- Исправление бага ЭУ SSTab
- Создадим письмо с вложением и поместим его в TheBat!
- Получение размера диска больше 2Gb
- Шифрование по алгоритму RC4
- Вопрос/Ответ
Книги
Остальные книги о 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 владельцу сайта.
наверх
|
Переход на VB .NET. Стратегии, концепции, код (цена ~ 158 руб.) Эта книга была задумана как одна из первых книг о .NET, которая ознакомит читателя с основными идеями новой архитектуры и подготовит его к знакомству с более детальной литературой, например документацией Microsoft и ее толкованиями, которая неизбежно появится на рынке. Она поможет вам взглянуть на эту технологию с позиций ваших собственных рабочих планов и быстро освоить те концепции, которые покажутся необычными для большинства прогр... |
||
|
Автор(ы): Дан Эпплман, Издательство: Питер, 2002 г.
|
|||
|
Программирование на VB.NET. Учебный курс (цена ~ 119 руб.)
Эта книга является вводным курсом по
изучению языка программирования Visual Basic .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
BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels.
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.
Вопросы:Автор вопроса: 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 владельцу сайта.