Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

Visual Basic для новичков и профессионалов #37


Информационный Канал Subscribe.Ru

Visual Basic для новичков и профессионалов
Visual Basic для новичков и профессионалов #36

 

Сегодня в выпуске:
>
Новости сайта
>
Новое на форуме
>
Вопросы и ответы
>
Курс обучения для начинающих
>
Компоненты, контролы, исходники
>
Статья выпуска
>
Наши партнеры
Бред автора

Здравствуйте уважаемые подписчики!

Очередной выпуск нашей рассылки. Спасибо за поздравления защите диплома, было очень приятно услышать от читателей несколько теплых строк.
Ну немного расскажу о работе сайта: сайт практически работает, но не все еще сделано на 100%. Думаю, что числу к 15-му сайт начнет работу. Опять таки (в последний раз) изменился дизайн рассылки, так как опять же был разработан новый дизайн сайта. Обещаю, что следующие выпуски будут без изменений дизайна рассылки.

Еще одно сообщение: изменилась таблица участников, теперь она выросла из привычных 5-ти мест в 10-местную таблицу. Поздравляю Андрея Еремина, он вырвался на 2-е место!

Хотел бы еще ответить на письмо Юрия, который написал:

Я только недавно случайно подписался на Вашу рассылку и очень доволен.
Конечно-же поздравляю Вас с успешной защитой дипломного проекта на отлично
(по-другому и быть не могло!!!) и хочу задать Вам один вопрос - Что Вы имели
в виду, когда писали "Используйте текстовый формат письма при написании
вопроса или ответа"?. Я так понимаю - это просто НЕ использование HTML при
написании письма или это имеется в виду, что вопросы и ответы необходимо
писать в отдельном текстовом документе и высылать их в виде вложения. Я
знаю, что я не один над этим вопросом долго думал. Если это возможно, то
напишите правила рассылки доходчевей на одно-два слова. Заранее благодарю и
еще раз поздравляю!

С уважением, Юрий!

Спасибо Юрий за вопрос. Спасибо за поздравление, очень приятно.
В смылсе использования текстового формата письма, я предпологал не приаттачивание документов к письму, а написание писем в текстовом формате, а не HTML. Некоторые ответы приходят с фоновыми рисунками, разношрифтовым текстом. Понимаете, это неудобно при создании очередного номера рассылки. Я не заставляю никого писать письма именно в текстовом формате, я призываю. Правило подкорректирую. Спасибо.


Правила рассылки
1. Вопросы, касающиеся другой сферы программирования, а также сферы ПО - НЕ ПРИНИМАЮТСЯ!
2. Письма с указанием ссылок на какой-либо ресурс или сайт будут отвергнуты, либо ссылкы будут заменены на <РЕКЛАМА> и не будут опубликованы в рассылке!
3. Используйте текстовый (не HTML) формат писем при написании вопроса или ответа.
4. ПИСЬМА С СОДЕРЖАНИЕМ ТИПА "ПИШИ СЮДА, Я ТЕБЕ ВЫШЛЮ ИСХОДНИК", ЛИБО "НАПИШИ МНЕ, Я ТЕБЕ ОБЪЯСНЮ" БОЛЬШЕ НЕ ПУБЛИКУЮТСЯ! ЕСЛИ ВЫ ХОТИТЕ ПОДЕЛИТЬСЯ ФАЙЛОМ, ПРИСЫЛАЙТЕ ЕГО АВТОРУ РАССЫЛКИ. ЭТО ВАМ НЕ ФОРУМ И НЕ СЛУЖБА СООБЩЕНИЙ МЕЖДУ ПОДПИСЧИКАМИ!
Новости сайта www.basic.webhost.ru

Продолжается работа над сайтом.

Вопросы и ответы

Место
Имя
Баллы
Место
Имя
Баллы
1
*Casper* (=)
86
6
sach (new!)
16
2
Андрей Е. (+)
42
7
Игорь (lover...) (New!)
15
3
Bullet [PCLO] (+)
30
8
OverKill (New!)
15
4
HouseBugs (-)
28
9
Гарвинев Олег (New!)
12
5
Андрей (now@) (-)
24
10
Леголегс (New!)
11

(+) - на место выше, (-) - на место ниже, (=) - прежнее место, (New!) - впервые в таблице.
Всего участников: 57
Общее количество баллов всех участников: 485
Из них не заработали ни одного балла: 4 участника

Новые вопросы

86/ Подскажите как запустить программу на удалённом компе? [Ответить]
87/ Помогите пожалуйста, как через ADO программно подключиться к базе данных FoxPro (dbf файл) примерчик бы не помешал [Ответить]
88/ Здравствуйте. У меня такой вопрос: можно ли из VB послать команду так, чтобы включилась удалённая машина в сети, на которой включен WakeUp on LAN. Если да, то как? За ранее спасибо за оказанную помощь! [Ответить]
89/ Привет! Я хочу в excel сделать архив моих дисков... Мне нужно сделать кнопку, по нажатию которой будет появлятся диалоговое окно добавления нового диска... Как это можно сделать? В программинге я пока не очень шарю... Всем спасибо! [Ответить]
90/ Привет всем. Нужно с помоью программы отправлять данные на вебстраницу, а именно отправить номер телефона и SMS сообщение на страницу php в интернете. Помогите пожалуйста. [Ответить]
91/ Как записать данные из Excel-таблицы в DBF-файл? [Ответить]
92/ Как сделать чтобы кнопка зыкрытия формы была недоступной в то время, как кнопка сворачивания формы отображалась. Я знаю, что это возможно сделать, но меня НЕ(!) интересуют программные коды на 1,5 страницы! Если кто-то знает что-то такое, что помещается в несколько строк сообщайте. Спасибо. [Ответить]
93/ Как определить запущена ли та или иная программа в Windows? [Ответить]
Вопросы, ответы на которые не были получены

