Visual Basic: новости сайтов, советы, примеры кодов. Выпуск 101. (comp.soft.prog.vbnewsadvices) : Рассылка : Subscribe.Ru

		Переход на VB .NET. Стратегии, концепции, код (цена ~ 158 руб.) Эта книга была задумана как одна из первых книг о .NET, которая ознакомит читателя с основными идеями новой архитектуры и подготовит его к знакомству с более детальной литературой, например документацией Microsoft и ее толкованиями, которая неизбежно появится на рынке. Она поможет вам взглянуть на эту технологию с позиций ваших собственных рабочих планов и быстро освоить те концепции, которые покажутся необычными для большинства прогр...
		Автор(ы): Дан Эпплман, Издательство: Питер, 2002 г.
		Программирование на VB.NET. Учебный курс (цена ~ 119 руб.) Эта книга является вводным курсом по изучению языка программирования Visual Basic .NET. Даны основные принципы объектно-ориентированного программирования в контексте языка VB .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 можно найти здесь.

наверх

Форматирование числа при выводе (заполнение до определенной длины)

Пример применения функции String

Иногда бывает полезно выводить числовую информацию с фиксированным числом знаков, заполняя левые позиции нулями. Для этого можно воспользоваться следующей функцией:

Function PadToString(myValue, Digits) As String
PadToString = String(Digits - Len(myValue), "0") & myValue
End Function

Сделав, например, такое обращение

NewStr = PadToString(1978, 8)

вы получите строковую переменную 00001978. Обратите внимание, что Digits и myValue — переменные типа Variant.

наверх

Захват текста из любого текстового поля

Хотелось ли вам захватить текст из текстового поля любого приложения? Данный код поможет вам в решении этой проблемы.

Вам необходимо разместить на форме элемент Timer.

'to get the foreground window
Private Declare Function GetForegroundWindow Lib "user32" () As Long
'to send a message system
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'to get the cursor position
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'to get the window from a point (y,x)
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'to get the window text
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'to get the class name (edit,combobox etc..)
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public strBuffer As String ' the string to append to the file that has all the text "grabed"
Public iEnum As Integer ' the file integer to open and write (I/O)
Public hJanelaCima As Long ' the window wich the user has the mouse over
Public hJanelaAntiga As Long ' the ancient window, to controlo if thereґs a new window or not
'constants to grab the text
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
'type for the GetCursorPos API
Private Type POINTAPI
x As Long
y As Long
End Type

Private Sub Form_Load()
'when starting the program, print date and time of the new logging...
strBuffer = "=============================================================" & vbCrLf
strBuffer = strBuffer & "Date of log: " & Format(Date, "YYYY-MM-DD") & vbCrLf
strBuffer = strBuffer & "Started logging at: " & Format(Time$, "HH:MM") & vbCrLf
strBuffer = strBuffer & "=============================================================" & vbCrLf
iEnum = FreeFile
'append it in the file
Open "C:\testes.txt" For Append As #iEnum
Print #iEnum, strBuffer
Close #iEnum
strBuffer = ""
'enable the timer...
Timer1.Interval = 100
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Dim ptCursor As POINTAPI ' the cursor type variable
Dim texto_janela As String ' the window text
Dim rc As Long
Dim nome_classe As String ' the class name
Dim fenster As Long ' the foreground window.. in deutsh.. ich wisse deutshe auch...
fenster = GetForegroundWindow ' get the window where user is
'create string objects
texto_janela = String(100, Chr(0))
nome_classe = String(100, Chr(0))
Call GetCursorPos(ptCursor) ' get the cursor position
'get the window(handle) where the user has the mouse
hJanelaCima = WindowFromPoint(ptCursor.x, ptCursor.y)
'get the window text and class name
rc = GetWindowText(fenster, texto_janela, Len(texto_janela))
rc = GetClassName(hJanelaCima, nome_classe, 100)
'format the assholes...
texto_janela = Left(texto_janela, InStr(texto_janela, Chr(0)) - 1)
nome_classe = Left(nome_classe, InStr(nome_classe, Chr(0)) - 1)
Debug.Print nome_classe
' check the class names... i tried some like WinWord and VB, but didnґt worked..

