Сборник примеров кода Visual Basic

Сборник примеров кода Visual Basic

Содержание Создаём оболочку для CD. Копируем и перемещаем файлы. Проигрываем музыкальные файлы 1. Проигрываем файл в формате *.mp3: Проигрываем файл в формате *.mid: Проигрываем файл в формате *.wav: Без Api Перезагрузка компьютера: Вызов окна "Форматирование: Диск 3,5 (А:). Открыть "Свойства экрана". Выстраивает все не свернутые окна сверху вниз. Обновить рабочий стол. Отключить клавиатуру. Отключить мышь. Функция Environ. Средства WinAPI. Реестр Ассоциация с типами файлов Убираем программу из списка Alt+Ctrl+Del. Разрываем соединение с Internet. Подключен ли к сети компьютер. Блокируем Alt+Ctrl+Del. Подсчет свободной памяти в данный момент. Получение информации об окнах Поиск окна по его заголовку Поиск окна по его классу Поиск дочернего окна Окна и манипуляторы Скрываем кнопку Пуск: Меняем заголовок заданного окна Отключение системного меню Заставляем VB работать с модемом. Размещение окна поверх всех

Создаём оболочку для CD

1. Откройте блокнот и запишите туда следующее:

[autorun] OPEN = setup.bat

Сохраните текстовый файл как Autorun.inf

2.Создайте новый текстовый файл и запишите туда следующее:

@Echo off Rem регистрируем msvbvm60.dll regsvr32 msvbvm60.dll

Rem чтобы зарегистрировать еще один компонент введите ещё одну строку: regsvr32 ИМЯ ВАШЕГО КОМПОНЕНТА, столько раз, сколько компонентов

Сохраните текстовый файл как Setup.bat

3. Теперь в корневом каталоге вашего CD обязательно должны быть файлы autorun.inf (ранее созданный текстовый файл), msvbvm60.dll (нужная библиотека), autorun.exe (созданная вами оболочка), setup.bat (ранее созданный исполняемый файл DOS) и все ваши компоненты.

Теперь при открытии CD появиться столько диалоговых окон о регистрации, сколько компонентов вы регистрируете, после этого будет запущена ваша оболочка. В начало

Копируем и перемещаем файлы.

Private Declare Function CopyFile Lib "kernel32" Alias _ "CopyFileA" (ByVal lpExistingFileName As String, ByVal _ lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Private Declare Function MoveFile Lib "kernel32" Alias _ "MoveFileA" (ByVal lpExistingFileName As String, ByVal _ lpNewFileName As String) As Long

Sub CopyMove()

Dim strSource As String

Dim strTarget As String

Dim lngRetVal As Long

strSource = "C:yfile.txt"

strTarget = "C:Windowsyfile.txt"

'// Копируем файл

lngRetVal = CopyFile(Trim$(strSource), Trim(strTarget), False)

If lngRetVal Then

MsgBox "Файл скопирован!"

Else

MsgBox "Ошибка!"

End If

'// Переместить файл

lngRetVal = MoveFile(Trim$(strSource), Trim(strTarget))

If lngRetVal Then

MsgBox "Файл перемещен!"

Else

MsgBox "Ошибка!"

End If

End Sub

В начало

Проигрываем музыкальные файлы

1. Проигрываем файл в формате *.mp3:

Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

'чтобы воспроизвести файл Call mciExecute("play имя вашего файла")

'чтобы закрыть файл Call mciExecute("close имя вашего файла")

2. Проигрываем файл в формате *.mid:

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uRetrunLength As Long, ByVal hwndCallback As Long) As Long

'Открываем файл

Call mciSendString ("open ИМЯ ВАШЕГО ФАЙЛА type sequencer alias passport", 0, 0,0)

'Проигрываем файл

Call micSendString ("play passport", 0, 0, 0)

'Останавливаем файл

Call micSendString ("stop passport", 0, 0, 0)

3. Проигрываем файл в формате *.wav:

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

'Проигрываем файл

Call sndPlaySound("ИМЯ ВАШЕГО ФАЙЛА", 0)

В начало

Без Api

1. Перезагрузка компьютера:

Shell "rundll32 shell32,SHExitWindowsEx 2" 'Если заменить 2 на 1, то получим функцию для выключения компьютера 2. Вызвать окно "Форматирование: Диск 3,5 (А:):