40/ Здраствуйте ! У меня к вам будет один вопрос. Можно ли на ВБ (у меня установлена 6-я версия программы) сделать поиск подключенных компьютеров по локальной сети.Мне нужно узнать их ай-пи адрес и желательно имя компьютера. Я начинающий программист, если можно, обьясните более подробно. Заранее спасибо [Ответить]
49/ Тут такая проблема... Я собрался изучить базы данных, а вот хелп не могу найти, в частности по MSH FlexGrid, если у вас есть хелп по контролам вы бы не смогли бы мне прислать или подсказать как с ним работать. Зарание благодарю!!!! [Ответить]
54/ Как сделать турнирную таблицу (Как в футболе). Самое главное - это сортировка. Заранее спасибо! [Ответить]
57/ Здравствуйте. Уважаемы програмисты, я не программирую на VB. Недавно появилась задачка, которую я предполагаю как можно решить, но не знаю как реализовать. Исходные данные. Есть сетевой принтер с возможностью двухсторонней печати. Пользователи работают с MS Word. На печать посылаются задания из n листов. При этом, листы с 1 по n-2 должны быть напечатаны с одной стороны. Лист n-1 является последним листом документа, а лист n оборотной стороной листа n-1. Предпологаемое решение. По нажатию кнопки "Печать1" из переменной "Количество листов в документе" извлекается заначение n и если n<2 выводится на экран сообщение "Печать с оборотом не возможна" и производится выход из программы, если n>2 вызывается на исполнение функция печати, которой в параметрах передается: 1. Печатать листы с 1 по n-2; 2. Печатать без оборота. Вызывается на исполнение функция печати, которой в параметрах передается: 1. Печатать листы n-1, n; 2. Печатать с оборотом. При этом желательно сделать так, чтобы между вызовами функций печати в очередь печати не проскочило какое-нибудь задание. Естественно, все это оформить в виде макроса. Прошу Вас помочь мне. [Ответить]
62/ Здравствуйте уважаемуе программисты. Подскажите принцип работы с объектом phone. Вопрос жизни и смерти. [Ответить]
63/ Здравствуйте! Как сделать столбец для таблицы с помощью VB который будет показывать номера кварталов с min зарплатой(в таблице 4 квартала). Другой столбец - Динамика изменения средней зарплаты по кварталам (рост, падение, колебание, постоянно)\ нужно найти среднее знаение среди записей каждого отдела и чтобы написал динамику изменени, то что напискано в скобках, одно слово. [Ответить]
67/ Здравствуйте! У меня к Вам два вопроса по VBA. 1. Мне часто приходится выполнять расчеты в Excel по формулам. Каким образом можно организовать вычисление в цикле так, чтобы после каждого следующего обращения формулы к ячейке X ее содержимое изменялось бы с определенным шагом? 2. При поиске в таблице базы данных какого-либо значения я пользуюсь формулами "ВПР" или "ГПР". Как можно сделать, чтобы при нахождении приближенного значения функция возвращала наименьшее из наибольших значений в строке или столбце списка, а не наибольшее из наименьших, как заложено в формулах? Заранее благодарю. Александр. [Ответить]
70/ Здраствуйте, подскажите пожалуйсто как наложить на большую картинку меньшую по определенным координатам, при этом результат сохранить в графический файл (bmp). [Ответить]
71/ Например есть соединение с интернетом и локальной сетью - как можно средствами VB6 узнать кол-во принятых и отправленых байт? Меня интересует конкректный пример, но можно хоть что-нибудь - если это вообще возможно. Заранее благодарю. [Ответить]
76/ podskazhite pozhalusta, kak pravil'nee pristupit' k sozdaniu tablic i kakogo roda tablica nujna dlya vvoda, obrabotki i rascheta dannix, na VB.net. mne bazu sozdavat' ne nado. Zaranee spasibo [Ответить]
78/ Предлагаю следующую проблему к обсуждению:как встроить диалоговое окно в метод класса в ActiveXDLL и получить с его помощью данные? Вот пример:
Public Function GetUserChoice$() ‘метод класса
MyForm.Show vbModal ‘диалоговое окно для получения данных от пользователя
‘Здесь возможна обработка данных
‘…
‘… GetUserChoice = куда сохраняли ввод
‘ см.обработчик OnClick ниже End Function Обработчик события OnClick для кнопки на диалоговой форме MyForm содержит такой код:
Private Sub Command1_Click() сюда сохраняем ввод = Text1.Text Unload Me End Sub Проблема,собственно, состоит в том,как сохранить введенные данные и вернуть их в метод.Все перепробовал (глобальные переменные,свойства вспомогательного класса итд.) –ничего не работает,форма как будто существует сама по себе,в глухой изоляции и в упор не видит ни переменных,ни классов в других модулях.Складывается такое впечатление,что в ActiveXDll в VB вообще нет поддержки визуальности. К слову, с этой проблемой я обращался за помощью к нескольким «профессиональным» программистам (или тем,которые заявляли себя таковыми) на VB,но ни один из них не ответил.Видимо,ответить было нечего ;).
[Ответить]
80/ Как прописать на кнопку запуск Microsoft Query? [Ответить]
81/ Здравствуйте Друзья, не работает CommonDialog пишет license information for this component not foundю You do not have an appropriate license to use this functionainality in the design environment. Как исправить помогите [Ответить]
Полученные ответы


28/Как вывести все иконки ассоциативных файлов (как в проводнике) [Ответить]