'If nome_classe = "Edit" Or nome_classe = "_WwG" Or nome_classe = "Internet Explorer_Server" Or nome_classe = "RichEdit20A" Or nome_classe = "VbaWindow" Then
'if this is the same window, forget
If hJanelaCima = hJanelaAntiga Then Exit Sub
'thereґs no text? Out!
If WindowText(hJanelaCima) = Empty Then Exit Sub
'put the ancient window handle, with the current one
hJanelaAntiga = hJanelaCima
'build string with time and the text grabed with WindowText
strBuffer = Time$ & " - " & texto_janela & vbCrLf
strBuffer = strBuffer & WindowText(hJanelaCima) & vbCrLf
'append to the file
Open "C:\testes.txt" For Append As #iEnum
Print #iEnum, strBuffer
Close #iEnum

'End If
End Sub

'grab the text window with this function.. argument- the window handle
Public Function WindowText(window_hwnd As Long) As String
Dim txtlen As Long
Dim txt As String
If window_hwnd = 0 Then Exit Function
'send the message to get the text lenght
txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
If txtlen = 0 Then Exit Function
txtlen = txtlen + 1
txt = Space$(txtlen)
'send the message to get the text
txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, ByVal txt)
'put that on the function
WindowText = Left$(txt, txtlen)
End Function

наверх

Послать строковое сообщение в другую программу

Откройте заранее стандартное приложение "Блокнот". В VB-проекте расположите на форме 1 CommandButton. Добавьте следующий код, запустите проект и нажмите на кнопку...

Private Sub Command1_Click()
AppActivate ("Безымянный")
SendKeys ("Привет из VB!!!")
End Sub

"{Up}"
"{TAB}"
"{ENTER}"
"{End}"
"+{Home}"
"{Left}"

наверх

Как определить серийный номер для диска

Расположите на форме элемент CommandButton

'ВАРИАНТ 1

Private Declare Function GetVolumeSerialNumber Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Function VolumeSerialNumber(ByVal RootPath As String) As String
Dim VolLabel As String
Dim VolSize As Long
Dim Serial As Long
Dim MaxLen As Long
Dim Flags As Long
Dim Name As String
Dim NameSize As Long
Dim s As String
Dim ret as Boolean
ret=GetVolumeSerialNumber(RootPath, VolLabel, VolSize, _
Serial, MaxLen, Flags, Name, NameSize)
If ret Then
'Create an 8 character string
s = Format(Hex(Serial), "00000000")
'Adds the '-' between the first 4 characters and the last 4 characters
VolumeSerialNumber = Left(s, 4) + "-" + Right(s, 4)
Else
'If the call to API function fails the function returns a zero serial number
VolumeSerialNumber = "0000-0000"
End If
End Function

