RusFAQ.ru: Программирование на Basic / VBA

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Basic/VBA

Выпуск № 136
от 20.10.2005, 23:33

Вопрос № 27.719

Здравствуйте. Есть вопросы по Microsoft Visual Basic 6.0. 1). Как добавить информацию в реестр, и как её оттуда удалить? 2)Как проверить есть ли связь с Интернетом. Как то в рассылках был такой вопрос, и был приведен код в ответ. Я его вставлял, но вылазит ошибка. 3) Как сделать так чтоб в программу нельзя было закрыть (например, как в nero во время записи, крестик невозможно нажать), и как сделать, чтоб нельзя было нажать на кнопки скрыть, развернуть. И как в определенные моменты сделать так, чтоб кнопку нельзя было нажать, например, идет подсчет (через таймер) до 10, и пока отсчёт не дойдет до 10 нельзя нажать кнопку на форме определённую. Приведите пример если нетрудно. Заранее спасибо за ответы.

Отправлен: 15.10.2005, 06:41 Вопрос задал: Неизвестнов Том (статус: Посетитель) Всего ответов: 5 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: _Виталий Здравствуйте, Неизвестнов Том! 1) Код для модуля в приложении. Пример использования: ------------------------------------ Call SaveString(HKEY_LOCAL_MACHINE, "Software estReg", "test", "testing") retval = GetString(HKEY_LOCAL_MACHINE, "Software estReg", "test") MsgBox retval Call DeleteValue(HKEY_LOCAL_MACHINE, "Software estReg", "test") Call DeleteKey(HKEY_LOCAL_MACHINE, "Software estReg") ------------------------------------ 2) См. вопрос № 27712 3)Блокировка обычной кнопки на форме: Command1.Enabled = False ну и обратно: Command1.Enabled = True По-поводу кнопок всернуть,развернуть,закрыть. Можно удалить их все свойство формы ControlBox=False, отключить MaxButton = False и MinButton = False, но при попытке сделать это в Runtime получается ошибка, у меня получилось только на стадии разработки. Приложение: ' ----------------- ' ADVAPI32 ' ----------------- ' function prototypes, constants, and type definitions ' for Windows 32-bit Registry API Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const ERROR_SUCCESS = 0& ' Registry API prototypes Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long Public Const REG_SZ = 1 ' Unicode nul terminated string Public Const REG_DWORD = 4 ' 32-bit number Public Sub SaveKey(Hkey As Long, strPath As String) Dim keyhand& r = RegCreateKey(Hkey, strPath, keyhand&) r = RegCloseKey(keyhand&) End Sub Public Function GetString(Hkey As Long, strPath As String, strValue As String) Dim keyhand As Long Dim datatype As Long Dim lResult As Long Dim strBuf As String Dim lDataBufSize As Long Dim intZeroPos As Integer r = RegOpenKey(Hkey, strPath, keyhand) lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize) If lValueType = REG_SZ Then strBuf = String(lDataBufSize, " ") lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize) If lResult = ERROR_SUCCESS Then intZeroPos = InStr(strBuf, Chr$(0)) If intZeroPos > 0 Then GetString = Left$(strBuf, intZeroPos - 1) Else GetString = strBuf End If End If End If RegCloseKey keyhand End Function Public Sub SaveString(Hkey As Long, strPath As String, strValue As String, strdata As String) Dim keyhand As Long Dim r As Long r = RegCreateKey(Hkey, strPath, keyhand) r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata)) r = RegCloseKey(keyhand) End Sub Function GetDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long Dim lResult As Long Dim lValueType As Long Dim lBuf As Long Dim lDataBufSize As Long Dim r As Long Dim keyhand As Long r = RegOpenKey(Hkey, strPath, keyhand) ' Get length/data type lDataBufSize = 4 lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize) If lResult = ERROR_SUCCESS Then If lValueType = REG_DWORD Then GetDword = lBuf End If 'Else ' Call errlog("GetDWORD-" & strPath, False) End If r = RegCloseKey(keyhand) End Function Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long) Dim lResult As Long Dim keyhand As Long Dim r As Long r = RegCreateKey(Hkey, strPath, keyhand) lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4) 'If lResult <> error_success Then Call errlog("SetDWORD", False) r = RegCloseKey(keyhand) End Function Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String) Dim r As Long r = RegDeleteKey(Hkey, strKey) End Function Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String) Dim keyhand As Long r = RegOpenKey(Hkey, strPath, keyhand) r = RegDeleteValue(keyhand, strValue) r = RegCloseKey(keyhand) End Function

Ответ отправил: _Виталий (статус: 8-ой класс) Отправлен: 15.10.2005, 10:54

Отвечает: Licvidator Здравствуйте, Неизвестнов Том! 1. Функции для работы с реестром см. в прикрепленном файле 2. http://rusfaq.ru/?Step=info&Action=Question&ID=27712 (только добавьте объявления АПИ и констант) 3. http://rusfaq.ru/?Step=info&Action=Question&ID=27644 Свернуть/развернуть: свойство ControlBox формы, значение False (убирает совсем) или же MaxButton=False, MinButton=False (деактивирует) Насчет кнопки: имя_кнопки.Enabled=False (потом сделать True) Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

Ответ отправил: Licvidator (статус: Профессор) Отправлен: 15.10.2005, 11:45