Отвечает: Власенко Федор
Я делал так
Option Explicit
Private Const MAX_PATH = 260
'Private Const SHGFI_USEFILEATTRIBUTES = &H10 ' use passed
dwFileAttribute
Private Const SHGFI_OPENICON = &H2 ' get open icon
Private Const SHGFI_ICON = &H100 ' get icon
Private Const SHGFI_SMALLICON = &H1 ' get small icon

Private Type SHFILEINFO
hIcon As Long ' out: icon
iIcon As Long ' out: icon
index
dwAttributes As Long ' out: SFGAO_
flags
szDisplayName As String * MAX_PATH ' out: display name (or path)
szTypeName As String * 80 ' out: type name
End Type

Private Type PictDesc
cbSizeofStruct As Long
picType As Long
hIcon As Long
hPal As Long
Reserved As Long
End Type

Private Type IID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias
"SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, _
ByVal uFlags As Long) As Long
Private Declare Sub OleCreatePictureIndirect Lib "olepro32.dll" _
(lpPictDesc As PictDesc, riid As IID, _
ByVal fPictureOwnsHandle As Long, IPic
As Image)
Function GetIcon(Path As String) ' As PictureFormat
Dim tShFI As SHFILEINFO, FI As Long
Dim IPic As Image, picdes As PictDesc, iidIPicture As IID
'Получаем индетификатор маленькой иконки файла
FI = SHGetFileInfo(Path, 0, tShFI, LenB(tShFI), _
SHGFI_OPENICON Or SHGFI_ICON Or SHGFI_SMALLICON)
If tShFI.hIcon = 0 Then Exit Function
' Fill picture description
picdes.cbSizeofStruct = Len(picdes) 'Размер структуры
picdes.picType = 3 ' Тип изображения
picdes.hIcon = tShFI.hIcon ' Указатель
'Заполняем GUID информацию
iidIPicture.Data1 = &H7BF80980
iidIPicture.Data2 = &HBF32
iidIPicture.Data3 = &H101A
iidIPicture.Data4(0) = &H8B
iidIPicture.Data4(1) = &HBB
iidIPicture.Data4(2) = &H0
iidIPicture.Data4(3) = &HAA
iidIPicture.Data4(4) = &H0
iidIPicture.Data4(5) = &H30
iidIPicture.Data4(6) = &HC
iidIPicture.Data4(7) = &HAB
'Создаём изображение
OleCreatePictureIndirect picdes, iidIPicture, True, IPic
'Возвращаем новое изображение
Set GetIcon = IPic
End Function

Оценка за ответ: 5
52/Привет всем! подскажите как на VB произвести чтение и запись данных с LPT порта Заранее благодарен, Константин. [Ответить]

Отвечает: RenegadeMS MS
Где-то видел это так:
Open "LPT 1" for output as #n
Print #n, sText
Close #n
Думаю так можно и читать.
RenegadeMS

Оценка за ответ: 3
68/Как поменять рисунок рабочего стола? SystemParametersInfo работает только с bmp файлами, а как применить jpg или gif? [Ответить]

Отвечает: Андрей Еремин
Не вижу ничего сложного: почему бы не преобразовать указанный jpeg в bmp? Через Picture например...

Оценка за ответ: 3
74/Как сделать хороший менеджер закачек с использованием DirectPlay? Желательно исходник [Ответить]

Отвечает: Андрей Еремин
А может быть, стоит с помощью каких-нибудь других средств менеджер закачек
делать? Кроме того, писать за Вас его не будет никто. Ну а в целом, догнать
таких лидеров как ReGet или DM даже наполовину - сложновато.

Оценка за ответ: 4
74/Всем привет!!! У меня три вопроса:
1)Для воспроизведения MP3 – файлов в своей программе я использовал следующую функцию Private Declare Function mciExecute Lib "winmm.dll" _ (ByVal lpstrCommand As String) As Long Private Sub Form_Load() lpstrCommand = "Play " & "C:\Windows\Media\Chimes.wav" Call mciExecute(lpstrCommand) End Sub При закрытии программы файл продолжает воспроизводиться. Как сделать что - то наподобие кнопки Стоп, чтобы можно было остановить воспроизведение до закрытия программы.
2)Почему вышеуказанная функция не понимает пробелов в указании пути к файлу. Как можно это исправить?
3)И последнее. Как задержать выполнение программы на несколько секунд. Например, перед закрытием проигрывается звуковой файл, а затем происходит выгрузка.
[Ответить]

Отвечает: Bullet [PCLO]
Попробуй так:

создай в проекте модуль и помести туда этот код:

' Для проигрывания любого музыкального файла
Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

' Проиграть любой музыкальный файл
' Параметры вызова:
' Команда (1 - Проиграть/ 0 - Остановить), Имя файла
Public Sub SoundPlay(ByVal bCommand As Boolean, ByVal sFileName As String)
On Error Resume Next
If bCommand Then
Call mciExecute("play " & sFileName)
Else
Call mciExecute("close " & sFileName)
End If
End Sub

' Создать задержку
' Параметры вызова:
' nSeconds - количество секунд для задержки
Public Function sWait(nSeconds)
Dim nStartTime
nStartTime = Timer
Do While Timer < nStartTime + nSeconds
DoEvents
Loop
End Function

Теперь на форме создай три кнопочки вставь в форму следуущий код:

' Запустить звук
Private Sub cmdStartPlay_Click()
SoundPlay True, "C:\Windows\Media\Chimes.wav"
End Sub
' Остановить звук
Private Sub cmdStopPlay_Click()
SoundPlay False, "C:\Windows\Media\Chimes.wav"
End Sub
' Звук с задержкой и все такое... :)
Private Sub cmdWait_Click()
sWait 5
SoundPlay True, "C:\Windows\Media\Chimes.wav"
sWait 5
MsgBox "Hello word!!!"
End Sub

