Голосование:
Ваш голос отсылается по E-mail владельцу сайта, после чего голоса анализируются и на отдельной странице выводятся результаты.
Нет тем.
Доска почёта:
Sergey Y. Tkachev
Кононенко Роман
Kirill
Ссылки:
Несколько слов от автора:
Опять пятница!
Читайте!
Читайте!
Содержание выпуска
- Книги
- Получение URL из адресной строки Microsoft Internet Explorer
- Автозавершение набора URL
- Запрещение запуска дополнительных окон IE
- Определение имени текущего домена и имени пользователя
- Подключение/отключение сетевого диска
- Определение имени или IP-адреса удаленного компьютера в сети
- Вопрос/Ответ
Книги
Остальные книги о VB можно найти здесь.
наверх
Получение URL из адресной строки Microsoft Internet Explorer
Примечание: не всегда у меня данный код срабатывал. Закройте все окна Internet Explorer, запустите программу, откройте любую htm-страницу, нажмите на кнопку в вашей программе.
Private Declare Function shellexecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) 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 SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_USER = &H400
Const EM_LIMITTEXT = WM_USER + 21
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Sub Command1_Click()
On Error GoTo CallErrorA
Dim iPos As Integer
Dim sClassName As String
Dim GetAddressText As String
Dim lhwnd As Long
Dim WindowHandle As Long
lhwnd = 0
sClassName = ("IEFrame")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("WorkerA")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ReBarWindow32")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ComboBoxEx32")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ComboBox")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("Edit")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
WindowHandle& = lhwnd
Dim buffer As String, TextLength As Long
TextLength& = SendMessage(WindowHandle&, WM_GETTEXTLENGTH, 0&, 0&)
buffer$ = String(TextLength&, 0&)
Call SendMessageByString(WindowHandle&, WM_GETTEXT, TextLength& + 1, buffer$)
MsgBox buffer$
Exit Sub
CallErrorA:
MsgBox Err.Description
Err.Clear
End Sub
наверх
Автозавершение набора URL
Этот пример для счастливых обладателей броузера ИнтернетЭксплорер версии от 5.0 и выше.
Помните про возможность автозавершения набора адреса? Нет? Не беда! Установите на форме компонент Label, компонент TextBox и CommandButton. И вы сразу почувствуете прелесть этого примера. Идеальный пример для работы с компонентом WebBrowser
Option Explicit
Private Const SHACF_AUTOSUGGEST_FORCE_ON As Long = &H10000000
Private Const SHACF_AUTOSUGGEST_FORCE_OFF As Long = &H20000000
Private Const SHACF_AUTOAPPEND_FORCE_ON As Long = &H40000000
Private Const SHACF_AUTOAPPEND_FORCE_OFF As Long = &H80000000
Private Const SHACF_DEFAULT As Long = &H0
Private Const SHACF_FILESYSTEM As Long = &H1
Private Const SHACF_URLHISTORY As Long = &H2
Private Const SHACF_URLMRU As Long = &H4
Private Const SHACF_URLALL As Long = (SHACF_URLHISTORY Or SHACF_URLMRU)
Private Const DLLVER_PLATFORM_WINDOWS As Long = &H1 'Windows 95
Private Const DLLVER_PLATFORM_NT As Long = &H2 'Windows NT
Private Type DllVersionInfo
cbSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformID As Long
End Type
Private Declare Function SHAutoComplete Lib "Shlwapi.dll" (ByVal hwndEdit As Long, ByVal dwFlags As Long) As Long
Private Declare Function DllGetVersion Lib "Shlwapi.dll" (dwVersion As DllVersionInfo) As Long
Private Function GetIEVersion(DVI As DllVersionInfo) As Long
DVI.cbSize = Len(DVI)
Call DllGetVersion(DVI)
GetIEVersion = DVI.dwMajorVersion
End Function
Private Function GetIEVersionString() As String
Dim DVI As DllVersionInfo
DVI.cbSize = Len(DVI)
Call DllGetVersion(DVI)
GetIEVersionString = "Internet Explorer " & DVI.dwMajorVersion & "." & DVI.dwMinorVersion & "." & DVI.dwBuildNumber
End Function
Private Sub Command1_Click()
Dim DVI As DllVersionInfo
If GetIEVersion(DVI) >= 5 Then
Call SHAutoComplete(Text1.hWnd, SHACF_DEFAULT)
Command1.Caption = "Автозавершение включено"
Command1.Enabled = False
Text1.SetFocus
Text1.SelStart = Len(Text1.Text)
Else
MsgBox "Простите, но у вас не установлен IE5", vbExclamation
End If
End Sub
Private Sub Form_Load()
Dim DVI As DllVersionInfo
Label1 = "Использование Shlwapi.dll для " & GetIEVersionString
Command1.Enabled = GetIEVersion(DVI) >= 5
Command1.Caption = "Автозавершение выключено"
End Sub
наверх
Запрещение запуска дополнительных окон IE
Данный пример запретит запуск дополнительных окон броузера ИнтернетЭксплорер. Этот пример хорош для борьбы с рекламными окошками, запускаемыми автоматически на тех или иных сайтах.
Определение имени текущего домена и имени пользователя
Вам понадобится элемент CommandButton
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Public Function GetLogonDomainuser() As String
Dim lResult As Long
Dim I As Integer
Dim bUserSid(255) As Byte
Dim sUserName As String
Dim sDomainName As String * 255
Dim lDomainNameLength As Long
Dim lSIDType As Long
sUserName = GetLogonUser
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
sDomainName = Space(lDomainNameLength)
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
If (lResult = 0) Then
MsgBox "Ошибка: невозможно найти имя домена для юзера: " & sUserName
Exit Function
End If
sDomainName = Left$(sDomainName, InStr(sDomainName, Chr$(0)) - 1)
GetLogonDomainuser = Trim(sDomainName)
End Function
Private Function GetLogonUser() As String
Dim strTemp As String, strUserName As String
strTemp = String(100, Chr$(0))
strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)
strUserName = String(100, Chr$(0))
GetUserName strUserName, 100
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetLogonUser = strUserName
End Function
Public Function UserName() As String
Dim cn As String
Dim ls As Long
Dim res As Long
cn = String(1024, 0)
ls = 1024
res = GetUserName(cn, ls)
If res <> 0 Then
UserName = Mid(cn, 1, InStr(cn, Chr(0)) - 1)
Else
UserName = ""
End If
End Function
Private Sub Command1_Click()
MsgBox GetLogonDomainuser
MsgBox GetLogonUser 'или MsgBox UserName
End Sub
наверх
Подключение/отключение сетевого диска
Прежде всего, добавьте дополнительный модуль, а также 2 элемента CommandButton.
'КОД ФОРМЫ
Private Sub Command1_Click()
Call Module1.Connect("Oksana\c$", "K:", "defaultsharename", "garik")
If (Module1.rc <> 0) And (Module1.rc <> 85) Then
MsgBox Module1.ErrorMsg
End If
End Sub
Private Sub Command2_Click()
Call Module1.DisConnect("K:", True)
If (Module1.rc <> 0) And (Module1.rc <> 85) Then
MsgBox Module1.ErrorMsg
End If
End Sub
'КОД МОДУЛЯ
Option Explicit
Public Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUsername As String, ByVal dwFlags As Long) As Long
Public Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Public ErrorNum As Long
Public ErrorMsg As String
Public rc As Long
Public RemoteName As String
Public Const ERROR_BAD_DEV_TYPE = 66&
Public Const ERROR_ALREADY_ASSIGNED = 85&
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_BAD_NET_NAME = 67&
Public Const ERROR_BAD_PROFILE = 1206&
Public Const ERROR_BAD_PROVIDER = 1204&
Public Const ERROR_BUSY = 170&
Public Const ERROR_CANCEL_VIOLATION = 173&
Public Const ERROR_CANNOT_OPEN_PROFILE = 1205&
Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202&
Public Const ERROR_EXTENDED_ERROR = 1208&
Public Const ERROR_INVALID_PASSWORD = 86&
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Public Const ERROR_NO_NETWORK = 1222&
Public Const ERROR_NO_CONNECTION = 8
Public Const ERROR_NO_DISCONNECT = 9
Public Const ERROR_DEVICE_IN_USE = 2404&
Public Const ERROR_NOT_CONNECTED = 2250&
Public Const ERROR_OPEN_FILES = 2401&
Public Const ERROR_MORE_DATA = 234
Public Const CONNECT_UPDATE_PROFILE = &H1
Public Const RESOURCETYPE_DISK = &H1
Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
Public lpNetResourse As NETRESOURCE
Public Sub Connect(ByVal HostName As String, ByVal RemoteName As String, ByVal Username As String, ByVal Password As String)
Dim lpUsername As String
Dim lpPassword As String
On Error GoTo Err_Connect
ErrorNum = 0
ErrorMsg = ""
lpNetResourse.dwType = RESOURCETYPE_DISK
lpNetResourse.lpLocalName = RemoteName & Chr(0)
'Drive Letter to use
lpNetResourse.lpRemoteName = "\\" & HostName & Chr(0)
'Network Path to share
lpNetResourse.lpProvider = Chr(0)
lpPassword = Password & Chr(0)
'password on share pass "" if none
lpUsername = Username & Chr(0)
'username to connect as if applicable
rc = WNetAddConnection2(lpNetResourse, lpPassword, lpUsername, CONNECT_UPDATE_PROFILE)
If rc <> 0 Then GoTo Err_Connect
Exit Sub
Err_Connect:
ErrorNum = rc
ErrorMsg = WnetError(rc)
End Sub
Public Sub DisConnect(ByVal Name As String, ByVal ForceOff As Boolean)
On Error GoTo Err_DisConnect
ErrorNum = 0
ErrorMsg = ""
rc = WNetCancelConnection2(Name & Chr(0), CONNECT_UPDATE_PROFILE, ForceOff)
If rc <> 0 Then GoTo Err_DisConnect
Exit Sub
Err_DisConnect:
ErrorNum = rc
ErrorMsg = WnetError(rc)
End Sub
Private Function WnetError(Errcode As Long) As String
Select Case Errcode
Case ERROR_BAD_DEV_TYPE
WnetError = "Bad device."
Case ERROR_ALREADY_ASSIGNED
WnetError = "Already Assigned."
Case ERROR_ACCESS_DENIED
WnetError = "Access Denied."
Case ERROR_BAD_NET_NAME
WnetError = "Bad net name"
Case ERROR_BAD_PROFILE
WnetError = "Bad Profile"
Case ERROR_BAD_PROVIDER
WnetError = "Bad Provider"
Case ERROR_BUSY
WnetError = "Busy"
Case ERROR_CANCEL_VIOLATION
WnetError = "Cancel Violation"
Case ERROR_CANNOT_OPEN_PROFILE
WnetError = "Cannot Open Profile"
Case ERROR_DEVICE_ALREADY_REMEMBERED
WnetError = "Device already remembered"
Case ERROR_EXTENDED_ERROR
WnetError = "Device already remembered"
Case ERROR_INVALID_PASSWORD
WnetError = "Invalid Password"
Case ERROR_NO_NET_OR_BAD_PATH
WnetError = "Could not find the specified device"
Case ERROR_NO_NETWORK
WnetError = "No Network Present"
Case ERROR_DEVICE_IN_USE
WnetError = "Connection Currently in use "
Case ERROR_NOT_CONNECTED
WnetError = "No Connection Present"
Case ERROR_OPEN_FILES
WnetError = "Files open and the force parameter is false"
Case ERROR_MORE_DATA
WnetError = "Buffer to small to hold network name, make lpnLength bigger"
Case Else:
WnetError = "Unrecognized Error " + Str(Errcode) + "."
End Select
End Function
наверх
Определение имени или IP-адреса удаленного компьютера в сети
Прежде всего, добавьте дополнительный модуль, а также 1 элемента CommandButton.
'КОД ФОРМЫ
Private Sub Command1_Click()
'Вначале вы должны инициализировать winsock
WinsockInit
'Определение имени машины, зная ее IP-адрес
MsgBox HostByAddress("192.168.1.1")
MsgBox HostByAddress("192.168.1.2")
'Определение IP-адреса машины, зная ее имя
MsgBox HostByName("GARIK")
MsgBox HostByName("OKSANA")
'В конце работы вы должны использовать функцию WSACleanUp
WSACleanUp
End Sub
'КОД МОДУЛЯ
Option Explicit
Public Const SOCKET_ERROR = -1
Public Const AF_INET = 2
Public Const PF_INET = AF_INET
Public Const MAXGETHOSTSTRUCT = 1024
Public Const SOCK_STREAM = 1
Public Const MSG_PEEK = 2
Private Type SockAddr
sin_family As Integer
sin_port As Integer
sin_addr As String * 4
sin_zero As String * 8
End Type
Private Type T_WSA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Dim WSAData As T_WSA
Type Inet_Address
Byte4 As String * 1
Byte3 As String * 1
Byte2 As String * 1
Byte1 As String * 1
End Type
Public IPStruct As Inet_Address
Public Type T_Host
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Declare Function inet_addr Lib "wsock32.dll" (ByVal addr As String) As Long
Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Declare Function GetHostName Lib "wsock32.dll" Alias "gethostname" (ByVal HostName As String, HostLen As Long) As Long
Declare Function WSAStartup Lib "wsock32.dll" (ByVal a As Long, b As T_WSA) As Long
Declare Function WSACleanUp Lib "wsock32.dll" Alias "WSACleanup" () As Integer
Function HostByName(sHost As String) As String
Dim s As String
Dim p As Long
Dim Host As T_Host
Dim ListAddress As Long
Dim ListAddr As Long
Dim Address As Long
s = String(64, 0)
sHost = sHost + Right(s, 64 - Len(sHost))
p = GetHostByName(sHost)
If p = SOCKET_ERROR Then
Exit Function
Else
If p <> 0 Then
CopyMemory Host.h_name, ByVal p, Len(Host)
ListAddress = Host.h_addr_list
CopyMemory ListAddr, ByVal ListAddress, 4
CopyMemory Address, ByVal ListAddr, 4
HostByName = InetAddrLongToString(Address)
Else
HostByName = "No DNS Entry"
End If
End If
End Function
Private Function InetAddrLongToString(Address As Long) As String
CopyMemory IPStruct, Address, 4
InetAddrLongToString = CStr(Asc(IPStruct.Byte4)) + "." + CStr(Asc(IPStruct.Byte3)) + "." + CStr(Asc(IPStruct.Byte2)) + "." + CStr(Asc(IPStruct.Byte1))
End Function
Function HostByAddress(ByVal sAddress As String) As String
Dim lAddress As Long
Dim p As Long
Dim HostName As String
Dim Host As T_Host
lAddress = inet_addr(sAddress)
p = gethostbyaddr(lAddress, 4, PF_INET)
If p <> 0 Then
CopyMemory Host, ByVal p, Len(Host)
HostName = String(256, 0)
CopyMemory ByVal HostName, ByVal Host.h_name, 256
If HostName = "" Then HostByAddress = "Unable to Resolve Address"
HostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)
Else
HostByAddress = "No DNS Entry"
End If
End Function
Public Sub WinsockInit()
WSAStartup &H101, WSAData
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
Автор: Шатрыкин Иван. Соавтор: Павел Сурменок.
наверх
Вопрос/Ответ
Автор вопроса: Мунгалов Андрей
Ответ ожидается по этому адресу
1.Подскажите пожалуйста как програмно создавать Базы данных .DBF формата 3 или 4.
2.Есть файл отчета CRystalReports. как в него из кода засунуть к примеру строку текста. ( конкретно такая ситуация. у меня отчет формирует список цен, а вконце надо добавить строку сумма прописью.) как?
Автор вопроса: pasha
Ответ ожидается по этому адресу
Где взять Visual Basic 7.0
Очень нужен.
Автор вопроса: Алексей
Ответ ожидается по этому адресу
А как можно программно закрыть любую другую программу, загруженную из-под Windows?
Автор вопроса: Rusty Angles
Ответ ожидается по этому адресу
Хочу создать трэйнер для игрушки, но как заменять данные в памяти? как их извлекать от туда, и чтобы при одном процессе, не мешая другим, в общем то что делают все трэйнеры. и еще, чтобы записывать и извлекать данные в hex(16-ти) что указывать и вообще как делаеться.. может есть сэмплы?! или инфа по этой теме?
Автор вопроса: tronos
Ответ ожидается по этому адресу
Как сменить кодировку текста,что-бы в Text-box иметь возможность выбора шрифта. Сейчас у меня выходит неискаженый текст(кирилица) в Text-box только со шрифтом Terminal.
Автор вопроса: Andrei
Ответ ожидается по этому адресу
Знает кто нибудь, как можно програмно ограничить скорость соединения при закачке файла?
Автор вопроса: sla_237
Ответ ожидается по этому адресу
1. Как считать скорость соединения модема с инетом в переменную?
2. Как програмно позвонить в инет (т.е. код и напишите пожалуйста где там username и логин вставлять.)
Автор вопроса: Rad
Ответ ожидается по этому адресу
Как можно можно сделать автоматический скроллинг в элементе Webbrowser ??
Автор вопроса: Проскурин
Ответ ожидается по этому адресу
Всем привет! Как бы написать прогу, что бы она преобразовывала (распознавала тональности, длину звучания и ноту) mp3 или wav в текст из аккордов или нот и наоборот.
Автор вопроса: P@Ssword
Ответ ожидается по этому адресу
Как и Win2000 определить, подключен ли компьютер к нитернету (черея модем)?
Автор вопроса: sv
Ответ ожидается по этому адресу
1)Программа запускает Windows Media Player, как его програмно закрыть и как определить закончено или нет воспроизведение клипа?
2)Что такое SDK?
Автор вопроса: Вячеслав Ленчевский
Ответ ожидается по этому адресу
нужна помощь: как организовать вложенный N раз цикл, если N заранее неизвестно? (границы у циклов одинаковые)
типа: for i(1)=1 to 10
for i(2)=1 to 10
.......................
for i(N)=1 to 10
i(0)=i(1)+i(2)+...+i(N)
next i(n)
...............
next i(2)
next i(1)
похоже тут необходима рекурсия? а как реализовать не соображу :-(
Автор вопроса: Vlad
Ответ ожидается по этому адресу
Как прочитать ия программы свои письма непосредственно с сервера. Подскажите где найти практические советы на эту тему или исходник.
Автор вопроса: Андрей
Ответ ожидается по этому адресу
1. Подскажите как в VB нажатием на кнопку открыть документ Microsoft vord, для добавления информации.
2. Нужна консультация! Написал прогу по расчету кое каких данных, эти данные у меня записываются в файл C:\Мои документы\1.Doc: Внимание вопрос? Как мне найти этот файл на диске нажав на кнопку расположенную в моей программе, открыть его в формате Мicrosoft vord для добавления , корректировки данных или печати запустив Microsoft vord не открывая проводник.
3. Подскажите как быть, пишу программу для тестирования эл. сварщиков, столкнулся с такой проблемой: 1. Какой код написать, чтоб на диске найти файл теста с вопросами и ответами, 2. вывести содержимое файла по необходимым TextBoxам, и чтоб программа сама перебирала вопросы и ответы по техт боксам при нажатии на кнопку дальше. Причем так чтоб этот файл можно было корректировать со временем.
4.Люди подскажите! По сл. необходимости пишу тестовую программу. Какой код вписаь чтоб программа могла различать правильные и неправеильные ответы! 2. Каким образом выести текст вопроса в полном объеме в TextBox (при длинном вопросе он показывает только его часть), Причем и варианты ответов написаны в одном файле.
Автор вопроса: LUX
Ответ ожидается по этому адресу
Нужна консультация, подскажите, как сделать мою форму поверх всех окон.
Ответы:
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: Иван
Для создания такого окна используется функция API SetWindowPos из библиотеки user32.dll. Декларируем в модуле следующую функцию и константы:
Option Explicit
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Declare Function 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) As Long
В форму вписывается следующий код
Option Explicit
Private Sub Form_Load()
Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End Sub
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: Ревягин_Алексей
Добавь 2 CommandButton (под именем Command1 и Command2). Когда нажмешь первую кнопку, форма поверх всех
Private Declare Function SetWindowPos Lib "user32" (ByVal h%, ByVal hb%, ByVal x%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal F%) As Integer
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const flags = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Private Sub Command1_Click()
res = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags) 'Форма on-top
End Sub
Private Sub Command2_Click()
res = SetWindowPos(Form1.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags) 'Форма non-on-top
End Sub
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: Иван
Если я правильно понял, то в окне проекта(где отображаются файлы форм) добавте форму нажав правую клавишу мыши add Form и выберите форму StayOnTop!
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: SHatrykin Ivan
Что означает fsStayOnTop? Если "поверх всех окон" то можно так:
'Устанавливаем окно поверх всех остальных
Public Sub SetFormPosition(frmHandl As Long, TopPosition As Boolean)
If TopPosition Then
SetWindowPos frmHandl, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
Else
SetWindowPos frmHandl, HWND_NOTOPMOST, 0, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOMOVE
End If
End Sub
Вызываем эту процедуру так:
call SetFormPosition Form1, True
Вопрос:
У меня вопрос по Web Browser'у. Подскажите как в VB менять раямер текста в Web Browser как это делает Internet Explorer.
Ответ:
Автор ответа: Ревягин_Алексей
Должен быть метод Font :
например
webbrowser.font=commondialog1.font
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: pasha
Наверно Option Explicit предназначен для программистов в прошлом программируемых на что то вроде Pascal, С, где необходимо объявлять каждую переменную перед использованием. А VB этим и отличается, что переменные объявлять практически вообще нет необходимости, хотя профессиональные программисты всегда ставят Option Explicit для объявления всех переменных тем самым создают эффективные программы. Вот и все.
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: Rafis
Что бы не было необьявленных переменных.
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: Roman 'devil' Yuakovlev
Повышение культуры программирования, возможность делания умного вида, борьба с вариантами и ошибками в набирании имен переменных... рекомендую настоятельно :)
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: Александр
Чтобы выявлялись ошибки.....
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: SHatrykin Ivan
И для этого тоже. Но основное предназначение этого оператора: исключение очепяток.
Вот пример:
Dim sLeft as String
sLeft = sLeff & "и что будет?"
Вопрос:
Как послать строку в текстовое поле чужого окна?
Ответ:
Автор ответа: XAlex-sub
Если курсор находится в нужном поле то можно воспользоваться функцией sendkeys("передаваемый текст") эта функция эмулирует нажатие клавиш на клаве в противном случае только через API и надо знать hwnd окна о обьекта
Вопрос:
Как послать строку в текстовое поле чужого окна?
Ответ:
Автор ответа: SHatrykin Ivan
Все зависит от того, куда и как нужно "послать" текст. Если вам известен hWnd этого окна, то воспользуйтесь функцией SetWindowText в первом параметре функции укажите hWnd окна, а во втором строку текста, которую нужно там "напечатать". В этом случае весь старый текст содержащийся в этом окне "исчезнет" и появится новый.
Вопрос:
Может кто знает как вытянуть данные из таблицы ворд в таблицу экселя, подскажите плиз.
Ответ:
Автор ответа: Андрей
Начиная с Office 2000 появляются вложенные таблицы, нужно учесть.
Private Sub GetParagraps(ByVal objParagraps As Word.Paragraphs)
On Error GoTo Check:
Dim objParagraph As Word.Paragraph
Dim blnTableComplete As Boolean
Dim iParagraph As Long
For iParagraph = 1 To objParagraps.Count
Set objParagraph = objParagraps.Item(iParagraph)
If objParagraph.Range.Tables.Count > 0 Then
If blnTableComplete = False Then GetTable objParagraph.Range.Tables(1)
blnTableComplete = True
Else
blnTableComplete = False
End If
Next
Set objParagraph = Nothing
Exit Sub
Check:
...
Resume Next
End Sub
Private Sub GetTable(ByVal tblCurrent As Word.Table)
Dim CurrentRow As Word.Row
Dim CurrentCell As Word.Cell
Dim i As Long, j As Long
On Error GoTo Check:
For i = 1 To tblCurrent.Rows.Count
Set CurrentRow = tblCurrent.Rows.Item(i)
....
For j = 1 To CurrentRow.Cells.Count
Set CurrentCell = CurrentRow.Cells.Item(j)
....
Next
Next
Set CurrentRow = Nothing
Set CurrentCell = Nothing
Exit Sub
Check:
...
Resume Next
End Sub
Вопрос:
Может кто знает как вытянуть данные из таблицы ворд в таблицу экселя, подскажите плиз.
Ответ:
Автор ответа: SHatrykin Ivan
Напрямую вытащить данные, скорее всего, не удастся. Можно воспользоваться обходным путем:
1. получить таблицу в программу - можно через буфер обмена в rtf формате
2. программно анализировать каждую полученную строчку! и самому создать массив из данных таблицы
3. перекинуть этот массив в Exel
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Duke
Точно могу ответить только на первый это пожно сделать командой Shell
напр. shell "C:\Myproga.exe"
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Иван
1) Самый надежный способ открытия любого файла получается с применением API – функций.
' Декларация функции для запуска файла.
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
' Декларация константы для максимизирования окна открываемого приложения.
' Для работы с другими константами смотрите Help по API.
Public Const SW_SHOWMAXIMIZED = 3
После этого нижеследующий код будет открывать файл test.xls находящийся в директории C:\My Documents\
Call ShellExecute(0, "open", " C:\My Documents\test.xls","", "", SW_SHOWMAXIMIZED)
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Иван
Нет ничего проще:
1. Функция Shell("path\name")-запускает исполняемую программу!
2. Стандартный объект File помещаеш на форму, устанавливаешь свйство Path, если не надо чтобы объект был виден отключи видемось! File1.List(номер строки).text-имя файла
Понятно? У меня подрукой нет VB, точнее напишу если попросиш!
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Ревягин_Алексей
есть такие функции как:
shell(Path as string)
ShellExecute
и т. д.
помести на форму объекты:
Filelist
dirlist
drivelist
и укажи для каждого из него параметр Default нажми F5.
Эксперементируй.
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Rafis
1)Shell "Полный путь к программе",стиль окна
2)Это можно сделать с помощью Dir-а
например:
Поставь на форму ListBox и напишите в нём следуещее:
Private Sub Form_Load()
ListBox1.Clear
st = Dir("C:\*.*", vbDirectory)
Do While Len(st)
st = Dir
ListBox1.AddItem st
Loop
End Sub
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: pasha
1) Чтобы запустить любой файл используется команда Shell ("Путь к файлу", параметр).
2) Ставишь FileListBox и DirListBox и в свойстве Path прописываешь путь.
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Roman 'devil' Yuakovlev
1) shell "notepad.exe"
2) функция dir$, контролы dirlistbox и filelistbox
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: SHatrykin Ivan
Для запуска чужой программы воспользуйтесь функцией Shell. Описание смотрите сами (можно на нашем сайте). А для поиска файлов в определенной папке Path создайте такой цикл:
sFile = Dir(Path & "*.*")
Do While sFile <> ""
имя_файла = sFile
sFile = Dir
Loop
Вопрос:
Как в VBA сояданному програмно объекту наяначить реакцию на событие OnClick.
Ответ:
Автор ответа: Ревягин_Алексей
Нужно создать массив элементов управления указать свойство index=0 и дальше копировать этот объект на форму а затем зайти в код и выбрать Объект_Clicl
в результате:
Private sub Объект_Click(Index as Integer)
select case index
case 0
событие нажатия на 0-й объект
case 1
событие нажатия на 1-й объект
case 2
событие нажатия на 2-й объект
.....
case n
событие нажатия на n-й объект
end select
end sub
где n-это Объект.UBound
Вопрос:
Как гарантированно опознать компьютер? То есть: сер.номер мамы, сер.номер винта или что-нибудь в этом духе, без компонентов, желательно через API.
Ответ:
Автор ответа: SHatrykin Ivan
Вопрос о серийном номере компьютера уже "обсуждался" в Библиотеке кодов. Смотрите раздел Информация о компьютере.
Вопрос:
Как можно в ресурсы засунуть WAV,AVI а потом их воспроизвести.
Ответ:
Автор ответа: Oleg Koren
The following code is a resource script that can be compiled by using the 16-bit and 32-bit versions of Rc.exe.
//////////////////////////////////////////////////////////////////////
//////
// Myres.rc - 16 & 32 bit script. This must be compiled into two
file://.res files using the 16 & 32 bit versions of RC.
///////////////////////////////////////////////////////////////////////
//////
// Wave Resources - You must copy these files from your \Windows
// directory to the directory where your .rc script resides.
CHIMES WAVE DISCARDABLE "Chimes.wav"
DING WAVE DISCARDABLE "Ding.wav"
Steps to Create a Resource File Save the preceding code in Notepad as Myres.rc in the directory where Rc.exe exists on your hard disk.
Copy Chimes.wav and Ding.wav from your Windows directory (\Windows\Media directory in Windows 95 and Windows 98 or \WinNT\Media directory in Windows NT and Windows 2000) to the same directory where you saved the Myres.rc file.
At the command line, type "RC -r Myres.rc." If you want a 16-bit and 32- bit version of your resource file, then you will have to save two copies of your resource file as Myres32.rc and Myres16.rc, and compile each separately with the appropriate resource compiler.
Steps to Run the Sample Application
Create a new project and add a command button to Form1.
Add the following code to Form1:
'*******
' Form1.frm - Calls PlayWaveRes to play a wave resource file.
'*******
Sub Command1_Click()
PlayWaveRes "Chimes"
PlayWaveRes "Ding"
End Sub
Add your resource file to the project.
Type the following code in a new code module:
******
' Baswave.bas - Plays a wave file from a resource using LoadResData.
'*****
Option Explicit
#If Win32 Then
Private Declare Function sndPlaySound Lib "winmm" Alias _
"sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) _
As Long
#Else
Private Declare Function sndPlaySound Lib "MMSYSTEM" ( _
lpszSoundName As Any, ByVal uFlags%) As Integer
#End If
'******
' Flag values for wFlags parameter.
'******
Public Const SND_SYNC = &H0 ' Play synchronously (default).
'Public Const SND_ASYNC = &H1 ' Play asynchronously (see note below).
Public Const SND_NODEFAULT = &H2 ' Do not use default sound.
Public Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file.
Public Const SND_LOOP = &H8 ' Loop the sound until next sndPlaySound.
Public Const SND_NOSTOP = &H10 ' Do not stop any currently playing sound.
'******
' Plays a wave file from a resource.
'******
Public Sub PlayWaveRes(vntResourceID As Variant, Optional vntFlags)
'-----------------------------------------------------------------
' WARNING: If you want to play sound files asynchronously in
' Win32, then you MUST change bytSound() from a local
' variable to a module-level or static variable. Doing
' this prevents your array from being destroyed before
' sndPlaySound is complete. If you fail to do this, you
' will pass an invalid memory pointer, which will cause
' a GPF in the Multimedia Control Interface (MCI).
'-----------------------------------------------------------------
Dim bytSound() As Byte ' Always store binary data in byte arrays!
bytSound = LoadResData(vntResourceID, "WAVE")
If IsMissing(vntFlags) Then
vntFlags = SND_NODEFAULT Or SND_SYNC Or SND_MEMORY
End If
If (vntFlags And SND_MEMORY) = 0 Then
vntFlags = vntFlags Or SND_MEMORY
End If
sndPlaySound bytSound(0), vntFlags
End Sub
REFERENCES
For information on how to store any file type in a resource file and retrieve the file for use at run-time in Visual Basic versions 5.0 and 6.0, please see the following article in the Microsoft Knowledge Base:
Q194409 SAMPLE: RESFILE.EXE Stores Any File Type in a Resource File
Additional query words: WAVE LOADRESDATA RESOURCES RC BYTE SND_ASYNC kbdsd
---------------
это пример из MSDN.
я его не проверял.
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по 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 можно найти здесь.
наверх
Получение URL из адресной строки Microsoft Internet Explorer
Примечание: не всегда у меня данный код срабатывал. Закройте все окна Internet Explorer, запустите программу, откройте любую htm-страницу, нажмите на кнопку в вашей программе.
Private Declare Function shellexecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) 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 SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_USER = &H400
Const EM_LIMITTEXT = WM_USER + 21
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Sub Command1_Click()
On Error GoTo CallErrorA
Dim iPos As Integer
Dim sClassName As String
Dim GetAddressText As String
Dim lhwnd As Long
Dim WindowHandle As Long
lhwnd = 0
sClassName = ("IEFrame")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("WorkerA")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ReBarWindow32")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ComboBoxEx32")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ComboBox")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("Edit")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
WindowHandle& = lhwnd
Dim buffer As String, TextLength As Long
TextLength& = SendMessage(WindowHandle&, WM_GETTEXTLENGTH, 0&, 0&)
buffer$ = String(TextLength&, 0&)
Call SendMessageByString(WindowHandle&, WM_GETTEXT, TextLength& + 1, buffer$)
MsgBox buffer$
Exit Sub
CallErrorA:
MsgBox Err.Description
Err.Clear
End Sub
наверх
Автозавершение набора URL
Этот пример для счастливых обладателей броузера ИнтернетЭксплорер версии от 5.0 и выше.
Помните про возможность автозавершения набора адреса? Нет? Не беда! Установите на форме компонент Label, компонент TextBox и CommandButton. И вы сразу почувствуете прелесть этого примера. Идеальный пример для работы с компонентом WebBrowser
Option Explicit
Private Const SHACF_AUTOSUGGEST_FORCE_ON As Long = &H10000000
Private Const SHACF_AUTOSUGGEST_FORCE_OFF As Long = &H20000000
Private Const SHACF_AUTOAPPEND_FORCE_ON As Long = &H40000000
Private Const SHACF_AUTOAPPEND_FORCE_OFF As Long = &H80000000
Private Const SHACF_DEFAULT As Long = &H0
Private Const SHACF_FILESYSTEM As Long = &H1
Private Const SHACF_URLHISTORY As Long = &H2
Private Const SHACF_URLMRU As Long = &H4
Private Const SHACF_URLALL As Long = (SHACF_URLHISTORY Or SHACF_URLMRU)
Private Const DLLVER_PLATFORM_WINDOWS As Long = &H1 'Windows 95
Private Const DLLVER_PLATFORM_NT As Long = &H2 'Windows NT
Private Type DllVersionInfo
cbSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformID As Long
End Type
Private Declare Function SHAutoComplete Lib "Shlwapi.dll" (ByVal hwndEdit As Long, ByVal dwFlags As Long) As Long
Private Declare Function DllGetVersion Lib "Shlwapi.dll" (dwVersion As DllVersionInfo) As Long
Private Function GetIEVersion(DVI As DllVersionInfo) As Long
DVI.cbSize = Len(DVI)
Call DllGetVersion(DVI)
GetIEVersion = DVI.dwMajorVersion
End Function
Private Function GetIEVersionString() As String
Dim DVI As DllVersionInfo
DVI.cbSize = Len(DVI)
Call DllGetVersion(DVI)
GetIEVersionString = "Internet Explorer " & DVI.dwMajorVersion & "." & DVI.dwMinorVersion & "." & DVI.dwBuildNumber
End Function
Private Sub Command1_Click()
Dim DVI As DllVersionInfo
If GetIEVersion(DVI) >= 5 Then
Call SHAutoComplete(Text1.hWnd, SHACF_DEFAULT)
Command1.Caption = "Автозавершение включено"
Command1.Enabled = False
Text1.SetFocus
Text1.SelStart = Len(Text1.Text)
Else
MsgBox "Простите, но у вас не установлен IE5", vbExclamation
End If
End Sub
Private Sub Form_Load()
Dim DVI As DllVersionInfo
Label1 = "Использование Shlwapi.dll для " & GetIEVersionString
Command1.Enabled = GetIEVersion(DVI) >= 5
Command1.Caption = "Автозавершение выключено"
End Sub
наверх
Запрещение запуска дополнительных окон IE
Данный пример запретит запуск дополнительных окон броузера ИнтернетЭксплорер. Этот пример хорош для борьбы с рекламными окошками, запускаемыми автоматически на тех или иных сайтах.
Что делает пример: 1) программа при запуске определяет количество запущенных окон InternetExplorer'а. 2) во время работы программа проводит мониторинг запущенных процессов, 3) и если запущено очередное окно Internet Explorer'а программа его закроет.
Ну а кнопка вам понадобится, если вы захотите отключить/снова включить процесс мониторинга.
Пример подробно описан, но... на английском языке.
Установите на форме компонент Label,
компонент Timer и CommandButton. Также в
этом примере вам понадобится дополнительный
модуль.
'КОД МОДУЛЯ:
Public Type WI
TitleBarText As String
TitleBarLen As Integer
hWnd As Long
End Type
Public Declare Function GetWindowTextLength Lib "user32.dll" Alias
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long,
ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32.dll" Alias
"GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount
As Long) As Long
Public WinNum As Integer 'holds the number of windows examined
Public CurrentWindows(299) As WI 'holds information about all of the currently open
windows
Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim WinInfo As WI 'holds information about the window currently being examined
Dim retval As Long 'holds the return value
Dim X As Integer
WinInfo.TitleBarLen = GetWindowTextLength(hWnd) + 1 'find the length of the title bar text
of the window currently being examined
If WinInfo.TitleBarLen > 0 And Len(hWnd) > 1 Then 'if the title bar text of the
window currently being examined is at least one character long AND the window's handle is
> 1
WinInfo.TitleBarText = Space(WinInfo.TitleBarLen) 'initialize the variable that will hold
the title bar text
retval = GetWindowText(hWnd, WinInfo.TitleBarText, WinInfo.TitleBarLen) 'retreive the
title bar text of the window currently being examined
WinInfo.hWnd = hWnd 'holds the value of this window's handle
CurrentWindows(WinNum).hWnd = WinInfo.hWnd 'store this window's handle in the current
windows array
CurrentWindows(WinNum).TitleBarText = WinInfo.TitleBarText 'store this window's title bar
text in the current windows array
WinNum = WinNum + 1 'increment the window counter
End If
EnumWindowsProc = 1 'continue enumeration of windows
End Function
'КОД ФОРМЫ
Option Explicit
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As
Long
Private Const WM_CLOSE = &H10
Dim ExistingIEWindows(49) As Long 'holds the handles of all of the currently existing IE
windows (50 max)
Dim Flash As Integer 'holds the value that determines if the status text should flash
Private Sub Command1_Click()
If Command1.Caption = "Отключить мониторинг" Then
Timer1.Enabled = False
Command1.Caption = "Включить мониторинг"
Else
Timer1.Enabled = True
End If
End Sub
Private Sub Form_Load()
Timer1.Interval = 100
Command1.Caption = "Отключить мониторинг"
Dim X As Integer 'loop variable
Label1.Caption = "Initializing..."
Flash = 0
For X = 0 To 49 'reset/initialize the existing IE windows array
ExistingIEWindows(X) = 0
Next
Call GetExistingIEWindows
End Sub
Private Sub GetExistingIEWindows() 'this sub checks to see if any IE windows are currently
open, and "remembers" them if so.
Dim retval As Long 'holds the return value
Dim X As Integer, Y As Integer 'loop variables
Label1.Caption = "Examining currently active system windows..."
WinNum = 0 'initialize number of windows to zero
For X = 0 To 199 'reset/initialize the current windows array
CurrentWindows(X).hWnd = 0
CurrentWindows(X).TitleBarLen = 0
CurrentWindows(X).TitleBarText = ""
Next
retval = EnumWindows(AddressOf EnumWindowsProc, 0) 'enumerate all open windows
Y = 0
For X = 0 To WinNum - 1 'for each window that is currently open
If InStr(1, CurrentWindows(X).TitleBarText, "Microsoft Internet Explorer",
vbTextCompare) > 0 Then 'if this window is an IE window...
Label1.Caption = "Storing IE window handle..."
ExistingIEWindows(Y) = CurrentWindows(X).hWnd 'add this window to the list of existing IE
windows
Y = Y + 1
End If
Next
If Y > 0 Then 'if any of the existing system windows are IE windows
Label1.Caption = "Enabling popup monitoring..."
Timer1.Enabled = True 'enable the timer that checks for any new IE windows
Label1.Caption = "Monitoring for new IE windows..."
Else 'if none of the existing system windows are IE windows
Label1.Caption = "No IE windows found!"
MsgBox "There are currently no IE windows open!" & vbLf & vbLf &
"Please start Internet Explorer before running this program.", vbExclamation +
vbOKOnly, "Error" 'if no IE windows are found, display an error message
End 'exit this program
End If
End Sub
Private Sub Timer1_Timer()
Dim retval As Long 'holds the return value
Dim X As Integer, Y As Integer 'loop variables
Dim KillCount As Integer 'holds the value that determines if the current window should be
killed
WinNum = 0 'initialize number of windows to zero
For X = 0 To 199 'reset/initialize the current windows array
CurrentWindows(X).hWnd = 0
CurrentWindows(X).TitleBarLen = 0
CurrentWindows(X).TitleBarText = ""
Next
retval = EnumWindows(AddressOf EnumWindowsProc, 0) 'enumerate all open windows
For X = 0 To WinNum - 1 'for each window that is currently open
If InStr(1, CurrentWindows(X).TitleBarText, "Microsoft Internet Explorer",
vbTextCompare) > 0 Then 'if this window is an IE window...
KillCount = 0
For Y = 0 To 49
If ExistingIEWindows(Y) <> 0 Then 'if array value holds a valid handle
If ExistingIEWindows(Y) = CurrentWindows(X).hWnd Then 'if the window currently being
examined matches any of the existing IE windows
KillCount = KillCount + 1 'increment
End If
End If
Next
If KillCount = 0 Then 'if an IE window that did not previously exist was found
retval = PostMessage(CurrentWindows(X).hWnd, WM_CLOSE, ByVal CLng(0), ByVal CLng(0)) 'post
the window close message to the newly created IE window's message queue
End If
End If
Next
Flash = Flash + 1 'increment the flash value
If Flash = 5 Then 'make the status label flash every 0.5 seconds
Flash = 0
If Label1.Visible = True Then
Label1.Visible = False
Else
Label1.Visible = True
End If
End If
End Sub
наверх
Определение имени текущего домена и имени пользователя
Вам понадобится элемент CommandButton
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Public Function GetLogonDomainuser() As String
Dim lResult As Long
Dim I As Integer
Dim bUserSid(255) As Byte
Dim sUserName As String
Dim sDomainName As String * 255
Dim lDomainNameLength As Long
Dim lSIDType As Long
sUserName = GetLogonUser
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
sDomainName = Space(lDomainNameLength)
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
If (lResult = 0) Then
MsgBox "Ошибка: невозможно найти имя домена для юзера: " & sUserName
Exit Function
End If
sDomainName = Left$(sDomainName, InStr(sDomainName, Chr$(0)) - 1)
GetLogonDomainuser = Trim(sDomainName)
End Function
Private Function GetLogonUser() As String
Dim strTemp As String, strUserName As String
strTemp = String(100, Chr$(0))
strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)
strUserName = String(100, Chr$(0))
GetUserName strUserName, 100
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetLogonUser = strUserName
End Function
Public Function UserName() As String
Dim cn As String
Dim ls As Long
Dim res As Long
cn = String(1024, 0)
ls = 1024
res = GetUserName(cn, ls)
If res <> 0 Then
UserName = Mid(cn, 1, InStr(cn, Chr(0)) - 1)
Else
UserName = ""
End If
End Function
Private Sub Command1_Click()
MsgBox GetLogonDomainuser
MsgBox GetLogonUser 'или MsgBox UserName
End Sub
наверх
Подключение/отключение сетевого диска
Прежде всего, добавьте дополнительный модуль, а также 2 элемента CommandButton.
'КОД ФОРМЫ
Private Sub Command1_Click()
Call Module1.Connect("Oksana\c$", "K:", "defaultsharename", "garik")
If (Module1.rc <> 0) And (Module1.rc <> 85) Then
MsgBox Module1.ErrorMsg
End If
End Sub
Private Sub Command2_Click()
Call Module1.DisConnect("K:", True)
If (Module1.rc <> 0) And (Module1.rc <> 85) Then
MsgBox Module1.ErrorMsg
End If
End Sub
'КОД МОДУЛЯ
Option Explicit
Public Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUsername As String, ByVal dwFlags As Long) As Long
Public Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Public ErrorNum As Long
Public ErrorMsg As String
Public rc As Long
Public RemoteName As String
Public Const ERROR_BAD_DEV_TYPE = 66&
Public Const ERROR_ALREADY_ASSIGNED = 85&
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_BAD_NET_NAME = 67&
Public Const ERROR_BAD_PROFILE = 1206&
Public Const ERROR_BAD_PROVIDER = 1204&
Public Const ERROR_BUSY = 170&
Public Const ERROR_CANCEL_VIOLATION = 173&
Public Const ERROR_CANNOT_OPEN_PROFILE = 1205&
Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202&
Public Const ERROR_EXTENDED_ERROR = 1208&
Public Const ERROR_INVALID_PASSWORD = 86&
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Public Const ERROR_NO_NETWORK = 1222&
Public Const ERROR_NO_CONNECTION = 8
Public Const ERROR_NO_DISCONNECT = 9
Public Const ERROR_DEVICE_IN_USE = 2404&
Public Const ERROR_NOT_CONNECTED = 2250&
Public Const ERROR_OPEN_FILES = 2401&
Public Const ERROR_MORE_DATA = 234
Public Const CONNECT_UPDATE_PROFILE = &H1
Public Const RESOURCETYPE_DISK = &H1
Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
Public lpNetResourse As NETRESOURCE
Public Sub Connect(ByVal HostName As String, ByVal RemoteName As String, ByVal Username As String, ByVal Password As String)
Dim lpUsername As String
Dim lpPassword As String
On Error GoTo Err_Connect
ErrorNum = 0
ErrorMsg = ""
lpNetResourse.dwType = RESOURCETYPE_DISK
lpNetResourse.lpLocalName = RemoteName & Chr(0)
'Drive Letter to use
lpNetResourse.lpRemoteName = "\\" & HostName & Chr(0)
'Network Path to share
lpNetResourse.lpProvider = Chr(0)
lpPassword = Password & Chr(0)
'password on share pass "" if none
lpUsername = Username & Chr(0)
'username to connect as if applicable
rc = WNetAddConnection2(lpNetResourse, lpPassword, lpUsername, CONNECT_UPDATE_PROFILE)
If rc <> 0 Then GoTo Err_Connect
Exit Sub
Err_Connect:
ErrorNum = rc
ErrorMsg = WnetError(rc)
End Sub
Public Sub DisConnect(ByVal Name As String, ByVal ForceOff As Boolean)
On Error GoTo Err_DisConnect
ErrorNum = 0
ErrorMsg = ""
rc = WNetCancelConnection2(Name & Chr(0), CONNECT_UPDATE_PROFILE, ForceOff)
If rc <> 0 Then GoTo Err_DisConnect
Exit Sub
Err_DisConnect:
ErrorNum = rc
ErrorMsg = WnetError(rc)
End Sub
Private Function WnetError(Errcode As Long) As String
Select Case Errcode
Case ERROR_BAD_DEV_TYPE
WnetError = "Bad device."
Case ERROR_ALREADY_ASSIGNED
WnetError = "Already Assigned."
Case ERROR_ACCESS_DENIED
WnetError = "Access Denied."
Case ERROR_BAD_NET_NAME
WnetError = "Bad net name"
Case ERROR_BAD_PROFILE
WnetError = "Bad Profile"
Case ERROR_BAD_PROVIDER
WnetError = "Bad Provider"
Case ERROR_BUSY
WnetError = "Busy"
Case ERROR_CANCEL_VIOLATION
WnetError = "Cancel Violation"
Case ERROR_CANNOT_OPEN_PROFILE
WnetError = "Cannot Open Profile"
Case ERROR_DEVICE_ALREADY_REMEMBERED
WnetError = "Device already remembered"
Case ERROR_EXTENDED_ERROR
WnetError = "Device already remembered"
Case ERROR_INVALID_PASSWORD
WnetError = "Invalid Password"
Case ERROR_NO_NET_OR_BAD_PATH
WnetError = "Could not find the specified device"
Case ERROR_NO_NETWORK
WnetError = "No Network Present"
Case ERROR_DEVICE_IN_USE
WnetError = "Connection Currently in use "
Case ERROR_NOT_CONNECTED
WnetError = "No Connection Present"
Case ERROR_OPEN_FILES
WnetError = "Files open and the force parameter is false"
Case ERROR_MORE_DATA
WnetError = "Buffer to small to hold network name, make lpnLength bigger"
Case Else:
WnetError = "Unrecognized Error " + Str(Errcode) + "."
End Select
End Function
наверх
Определение имени или IP-адреса удаленного компьютера в сети
Прежде всего, добавьте дополнительный модуль, а также 1 элемента CommandButton.
'КОД ФОРМЫ
Private Sub Command1_Click()
'Вначале вы должны инициализировать winsock
WinsockInit
'Определение имени машины, зная ее IP-адрес
MsgBox HostByAddress("192.168.1.1")
MsgBox HostByAddress("192.168.1.2")
'Определение IP-адреса машины, зная ее имя
MsgBox HostByName("GARIK")
MsgBox HostByName("OKSANA")
'В конце работы вы должны использовать функцию WSACleanUp
WSACleanUp
End Sub
'КОД МОДУЛЯ
Option Explicit
Public Const SOCKET_ERROR = -1
Public Const AF_INET = 2
Public Const PF_INET = AF_INET
Public Const MAXGETHOSTSTRUCT = 1024
Public Const SOCK_STREAM = 1
Public Const MSG_PEEK = 2
Private Type SockAddr
sin_family As Integer
sin_port As Integer
sin_addr As String * 4
sin_zero As String * 8
End Type
Private Type T_WSA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Dim WSAData As T_WSA
Type Inet_Address
Byte4 As String * 1
Byte3 As String * 1
Byte2 As String * 1
Byte1 As String * 1
End Type
Public IPStruct As Inet_Address
Public Type T_Host
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Declare Function inet_addr Lib "wsock32.dll" (ByVal addr As String) As Long
Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Declare Function GetHostName Lib "wsock32.dll" Alias "gethostname" (ByVal HostName As String, HostLen As Long) As Long
Declare Function WSAStartup Lib "wsock32.dll" (ByVal a As Long, b As T_WSA) As Long
Declare Function WSACleanUp Lib "wsock32.dll" Alias "WSACleanup" () As Integer
Function HostByName(sHost As String) As String
Dim s As String
Dim p As Long
Dim Host As T_Host
Dim ListAddress As Long
Dim ListAddr As Long
Dim Address As Long
s = String(64, 0)
sHost = sHost + Right(s, 64 - Len(sHost))
p = GetHostByName(sHost)
If p = SOCKET_ERROR Then
Exit Function
Else
If p <> 0 Then
CopyMemory Host.h_name, ByVal p, Len(Host)
ListAddress = Host.h_addr_list
CopyMemory ListAddr, ByVal ListAddress, 4
CopyMemory Address, ByVal ListAddr, 4
HostByName = InetAddrLongToString(Address)
Else
HostByName = "No DNS Entry"
End If
End If
End Function
Private Function InetAddrLongToString(Address As Long) As String
CopyMemory IPStruct, Address, 4
InetAddrLongToString = CStr(Asc(IPStruct.Byte4)) + "." + CStr(Asc(IPStruct.Byte3)) + "." + CStr(Asc(IPStruct.Byte2)) + "." + CStr(Asc(IPStruct.Byte1))
End Function
Function HostByAddress(ByVal sAddress As String) As String
Dim lAddress As Long
Dim p As Long
Dim HostName As String
Dim Host As T_Host
lAddress = inet_addr(sAddress)
p = gethostbyaddr(lAddress, 4, PF_INET)
If p <> 0 Then
CopyMemory Host, ByVal p, Len(Host)
HostName = String(256, 0)
CopyMemory ByVal HostName, ByVal Host.h_name, 256
If HostName = "" Then HostByAddress = "Unable to Resolve Address"
HostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)
Else
HostByAddress = "No DNS Entry"
End If
End Function
Public Sub WinsockInit()
WSAStartup &H101, WSAData
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels.
Автор: Шатрыкин Иван. Соавтор: Павел Сурменок.
наверх
Вопрос/Ответ
Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.
Вопросы:Автор вопроса: Мунгалов Андрей
Ответ ожидается по этому адресу
1.Подскажите пожалуйста как програмно создавать Базы данных .DBF формата 3 или 4.
2.Есть файл отчета CRystalReports. как в него из кода засунуть к примеру строку текста. ( конкретно такая ситуация. у меня отчет формирует список цен, а вконце надо добавить строку сумма прописью.) как?
Автор вопроса: pasha
Ответ ожидается по этому адресу
Где взять Visual Basic 7.0
Очень нужен.
Автор вопроса: Алексей
Ответ ожидается по этому адресу
А как можно программно закрыть любую другую программу, загруженную из-под Windows?
Автор вопроса: Rusty Angles
Ответ ожидается по этому адресу
Хочу создать трэйнер для игрушки, но как заменять данные в памяти? как их извлекать от туда, и чтобы при одном процессе, не мешая другим, в общем то что делают все трэйнеры. и еще, чтобы записывать и извлекать данные в hex(16-ти) что указывать и вообще как делаеться.. может есть сэмплы?! или инфа по этой теме?
Автор вопроса: tronos
Ответ ожидается по этому адресу
Как сменить кодировку текста,что-бы в Text-box иметь возможность выбора шрифта. Сейчас у меня выходит неискаженый текст(кирилица) в Text-box только со шрифтом Terminal.
Автор вопроса: Andrei
Ответ ожидается по этому адресу
Знает кто нибудь, как можно програмно ограничить скорость соединения при закачке файла?
Автор вопроса: sla_237
Ответ ожидается по этому адресу
1. Как считать скорость соединения модема с инетом в переменную?
2. Как програмно позвонить в инет (т.е. код и напишите пожалуйста где там username и логин вставлять.)
Автор вопроса: Rad
Ответ ожидается по этому адресу
Как можно можно сделать автоматический скроллинг в элементе Webbrowser ??
Автор вопроса: Проскурин
Ответ ожидается по этому адресу
Всем привет! Как бы написать прогу, что бы она преобразовывала (распознавала тональности, длину звучания и ноту) mp3 или wav в текст из аккордов или нот и наоборот.
Автор вопроса: P@Ssword
Ответ ожидается по этому адресу
Как и Win2000 определить, подключен ли компьютер к нитернету (черея модем)?
Автор вопроса: sv
Ответ ожидается по этому адресу
1)Программа запускает Windows Media Player, как его програмно закрыть и как определить закончено или нет воспроизведение клипа?
2)Что такое SDK?
Автор вопроса: Вячеслав Ленчевский
Ответ ожидается по этому адресу
нужна помощь: как организовать вложенный N раз цикл, если N заранее неизвестно? (границы у циклов одинаковые)
типа: for i(1)=1 to 10
for i(2)=1 to 10
.......................
for i(N)=1 to 10
i(0)=i(1)+i(2)+...+i(N)
next i(n)
...............
next i(2)
next i(1)
похоже тут необходима рекурсия? а как реализовать не соображу :-(
Автор вопроса: Vlad
Ответ ожидается по этому адресу
Как прочитать ия программы свои письма непосредственно с сервера. Подскажите где найти практические советы на эту тему или исходник.
Автор вопроса: Андрей
Ответ ожидается по этому адресу
1. Подскажите как в VB нажатием на кнопку открыть документ Microsoft vord, для добавления информации.
2. Нужна консультация! Написал прогу по расчету кое каких данных, эти данные у меня записываются в файл C:\Мои документы\1.Doc: Внимание вопрос? Как мне найти этот файл на диске нажав на кнопку расположенную в моей программе, открыть его в формате Мicrosoft vord для добавления , корректировки данных или печати запустив Microsoft vord не открывая проводник.
3. Подскажите как быть, пишу программу для тестирования эл. сварщиков, столкнулся с такой проблемой: 1. Какой код написать, чтоб на диске найти файл теста с вопросами и ответами, 2. вывести содержимое файла по необходимым TextBoxам, и чтоб программа сама перебирала вопросы и ответы по техт боксам при нажатии на кнопку дальше. Причем так чтоб этот файл можно было корректировать со временем.
4.Люди подскажите! По сл. необходимости пишу тестовую программу. Какой код вписаь чтоб программа могла различать правильные и неправеильные ответы! 2. Каким образом выести текст вопроса в полном объеме в TextBox (при длинном вопросе он показывает только его часть), Причем и варианты ответов написаны в одном файле.
Автор вопроса: LUX
Ответ ожидается по этому адресу
Нужна консультация, подскажите, как сделать мою форму поверх всех окон.
Ответы:
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: Иван
Для создания такого окна используется функция API SetWindowPos из библиотеки user32.dll. Декларируем в модуле следующую функцию и константы:
Option Explicit
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Declare Function 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) As Long
В форму вписывается следующий код
Option Explicit
Private Sub Form_Load()
Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End Sub
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: Ревягин_Алексей
Добавь 2 CommandButton (под именем Command1 и Command2). Когда нажмешь первую кнопку, форма поверх всех
Private Declare Function SetWindowPos Lib "user32" (ByVal h%, ByVal hb%, ByVal x%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal F%) As Integer
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const flags = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Private Sub Command1_Click()
res = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags) 'Форма on-top
End Sub
Private Sub Command2_Click()
res = SetWindowPos(Form1.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags) 'Форма non-on-top
End Sub
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: Иван
Если я правильно понял, то в окне проекта(где отображаются файлы форм) добавте форму нажав правую клавишу мыши add Form и выберите форму StayOnTop!
Вопрос:
Как в VB6.0 сделать форму fsStayOnTop??
Ответ:
Автор ответа: SHatrykin Ivan
Что означает fsStayOnTop? Если "поверх всех окон" то можно так:
'Устанавливаем окно поверх всех остальных
Public Sub SetFormPosition(frmHandl As Long, TopPosition As Boolean)
If TopPosition Then
SetWindowPos frmHandl, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
Else
SetWindowPos frmHandl, HWND_NOTOPMOST, 0, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOMOVE
End If
End Sub
Вызываем эту процедуру так:
call SetFormPosition Form1, True
Вопрос:
У меня вопрос по Web Browser'у. Подскажите как в VB менять раямер текста в Web Browser как это делает Internet Explorer.
Ответ:
Автор ответа: Ревягин_Алексей
Должен быть метод Font :
например
webbrowser.font=commondialog1.font
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: pasha
Наверно Option Explicit предназначен для программистов в прошлом программируемых на что то вроде Pascal, С, где необходимо объявлять каждую переменную перед использованием. А VB этим и отличается, что переменные объявлять практически вообще нет необходимости, хотя профессиональные программисты всегда ставят Option Explicit для объявления всех переменных тем самым создают эффективные программы. Вот и все.
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: Rafis
Что бы не было необьявленных переменных.
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: Roman 'devil' Yuakovlev
Повышение культуры программирования, возможность делания умного вида, борьба с вариантами и ошибками в набирании имен переменных... рекомендую настоятельно :)
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: Александр
Чтобы выявлялись ошибки.....
Вопрос:
Зачем нужно обьявлять Option Explicit ?
Что бы не яабыть обьявить переменную ???
Ответ:
Автор ответа: SHatrykin Ivan
И для этого тоже. Но основное предназначение этого оператора: исключение очепяток.
Вот пример:
Dim sLeft as String
sLeft = sLeff & "и что будет?"
Вопрос:
Как послать строку в текстовое поле чужого окна?
Ответ:
Автор ответа: XAlex-sub
Если курсор находится в нужном поле то можно воспользоваться функцией sendkeys("передаваемый текст") эта функция эмулирует нажатие клавиш на клаве в противном случае только через API и надо знать hwnd окна о обьекта
Вопрос:
Как послать строку в текстовое поле чужого окна?
Ответ:
Автор ответа: SHatrykin Ivan
Все зависит от того, куда и как нужно "послать" текст. Если вам известен hWnd этого окна, то воспользуйтесь функцией SetWindowText в первом параметре функции укажите hWnd окна, а во втором строку текста, которую нужно там "напечатать". В этом случае весь старый текст содержащийся в этом окне "исчезнет" и появится новый.
Вопрос:
Может кто знает как вытянуть данные из таблицы ворд в таблицу экселя, подскажите плиз.
Ответ:
Автор ответа: Андрей
Начиная с Office 2000 появляются вложенные таблицы, нужно учесть.
Private Sub GetParagraps(ByVal objParagraps As Word.Paragraphs)
On Error GoTo Check:
Dim objParagraph As Word.Paragraph
Dim blnTableComplete As Boolean
Dim iParagraph As Long
For iParagraph = 1 To objParagraps.Count
Set objParagraph = objParagraps.Item(iParagraph)
If objParagraph.Range.Tables.Count > 0 Then
If blnTableComplete = False Then GetTable objParagraph.Range.Tables(1)
blnTableComplete = True
Else
blnTableComplete = False
End If
Next
Set objParagraph = Nothing
Exit Sub
Check:
...
Resume Next
End Sub
Private Sub GetTable(ByVal tblCurrent As Word.Table)
Dim CurrentRow As Word.Row
Dim CurrentCell As Word.Cell
Dim i As Long, j As Long
On Error GoTo Check:
For i = 1 To tblCurrent.Rows.Count
Set CurrentRow = tblCurrent.Rows.Item(i)
....
For j = 1 To CurrentRow.Cells.Count
Set CurrentCell = CurrentRow.Cells.Item(j)
....
Next
Next
Set CurrentRow = Nothing
Set CurrentCell = Nothing
Exit Sub
Check:
...
Resume Next
End Sub
Вопрос:
Может кто знает как вытянуть данные из таблицы ворд в таблицу экселя, подскажите плиз.
Ответ:
Автор ответа: SHatrykin Ivan
Напрямую вытащить данные, скорее всего, не удастся. Можно воспользоваться обходным путем:
1. получить таблицу в программу - можно через буфер обмена в rtf формате
2. программно анализировать каждую полученную строчку! и самому создать массив из данных таблицы
3. перекинуть этот массив в Exel
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Duke
Точно могу ответить только на первый это пожно сделать командой Shell
напр. shell "C:\Myproga.exe"
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Иван
1) Самый надежный способ открытия любого файла получается с применением API – функций.
' Декларация функции для запуска файла.
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
' Декларация константы для максимизирования окна открываемого приложения.
' Для работы с другими константами смотрите Help по API.
Public Const SW_SHOWMAXIMIZED = 3
После этого нижеследующий код будет открывать файл test.xls находящийся в директории C:\My Documents\
Call ShellExecute(0, "open", " C:\My Documents\test.xls","", "", SW_SHOWMAXIMIZED)
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Иван
Нет ничего проще:
1. Функция Shell("path\name")-запускает исполняемую программу!
2. Стандартный объект File помещаеш на форму, устанавливаешь свйство Path, если не надо чтобы объект был виден отключи видемось! File1.List(номер строки).text-имя файла
Понятно? У меня подрукой нет VB, точнее напишу если попросиш!
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Ревягин_Алексей
есть такие функции как:
shell(Path as string)
ShellExecute
и т. д.
помести на форму объекты:
Filelist
dirlist
drivelist
и укажи для каждого из него параметр Default нажми F5.
Эксперементируй.
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Rafis
1)Shell "Полный путь к программе",стиль окна
2)Это можно сделать с помощью Dir-а
например:
Поставь на форму ListBox и напишите в нём следуещее:
Private Sub Form_Load()
ListBox1.Clear
st = Dir("C:\*.*", vbDirectory)
Do While Len(st)
st = Dir
ListBox1.AddItem st
Loop
End Sub
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: pasha
1) Чтобы запустить любой файл используется команда Shell ("Путь к файлу", параметр).
2) Ставишь FileListBox и DirListBox и в свойстве Path прописываешь путь.
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: Roman 'devil' Yuakovlev
1) shell "notepad.exe"
2) функция dir$, контролы dirlistbox и filelistbox
Вопрос:
Кто знает как в VB
1)запустить какой-нибудь файл?
2)получить список всех файлов и папок в какой-нибудь определенной папке?
Ответ:
Автор ответа: SHatrykin Ivan
Для запуска чужой программы воспользуйтесь функцией Shell. Описание смотрите сами (можно на нашем сайте). А для поиска файлов в определенной папке Path создайте такой цикл:
sFile = Dir(Path & "*.*")
Do While sFile <> ""
имя_файла = sFile
sFile = Dir
Loop
Вопрос:
Как в VBA сояданному програмно объекту наяначить реакцию на событие OnClick.
Ответ:
Автор ответа: Ревягин_Алексей
Нужно создать массив элементов управления указать свойство index=0 и дальше копировать этот объект на форму а затем зайти в код и выбрать Объект_Clicl
в результате:
Private sub Объект_Click(Index as Integer)
select case index
case 0
событие нажатия на 0-й объект
case 1
событие нажатия на 1-й объект
case 2
событие нажатия на 2-й объект
.....
case n
событие нажатия на n-й объект
end select
end sub
где n-это Объект.UBound
Вопрос:
Как гарантированно опознать компьютер? То есть: сер.номер мамы, сер.номер винта или что-нибудь в этом духе, без компонентов, желательно через API.
Ответ:
Автор ответа: SHatrykin Ivan
Вопрос о серийном номере компьютера уже "обсуждался" в Библиотеке кодов. Смотрите раздел Информация о компьютере.
Вопрос:
Как можно в ресурсы засунуть WAV,AVI а потом их воспроизвести.
Ответ:
Автор ответа: Oleg Koren
The following code is a resource script that can be compiled by using the 16-bit and 32-bit versions of Rc.exe.
//////////////////////////////////////////////////////////////////////
//////
// Myres.rc - 16 & 32 bit script. This must be compiled into two
file://.res files using the 16 & 32 bit versions of RC.
///////////////////////////////////////////////////////////////////////
//////
// Wave Resources - You must copy these files from your \Windows
// directory to the directory where your .rc script resides.
CHIMES WAVE DISCARDABLE "Chimes.wav"
DING WAVE DISCARDABLE "Ding.wav"
Steps to Create a Resource File Save the preceding code in Notepad as Myres.rc in the directory where Rc.exe exists on your hard disk.
Copy Chimes.wav and Ding.wav from your Windows directory (\Windows\Media directory in Windows 95 and Windows 98 or \WinNT\Media directory in Windows NT and Windows 2000) to the same directory where you saved the Myres.rc file.
At the command line, type "RC -r Myres.rc." If you want a 16-bit and 32- bit version of your resource file, then you will have to save two copies of your resource file as Myres32.rc and Myres16.rc, and compile each separately with the appropriate resource compiler.
Steps to Run the Sample Application
Create a new project and add a command button to Form1.
Add the following code to Form1:
'*******
' Form1.frm - Calls PlayWaveRes to play a wave resource file.
'*******
Sub Command1_Click()
PlayWaveRes "Chimes"
PlayWaveRes "Ding"
End Sub
Add your resource file to the project.
Type the following code in a new code module:
******
' Baswave.bas - Plays a wave file from a resource using LoadResData.
'*****
Option Explicit
#If Win32 Then
Private Declare Function sndPlaySound Lib "winmm" Alias _
"sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) _
As Long
#Else
Private Declare Function sndPlaySound Lib "MMSYSTEM" ( _
lpszSoundName As Any, ByVal uFlags%) As Integer
#End If
'******
' Flag values for wFlags parameter.
'******
Public Const SND_SYNC = &H0 ' Play synchronously (default).
'Public Const SND_ASYNC = &H1 ' Play asynchronously (see note below).
Public Const SND_NODEFAULT = &H2 ' Do not use default sound.
Public Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file.
Public Const SND_LOOP = &H8 ' Loop the sound until next sndPlaySound.
Public Const SND_NOSTOP = &H10 ' Do not stop any currently playing sound.
'******
' Plays a wave file from a resource.
'******
Public Sub PlayWaveRes(vntResourceID As Variant, Optional vntFlags)
'-----------------------------------------------------------------
' WARNING: If you want to play sound files asynchronously in
' Win32, then you MUST change bytSound() from a local
' variable to a module-level or static variable. Doing
' this prevents your array from being destroyed before
' sndPlaySound is complete. If you fail to do this, you
' will pass an invalid memory pointer, which will cause
' a GPF in the Multimedia Control Interface (MCI).
'-----------------------------------------------------------------
Dim bytSound() As Byte ' Always store binary data in byte arrays!
bytSound = LoadResData(vntResourceID, "WAVE")
If IsMissing(vntFlags) Then
vntFlags = SND_NODEFAULT Or SND_SYNC Or SND_MEMORY
End If
If (vntFlags And SND_MEMORY) = 0 Then
vntFlags = vntFlags Or SND_MEMORY
End If
sndPlaySound bytSound(0), vntFlags
End Sub
REFERENCES
For information on how to store any file type in a resource file and retrieve the file for use at run-time in Visual Basic versions 5.0 and 6.0, please see the following article in the Microsoft Knowledge Base:
Q194409 SAMPLE: RESFILE.EXE Stores Any File Type in a Resource File
Additional query words: WAVE LOADRESDATA RESOURCES RC BYTE SND_ASYNC kbdsd
---------------
это пример из MSDN.
я его не проверял.
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.