Private Sub Command1_Click()
MsgBox VolumeSerialNumber("C:\") 'Shows the serial number of your Hard Disk
End Sub

'ВАРИАНТ 2

Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Function GetSerialNumber(DriveLetter As String) As String
Dim SerialNum As Long
Dim VolNameBuf As String
Dim FileSysNameBuf As String
Select Case Len(DriveLetter)
Case 1
If LCase(DriveLetter) Like "[a-z]" Then
DriveLetter = Left(DriveLetter, 1) & ":\"
Else
GetSerialNumber = "Error - Bad drive designation"
End If
Case 2
If LCase(DriveLetter) Like "[a-z]:" Then
DriveLetter = DriveLetter & "\"
Else
GetSerialNumber = "Error - Bad drive designation"
End If
Case 3
If LCase(DriveLetter) Like "[!a-z]:\" Then
GetSerialNumber = "Error - Bad drive designation"
End If
Case Else
GetSerialNumber = "Error - Bad drive designation"
End Select
If Len(GetSerialNumber) = 0 Then
VolNameBuf = String(255, Chr(0))
FileSysNameBuf = String(255, Chr$(0))
GetVolumeInformation DriveLetter, VolNameBuf, Len(VolNameBuf), SerialNum, 0, 0, FileSysNameBuf, Len(FileSysNameBuf)
GetSerialNumber = Right("00000000" & Hex(SerialNum), 8)
End If
End Function

Private Sub Command1_Click()
MsgBox GetSerialNumber("C:")
End Sub

наверх

Определить количество процессоров в компьютере

Option Explicit
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private m_typSystemInfo As SYSTEM_INFO
Public Function NumberOfProcessors() As Long
GetSystemInfo m_typSystemInfo
NumberOfProcessors = m_typSystemInfo.dwNumberOfProcessors
End Function

Private Sub Form_Load()
MsgBox NumberOfProcessors
End Sub

наверх

Получить сведений о любом диске: Floppy Disk/CD/Hard Drive

Данный пример позволяет определить серийный номер диска, метку диска и тип файловой системы

Добавьте CommandButton на форму

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Const GET_SERIAL = 1
Const GET_LABEL = 2
Const GET_TYPE = 3
Private Function GetDriveInfo(strDrive As String, iType As Integer)
Dim SerialNum As Long
Dim strLabel As String
Dim strType As String
Dim lRetVal As Long
strLabel = Space(256)
strType = Space(256)
lRetVal = GetVolumeInformation(strDrive, strLabel, Len(strLabel), SerialNum, 0, 0, strType, Len(strType))
Select Case iType
Case Is = 1
GetDriveInfo = CStr(SerialNum)
Case Is = 2
GetDriveInfo = strLabel
Case Is = 3
GetDriveInfo = strType
End Select
End Function
Private Sub Command1_Click()
strValue = GetDriveInfo("c:\", GET_SERIAL)
MsgBox strValue
strValue = GetDriveInfo("c:\", GET_LABEL)
MsgBox strValue
strValue = GetDriveInfo("c:\", GET_TYPE)
MsgBox strValue
End Sub

наверх

Мои программы

BalloonMessage for MS Agent

BalloonMessage for Microsoft Agent реализует диалог программы с пользователем, используя при этом технологию Microsoft Agent. OCX реализует три типа диалоговых окон: InputBox, MsgBox и MsgLabels.

Автора: Шатрыкин Иван и Павел Сурменок.

Подробнее...

наверх

Вопрос/Ответ

Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.

Вопросы:

Автор вопроса: Саша

Ответ ожидается по этому адресу

Как exe программе под дос можно снять и установить флажок "Завершать окно по яавершению работы"

Автор вопроса: Саша

Ответ ожидается по этому адресу

вопрос по RichTextBox
Как яделать так, что бы когда нажимали на Shift+Insert вставка была неформатированная т.е. просто текст

Автор вопроса: Саша

Ответ ожидается по этому адресу

Как уянать реальную скорость яакачки файлов.

Автор вопроса: Саша

Ответ ожидается по этому адресу

Как текст набранный, на пример, в RichTextBox сохранить в фомате *.doc (имеется в виду Microsoft Word)

Автор вопроса: kav

Ответ ожидается по этому адресу

Каким образом можно из VB получать и обрабатывать системные события Windows ! Например, читать клавиатуру.

Автор вопроса: karty

Ответ ожидается по этому адресу

Как при перетаскивании объекта в TREEVIEW, главная ветка раскрывалась бы автоматически.

Автор вопроса: karty

Ответ ожидается по этому адресу

Как при работе с DAO новую запись в таблицу добавить не в конец таблицы, а в нужное мне место.

Автор вопроса: Роман

Ответ ожидается по этому адресу

Как можно с помощью VB наложить пароль на папку?

Автор вопроса: Алексей

Ответ ожидается по этому адресу

Как в VB яавершить работу приложения Windows?

Ответы:

Вопрос:

Подскажите пожалуйсто как сделать так что при наведении курсора на кнопку, она убегала в абсолютное безразличное место?

Ответ:

Автор ответа: Murat Shonov

Событием Mouse_Move
Создаешь форму и пихаешь на нее кнопку затем пишешь следующий код

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Randomize Timer
'это функция псевдослучайных чисел для того чтоб кнопка прыгала каждый раз куда попало
Command1.Top = Rnd(1) * 1000
'эту тысячу меняешь на свои значения в зависимости от размера формы (желательно ставить не больше значений Form.Widht и Form.Height не то она убежит за форму)
Command1.Left = Rnd(1) * 1000
'эту тоже (rnd - псевдослучайный генератор чисел)
End Sub

Вопрос:

   Подскажите пожалуйсто как сделать так что при наведении курсора на кнопку, она убегала в абсолютное безразличное место?

Ответ:

Автор ответа: mikl

Попробуй написать такую процедуру при наведении на кнопку указателя мыши(Command2_MouseMove) Вместо 4000 и 5700 подбирай исходя из рамеров формы. Эти для формы размером Top = 7290, а Left = 4935.

Private Sub Form_Load()
     Randomize
End Sub

Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command2.Top = Int(Rnd * 4000) 'делаем чтобы кнопка убегала от мышки
Command2.Left = Int(Rnd * 5700)
End Sub

Вопрос:

   Подскажите пожалуйсто как сделать так что при наведении курсора на кнопку, она убегала в абсолютное безразличное место?

Ответ:

Автор ответа: RaZoom

Private Sub btn1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     'Form1 - форма на которой находится кнопка
     'btn1 - "бегающая" кнопка
     With btn1 'Если не в курсе, будет подставлять btn1 там, где объект не указан явно
         maxX& = Form1.Width - .Width
         maxy& = Form1.Height - .Width
         .Left = Rnd * maxX
         .Top = Rnd * maxy
     End With
End Sub

Вопрос:

   Подскажите пожалуйсто как сделать так что при наведении курсора на кнопку, она убегала в абсолютное безразличное место?

Ответ:

Автор ответа: Tibor

примерно ето будет выглядеть так:

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.Move Rnd((Form1.Width - Command1.Width)), _
                           Rnd((Form1.Height - Command1.Height))
'размеры кнопки вычитаем, чтоб за края не забигала
End Sub

вот собственно и всё.

Вопрос:

Подскажите пожалуйсто как сделать так что при наведении курсора на кнопку, она убегала в абсолютное безразличное место?

Ответ:

Автор ответа: Артём Кривокрисенко

Очень просто:

Sub CommandButton1_mouseover(тут аргументы)
CommandButton1.move Int(RND*1000)-500, Int(RND*1000)-500
End Sub

Если хочешь, после CommandButton1.move пиши конкретные значения (у меня просто генерируется произвольное число)

Вопрос:

Подскажите пожалуйста как сделать так: когда нажимаешь на .exe файл он сам определял полный адрес папки, в которой он находится.

Ответ:

Автор ответа: Rutshtein Akex

Используй App.Path

Вопрос:

   Подскажите пожалуйста как сделать так: когда нажимаешь на .exe файл он сам определял полный адрес папки, в которой он находится.

Ответ:

Автор ответа: Tibor

Ещо раз повтаряю для всех! Будте внимательны и тыркайте везде. Не ленитесь!

В VB5-6 (про NET не знаю) есть библиотека, в которой хоть и кратко но описываются все её функции. Также описание функций и событий подключеных к проекту объектов.

Тыркаеш F2 и оно выскакивает.

А на вопрос отвечу:

App.Path

Вопрос:

   Подскажите пожалуйста как сделать так: когда нажимаешь на .exe файл он сам определял полный адрес папки, в которой он находится.

Ответ:

Автор ответа: RaZoom

'Все объявления могут быть Public, но тогда их надо поместить в модуль

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" _
         (ByVal lpModuleName As String) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" _
         (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private hModule As Long, strBuff$

Private Sub Form_Load()
     'определяем дескриптор нашего приложения
     hModule& = GetModuleHandle(App.EXEName)
     'Создаем буфер длиной = (предполагаемое число символов)+1
     strBuff$ = Space(101)
     'Функция GetModuleFileName возвращает полный путь к исполняемому файлу в strBuff
     'и количество считанных символов, но, так как требуется только путь, мы обрезаем
     '"лишние символы". "-4" во втором параметре функции Left$ необходимо, так как
     'App.EXEName возвращает имя модуля без точки и расширения. Вообще более корректно
     'было бы определить положение последнего слеша в строке и обрезать все, что после
     'него, но так как расширений исполняемых файлов длиной более 3 символов я не видел,
     'то и поступил по-простому.
     strBuff$ = Left$(strBuff$, GetModuleFileName(hModule&, strBuff, 100) - Len(App.EXEName) - 4)
     'В strBuff$ путь к нашему файлу с завершающим слешем
End Sub

Вопрос:

Подскажите пожалуйста как сделать так: когда нажимаешь на .exe файл он сам определял полный адрес папки, в которой он находится.

Ответ:

Автор ответа: Mind Engine

Хиииии, app.path тебя спасет! :)

Вопрос:

Подскажите пожалуйста как сделать так: когда нажимаешь на .exe файл он сам определял полный адрес папки, в которой он находится.

Ответ:

Автор ответа: Артём Кривокрисенко

Если я правильно понял, нужно определить, в какой папке находится исполняемый файл:

Path=App.Path

NB! путь возвращается без имени файла и без последнего слэша (Например, "C:\Projects\Soft"). Чтоб добавить слеш, пиши:

Path=App.Path & "\"

Вопрос:

Подскажите пожалуйста как сделать так: когда нажимаешь на .exe файл он сам определял полный адрес папки, в которой он находится.

Ответ:

Автор ответа: ViTal

Используй App.Path

Вопрос:

Как сделать автозапуск с 3.5 диска (дискеты)?

Ответ:

Автор ответа: Артём Кривокрисенко

Насколько мне известно, это сделать никак невозможно (дисковод не определяет дискеты автоматически).

Вопрос:

Работаю в VBA, как полученные данные сунуть в ячейки Excel 2002, а потом вынуть. Пришлите пример на мылои плия. Желательно в коде VBA.

Ответ:

Автор ответа: Zoubar Serguey

Запись числа 100 в 1-ю ячейку 1-го рабочего листа:

worksheets(1).cells(1,1).value = 100

Или, используя объект Range:

worksheets("Лист1").range("D1").value = 100

(для текущего листа worksheets можно пропустить) Можно также использовать поименованный диапазон ячеек:

range("ИмяДиапазона").cells(5).value = 100

Аналогично производится считывание данных из ячеек Excel:

Try = worksheets(1).cells(1,1).value

и т. п.

Вопрос:

Прочитал, как можно заставить модем перезванивать при низкой скорости.
У меня же все полностью противоположно. Мне надо, чтобы модем коннектился только на 31200. Если больше, то связь очень плохая (такая, что за 10мин можно не получить не байта), а меньше смысла нет.

Ответ:

Автор ответа: -=CBK=-CRaSH

Добавь в строку инициализации модема
Её можешь найти в свойсвах модема

AT+MS=v34,0,75,33600,75,33600

Всё

Вопрос:

Как сделать всплывающую подсказку (ToolTipText)в 2 и более строк?

Ответ:

Автор ответа: Mind Engine

Ха, а вроде никак... vbCrLf и прочее на нем не срабатывает, да и вообще, где ты видел двухэтажный ToolTipText?

Вопрос:

Как скопировать из папки все файлы одного расширения?

Ответ:

Автор ответа: Nechaev Sergey

Кинь на форму FileListBox имя стандартное. Копирует все sys файлы (кроме системных и скрытытх) из корня в C:\Check. Если Check не создана - ошибка.

Private Sub Form_Load()
With File1
.Pattern = "*.sys"
.Path = "C:\"
For q = 0 To .ListCount - 1
FileCopy .Path & .List(q), "C:\Check\" & .List(q)
Next q
End With
End Sub

Вопрос:

Есть такая проблема. Работаю с DirectX весь код пишу сам, никакими контролами не пользуюсь. Ставлю простой кубик и двигаю его программно, если он подвигается очень близко к позиции камеры, тоесть к экрану, начинает жутко тормозить 1fps. В играх же целый уровень нетормозит. Подскажите что делать. И если кто нибудь знает где взять описание этих функций, желательно с примерами.

Ответ:

Автор ответа: Dr.Max

Может тебе нужно оптимизтировать код? Исползуй переменные по-быстрей - старайся не использовать Variant, если ты объявляешь переменные так:

Dim A,B,C as integer

, то знай: A и B - это variant, И только С integer!!
И проверь, может в коде много циклов.

Вопрос:

Есть такая проблема. Работаю с DirectX весь код пишу сам, никакими контролами не пользуюсь. Ставлю простой кубик и двигаю его программно, если он подвигается очень близко к позиции камеры, тоесть к экрану, начинает жутко тормозить 1fps. В играх же целый уровень нетормозит. Подскажите что делать. И если кто нибудь знает где взять описание этих функций, желательно с примерами.

Ответ:

Автор ответа: -=CBK=-CRaSH

Блин у меня такое же горе. А все из-за тупого компилятора ВБ. Если дядюшка Си работает сам по себе и в десять раз быстрее, то VB постоянно опирается на свои подпорки - Runtime-библиотеки, с помощью которых он, собственно говоря и работает. Поможет тебе только переход на Си.

Вопрос:

   При записи информации в файл (методом Put) выводится сообщение "Неправильная длина строки" (если объём информации большой). Что делать? (И кто виноват? :)

Ответ:

Автор ответа: VADIM SHER

Option Explicit
Public NameUser As String
#If Win32 Then
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal
lpBuffer As String, nSize As Long) As Long
Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetLastError Lib "kernel32.lib" () As Long
Public Const UNLEN = 256 ' as defined in LMCONS.H
Public Const MAX_COMPUTERNAME_LENGTH = 31 ' as defined in WINBASE.H
#Else
#End If
Function UserName()
Dim intPos As Integer
Dim un As String, lpBuffer As String, nSize As Long
lpBuffer = "..............................."
nSize = 30
un = GetUserName(lpBuffer, nSize)
un = lpBuffer
         intPos = InStr(un, ".")
         NameUser = Left(un, intPos - 1)
End Function

Можете заполнить эту форму, либо отослать вопрос СЮДА

Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.
наверх

Выпуск подготовили:

Сурменок Павел

http://subscribe.ru/
E-mail: ask@subscribe.ru

Отписаться
Убрать рекламу

В избранное

{#template MAIN} <div id="loginForm" style="display:none;" class="subscriberu_popup"> <div class="popup_register"> {#include js_tmpl_auth_reg_tab} {#if $P.login_register_tab == 1} <form class="authentication-form" method="post" action="/MEMBERLOGIN_authen_cred"> <dl class="rg_block_options"> <dt id="js_tap_panel_auth"> <h1>Войти на сайт</h1> {* {#include js_tmpl_auth_reg_button} *} {#include js_tmpl_auth_reg_action} <hr class="logreg_line noPhones"> <div class="logreg_descr noPhones"><p>{#include js_tmpl_auth_reg_descr} </p></div> <div class="logreg_advice noPhones"> Если вы еще не с нами, то начните с <a href="#" onclick="rgNav('js_tab_reg');return false;" class="dashed" data-func="registr">регистрации</a> </div> <br><br> <a class="dashed auth-enter" href="/manage/author/"><b>Вход для авторов</b></a> </dt> </dl> </form> {#/if} {#if $P.login_register_tab == 2} <div class="rg_block_options"> <div id="js_tap_panel_auth"> <h1>Регистрация</h1> <div class="social_reg"> {* <div class="rg_description">{#include js_tmpl_soc_auth_reg_descr}</div> *} {#include js_tmpl_auth_reg_soc} <div class="rg_soc_auth_agree">{#include js_tmpl_auth_reg_agree}</div> </div> <div class="subscribe_reg"> {* <div class="rg_description"> #include js_tmpl_auth_reg_descr </div> *} {#include js_tmpl_auth_reg_action} </div> {* {#include js_tmpl_auth_reg_button} *} <div class="clr"> </div> <hr class="logreg_line noPhones"> <div class="logreg_descr noPhones">{#include js_tmpl_auth_reg_descr} {#include js_tmpl_soc_auth_reg_descr} </div> </div> </div> {#/if} </div> {* <div class="gray_bg register_shadow"></div> *} </div> {#/template MAIN} {#template js_tmpl_auth_reg_tab} <ul class="rg_nav"> <li id="js_tab_auth" class="{#if $P.login_register_tab == 1} rg_active_nav {#/if} rg_first_nav"><a onclick="rgNav('js_tab_auth');return false;" href="">Вход на сайт</a></li> <li id="js_tab_reg" class="{#if $P.login_register_tab == 2} rg_active_nav {#/if}"><a onclick="rgNav('js_tab_reg');return false;" href="">Регистрация </a></li> </ul> <span onclick="hidebo();" class="rg_closed"> </span> {#/template js_tmpl_auth_reg_tab} {#template js_tmpl_auth_reg_action} {#if $P.login_register_tab == 1} {#include js_tmpl_auth_reg_soc} {#/if} <div class="rg_forms"> <input type="hidden" id="login_register_destination" value="{$P.login_register_destination}"/> {#if $P.login_register_tab == 1} <div class="rg_for_input"> <span class="rg_text_inner">E-mail или код подписчика</span> <input id="credential_0" class="js_keydown_selector rg_input_text" data-js_submit="no" data-js_next_input_name="credential_1" name="" type="text" /> </div> <div class="rg_for_input"> <span class="rg_text_inner">Пароль</span> <input id="credential_1" class="js_keydown_selector rg_input_text" data-js_submit="yes" data-js_action="js_loginFormBut" name="" type="password" onkeyup="showAttention(this,!!window.event.shiftKey)" /> <span class="pswd_attention" id="attention_pswd"> <span class="icon_attention"></span> <span class="pswd_attention-text" id="attention-text_pswd1">Русская раскладка клавиатуры!</span> <span class="pswd_attention-text" id="attention-text_pswd2">У вас включен Caps Lock!</span> <span class="pswd_attention-text" id="attention-text_pswd3">У вас включен Caps Lock и русская раскладка клавиатуры!</span> </span> </div> <div class="rg_for_input input-alien"> <span class="chk noPhones"><input id="chk_alien" name="" type="checkbox" /></span><label for="chk_alien" class="noPhones"> Чужой компьютер</label> <a class="forgot_pass" href="/member/totalrecall">Забыли пароль?</a> </div> <div class="rg_for_input"> <em id="auth_msg" class="reg_error"></em> <input id="lf_typeauthid" value="email" type="hidden"> <input type="submit" class="button button-red logreg_submit" id="js_loginFormBut" value="Войти">  <div class="loading loading-cover" style="display: none;"><div class="loader"></div></div> </div> {#/if} {#if $P.login_register_tab == 2} <div class="rg_for_input"> <span class="rg_text_inner">E-mail</span> <input id="arfemail" class="js_keydown_selector rg_input_text" name="" type="text" data-js_submit="yes" data-js_action="js_regFormBut"/> </div> <div class="rg_for_input rg_set_lineh rg_for_input_wide"> <label class="js_tap_panel_checkbox"> <span class="chk"><input name="" id='js_tap_panel_checkbox_terms' type="checkbox" data-js_submit="yes" /></span> Я ознакомился и согласен с <a class="link_txd logreg_accLink" href="/faq/vereinbarung.html">условиями сервиса Subscribe.ru</a> </label> <br /> <label class="js_tap_panel_checkbox"> <span class="chk"><input name="" id='js_tap_panel_checkbox_personal' type="checkbox" data-js_submit="yes" /></span> Нажимая на кнопку "Готово!", я даю <a class="link_txd logreg_accLink" href="/faq/persverordnung.html">согласие на обработку персональных данных</a> </label> </div> {* <div style="float: left;position: absolute;left: 11em;"> <img src="http://www.kupivip.ru/images/vip/logo.png?1604" style="width: 86px; vertical-align: middle;display: block;"> </div> <div class="rg_for_input rg_set_lineh"> <label class="js_tap_panel_checkbox"><input name="" id="js_tap_panel_checkbox_kupivip" type="checkbox" data-js_submit="yes"> Я хочу получать новости о скидках на одежду</label> </div> *} <div class="rg_for_input"> <em id="reg_msg" class="reg_error rg_for_input_wide"></em> <em id="reg_msg2" class="reg_error rg_for_input_wide"></em> <input id="rf_typeauthid" value="email" type="hidden"> <a class="button button-red logreg_submit" id="js_regFormBut" href="#">Готово!</a> <div class="loading loading-cover" style="display: none;"><div class="loader"></div></div> </div> {#/if} </div> {#/template js_tmpl_auth_reg_action} {#template js_tmpl_auth_reg_agree} <div class="rg_for_input rg_set_lineh rg_for_input_wide"> <label class="js_tap_panel_checkbox"> <span class="chk"><input name="" id='js_tap_panel_checkbox_terms_reg' type="checkbox" data-js_submit="yes" /></span> Я ознакомился и согласен с <a class="link_txd logreg_accLink" href="/faq/vereinbarung.html">условиями сервиса Subscribe.ru</a></label> <em id="reg_msg_soc" class="reg_error rg_for_input_wide"></em> </div> {#/template js_tmpl_auth_reg_agree} {#template js_tmpl_auth_reg_button} <div class="rg_butons_socials"> {#if $P.login_register_tab == 1} <a class="rg_btn_soc rg_bs_01 js_tap_panel_selector" action="auth_email" href="#"><span><i></i>Email</span></a> <a class="rg_btn_soc rg_bs_01 js_tap_panel_selector" action="auth_openid" href="#"><span><i></i>OpenID</span></a> <a class="rg_btn_soc rg_bs_02 js_tap_panel_selector" action="auth_vkontakte" href="#"><span><i></i>Вконтакте</span></a> <a class="rg_btn_soc rg_bs_02 js_tap_panel_selector" action="auth_mailru" href="#"><span><i></i>Mail.Ru</span></a> {#/if} {#if $P.login_register_tab == 2} <a class="rg_btn_soc rg_bs_01 js_tap_panel_selector" action="reg_email" href="#"><span><i></i>Email</span></a> <a class="rg_btn_soc rg_bs_01 js_tap_panel_selector" action="reg_openid" href="#"><span><i></i>OpenID</span></a> <a class="rg_btn_soc rg_bs_02 js_tap_panel_selector" action="reg_vkontakte" href="#"><span><i></i>Вконтакте</span></a> <a class="rg_btn_soc rg_bs_02 js_tap_panel_selector" action="reg_mailru" href="#"><span><i></i>Mail.Ru</span></a> {#/if} </div> {#/template js_tmpl_auth_reg_button} {#template js_tmpl_auth_reg_descr} {#if $P.login_register_tab == 1} Для оформления подписки на выбранную рассылку, работы с интересующей вас группой или доступа в нужный вам раздел, просим авторизоваться на Subscribe.ru {#/if} {#if $P.login_register_tab == 2} Для регистрации укажите ваш e-mail адрес. Адрес должен быть действующим, на него сразу после регистрации будет отправлено письмо с инструкциями и кодом подтверждения. {#/if} {#/template js_tmpl_auth_reg_descr} {#template js_tmpl_soc_auth_reg_descr} Или зарегистрируйтесь через социальную сеть. {#/template js_tmpl_soc_auth_reg_descr} {#template js_tmpl_auth_reg_soc} <div class="rg_soc"> {#if $P.login_register_tab == 1} <a onclick="return _checkSocConfirm(event)" href="https://oauth.vk.com/authorize?client_id=3954260&scope=wall,offline,photos,groups,video,audio,email&redirect_uri={location.protocol+'//'+location.host}/member/login/vk/&response_type=code&v=5.15" class="login_register_vk_button"> <span class="login_register_vk_icon"></span> </a> {#/if} {#if $P.login_register_tab == 2} <a onclick="return _checkSocConfirm(event)" href="https://oauth.vk.com/authorize?client_id=3954260&scope=wall,offline,photos,groups,video,audio,email&redirect_uri={location.protocol+'//'+location.host}/member/join/vk&response_type=code&v=5.15" class="login_register_vk_button"> <span class="login_register_vk_icon"></span> </a> {#/if} </div> {#/template js_tmpl_auth_reg_soc}

{#template MAIN} <div id="loginForm" style="display:none;" class="subscriberu_popup"> <div class="popup_register"> {#include js_tmpl_auth_reg_tab} <dl class="rg_block_options"> <dt id="js_tap_panel_auth"> <p class="rg_description">{#include js_tmpl_auth_reg_descr}</p> <div class="clr"> </div> {#include js_tmpl_auth_reg_action} <div class="clr"> </div> </dt> </dl> </div>  </div> {#/template MAIN} {#template js_tmpl_auth_reg_tab} <ul class="rg_nav"> <li id="js_tab_reg" class="rg_active_nav rg_first_nav"><a href="" onclick="return false;" >Регистрация</a></li> </ul> <span onclick="hidebo();" class="rg_closed"> </span> {#/template js_tmpl_auth_reg_tab} {#template js_tmpl_auth_reg_descr} <strong>Пожалуйста, подтвердите ваш адрес.</strong><br><br>Вам отправлено письмо для подтверждения вашего адреса {$P.register_confirm_mail}.<br>Для подтверждения адреса перейдите по ссылке из этого письма. {#/template js_tmpl_auth_reg_descr} {#template js_tmpl_auth_reg_action} <div class="rg_forms confirm_code_from_letter"> <div class="rg_for_input"> <span class="rg_inp_descr" style="width:15em;">Или введите код из письма:</span> <input type="text" value="" id="confirm_code" name="" data-js_submit="yes" data-js_action="js_confirmFormBut" class="js_keydown_selector rg_input_text_conf" > </div> <div class="rg_for_input"><label>Не пришло письмо? <b>Пожалуйста, проверьте папку Спам</b><br /> (папку для нежелательной почты).</label><br /> <a href="" onclick="ajax_recall_code();return false" >Вышлите мне письмо еще раз!</a></div> <div class="rg_for_input"> <em class="reg_error" id="confirm_msg"></em> <a href="#" class="button button-red" id="js_confirmFormBut">Готово</a> <div class="loading loading-cover" style="display: none;"><div class="loader"></div></div> <br> </div> </div> {#/template js_tmpl_auth_reg_action}