Оценка за ответ: 5

Отвечает: Андрей Еремин
2) Попробуйте заменять пробелы на комбинации "%20" (без кавычек). Так
должно работать.
3) Чтобы выполнить задержку, существуют следующие API-функции:
Sleep - задерживает выполнение кода на указанное количество миллисекунд.
SleepEx - похожее назначение, но принимает ещё второй параметр. С помощью него можно
указать, как программа будет себя вести во время выполнения. Там же можно установить
связь с каким-либо файлом или DDE-приложением.
Yield - Останавливает текущую задачу и запускает ожидающую задачу. Как правило, используется после
выполнения Sleep и SleepEx.

Оценка за ответ: 4
82/Как сделать чтобы при нажатии на объекте звучал звук (wav)? [Ответить]

Отвечает: Bullet [PCLO]
Создаешь форму, на ней создаешь PictureBox, Label, TextBox.
Называешь их picPlay, lblPlay, txtPlay

Затем добавляешь модуль, в кторый пишеш код:

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

' Проиграть любой музыкальный файл
' Параметры вызова:
' Команда (1 - Проиграть/ 0 - Остановить), Имя файла
Public Sub SoundPlay(ByVal bCommand As Boolean, ByVal sFileName As String)
On Error Resume Next
If bCommand Then
Call mciExecute("play " & sFileName)
Else
Call mciExecute("close " & sFileName)
End If
End Sub

Ну и соотвественно на саму форму делаешь такой код:

Private Sub lblPlay_Click()
SoundPlay True, "C:\Windows\Media\Chimes.wav"
End Sub

Private Sub picPlay_Click()
SoundPlay True, "C:\Windows\Media\Chimes.wav"
End Sub

Private Sub txtPlay_Click()
SoundPlay True, "C:\Windows\Media\Chimes.wav"
End Sub

Запускаешь проект, нажимаешь на все эти объекты и слышишь звук

Оценка за ответ: 5

Отвечает: pushynka
Чтобы при нажатии (чего?) на объекте звучал звук wav можно поступить
одним из по крайней мере двух способов:
1) отформировать объект как внедренный объект OLE (кажется, это так
называется) - исчите на панельке с инструментами что-то в виде картинки
с рамочкой и заполняйте графы в открывающихся "менюшках";
2) составить процедуру обработки события Вашего "нажатия на объект",
предварительно определив обращение к стандартной
программе-"проигрывателю" в таком вот "духе":

'Вариант 1

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

Private Sub Form_Click()
Dim res
res = mciExecute("Play C:\Путь_до_файла")
End Sub

'Вариант 2

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA"
(ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long)
As Long
.........

Private Sub Form_Click()
Dim x As Long
x = PlaySound("C:\Путь_до_файла", 0, &H1 Or &H10)
End Sub

'Вариант 3

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

Private Sub Form_Click()
Dim x As Long
x = sndPlaySound("C:\Путь_до_файла", &H1 Or &H10)
End Sub


Второй вариант многократно проверялся - работает.

Оценка за ответ: 5

Отвечает: Игорь
Как сделать чтобы при нажатии на объекте звучал звук (wav)?

Ответ:

В модуле программы или коде формы необходимо написать следующее:

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

Private Const SND_ASYNC = &H1 'Запускает звуковой файл (далее ЗФ)
сразу после воспроизведения ЗВ
Private Const SND_NODEFAULT = &H2 'Если ЗФ не найден ничего не
проигрывать
Private Const SND_NOSTOP = &H10 'Не останавливать текущий ЗФ для
проигр. другого

В процедуре нажатия (click) на любой объект необходимо написать:
Например, нажатие на кнопку -

Private Sub cmbCommand1_Click()
PlaySound "C:\Windows\Media\Chimes.wav", SND_ASYNC Or SND_NODEFAULT
End Sub

"C:\Windows\Media\Chimes.wav" - это и есть тот звуковой файл, кторый будет
проигрываться. Его можно заменить на любой другой.

Если применение данной процедуры в Вашей программе будет встречаться чаще
1-го раза, предлагаю написать следующую функцию в модуле программы:

Public Function MySound (SoundFile As String)
PlaySound SoundFile, SND_ASYNC Or SND_NODEFAULT
'где SoundFile - путь к звуковому файлу
End Function

Теперь в любом месте программы в процедуре нажатии на объект (или даже в
месте загрузки формы - Form_Load() или каком-либо другом) достаточно будет
просто написать:
MySound SoundFile, например, MySound "C:\Windows\Media\Welcome.wav"

По-моему на Вас вопрос ответил.

Для дополнения своего ответа высылаю VB-проект "TestSound", в котором кроме
вышеуказанного примера демонстрируется использование системных звуков
Windows (например, звуки при ошибке, стандартный звук Windows, звук при
вопросе, восклицании), а также использование и проигрывание звуковых файлов
*.wav из файла ресурсов, что тоже может пригодиться в Вашей работе со
звуковыми файлами.

За проигрывание файлов формата *.mp3, кажется, Вы не спрашивали

Оценка за ответ: 5
83/Помогите пожалуйста. Нужно написать на VB прогу которая отправляла бы на интернет страницу (php) данные. Тоесть программа отправки SMS должна передавать само сообщение, номер и оператор на определенную страницу. Заранее благодарен. [Ответить]