Shell "rundll32 shell32,SHFormatDrive"

3. Открыть "Свойства экрана":

Shell"rundll32 shell32,Control_RunDLL desk.cpl"

4. Выстраивает все не свернутые окна сверху вниз:

Shell"rundll32 user,tilechildwindowsl"

5. Обновить рабочий стол:

Shell"rundll32 user,repaintscreen"

6. Отключить клавиатуру:

Shell "rundll32 keyboard,disable"

7. Отключить мышь:

Shell "rundll32 mouse,disable"

8. Функция Environ:

MsgBox Environ ("TMP") 'Выводит директорию временных файлов MsgBox Environ ("COMSPEC") 'Выводит загрузчик ДОСовской оболочки (обычно, command.com) MsgBox Environ ("PATH") 'Выводит пути, объявленные в autoexec.bat MsgBox Environ ("WINDIR") 'Выводит каталог Windows В начало

Средства WinAPI. Реестр

Const REG_SZ As Long = 1 Const REG_DWORD As Long = 4 Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_DYN_DATA = &H80000006

Const KEY_ALL_ACCESS = &H3F

Type SECURITY_ATTRIBUTES

nLength As Long lpSecurityDescriptor As Long bInheritHandle As Boolean End Type

RegOpenKeyEx - Функция открывает существующий ключ реестра, а точнее определяет его манипулятор.

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Основные параметры: hKey - имя стандартного ключа (например, HKEY_CLASSES_ROOT)

lpSubKey - имя открываемого ключа (например, "MyProgramOptions")

phkResult - заполняется манипулятором открытого ключа

Пример: Dim Result As Long

RegOpenKeyEx HKEY_CLASSES_ROOT, "MyProgramOptions", 0, KEY_ALL_ACCESS, Result

'// В этом примере выводится манипулятор ключа HKEY_CLASSES_ROOTMyProgramOptions RegCloseKey - Функция закрывает ключ системного реестра.

Declare Function RegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long Основные параметры: hKey - манипулятор закрываемого ключа Пример: Dim Result As Long

RegOpenKeyEx HKEY_CLASSES_ROOT, "MyProgramOptions", 0, KEY_ALL_ACCESS, Result '// Открытие ключа RegCloseKey Result '// Закрытие ключа

RegCreateKeyEx - Функция для создания нового ключа. Если ключ существует, функция открывает его.

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long Основные параметры:

hKey - имя стандартного ключа (например, HKEY_CLASSES_ROOT) lpSubKey - имя создаваемого подключа (например, "MyProgramOptions") Пример: Dim SA As SECURITY_ATTRIBUTES

Dim Result As Long

RegCreateKeyEx HKEY_CURRENT_USER, "MyProgramOptions", 0, vbNullString, 0, KEY_ALL_ACCESS, SA, _ Result, &H1

RegDeleteKey - Функция удаляет указанный ключ

Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Основные параметры: hKey - имя стандартного ключа lpSubKey - имя удаляемого подключа. В Win9x/Me все подключи указанного подключа также удаляются. В WinNT подключ не должен содержать других подключей. Пример: RegDeleteKey HKEY_CURRENT_USER, "MyProgramOptions" RegSetValueEx - Функция задаёт значение и тип параметра, находящегося в заданном ключе.

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

Основные параметры:

hKey - манипулятор ключа lpValueName - имя параметра dwType - тип ключа lpData - новое значение

Пример: Dim Result As Long

Dim Retval As Long

'// Находим манипулятор нужного ключа Retval = RegOpenKeyEx(HKEY_CURRENT_USER, "MyProgramOptions", 0, KEY_ALL_ACCESS, Result)

'// Числовому параметру DWordValue присваивается значение 22 RegSetValueEx Result, "DWordValue", 0, REG_DWORD, 22, 4

'// Строковому параметру StringValue присваивается значение "Реестр" RegSetValueEx Result, "StringValue", 0, REG_SZ, ByVal "Реестр", Len("Реестр") RegCloseKey Result '// Закрытие ключа

RegDeleteValue - Функция удаляет заданный параметр

Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Основные параметры:

hKey - манипулятор ключа lpValueName - имя удаляемого параметра Пример:

