| ← Апрель 2003 → | ||||||
|
1
|
2
|
3
|
4
|
6
|
||
|---|---|---|---|---|---|---|
|
7
|
8
|
10
|
12
|
|||
|
14
|
15
|
16
|
17
|
19
|
20
|
|
|
22
|
23
|
24
|
26
|
27
|
||
|
29
|
30
|
|||||
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://vbnet.ru
Открыта:
31-07-2001
Статистика
0 за неделю
Visual Basic: новости сайтов, советы, примеры кодов. Выпуск 156.
| Информационный Канал Subscribe.Ru |
Visual Basic: новости сайтов, советы, примеры кодов.
Выпуск 156.
|
VBNet
VBMania
Голосование: Ссылки: |
Господа!!! читайте MSDN!!! Несколько слов от автора:
Присылайте коды по адресу pavel@vbnet.ru или subscribe@vbnet.ru. Мои запасы подходят к концу!
Читайте! Содержание выпуска
Книги
Остальные книги о VB можно найти здесь. наверх Citycat by Email Программа Citycat by Email позволяет работать с сервером Subscribe.ru с помощью электронной почты. Теперь Вам не нужно тратить деньги на работу в online и просматривать мегабайты рекламы для того, чтобы подписаться на нужную рассылку! Вам просто необходимо скачать небольшую базу данных по всем рассылкам каталога с нашего сайта, после чего Вы сможете подписываться и отписываться от рассылок, заказывать архивы прошлых выпусков, выполнять поиск по каталогу рассылок и многое другое. Программу Citycat by Email можно бесплатно загрузить с сайта http://sapisoft.h1.ru. наверх Новости сайта VBNet
Последние 20 тем форума на VBNet.Ru: 15:34 / 28 апр. Тормазит цикл .... | Хитов: 1 | Ответов: 0 15:21 / 28 апр. Напоминатель 1.0 | Хитов: 10 | Ответов: 0 14:28 / 28 апр. Minimize... | Хитов: 7 | Ответов: 1 13:02 / 28 апр. Как создать .dll для Excel? | Хитов: 12 | Ответов: 0 11:24 / 28 апр. как отсылать данные на мыло??? | Хитов: 16 | Ответов: 1 10:11 / 28 апр. Нужны файлы HELP для работы в Инет | Хитов: 8 | Ответов: 0 08:56 / 28 апр. Что скажите о моей проге | Хитов: 28 | Ответов: 1 07:01 / 28 апр. http://www.vbnet.ru/article/showarticle.asp?id=105 | Хитов: 19 | Ответов: 1 04:48 / 28 апр. Install | Хитов: 14 | Ответов: 1 00:13 / 28 апр. Install... | Хитов: 22 | Ответов: 1 21:12 / 27 апр. Как вставить форму в форму | Хитов: 25 | Ответов: 1 20:48 / 27 апр. Массивы и файлы | Хитов: 15 | Ответов: 0 19:14 / 27 апр. Отправка данных | Хитов: 22 | Ответов: 1 18:20 / 27 апр. последний символ | Хитов: 19 | Ответов: 3 16:52 / 27 апр. Microsoft Data Bound Grid Control 5.0. (SP3). | Хитов: 11 | Ответов: 0 16:47 / 27 апр. Visual С++++++++++++++++++++++ | Хитов: 22 | Ответов: 1 14:30 / 27 апр. Модем | Хитов: 20 | Ответов: 1 13:47 / 27 апр. Номер кластера | Хитов: 10 | Ответов: 0 13:21 / 27 апр. Заходите и голосуйте!! | Хитов: 42 | Ответов: 5 13:02 / 27 апр. VS .NET 2003 Everett Final beta November | Хитов: 0 | Ответов: 0 Последние поступления в Библиотеку кодов: Новости от VBNet-чиков!: наверх Новости сайта VBMania наверх Новости сайта Азбука VB наверх Новости сайта MSDN наверх Новости сайта GotdotNet
Новые статьи:
наверх Новости сайта dotSite Новые статьи:
Новые примеры: наверх Один момент из жизни форума: Приоритеты Вопрос: Автор вопроса: Justas Как назначить приоритет, любой запущенной программе, зная путь к ней. (не у всякого exe_шника есть хендл). Ответы: Автор: Konstantin Вот какую фичу я нашел в API Public Declare Function SetPriorityClass Lib "kernel32" Alias "SetPriorityClass" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long И теперь константы к ним: Public Const IDLE_PRIORITY_CLASS = &H40 Public Const NORMAL_PRIORITY_CLASS = &H20 Public Const HIGH_PRIORITY_CLASS = &H80 Public Const REALTIME_PRIORITY_CLASS = &H100 Юзай наздоровье! ;) наверх Доска объявлений Ищу телеработу.
наверх Мои программы BalloonMessage for MS Agent BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels. Авторы: Шатрыкин Иван и Павел Сурменок. наверх Вопрос/Ответ Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы. Вопросы:Автор вопроса: phis Ответ ожидается по этому адресу Подскажите как в ASP.NET обратиься к свойствам элемента управления, черея коллекцию Controls объекта Page. Код примерно следующий: Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim i As Integer Dim t As New TextBox() For i = 0 To Page.Controls.Count - 1 If TypeOf Page.Controls.Item(i) Is TextBox Then t = Page.Controls.Item(i) If NotChar(t.Text) Then label1.Text = "Текст сообщения" GoTo 1 End If End If Next i 1: End Sub Где NotChar-просто функция, которая находит определенный символ строки, работает исправно, дело не в ней. При нажатии ничего не происходит, даже если этот символ есть в строке. Автор вопроса: K. Ответ ожидается по этому адресу Существует (и если да, то где?) контрол как в VB6 организовано окно Propetis, т.е. в одной колонке названия св-в, а в другой их значение, причем как обычные текстовые поля, так и списки. Очень необходим. Автор вопроса: Ice Ответ ожидается по этому адресу Как лучше органияовать SAVE/LOAD компонентов в TreeView контроле? Я пытался решить проблему черея INI файл(т.к. др. методы недоступны -> я только учусь), но желаемого реяультата не добился.(хотя теоретически должно работать) И еще: там к каждому компоненту строковая переменная с описанием. Автор вопроса: Костик Ответ ожидается по этому адресу Срочно необходимо сделать, чтобы при нажатии определенной комбинации клавиш при неактивном приложении, выполнялась заданая процедура. Автор вопроса: Alex Velikiy Ответ ожидается по этому адресу Как открыть дверцу Cd-Rom програмно? Автор вопроса: K. Ответ ожидается по этому адресу Существуют ли библиотеки (или контролы) для генерирования случайных чисел с заданным законом распределения, как например в Си? Ответы: Вопрос: Как с помощью VB узнать подключен ты к сети, например Интернету? Ответ: Автор ответа: KimNews Вот 3 способа проверки связи с интернет: '---1--- Private Sub CheckConnection1() Dim ReturnCode As Long Dim hKey As Long Dim lpSubKey As String Dim phkResult As Long Dim lpValueName As String Dim lpReserved As Long Dim lpType As Long Dim lpData As Long Dim lpcbData As Long lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" & Chr$(0) ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult) If ReturnCode = ERROR_SUCCESS Then hKey = phkResult lpValueName = "Remote Connection" lpReserved = APINULL lpType = APINULL lpData = APINULL lpcbData = APINULL ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData) lpcbData = Len(lpData) ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData) If ReturnCode = ERROR_SUCCESS Then If lpData = 0 Then MsgBox "Your computer is not connected to Internet via modem", vbInformation, "Checing connection" Else MsgBox "Your computer is connected to Internet via modem", vbInformation, "Checing connection" End If Else MsgBox "Your computer is not connected to Internet via modem, but it can be connected via LAN", vbInformation, "Checing connection" End If End If RegCloseKey (hKey) End Sub '---2--- Private Sub CheckConnection2(Optional ByRef ConnectionInfo As Long, Optional ByRef sConnectionName As String) Dim dwFlags As Long Dim sNameBuf As String, msg As String Dim lPos As Long sNameBuf = String$(513, 0) If InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&) Then lPos = InStr(sNameBuf, vbNullChar) If lPos > 0 Then sConnectionName = Left$(sNameBuf, lPos - 1) Else sConnectionName = "" End If msg = "Your computer is connected to Internet" & vbCrLf & "Connection Name: " & sConnectionName If (dwFlags And INTERNET_CONNECTION_LAN) Then msg = msg & vbCrLf & "Connection use LAN" ElseIf lFlags And INTERNET_CONNECTION_MODEM Then msg = msg & vbCrLf & "Connection use modem" End If If lFlags And INTERNET_CONNECTION_PROXY Then msg = msg & vbCrLf & "Connection use Proxy" If lFlags And INTERNET_RAS_INSTALLED Then msg = msg & vbCrLf & "RAS INSTALLED" Else msg = msg & vbCrLf & "RAS NOT INSTALLED" End If If lFlags And INTERNET_CONNECTION_OFFLINE Then msg = msg & vbCrLf & "You are OFFLINE" Else msg = msg & vbCrLf & "You are ONLINE" End If If lFlags And INTERNET_CONNECTION_CONFIGURED Then msg = msg & vbCrLf & "Your connection is Configured" Else msg = msg & vbCrLf & "Your connection is not Configured" End If Else msg = "Your computer is NOT connected to Internet" End If MsgBox msg, vbInformation, "Checking connection" End Sub '---3--- Private Sub CheckConnection3() Dim sTmp As String Dim hInet As Long Dim hUrl As Long Dim Flags As Long Dim url As Variant hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&) sTmp = Me.Caption Me.Caption = "Checking connection with www.yahoo.com..." If hInet Then Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD hUrl = InternetOpenUrl(hInet, "http://www.yahoo.com", vbNullString, 0, Flags, 0) If hUrl Then MsgBox "Your computer is connected to Internet", vbInformation, "Checing connection" Call InternetCloseHandle(hUrl) Else MsgBox "Your computer is not connected to Internet", vbInformation, "Checing connection" End If End If Call InternetCloseHandle(hInet) Me.Caption = sTmp End Sub Ответ: Автор ответа: Лесник Попробуй так: Размести Winsock , затем попробуй присоединиться к Яндексу по 80 порту (RemoteHost="yandex.ru", remotePort=80). Если получится (winsock.state=sckConnected), то ты в инете... Если нет - то оффлайн ... Вопрос: Подскажите пожалуйста как правильно записать файл с картинкой типа *.bmp, *.jpg в БД SQL Server. Ответ: Автор ответа: Sergey Y. Tkachev Вот код модуля. Предлагаются различные варианты. Некоторые работают корректно даже с MySQL. Option Explicit Private Const BlockSize = 32768 Public Function PostBLOB(ByVal strFileName As String, ByRef objRecSet As adodb.Recordset, ByVal strFieldName As String) As Boolean On Error GoTo ERRHANDLER Dim objStream As Stream Dim varChunk As Variant PostBLOB = False Set objStream = New adodb.Stream objStream.Type = adTypeBinary objStream.Open objStream.LoadFromFile strFileName varChunk = objStream.Read objRecSet.Fields(strFieldName).Value = " 'TEST' " objStream.Close Set objStream = Nothing PostBLOB = True Exit Function ERRHANDLER: PostBLOB = False Set objStream = Nothing End Function Public Function GetBLOB(ByVal strFileName As String, ByRef objRecSet As adodb.Recordset, ByVal strFieldName As String) On Error GoTo ERRHANDLER Dim objStream As Stream GetBLOB = False Set objStream = New adodb.Stream objStream.Type = adTypeBinary objStream.Open objStream.Write objRecSet.Fields(strFieldName).Value objStream.SaveToFile strFileName objStream.Close Set objStream = Nothing GetBLOB = True Exit Function ERRHANDLER: GetBLOB = False Set objStream = Nothing End Function Public Function FileToBLOB(ByVal strFullPath As String, ByRef objField As adodb.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean On Error Resume Next Dim objStream As adodb.Stream Dim intFreeFile As Integer Dim lngBytesLeft As Long Dim lngReadBytes As Long Dim byBuffer() As Byte Dim varChunk As Variant If bUseStream Then Set objStream = New adodb.Stream With objStream .Type = adTypeBinary .Open .LoadFromFile strFullPath objField.Value = .Read(adReadAll) End With Else With objField '<<--If the field does not support ' Long Binary data'-->> '<<--then we cannot load the data ' into the field.-->> If (.Attributes And adFldLong) <> 0 Then intFreeFile = FreeFile Open strFullPath For Binary Access Read As #intFreeFile lngBytesLeft = LOF(intFreeFile) Do Until lngBytesLeft <= 0 If lngBytesLeft > lngChunkSize Then lngReadBytes = lngChunkSize Else lngReadBytes = lngBytesLeft End If ReDim byBuffer(lngReadBytes) Get #intFreeFile, , byBuffer() objField.AppendChunk byBuffer() lngBytesLeft = lngBytesLeft - lngReadBytes DoEvents Loop Close #intFreeFile Else Err.Raise -10000, "FileToBLOB", "The Database Field does Not support Long Binary Data." End If End With End If If Err.Number <> 0 Or Err.LastDllError <> 0 Then FileToBLOB = False Else FileToBLOB = True End If End Function Function ReadBLOB(Source As String, T As Recordset, sField As String) Dim NumBlocks As Integer Dim SourceFile As Integer Dim i As Integer Dim FileLength As Long Dim LeftOver As Long Dim byteData() As Byte On Error GoTo Err_ReadBLOB SourceFile = FreeFile Open Source For Binary Access Read As SourceFile FileLength = LOF(SourceFile) If FileLength = 0 Then ReadBLOB = 0 Exit Function End If NumBlocks = FileLength \ BlockSize LeftOver = FileLength Mod BlockSize If LeftOver > 0 Then ReDim byteData(0 To LeftOver - 1) Get SourceFile, , byteData 'T.Edit T(sField).AppendChunk (byteData) 'T.Update End If ReDim byteData(0 To BlockSize - 1) For i = 1 To NumBlocks Get SourceFile, , byteData T(sField).AppendChunk (byteData) Next i Close SourceFile ReadBLOB = FileLength Exit Function Err_ReadBLOB: ReadBLOB = -Err MsgBox Err.Description, , Err.Number Exit Function End Function Function WriteBLOB(T As adodb.Recordset, sField As String, Destination As String) Dim NumBlocks As Integer, DestFile As Integer, i As Integer Dim FileLength As Long, LeftOver As Long Dim byteData() As Byte On Error GoTo Err_WriteBLOB FileLength = T.Fields(sField).ActualSize If FileLength = 0 Then WriteBLOB = 0 Exit Function End If NumBlocks = FileLength \ BlockSize LeftOver = FileLength Mod BlockSize DestFile = FreeFile Open Destination For Output As DestFile Close DestFile Open Destination For Binary As DestFile If LeftOver > 0 Then byteData() = T(sField).GetChunk(LeftOver) Put DestFile, , byteData End If For i = 1 To NumBlocks byteData() = T(sField).GetChunk((i - 1) * BlockSize + LeftOver, BlockSize) Put DestFile, , byteData Next i Close DestFile WriteBLOB = FileLength Exit Function Err_WriteBLOB: WriteBLOB = -Err MsgBox Err.Description, vbCritical, Err.Number Exit Function End Function Public Function GetTEXT(ByRef objRecSet As adodb.Recordset, ByVal strFieldName As String) As String On Error GoTo ERRHANDLER Dim objStream As Stream GetTEXT = "" Set objStream = New adodb.Stream objStream.Type = adTypeBinary objStream.Open objStream.Write objRecSet.Fields(strFieldName).Value objStream.Position = 0 Do Until objStream.EOS GetTEXT = GetTEXT & objStream.Read(1) Loop 'objStream.SaveToFile strFileName objStream.Close Set objStream = Nothing Exit Function ERRHANDLER: GetTEXT = "" MsgBox Err.Number & Err.Description Set objStream = Nothing End Function Function AddLongRaw(ByVal strFileName As String, ByRef objRecSet As ADODB.Recordset, ByVal strFieldName As String) As Boolean On Error GoTo ERRHANDLER AddLongRaw = False Dim objStream As Stream Set objStream = New ADODB.Stream objStream.Type = adTypeBinary objStream.Open objStream.LoadFromFile strFileName objRecSet.Fields(strFieldName).Value = objStream.Read objStream.Close Set objStream = Nothing AddLongRaw = True Exit Function ERRHANDLER: AddLongRaw = False Set objStream = Nothing End Function Вопрос: Кто-нибудь знает, где можно найти листинг проги, которая запароливает папки? Дайте ссылочку, плз. Ответ: Автор ответа: Programmer Ссылочку не дам, могу только сказать, что что-либо стоящее может получиться только под NTFS/ Вопрос: Как отследить события подключения и отключения соединения с провайдером для программы счета трафика? Ответ: Автор ответа: Programmer 'CHECK CONNECTION Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long Public Declare Function RasGetConnectStatus Lib "rasapi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long Public Const RAS95_MaxEntryName = 256 Public Const RAS95_MaxDeviceType = 16 Public Const RAS95_MaxDeviceName = 32 Public Type RASCONN95 dwSize As Long hRasCon As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Public Type RASCONNSTATUS95 dwSize As Long RasConnState As Long dwError As Long szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type 'CHECK CONNECTION Public Function IsConnected() As Boolean Dim TRasCon(255) As RASCONN95 Dim lg As Long Dim lpcon As Long Dim RetVal As Long Dim Tstatus As RASCONNSTATUS95 TRasCon(0).dwSize = 412 lg = 256 * TRasCon(0).dwSize RetVal = RasEnumConnections(TRasCon(0), lg, lpcon) Tstatus.dwSize = 160 RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus) If Tstatus.RasConnState = &H2000 Then IsConnected = True Else IsConnected = False End If End Function Вопрос: Есть задумка программы, использующей Латиницу-1 и Латиницу-2; она должна выводить символы с диакритикой. Проблему можно коряво решить встраиванием Excel-таблицы в VB-форму. А есть ли в VB(6) контрол, который может такое сделать? Ответ: Автор ответа: Alexander Да, есть! Это RichTextBox :-) Вопрос: Трижды вложенный цикл For по переменным i,j,k позволяет перебрать все возможные комбинации (i,j,k). А можно ли сделать для n-ого количества переменных. Может быть можно сделать это с помощью циклических ссылок на функцию, где описан один цикл For. Помогите очень нужно... Ответ: Автор ответа: Vir Для этого делаеш рекурсивную процедуру. Тоесть процедура вызывает сама себя. Например: Private Sub Procedure_f(index As Integer, n As Integer) For i(index) = X1 To X2 If index < n Then Call Procedure_f(index + 1,n) Next End Sub Приблезительно так. А лучше возьми учебник по паскалю там вроде должны рассматриватся рекурсивные процедуры Ответ: Автор ответа: Alexander Это ReDim [Preserve] varname(subscripts) [As type] [, varname(subscripts) [As type]] . . . Вопрос: Прошу, кто знает, напишите код на VB6 или хотя бы подскажите, как отследить нажатие символьных и цифровых клавиш на клаве в любом приложении. Желательно чтобы потом конкретно знать где что нажималось. Ответ: Автор ответа: Programmer Cходи на www.vbrussian.com там много инфы по хуку клавы/ Вопрос: Я хочу с удаленного компа, не зная системную папку винды (типо: c:\windows), скачть (из этой папки) файл (пусть будет win.ini). Тако вот вопрос: Как определить системную папо4ку винды? Ответ: Автор ответа: KimNews Вот так: Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) As Long '****************************** Function CurSysDir() As String On Error GoTo CurSysDirErr Dim WinPath As String Const MAXWINPATH = 255 WinPath = Space$(MAXWINPATH) Call GetSystemDirectory(WinPath, MAXWINPATH) CurSysDir = StrZ(WinPath) 'См функцию StrZ ниже CurSysDirExit: Exit Function CurSysDirErr: Resume CurSysDirExit End Function Function StrZ(par As String) As String 'API функция возвращает строковое значение 'заканчивающееся Chr(0) - за ним могут быть пробелы 'или "мусор" - и функция сея как раз и отсекает 'справа Chr(0) вместе с пробелами (мусором). Dim nSize As Long, i As Long nSize = Len(par) i = InStr(1, par, Chr(0)) - 1 If i > nSize Then i = nSize If i < 0 Then i = nSize StrZ = Mid(par, 1, i) End Function Ответ: Автор ответа: Пащенко А. В Win2000 и XP \\compname\admin$ Ответ: Автор ответа: UPS!!! функция Environ. Она возвращает имена и содержание всех переменных среды операционной системы. Так, например, чтобы получить директорию Windows, ABC = Environ ("windir") ABC = Environ ("TMP") 'директория временных файлов TEMP ABC = Environ ("BLASTER") 'координаты звуковой карты ABC = Environ ("PATH") 'пути, объявленные в autoexec.bat Чтобы получить имя и значение перменной, в скобках вместо строки надо поставить номер переменной (или индекс?). Вставьте следуюшую процедуру в код, запустите проект, кликните на форме увидите список всех переменных и их значений! Private Sub Form_Click() 'берём перменную и присваеваем ей единицу m = 1 'запускаем цикл, который увеличивает переменную m каждый 'раз на единицу и подсовывает её функции Environ Do 'присваеваем перменной EnvString возвращаемую перменную, 'соответсвующую номеру m EnvString = Environ(m) 'печатаем перменную, соответсвующую номеру m Print Environ(m) 'перменную m увеличиваем на один m = m 1 'если перменная EnvString всё ещё не пустая - крутим дальше... Loop Until EnvString = "" End Sub Не мое.. А еще, говорят есть API-функция GetWindowsDirectory...? Можете заполнить эту форму, либо отослать вопрос СЮДА Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта. |
|||||||||||||||||||||||||||||||||||
Выпуск подготовили: |
Сурменок Павел | |||||||||||||||||||||||||||||||||||
| http://subscribe.ru/
E-mail: ask@subscribe.ru |
Отписаться
Убрать рекламу |
| В избранное | ||