Отвечает: Залетин Виталий Викторович Здравствуйте, Неизвестнов Том! 1. Есть стандартные функции SaveSetting и т. д. Можно пользоваться АПИ функциями (см. почту). 3. Чтоб нельзя было закрыть через крестик, надо удалить последний пункт системного меню формы. Можно юзать, например, такой код: Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" _ (ByVal hMenu As Long, _ ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long Const MF_BYPOSITION = &H400& Const MF_REMOVE = &H1000& Const SC_CLOSE=&H6 'Вот тут, если память не изменяет, такое значение, но в АПИ вьювере оно есть Sub KillClose() dim hMnu as long hMnu=GetSystemMenu(Form.HWND, False) RemoveMenu hMnu, SC_CLOSE, MF_BYPOSITION Or MF_REMOVE DrawMenuBar Form.HWND End Sub Можно и так (недавно наткнулся на этот пример, и это самое верное решение - удалять последний пункт системного меню окна, не по его номеру в константе): Private Sub Form_Load() Dim hSysMenu As Long, nCnt As Long hSysMenu = GetSystemMenu(Me.hwnd, False) If hSysMenu Then nCnt = GetMenuItemCount(hSysMenu) If nCnt Then RemoveMenu hSysMenu, nCnt - 1, _ MF_BYPOSITION Or MF_REMOVE RemoveMenu hSysMenu, nCnt - 2, _ MF_BYPOSITION Or MF_REMOVE DrawMenuBar Me.hwnd Me.Caption = "Пробуй закрыть меня!!!" End If End If End Sub Насчет скрыть/развернуть, думаю, можно пойти тем же путем (в апивьювере все константы есть (по идее, они должны называться SC_MINIMIZE, SC_MAXIMIZE (или около того)). А насчет кнопки, то тут можно просто присваивать ей свойство Enabled=False (заблокировать) и Enabled=True (разблокировать). С таймерои та же история, считайте в таймере хоть до ста, а потом CommandButton.Enabled=True и все! 2. Насчет интернета, я сам в этом пока на стадии разборок. Поищите в НЕТе какие-либо статьи по RAS - это самое то, либо ищите в МСДН (если она есть). --------- Учиться никогда не поздно. Особенно программированию!

Ответ отправил: Залетин Виталий Викторович (статус: 4-ый класс) Отправлен: 15.10.2005, 14:28

Отвечает: Евгений Неверов Здравствуйте, Неизвестнов Том! Насчёт второго вопроса смотрите код ниже. Функция inNet возвращает True, если пользователь в сети. Приложение: Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long ' эту строку впишите в самое начало файла формы или модуля Public Function inNET() As Boolean Dim dwFlags As Long Dim sNameBuf As String sNameBuf = String$(513, 0) If InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&) Then inNET = True Else inNET = False End If End Function

Ответ отправил: Евгений Неверов (статус: Студент) Отправлен: 15.10.2005, 15:57

Отвечает: Miklucho Здравствуйте, Неизвестнов Том! 3) чтоб программу нельзя было закрыть, на событие unload формы нужно написать cancel=-1, а кнопки (и др. элементы) блокируются свойством enable. PS Смотри почаще архив рассылки, т.к твои вопросы уже проходили и не раз.

Ответ отправил: Miklucho (статус: Студент) Отправлен: 18.10.2005, 18:46

Вопрос № 27.750

Здравствуйте глубоко уважаемые эксперты! Нужно чтобы на форме показывалась конфигурация компьютера(очень простенькая) Как можно, если вообще возможно, это сделать?

Отправлен: 15.10.2005, 20:05 Вопрос задал: Dushin Igor (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Licvidator Здравствуйте, Dushin Igor! Ну.. например код в приложении. Для его работы нужно подключить Microsoft Scripting Runtime (Project - References), Microsoft Sysinfo Control (Project - Components), добавить 5 кнопок и textbox Приложение: Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Type system_info dwoemid As Long ippagesize As Long ipminimumapplicatinaddress As Long dwmaximumapplicationaddress As Long dwactiveprocessormasc As Long dwnumberofprocessors As Long dwprocessortype As Long dwallocationgranularity As Long dwreserved As Long End Type Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As system_info) Private Sub Command1_Click() Dim sys As system_info GetSystemInfo sys Print "Processor type: "; sys.dwprocessortype Print "Number of processors: "; sys.dwnumberofprocessors Print sys.ippagesize End Sub Private Sub Command2_Click() Select Case SysInfo1.OSPlatform Case 0 Print "NNN" Case 1 Print "wiN95" Case 2 Print "WinNT" End Select Print SysInfo1.OSBuild Print SysInfo1.OSVersion End Sub Private Sub Command3_Click() Dim str As String Dim ing As Long Const max = 144 str = Space(max) ing = GetWindowsDirectory(str, max) str = Left(str, ing) Print str End Sub Private Sub Command4_Click() Dim s As New Scripting.FileSystemObject Dim d As Drive Text1 = "Drive" & vbTab & " Free space " & vbCrLf MousePointer = vbHourglass For Each d In s.Drives DoEvents If d.IsReady Then Text1 = Text1 & d.DriveLetter & vbTab & _ d.FreeSpace & vbCrLf Else Text1 = Text1 & d.DriveLetter & vbTab & _ "Not Ready." & vbCrLf End If Next d MousePointer = vbDefault Text1 = Text1 & s.GetSpecialFolder(TemporaryFolder) End Sub Private Sub Command5_Click() Dim i, id, s For i = 0 To 25 s = Chr(i + 65) & ":" id = GetDriveType(s) Select Case id Case 2 Print "Drive " & s & " is removable" Case 3 Print "Drive " & s & " is fixed" Case 4 Print "Drive " & s & " is remote" Case 5 Print "Drive " & s & " is CD-ROM" Case 6 Print "Drive " & s & " is RAM disk" Case Else End Select Next End Sub

Ответ отправил: Licvidator (статус: Профессор) Отправлен: 15.10.2005, 21:08

© 2001-2005, RusFAQ.ru, Россия, Москва. Все права защищены.
Идея, дизайн, программирование, авторское право: Калашников О.А.