Dim Result As Long

'// Находим манипулятор нужного ключа RegOpenKeyEx HKEY_CURRENT_USER, "MyProgramOptions", 0, KEY_ALL_ACCESS, Result

'// Удаляем параметр с именем StringValue

RegDeleteValue Result, "StringValue"

RegCloseKey Result '// Закрытие ключа

RegQueryValueEx - Функция считывает значения параметра

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

Основные параметры:

hKey - манипулятор ключа lpValueName - имя читаемого параметра lpData - заполняется значением заданного параметра Пример: Dim Result As Long Dim DWResult As Long Dim STResult As String

STResult = Space(255)

'// Находим манипулятор нужного ключа RegOpenKeyEx HKEY_CURRENT_USER, "MyProgramOptions", 0, KEY_ALL_ACCESS, Result

'// Считываем значения числового параметра с именем DWordValue RegQueryValueEx Result, "DWordValue", 0, 0, DWResult, 4

'// Считываем значения строкового параметра с именем StringValue RegQueryValueEx Result, "StringValue", 0, 0, ByVal STResult, Len(STResult) RegCloseKey Result '// Закрытие ключа

'// Выводим значение параметров

MsgBox DWResult '// Числовое MsgBox STResult '// Строковое

В начало

Ассоциация с типами файлов

'// Функции

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long

Private 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

'// Структуры

Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Boolean End Type

'// Константы Const HKEY_CLASSES_ROOT = &H80000000 Const REG_SZ = 1 Const KEY_ALL_ACCESS = &H3F

'// Функция для ассоциации типа файла с приложением '// FileType - расширение файла

Public Sub AsProgram(FileType As String)

Dim retval As Long

Dim Result As Long

Dim SA As SECURITY_ATTRIBUTES

Dim sPath As String

'// Создаем ключ для программы retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, App.Title, 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)

'// Присваиваем значению по умолчанию название программы

<

p>RegSetValueEx Result, "", 0, REG_SZ, ByVal App.Title, Len(App.Title)

'// Создаём ключ, связанный с расширением файла

retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, FileType, 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)

'// Присваиваем значению по умолчанию название программы

RegSetValueEx Result, "", 0, REG_SZ, ByVal App.Title, Len(App.Title)

'// Последние шаг - ассоциация типа с приложением

'// Определяем командную строку для приложения

If Right(App.Path, 1) = "" Then

sPath = App.Path & App.EXEName & ".exe %1"

Else

sPath = App.Path & "" & App.EXEName & ".exe %1"

End If

retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, App.Title & "shellopencommand", 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)

RegSetValueEx Result, "", 0, REG_SZ, ByVal sPath, Len(sPath)

End Sub

В начало

Убираем программу из списка Alt+Ctrl+Del.

Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long Public Declare Function GetCurrentProcess Lib "kernel32" () As Long Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long Public Const RSP_SIMPLE_SERVICE = 1 Public Const RSP_UNREGISTER_SERVICE = 0

Чтобы убрать вашу программу из списка Ctrl+Alt+Delete list, используйте процедуру MakeMeService:

Public Sub MakeMeService() Dim pid As Long Dim reserv As Long pid = GetCurrentProcessId() regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE) End Sub

Чтобы показать вашу программу в списке Ctrl+Alt+Delete, используйте процедуру UnMakeMeService:

Public UnMakeMeService() Dim pid As Long Dim reserv As Long pid = GetCurrentProcessId() regserv = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE) End Code

В начало

Разрываем соединение с Internet.

Поместите на форму кнопку с именем Command1

Const RAS_MAXENTRYNAME As Integer = 256 Const RAS_MAXDEVICETYPE As Integer = 16 Const RAS_MAXDEVICENAME As Integer = 128 Const RAS_RASCONNSIZE As Integer = 412 Const ERROR_SUCCESS = 0&

Private Type RasEntryName dwSize As Long szEntryName(RAS_MAXENTRYNAME) As Byte End Type

Private Type RasConn dwSize As Long hRasConn As Long szEntryName(RAS_MAXENTRYNAME) As Byte szDeviceType(RAS_MAXDEVICETYPE) As Byte szDeviceName(RAS_MAXDEVICENAME) As Byte End Type

Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long

Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