Отвечает: Андрей Еремин
Может быть, открывать эту страницу в WebBrowser? По идее, это приведёт к выполнению
скрипта и соответственно, отправке SMS. Ну а как забирать командные параметры - это уже
надо PHP изучать, а не VB. Просто передавайте так:
http://www.site.ru/sms.php?operator=beeline&num=9039999999&text=Hello

Оценка за ответ: 5
84/1) Как сделать ярлык на рабочем столе.
2) Как зарегистрировать расширение (т.е. при открытие файла с твоим выдуманным расширением, открывалась твоя программа и т.д. и т.п.) Спасибо!
[Ответить]

Отвечает: Stormbringer
Пример создания ярлыка(вставить в модуль формы):


Enum ShortCutDest
DeskTop
Programs
StartMenu
StartUp
End Enum
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As
Long
Private Const MAX_PATH = 260

Public Function CreateLink(dest As ShortCutDest, ByVal sName As String,
ByVal sPath As String, Optional HotKey As String = "", Optional sIcon As
String = "", Optional sWorkingDirectory As String = "", Optional sSubFolder
As String = "", Optional WinStyle As Integer = vbNormalFocus)
Dim WshShell As Object
Dim oShellLink As Object
Dim sLinkPath As String
Set WshShell = CreateObject("WScript.Shell")
Select Case dest
Case DeskTop
sLinkPath = WshShell.SpecialFolders("Desktop")
Case StartMenu
sLinkPath = WshShell.SpecialFolders("StartMenu")
Case StartUp
sLinkPath = WshShell.SpecialFolders("StartUp")
Case Programs
sLinkPath = WshShell.SpecialFolders("Programs")
End Select
On Error Resume Next
If sSubFolder <> "" Then
sLinkPath = sLinkPath & "\" & sSubFolder
If Dir(sLinkPath) = "" Then MkDir sLinkPath
End If
On Error GoTo 0
Set oShellLink = WshShell.CreateShortCut(sLinkPath & "\" & sName &
".lnk")
oShellLink.Windowstyle="WinStyle"
oShellLink.HotKey = sHotKey
oShellLink.TargetPath = sPath
oShellLink.IconLocation = sIcon
oShellLink.Description = sName
oShellLink.WorkingDirectory = sWorkingDirectory
oShellLink.Save
Set oShellLink = Nothing
Set WshShell = Nothing
End Function

Private Sub Command1_Click()
CreateLink DeskTop, "Calculator", WinDir & "\calc.exe", "CTRL+SHIFT+C",
"calc.exe,0", "c:\windows"
CreateLink StartMenu, "Calculator", WinDir & "\calc.exe", "CTRL+SHIFT+C",
"calc.exe,0", "c:\windows"
CreateLink StartUp, "Calculator", WinDir & "\calc.exe", "CTRL+SHIFT+C",
"calc.exe,0", "c:\windows"
CreateLink Programs, "Calculator", WinDir & "\calc.exe", "CTRL+SHIFT+C",
"calc.exe,0", "c:\windows", "WinCalc"
CreateLink Programs, "Calculator Help", WinDir & "\help\calc.hlp", "",
"winhlp32.exe,0", "c:\windows\help", "WinCalc"
CreateLink Programs, "Visit our web site", "http://vbcity.com", ,
"shdocvw.dll,0", , "WinCalc", vbMaximizedFocus
End Sub

Private Function WinDir()
Dim buff As String * MAX_PATH
buff = Space(MAX_PATH)
GetWindowsDirectory buff, MAX_PATH

WinDir = Trim$(buff)

End Function

Расширение:

Постмотрим внимательно на реестр: HKEY_CLASSES_ROOT
для простоты рассмотрим на примере расширения .txt

выделим ветку ".txt".
у меня там два параметра:

(по умолчанию) txtfile
ContentType text/plain

Что дальше?
Посмотрим в той же ветке (HKEY_CLASSES_ROOT)
параметр txtfile
УХ ТЫ! Да вот же он!
развернем!
У меня два параметра:

DefaultIcon
Shell

Откроем DefaultIcon:
По умолчанию shell32.dll,-152
Тут всё вроде ясно - shell32.dll - файл в котором содержится значок
-152 - номер заначка
Правда я что-то не понял почему там с минусом - в других ключах этот
параметр положителен: exe, num.



Развернем Shell :
У меня там два раздела:
Open
Print

В каждом из них есть раздел command
В open
(По умолчанию) C:\WINDOWS\NOTEPAD.EXE %1
В print
(По умолчанию) C:\WINDOWS\NOTEPAD.EXE /p %1



ВАЖНО!
параметр %1 обозначает путь к файлу!
например при записи в реестре:
C:\WINDOWS\NOTEPAD.EXE %1
после получения командной строки вы получите что-то вроде:
C:\WINDOWS\NOTEPAD.EXE С:\WINDOWS\РАБОЧИЙ СТОЛ\текстовый документ.txt

Оценка за ответ: 5

Отвечает: Игорь
1) Как сделать ярлык на рабочем столе.
2) Как зарегистрировать расширение (т.е. при открытие файла с твоим
выдуманным расширением, открывалась твоя программа и т.д. и т.п.) Спасибо!


Для регистрации своего типа файла необходимо провести запись в некотором
разделе реестра: HKEY_CLASSES_ROOT.
1. Создать ключ (1) в реестре в разделе HKEY_CLASSES_ROOT: с нужным
расширением (например ".dem").
2. Создать ключ (2) в реестре в разделе HKEY_CLASSES_ROOT: с именем вашей
программы (уникальным в системе), например, "myprogram".
3. Присвоить параметру "По-умолчанию" ключа (1) значение имени ключа (2).
4. Создать подключи для ключа (2):
HKEY_CLASSES_ROOT
- myprogram
- shell
- open
- command
5. Параметру "По-умолчанию" ключа "command" задать командную строку.
6. Иконку задать с помощью подключа DefaultIcon