Private gstrISPName As String Public ReturnCode As Long

Public Sub HangUp() Dim i As Long Dim lpRasConn(255) As RasConn Dim lpcb As Long Dim lpcConnections As Long Dim hRasConn As Long

lpRasConn(0).dwSize = RAS_RASCONNSIZE lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize lpcConnections = 0 ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections) If ReturnCode = ERROR_SUCCESS Then For i = 0 To lpcConnections - 1 If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then hRasConn = lpRasConn(i).hRasConn ReturnCode = RasHangUp(ByVal hRasConn) End If Next i End If End Sub

Public Function ByteToString(bytString() As Byte) As String Dim i As Integer ByteToString = "" i = 0 While bytString(i) = 0& ByteToString = ByteToString & Chr(bytString(i)) i = i + 1 Wend End Function

Private Sub Command1_Click() Call HangUp End Sub

В начало

Подключен ли к сети компьютер.

Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (lpdwFlags As Long, lpszConnectionName As Long, dwNameLen As Long, ByVal dwReserved As Long) As Long

Private Sub Form_Load() Dim strConnectionName As String Dim lNameLen As Long Dim lRetVal As Long Dim lConnectionFlags As Long Dim lPtr As Long Dim lNameLenPtr As Long

strConnectionName = Space(256) lNameLen = 256 lPtr = StrPtr(strConnectionName) lNameLenPtr = VarPtr(lNameLen)

lRetVal = InternetGetConnectedStateEx(lConnectionFlags, ByVal lPtr, ByVal lNameLen, 0&)

If lRetVal <> 0 Then MsgBox("Комп в сети") Else MsgBox("Комп не в сети") End If End Sub

В начало

Блокируем Alt+Ctrl+Del.

'Пример 1
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long Private Const SPI_SCREENSAVERRUNNING = 97&

Public Sub AllowKeys(bParam As Boolean) Dim lRetVal As Long, bOld As Boolean lRetVal = SystemParametersInfo(SPI_SCREENSAVERRUNNING, bParam, bOld, 0&) End Sub

Private Sub Form_Load() Call AllowKeys(True) 'блокировка сочетаний End Sub

Private Sub Form_Unload(Cancel As Integer) Call AllowKeys(False) 'разблокировка сочетаний End Sub 'Пример 2
Const SPI_SCREENSAVERRUNNING = 97 Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Private Sub Command1_Click() Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, "1", 0) End Sub

Private Sub Command2_Click() Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, "1", 0) End Sub

Private Sub Form_Unload(Cancel As Integer) Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, "1", 0) End Sub

В начало

Подсчет свободной памяти в данный момент.

Private Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type

Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Const fmt As String = "###,###,###,###" Const skb As String = " Kb" Const nkb As Long = 1024

Private Sub Form_Load()

Dim MS As MEMORYSTATUS

MS.dwLength = Len(MS)

GlobalMemoryStatus MS

lbMemStat(0) = Format$(MS.dwMemoryLoad, fmt) & " % Use"

lbMemStat(1) = Format$(MS.dwTotalPhys / nkb, fmt) & skb

lbMemStat(2) = Format$(MS.dwAvailPhys / nkb, fmt) & skb

lbMemStat(3) = Format$(MS.dwTotalPageFile / nkb, fmt) & skb

lbMemStat(4) = Format$(MS.dwAvailPageFile / nkb, fmt) & skb

lbMemStat(5) = Format$(MS.dwTotalVirtual / nkb, fmt) & skb

lbMemStat(6) = Format$(MS.dwAvailVirtual / nkb, fmt) & skb

End Sub

В начало

Получение информации об окнах

1. Поиск окна по его заголовку

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Процедура для получения манипулятора окна по его заголовку Public Function GetHwnd(Caption As String) As Long Dim hwnd As Long hwnd = FindWindow(vbNullString, Caption) 'Caption - заголовок окна GetHwnd = hwnd End Function

2. Поиск окна по его классу

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Процедура для получения манипулятора окна по его классу Public Function GetHwnd(Class As String) As Long Dim hwnd As Long hwnd = FindWindow(Class, vbNullString) GetHwnd = hwnd End Function

3. Поиск дочернего окна

'Функция для получения окна первого уровня

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Функция для получения дочернего окна

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