Для наглядности примера создайте новый проект. Добавьте в него три текстовых
поля. Назовите их "txtExpansion", "txtShortDescription", "txtDescription".
Установите значение MaxLenght первого текстового поля
(txtExpansion) равным 3 (так как обычно расширение файла имеет 3 символа;
это можно сделать и программно).

Подключите к проекту Microsoft Common Dialog Control 6.0 (Comdlg32.ocx),
вставите его в форму и назовите "CommonDialog".
Добавьте две кнопки. Первую назовите "cmbCreate", а вторую - "cmbCheckUp". В
значение Caption первой напишите "Создать", а второй "Проверить". Первая
кнопка будет служить для команды создания нового расширения, а вторая для
проверки работы расширения.
Вставьте следующий код в форму.

Option Explicit
On Error Resume Next
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As
Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal
samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long,
lpdwDisposition As Long) As Long
'Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long)
As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
'Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
' Note that if you declare the lpData parameter as String, you must pass it
By Value.
'Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal
cbData As Long) As Long
'Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As
Long) As Long
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const KEY_SET_VALUE = &H2
Private Const ERROR_SUCCESS = 0
Private Const REG_SZ = 1
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 Check As Boolean
Private Sub CreateKey(ByVal lRootKey As Long, ByVal sKeyName As String)
On Error Resume Next
'create a new registry key
Dim hKey As Long
Call RegCreateKey(lRootKey, sKeyName, hKey)
RegCloseKey (hKey)
End Sub
Private Sub WriteString(ByVal lRootKey As Long, ByVal sPath As String, ByVal
sValueName As String, sValueData As String)
On Error Resume Next
'write a string of data to the registry
Dim hKey As Long, lResult As Long
lResult = RegOpenKeyEx(lRootKey, sPath, vbNull, KEY_SET_VALUE, hKey)
If lResult = ERROR_SUCCESS Then
sValueData = sValueData & Chr(0)
Call RegSetValueEx(hKey, sValueName, vbNull, REG_SZ, ByVal sValueData,
Len(sValueData))
Call RegCloseKey(hKey)
End If
End Sub
Private Sub cmbCheckUp_Click()
If Len(txtExpansion.Text) = 0 Then MsgBox "Введите расширение файла, который
хотите проверить.", vbExclamation + 0, "Не задано проверяемое расширение":
txtExpansion.SetFocus: Exit Sub
Open "C:\temp." & txtExpansion.Text For Random As FreeFile
'Создается файл с заданым расширением в корневой паке диска С
Close
'Открываем файл, ассоциированную с заданым расширением
ShellExecute Me.hwnd, "open", "C:\temp." & txtExpansion.Text, 0, 0, 1
Check = True
End Sub
Private Sub cmbCreate_Click()
If Len(txtExpansion.Text) = 0 Or Len(txtShortDescription.Text) = 0 Or
Len(txtDescription.Text) = 0 Then MsgBox "Все поля должны быть заполнены!",
vbExclamation + 0, "Ошибка регистрации нового типа файла": Exit Sub
With CommonDialog
.CancelError = False
.Filter = "Программы (*.exe)|*.exe|"
.InitDir = App.Path
.FilterIndex = 1
.InitDir = Environ("windir")
.Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
.FileName = Empty
.DialogTitle = "Выбор программы"
End With
CommonDialog.ShowOpen
If CommonDialog.FileName = vbNullString Then Exit Sub
CreateKey HKEY_CLASSES_ROOT, "." & txtExpansion.Text
WriteString HKEY_CLASSES_ROOT, "." & txtExpansion, "",
txtShortDescription.Text
CreateKey HKEY_CLASSES_ROOT, txtShortDescription.Text & "\DefaultIcon"
CreateKey HKEY_CLASSES_ROOT, txtShortDescription.Text &
"\shell\open\command"
WriteString HKEY_CLASSES_ROOT, txtShortDescription.Text, "",
txtDescription.Text
WriteString HKEY_CLASSES_ROOT, txtShortDescription.Text &
"\shell\open\command", "", CommonDialog.FileName & " %1"
WriteString HKEY_CLASSES_ROOT, txtShortDescription & "\DefaultIcon", "",
CommonDialog.FileName & ",1"
MsgBox "Успешно создан новый тип файла!" + vbNewLine + vbNewLine +
"Расширение файла: " + "." & txtExpansion.Text + vbNewLine + "Описание
файла: " & txtDescription.Text + vbNewLine + "Программа для открытия файла:
" + CommonDialog.FileName, vbInformation + 0, "Регистрация нового типа
файла"
txtExpansion.Text = vbNullString: txtShortDescription = vbNullString:
txtDescription = vbNullString
End Sub
Private Sub Form_Load()
txtExpansion.MaxLength = 3
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Check = True Then MsgBox "Не забудьте удалить временные файлы в корневой
директории диска С.", vbInformation + 0, "Удаление временных файлов
(C:\temp.*)"
End Sub



Нажмите клавишу F5 (предпочтительней Ctrl + F5) и проверьте работу.
В текстовое поле txtExpansion введите создаваемое расширение без точки,
например "mce".
В текстовое поле txtShortDescription введите краткое описание расширения,
например "My Created Expansion"
.
В текстовое поле txtDescription введите описание файла расширение которого
Вы создаете, например "Файл моей новой программы".

Нажмимте кнопку cmbCreate. Откроется диалоговое окно выбора программы для
открытия придуманого Вами расширения. Выберете необходимую программу. Если
все прошло удачно, то программа выдаст оповещающее сообщение.

Для проверки заданого расширения снова введите его в текстовое поле
txtExpansion и нажмите кнопку cmbCheck. Создастся новый временный файл в
директории "С:\temp.*", имеющий указаное Вами расширение и запустится
программа, ассоциируемая с данным расширение. Если Вы введете созданое Вами
расширение, то запустится программа, которую Вы выбрали.
Если Вы проводили проверку, то при окончании работы не забудьте удалить
временные файлы в директории "C:\".
Конечно же теперь следовало бы написать, как удалять расширения, но это уже
другой вопрос. Желаю удачи!


ВНИМАНИЕ! При создании своего расширения, убедитесь, что оно является
уникальным в системе. Мой пример не описывает проверки наличия расширения,
поэтому если заданое Вами расширение уже существует в системе, то оно
заменится на Ваше, что может привести к некоторым неприятностям.

P.S.: При пересылке примера текстовый формат разрывает строки. Проследите
внимательно, чтобы в коде не было разрывов.

Оценка за ответ: 5

Отвечает: Игорь
Для создания ярлыка используется API функция fCreateShellLink, которая
находится в файле Stkit432.dll, поставляемым с Microsoft Visual Basic версии
4.0 for Windows либо в файле Vb5stkit.dll, который поставляется с Visual
Basic 5.0, либо в файле Vb6stkit.dll, который поставляется с Visual Basic
6.0 (лично у меня последний не работает, поэтому буду приводить пример на
Vb5stkit.dll).

Для рассмотрения примера создайте новый проект. Поместите на форму одну
командную кнопку и назовите ее . Подключите к проекту один
компонент - Microsoft Common Dialog Control 6.0 (Comdlg32.ocx), вставите его
на новую форму и назовите .

Далее вставьте в код формы следующий код:

Option Explicit