'Разместите на форме кнопку (Command1)

Private Sub Command1_Click() Dim hwnd As Long hwnd = FindWindow("Класс родителя", "Заголовок родителя") 'Поиск родителя hwnd = FindWindowEx(hwnd, 0, "Класс дочернего окна", "Заголовок дочернего окна") 'Поиск дочернего окна End Sub

В начало

Окна и манипуляторы

1. Скрываем кнопку Пуск:

1. Создайте новый проект. 2. На создавшейся вместе с проектом форме разместите две кнопки. 3. Назовите первую кнопку cmdHide, и измените, свойство Caption на "Скрыть кнопку Пуск", вторую кнопку назовите cmdShow и измените Caption на "Показать кнопку Пуск".

4. Добавьте следующий код:

'Функция для поиска окна первого уровня Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Функция для поиска дочернего окна Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

'Функция для скрытия/показа окна

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Dim hnd As Long

Private Sub Form_Load() 'Кнопка Пуск является дочерним окном панели задач 'Кнопка Пуск относится к классу "BUTTON", Панель задач относится к классу "Shell_TrayWnd" 'Ищем, манипулятор панели задач hnd = FindWindow("Shell_TrayWnd", vbNullString) 'Ищем манипулятор кнопки пуск hnd = FindWindowEx(hnd, 0, "BUTTON", vbNullString) End Sub

Private Sub cmdHide_Click() 'Скрываем окно с заданным манипулятором ShowWindow hnd, 0 End Sub

Private Sub cmdShow_Click() 'Показываем окно с заданным манипулятором ShowWindow hnd, 1 End Sub

2. Меняем заголовок заданного окна

1. Создайте новый проект. 2. На создавшейся вместе с проектом форме разместите две метки, два текстовых поля и одну кнопку 3. Назовите первое текстовое поле txt1, второе txt2, кнопку cmdRename.

4. Добавьте следующий код:

'Функция для поиска окна первого уровня Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Функция для изменения заголовка окна Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Sub cmdRename_Click() Dim hwn As Long 'Ищем окно по его заголовку hwn = FindWindow(vbNullString, txt1) 'Меняем заголовок окна SetWindowText hwn, txt2 End Sub

В начало

Отключение системного меню

'процедура определения системного меню

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

'процедура удаления меню Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long Sub Disable_SysMenu(handle As Long) Dim menu_handle As Long 'переменная с хэндлом меню menu_handle = GetSystemMenu(handle, 0)

DestroyMenu (menu_handle) End Sub

handle =vForm.hwnd , где vForm - форма, над которой нужно поиздеваться

В начало

Заставляем VB работать с модемом.

Подключай к проекту mscomm32.ocx.

MSComm1.CommPort = 2 'номер порта MSComm1.Settings = "9600,n,8,1" 'параметры порта MSComm1.PortOpen = True 'открываем указанный выше порт MSComm1.Output = "AT" 'пересылаем в порт tim = Timer 'В течение 3-х секунд 1 DoEvents 'ждем ответ от модема If tim + 3 > Timer Then Goto 1 ' receive$ = MSComm1.Input 'принимаем с порта MSComm1.PortOpen = False 'закрываем порт

В начало

Размещение окна поверх всех

Public Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) Public Const HWND_TOPMOST = -1 Public Const HWND_NOTOPMOST = -2 Public Const SWP_NOACTIVATE = &H10 Public Const SWP_SHOWWINDOW = &H40 ' Для размещения окна OnTop: SetWindowPos Form1.hWnd, HWND_TOPMOST, Form1.Left / 15, Form1.Top / 15, Form1.Width / 15, Form1.Height / 15, SWP_NOACTIVATE Or SWP_SHOWWINDOW ' Для возвращения окну нормального статуса: SetWindowPos Form1.hWnd, HWND_NOTOPMOST, Form1.Left / 15, Form1.Top / 15, Form1.Width / 15, Form1.Height / 15, SWP_NOACTIVATE Or SWP_SHOWWINDO

Заменить "Form1" на имя вашей формы или поставить "Me" или вообще опустить название формы (для текущей формы). Число 15 было бы правильно заменить на значения Screen.TwipsPerPixelX и Screen.TwipsPerPixelY.

В начало