Private Declare Function fCreateShellLink Lib "Vb5stkit.dll" (ByVal
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long

Dim mPath As String, mName As String

Private Sub cmbShortcut_Click()
On Error Resume Next 'Т.к. мне не известна Ваша операционная система
необходимо пропускать ошибки, которые возникнут:

With CommonDialog
.CancelError = False
.Filter = "Все файлы (*.*)|*.*"
.FilterIndex = 1
.Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
.InitDir = Environ("windir") 'Это означает, что диалоговое
окно всегда будет открываться начиная с папки Windows. Если не устраивает
можно заменить или вообще убрать эту строку
.FileName = Empty
.DialogTitle = "Выбор файла для создания ярлыка"
End With

CommonDialog.ShowOpen
mPath = CommonDialog.FileName
If mPath = vbNullString Then Exit Sub

mName = InputBox("Новому ярлыку будет присвоено имя по умолчанию. Если не
хотите использовать имя ярлыка по умолчанию, то введите новое имя, которое
будет использовано в названии ярлыка." + vbNewLine + vbNewLine + "Например,
Visual Basic.", "Присвоение имени ярлыку", "Ярлык для " &
Replace(CommonDialog.FileTitle, Right(CommonDialog.FileTitle, 4), ""))

If mName = vbNullString Then mName = "Ярлык для " &
Replace(CommonDialog.FileTitle, Right(CommonDialog.FileTitle, 4), "")

Dim lReturn As Long

'Добавление ярлыка на рабочий стол:
lReturn = fCreateShellLink("..\..\Рабочий стол", mName, mPath, "")
'Для Windows 95/98/Me
lReturn = fCreateShellLink("..\..\Desktop\", mName, mPath, "") 'Для
Windows NT

'Добавление ярлыка в меню Программы:
lReturn = fCreateShellLink("", mName, mPath, "") 'Для всех Windows

'Добавление ярлыка в меню автозапуска:
lReturn = fCreateShellLink("\Автозагрузка", mName, mPath, "") 'Для
Windows 95/98/Me
lReturn = fCreateShellLink("\Startup", mName, mPath, "") 'Для
Windows NT

MsgBox "Поздравляю!" + vbNewLine + "Создание нового ярлыка прошло успешно.",
vbInformation + 0, "Создан новый ярлык"

End Sub


Нажмите клавишу F5 (предпочтительней Ctrl + F5) и проверьте работу. При
нажатии на кнопку появится диалоговое окно в котором Вы выберете файл для
которого хотите создать ярлык. После этого откроется InputBox в текстовом
поле которого Вы должны будете ввести новое имя ярлыка, если не хотите
использовать имя по умолчанию. При успешном создании ярлыка появится
извещающее сообщение. Данный пример показывает создание ярлыков на Рабочем
столе, в меню Программы и в папке Автозагрузки. Затем, конечно же, их
необходимо будет удалить, но это уже другой вопрос: Желаю удачи!

P.S.: При пересылке примера текстовый формат разрывает строки. Проследите
внимательно, чтобы в коде не было разрывов.

Оценка за ответ: 5
85/имеется элемент WebBrowser1, как сделать чтобы в нем открывалася web страница находящаяся в одной папке с программой? [Ответить]

Отвечает: Боровик Денис
EnzO)Stalker

Все очень легко. Пишеш где надо WebBrowser1.Navigate "C:\index.htm".

Оценка за ответ: 4
Обучение для новичков

На данный момент раздел приостановлен в связи с переездом на другой домен. Приносим свои извинения.
Задать вопрос>>>

Компоненты, контролы, исходники

M означает, что данный архив содержит только модуль.

Примеры и модули
Ссылка
Описание
Ссылка
Описание
about.zip Стандартное окно About в VB (4.2KB) OpenCD.zip Управление CD (M) (1KB)
anigif.zip Анимация в VB (5KB) progressbar.zip Progress Bar в трее (4KB)
appprioritet.zip Устанавливаем приоритет в приложении (1.8KB) randomform.zip Разные формы (M) (2KB)
biosinfo.zip Просматривает ифрормацию о БИОСе (5.5KB) RandomForms.zip Разные формы (1KB)
cd-rom.zip Работа с CD-ROM (1.6KB) Reestr.zip Работа с реестром (2.5KB)
commondialog.zip Диалог открытия файла без контрола (1.9KB) registry.zip Регистрация в реестре (9.5KB)
coolvbmenu.zip Клевое меню в VB (14KB) resource.zip Просмоторщик ресурсов проги (46.6KB)
disableendtasks.zip Запрет нажатия Ctrl+Alt+Del (1.8KB) RU_EN.zip Переключение языка программно (M) (1KB)
File_size.zip Определяет размер файла (M) (1KB) sharp.zip Пример часиков (2.1KB)
fso.zip Работа с FSO (File System Object) (101KB) ShutDown.zip Шатдаун компьютера (M) (1KB)
HDD_info.zip Информация о диске (M) (1KB) sort.zip Сортировка массива за 0.2 секунды! (M) (1KB)
hddserial.zip Серийный номер диска (24KB) Standart.zip Стандартные диалоги и окна (M) (1KB)
Hibernate.zip Выключение и перезагрузка ПК (M) (1KB) systrayicon.zip Иконка в трее (21KB)
lines2000.zip Пример игры Lines (74KB) transparent.zip Прозрачность окна (M) (1KB)
manifest.zip ХР стиль в аппликухе (2.5KB) Tray_icon2.zip Икнока в трее 2 (M) (1KB)
mdlMain.zip ХР стиль в приложении (M) (1KB) Tray_icon.zip Иконка в трее (M) (1KB)
winwordorfo.zip Проверка орфографии с помощью Word'а (1.9KB)    

Компоненты:

Ссылка
Описание
Ссылка
Описание
Кнопка с текстовым полем Двухцветный прогресс бар
Электронные часы Бегущая строка
Компонент редактирования даты Иконка в трее
Кнопка в стиле XP, Office, и др. TextBox вмещающий более 65КБ текста
Прогресс Бар в классическом стиле Вертикальный лейбл
Кнопка Плейер
Компонент для создания гиперссылок Программное создание иконки NEW!!!

Статья

Есть вопросы относительно статьи, задавайте!

Запуск приложений с задержкой
Вы наверняка сталкивались (а если нет то столкнётесь) с проблемой наподобие следующей. Вы запустили консольное приложение, перенаправив вывод в файл, а при попытке прочесть получили ошибку "Доступ закрыт(Permission Denied)". Легко догадаться, что ошибка возникла из-за того, что консольное приложение не завершило вывод в файл, а Вы уже из него читаете. Возникает вопрос - Что делать? Ответ: Использовать API!
Ниже я приведу код, позволяющий приостановить Вашу программу (точнее поток), до того момента, как вызванная программа закончит свою работу.

Public Function ShellWait(ByVal CommandString As String, Optional ShowCommand As VbAppWinstyle="vbNormalFocus)" As Long
' Необходимые переменные
Dim phnd As Long, pid As Long, StartSec As Long
' Засекаем время
StartSec = Timer
' Выполняем команду
pid = Shell(CommandString, ShowCommand)
' Получаем манипулятор процесса
phnd = OpenProcess(SYNCHRONIZE, 0, pid)
If phnd <> 0 Then
' Вечно ожидаем завершения процесса
Call WaitForSingleObject(phnd, INFINITE)
' Закрываем манипулятор
Call CloseHandle(phnd)
End If
ShellWait = Timer - StartSec ' Возвращаем прошедшее время
End Function

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


Дружественные сайты
http://www.delphi.int.ru - Программирование на DELPHI: Вопросы и Ответы читателей; Статьи по программированию на Delphi, других языках программирования, графике (OpenGL/DirectX); Компоненты, Пакеты, Plug-in'ы, Модули для Delphi; Исходники программ, игр; Документация и ссылки на документацию по программированию; Рассылка, в которой каждый программист найдёт что-то полезное!

http://infomania2004.webhost.ru. Этот сайт создан для того, чтобы вы могли получить интересующую вас информацию с минимальными затратами сил и времени. Если вы не нашли здесь нужной информации, оставьте заявку...">

Все о Динамо - www.DinamoMania.ru На этом сайте вы найдете все новости и интервью ВСЕХ видов спорта Динамо. Также на сайте есть таблицы всех видов спорта. Видео и Фото материалы. И все это на одном сайте - www.DinamoMania.ru Это первый и единственный сайт, который освещает все виды одного клуба.
Юмор

- Почему пить Пепси-Колу вредно?
- Потому что после 20-ой бутылки появляется зеленый чебурашка и начинает отбирать у вас всю еду.

***

Стандартные образцы заполнения анкеты.
Мужская:
"Сергей. 23 года, 230 баксов, 23 см".
Женская:
"Здравствуйте! Меня зовут Ирина. Я увлекаюсь литературой, японской культурой, суши, сашими, Мураками, оригами, татами, салями, степями, полями, кораблями и суммами с тремями и четырьмями нулями..."

:))

Наши партнеры

Рассылки Subscribe.Ru
Visual Basic для новичков и профессионалов
Программирование на Delphi

Хотите стать нашим партнером? Пишите сюда.


Subscribe.Ru
Поддержка подписчиков
Другие рассылки этой тематики
Другие рассылки этого автора
Подписан адрес:
Код этой рассылки: comp.soft.prog.vbforbeginprof
Отписаться
Вспомнить пароль

В избранное