FAQ Конференции VBStreets (FAQ)

Источник: FAQ выпуск 1

Николай Белоусов

2. A. Skrobov - ФУНКЦИИ, ЭКСПОРТИРУЕМЫЕ ИЗ MSVBVM60

Известно, что рантайм-библиотека ВБ6 экспортирует около тысячи функций. Некоторые из них могут пригодиться нам в наших программах. Вот те из них, смысл которых я смог выяснить:

'1. Функции передачи данных.

Private Declare Sub CopyBytes Lib "MSVBVM60.DLL" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any) 'Аналогично RtlMoveMemory, но только для неперекрывающихся блоков Private Declare Sub CopyBytesZero Lib "MSVBVM60.DLL" Alias "__vbaCopyBytesZero" (ByVal Size As Long, Dest As Any, Source As Any) 'То же, причём после копирования обнуляются Size байт источника

Private Declare Function GetLong Lib "MSVBVM60.DLL" Alias "VarPtr" (ByVal Value As Long) As Long 'Возвращает переданное значение (полезно для тайпкастов)

Private Declare Sub CopyByte Lib "MSVBVM60.DLL" Alias "GetMem1" (ByVal Source As Long, Dest As Byte) Private Declare Sub CopyInteger Lib "MSVBVM60.DLL" Alias "GetMem2" (ByVal Source As Long, Dest As Integer) Private Declare Sub CopyLong Lib "MSVBVM60.DLL" Alias "GetMem4" (ByVal Source As Long, Dest As Long) Private Declare Sub CopyCurrency Lib "MSVBVM60.DLL" Alias "GetMem8" (ByVal Source As Long, Dest As Currency) 'Работают как PEEK: передают значение из памяти в переменную Private Declare Sub CopyObject Lib "MSVBVM60.DLL" Alias "GetMemObj" (ByVal Source As Long, Dest As Object) 'То же, причём корректно работает со счётчиками ссылок объектов Private Declare Sub CopyString Lib "MSVBVM60.DLL" Alias "GetMemStr" (ByVal Source As Long, Dest As String) 'То же, причём корректно освобождает/выделяет память Private Declare Sub CopyVariant Lib "MSVBVM60.DLL" Alias "GetMemVar" (ByVal Source As Long, Dest As Variant) 'Объединение двух предудущих вариантов

Private Declare Sub StoreByte Lib "MSVBVM60.DLL" Alias "PutMem1" (ByVal Dest As Long, ByVal Value As Byte) Private Declare Sub StoreInteger Lib "MSVBVM60.DLL" Alias "PutMem2" (ByVal Dest As Long, ByVal Value As Integer) Private Declare Sub StoreLong Lib "MSVBVM60.DLL" Alias "PutMem4" (ByVal Dest As Long, ByVal Value As Long) Private Declare Sub StoreCurrency Lib "MSVBVM60.DLL" Alias "PutMem8" (ByVal Dest As Long, ByVal Value As Currency) 'Работают как POKE: передают значение в память Private Declare Sub StoreObject Lib "MSVBVM60.DLL" Alias "SetMemObj" (ByVal Dest As Long, ByVal Value As Object) Private Declare Sub StoreVariantObject Lib "MSVBVM60.DLL" Alias "SetMemVar" (ByVal Dest As Long, ByVal Value As Variant) 'То же, причём корректно работают со счётчиками ссылок объектов Private Declare Sub StoreString Lib "MSVBVM60.DLL" Alias "PutMemStr" (ByVal Dest As Long, ByVal lpOleStr As Long) Private Declare Sub StoreVariantNotObject Lib "MSVBVM60.DLL" Alias "PutMemVar" (ByVal Dest As Long, ByVal Value As Variant) 'То же, причём корректно освобождают/выделяют память

'2. Функции работы с SAFEARRAY-ями.

Private Declare Sub ArrayRebase1 Lib "MSVBVM60.DLL" Alias "__vbaAryRebase1Var" (Ary As Variant) 'Изменяет нижнюю границу массива на 1 'Аналогично ReDim Preserve Ary(1 To UBound(Ary) - LBound(Ary) + 1), но быстрее

Private Declare Function AryPtr Lib "MSVBVM60.DLL" Alias "VarPtr" (Ary() As
Long) As Long
'Возвращает указатель на lpSAFEARRAY
'Пример использования:
'Dim v(), lpSAFEARRAY As Long
' v() = Array("First", "Second", "Last")
' CopyLong AryPtr(v()), lpSAFEARRAY

Private Declare Function ArrayAddress Lib "MSVBVM60.DLL" Alias "__vbaRefVarAry" (Ary As Variant) As Long 'Возвращает указатель на lpSAFEARRAY 'Пример использования: 'Dim v, lpSAFEARRAY As Long
' v = Array("First", "Second", "Last")
' CopyLong ArrayAddress(v), lpSAFEARRAY

Private Declare Function ElementAddress Lib "MSVBVM60.DLL" Alias "__vbaDerefAry1" (ByVal lpsaAry As Long, ByVal Index0 As Long) As Long 'Возвращает адрес элемента SAFEARRAY-я (элементы индексируются с 0) 'Пример использования:
' Debug.Print ElementAddress(lpSAFEARRAY, 0)

Private Declare Function vbaLBound Lib "MSVBVM60.DLL" Alias "__vbaLbound" (ByVal Dimension As Integer, ByVal lpsaAry As Long) As Long Private Declare Function vbaUBound Lib "MSVBVM60.DLL" Alias "__vbaUbound" (ByVal Dimension As Integer, ByVal lpsaAry As Long) As Long 'Возвращают нижнюю и верхнюю границы любого измерения SAFEARRAY-я 'Пример использования:
' Debug.Print vbaLBound(1, lpSAFEARRAY)
' Debug.Print vbaUBound(1, lpSAFEARRAY)

'3. Другие функции.

Private Declare Function HalfPrevDWord Lib "MSVBVM60.DLL" Alias "__vbaLenBstr" (ByVal Address As Long) As Long 'Возвращает половину двойного слова [Address - 4] (может, кому-то
пригодится)

Private Declare Sub AddRef Lib "MSVBVM60.DLL" Alias "__vbaObjAddref" (ByVal Obj As Object) 'Увеличивает счётчик ссылок объекта

P.S. На диске с ВБ6 лежит файл MSVBVM60.DBG. Какую пользу можно извлечь из его наличия? P.P.S Кто-нибудь знает, что делает функция Zombie_Release? Уж больно название красивое.

наверх

3. Гревцов Юрий. Забудте про GetWindowsDirectory и ещё кое что.

В БЕЙСИКе есть одна ОЧЕНЬ полезная, но многими забытая функция Environ! Она возвращает имена и содержание всех переменных среды операционной системы!!! Так, например, чтобы получить директорию Windows, совсем не надо прибегать к API-функции GetWindowsDirectory!!!!!! А получить её можно так:
ABC = Environ ("windir")
И ВСЁ!
Но и это ещё не всё! Также можно получить следующие переменные:
ABC = Environ ("TMP") 'директория временных файлов TEMP
ABC = Environ ("BLASTER") 'координаты звуковой карты
ABC = Environ ("PATH") 'пути, объявленные в autoexec.bat
НО И ЭТО ВСЁ ЕЩЁ НЕ ВСЁ!!!!
Чтобы получить имя и значение переменной, в скобках вместо строки надо поставить номер переменной (или индекс?).
Вставьте следуюшую процедуру в окно Code, запустите проект, кликните на форме увидите список всех переменных и их значений!
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-функции (по-моему их вообще мало, кто долюбливает :-)) могут пользоваться только этой строчкой!

наверх

4. Как работать с Реестром (Registry)?

Visual Basic имеет встроенные операторы и функции для работы с Системным Реестром (в дальнешем - реестр), он позволяет записывать, считывать и удалять данные только в разделе ключа HKEY_CURRENT_USER Software VB and VBA Program Setting.

Операторы:

Оператор SaveSetting - позволяет производить запись запись данных (автоматически создает подключи).

Синтаксис:

SaveSetting VBKeyName, Section, Key, Setting

Где:

SaveSetting имя самого оператора:

VBKeyName строковое значение, которое является именем внутреннего
подраздела VB and VBA Program Setting (иными словами,
создаваемая Вами главная папка);

Section строковое значение, которое является именем внутреннего
подраздела VBKeyName (иными словами, создаваемая Вами
папка находящаяся в Вашей главной папке. Таких Section -
папок у Вас может быть несколько.);

Key строковое значение, которое является именем параметра в
созданном, внутреннем подразделе Section (иными словами,
имя данных в созданной Вами Section - папке. Таких Key -

параметров у Вас может буть несколько.);

Setting строковое значение, которое Вы хотите присвоить созданному
Вами параметру;

Оператор DeleteSetting - позволяет удалять параметры и внутренние подразделы.

Синтаксис:

DeleteSetting VBKeyName, Section, Key

Где:

DeleteSetting имя самого оператора

VBKeyName строковое значение, которое является именем внутреннего
подраздела VB and VBA Program Setting (иными словами,
созданная Вами главная папка);

Section строковое значение, которое является именем внутреннего
подраздела VBKeyName (иными словами, одна из созданных
Вами папок находящихся в Вашей главной папке.);

Key строковое значение, которое является именем параметра в
удаляемом, внутреннем подразделе Section (иными словами,
имя удаляемых данных);

Если Вы захотите удалить сразу весь подраздел, а не некоторые параметры, то для этого используйте следующий синтаксис оператора DeleteSetting :

DeleteSetting VBKeyName, Section

Или, если Вы захотите удалить целиком созданный Вами внутренний подраздел VB and VBA Program Setting используйте следующий синтаксис оператора DeleteSetting :

DeleteSetting VBKeyName

Внимание!!! Пользуйтесь оператором DeleteSetting очень осторожно!

Функции

Функция GetSetting() - позволяет получить значения определенного параметра.

Синтаксис

MySet = GetSetting ( VBKeyName, Section, Key [, Default ] )

Где:

MySet строка для хранения возвращаемого функцией GetSetting значения;

GetSetting имя самой функции;

VBKeyName строковое значение, которое является именем внутреннего подраздела
VB and VBA Program Setting (иными словами, созданная Вами
главная папка);

Section строковое значение, которое является именем внутреннего подраздела
VBKeyName (иными словами, имя папки находящаяся в Вашей
главной папке.);

Key строковое значение, которое является именем параметра в созданном,
внутреннем подразделе Section (иными словами, имя данных
в Section - папке.);

Setting строковое значение, которое Вы хотите считать из данного параметра;

[ Default ] необязательный аргумент, представляющий строковое значение,
которое будет возвращено функцией в случае ошибки
(если такого параметра нет);

Функциа GetAllSettings() - позволяет получить массив значений из определенного подраздела.

Синтаксис:

MySet = GetAllSettings ( VBKeyName, Section)

Где:

MySet строка для хранения возвращаемого функцией GetAllSettings
значения;

GetAllSettings имя самой функции;

VBKeyName строковое значение, которое является именем внутреннего
подраздела VB and VBA Program Setting (иными словами,
созданная Вами главная папка);

Section строковое значение, которое является именем внутреннего
подраздела VBKeyName (иными словами, имя папки
находящаяся в Вашей главной папке.);

Обработать массив значений и получить информацию в удобном виде можно следующим образом:

Dim intSettings As Integer

MySet = GetAllSettings(App.Title, "PortSettings")

For intSettings = LBound(MySet, 1) To UBound(MySet, 1)

Debug.Print MySet(intSettings, 0), MySet(intSettings, 1)

Next intSettings

End Sub

Чтение/Запись данных в системный реестр (API):

Объявите все константы и API-функции в отдельном модуле. Там же создайте функцию по созданию ключа, функцию записи в него данных, функцию считывания данных , функцию удаления данных из ключа и функцию удаления самого ключа.

Option Explicit

Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4

Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_USERS = &H80000003

Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8

Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259

Public Const KEY_ALL_ACCESS = &H3F

Public Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

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

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

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long
, lpcbData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

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

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

Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)

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

Создание нового ключа (подключа)

Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)

Dim hNewKey As Long
Dim lRetVal As Long

lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)

RegCloseKey (hNewKey)

End Function

Запись данных в ключ

Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

Dim lRetVal As Long

Dim hKey As Long

lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

RegCloseKey (hKey)

End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

Dim lValue As Long
Dim sValue As String

Select Case lType

Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))

Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)

End Select

End Function

Возвращает значения записанные в ключе

Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant

lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)

QueryValue = vValue
RegCloseKey (hKey)

End Function

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

'Определение размера и типа считываемых данных

lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)

If lrc <> ERROR_NONE Then MsgBox "Данных (ключа) не существует!", vbExclamation, Form1.Caption

Select Case lType

'Для символьных
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then

vValue = Left$(sValue, cch)

Else
vValue = Empty

End If

'Для числовых
Case REG_DWORD:

lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)

If lrc = ERROR_NONE Then vValue = lValue

'Для остальных не поддержанных типов данных
Case Else
lrc = -1

End Select

QueryValueExExit:
QueryValueEx = lrc
Exit Function

QueryValueExError:

Resume QueryValueExExit

End Function

Удаление значений ключа

Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

Dim lRetVal As Long
Dim hKey As Long

lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)

RegCloseKey (hKey)

End Function

Удаление ключа

Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)

Dim lRetVal As Long

lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)

End Function

Вызов функций из модуля осуществляется следующим образом:

Создание ключа

CreateNewKey HKEY_LOCAL_MACHINE, "VB6"

'Можно создать и подключи
'CreateNewKey HKEY_LOCAL_MACHINE, "VB6RegistryKey"

Запись данных в ключ

SetKeyValue HKEY_LOCAL_MACHINE, "VB6", "Program", "Ваши данные", REG_SZ

Считывание данных

Dim Variable As Variant

Variable = QueryValue(HKEY_LOCAL_MACHINE, "VB6", "Program")

Удаление данных из ключа

DeleteValue HKEY_LOCAL_MACHINE, "VB6", "Program"

Удаление ключа

DeleteKey HKEY_LOCAL_MACHINE, "VB6"

Внимание! Соблюдайте осторожность, что бы не удалить главный ключ реестра Windows.

наверх

5. Как отобразить Help (*.chm)

При начальной инициализации приложения указываем файл справки:

App.HelpFile = App.Path & "MyHelp.chm"

В основной форме своей программы добавляем:

'Help Support Declarations

Private Declare Function HtmlHelp Lib "hhctrl.ocx" _
Alias "HtmlHelpA" (ByVal hwndCaller As Long, _
ByVal pszFile As String, ByVal uCommand As Long, _
ByVal dwData As Long) As Long

Private Const HH_HELP_CONTEXT = &HF
Private Const HH_DISPLAY_INDEX = &H2
Private Const HH_DISPLAY_TOC = &H1
Private Const HH_CLOSE_ALL = &H12

' Help support

Private Sub cmdHelpContents_Click() ' Обработка пункта меню Help/Contents
HtmlHelp Me.hWnd, App.HelpFile, HH_DISPLAY_TOC, 0
End Sub

Private Sub cmdHelpIndex_Click() ' Обработка пункта меню Help/Index
HtmlHelp Me.hWnd, App.HelpFile, HH_DISPLAY_INDEX, 0
End Sub

Public Sub HelpContext(ID As Long)
If ID = 0 Then
MsgBox "No help is available for this item.", vbInformation
Else
HtmlHelp Me.hWnd, App.HelpFile, HH_HELP_CONTEXT, ID
End If
End Sub

После этого всю обработку клавиш F1 и кнопок Help перенаправляем в HelpContext
с соответствующим HelpContextID. Этот ID назначаем свой для каждого из диалогов
и важных контролов.

наверх

6. Как добавить иконки в меню

Создайте новый проект с формой и кнопкой на ней. Добавьте picturebox (установите Autosize=True) с картинкой bmp (не иконкой ico!), размер картинки должен быть 13х13. Скопируйте в проект код примера.

Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Public Const MF_BITMAP = &H4&

Type MENUITEMINFO

cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long

End Type

Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean

Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&

Private Sub Command1_Click()

'Get the menuhandle of your app
hMenu& = GetMenu(Form1.hwnd)

'Get the handle of the first submenu (Hello)
hSubMenu& = GetSubMenu(hMenu&, 0)

'Get the menuId of the first entry (Bitmap)
hID& = GetMenuItemID(hSubMenu&, 0)

'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture

End Sub

Еще. На http://vbaccelerator.com см. cPopMenu.ocx

наверх

7. Как из программы узнать путь, откуда она запущена

App.Path вам поможет.

Тем не менее, тут есть одна особенность - если мы запускаем программу из c:\temp\my_program, то App.Path вернет "c:\temp\my_program" (без слеша в конце), а если запускаем просто с диска (скажем, d:\), то в App.Path будет слеш в конце - "d:\".

Т.е. нужно еще анализировать наличие слеша в конце.

наверх

8. Как открыть файл в свзянанном с ним приложении

Расположи на форме textbox и button. Путь, естественно, пиши в texbox'е.

Option Explicit
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

Const SW_SHOWNORMAL = 1

Private Sub Command1_Click()
Call ShellExecute(0, "open", text1.text, "", "", SW_SHOWNORMAL)
End Sub

наверх

9. FTP Commands

CD file1 Change Directory. Changes to the directory specified in file1. Execute , "CD docsmydocs" CDUP Change to Parent. Same as "CD .." Execute , "CDUP" DELETE file1 Deletes the file specified in file1. Execute , "DELETE discard.txt" DIR [ file1 ] Searches the directory specified in file1. If file1 isn't supplied, the current working directory is searched. Use the GetChunk method to return the data. Execute , "DIR /mydocs" GET file1 file2 Retrieves the remote file specified in file1, and creates a new local file specified in file2. Execute , _
"GET getme.txt C:gotme.txt"

MKDIR file1 Creates a directory as specified in file1. Success is dependent on user privileges on the remote host. Execute , "MKDIR /myDir" PUT file1 file2 Copies a local file specified in file1 to the remote host specified in file2. Execute , _
"PUT C:putme.txt /putme.txt"

PWD Print Working Directory. Returns the current directory name. Use the GetChunk method to return the data. Execute , "PWD" QUIT Terminate current connection Execute , "QUIT" RECV file1 file2 Same as GET. Execute , _
"RECV getme.txt C:gotme.txt"

RENAME file1 file2 Renames a file. Success is dependent on user privileges on the remote host. Execute ,
"RENAME old.txt new.txt"

RMDIR file1 Remove directory. Success is dependent on user privileges on the remote host. Execute , "RMDIR oldDir" SEND file1 Copies a file to the FTP site. (same as PUT.) Execute , _
"SEND C:putme.txt /putme.txt"

SIZE file1 Returns the size of the file specified in file1. Execute

наверх

10. Как проигрывать .gif - анимацию

Лежит на VBstreets:
http://vbsdown.aic.ru/vb/ocx/animgif.zip

наверх

11. Как найти имя .exe файла по hWnd окна

Option Explicit

Const TH32CS_SNAPPROCESS As Long = 2&
Const MAX_PATH As Long = 260

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwflags As Long
szexeFile As String * MAX_PATH
End Type

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlgas As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

Public Function GetExeFromHandle(hwnd As Long) As String Dim threadID As Long, processID As Long, hSnapshot As Long
Dim uProcess As PROCESSENTRY32, rProcessFound As Long
Dim i As Integer, szExename As String

threadID = GetWindowThreadProcessId(hwnd, processID)

If threadID = 0 Or processID = 0 Then Exit Function

hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

If hSnapshot = -1 Then Exit Function

uProcess.dwSize = Len(uProcess)

rProcessFound = ProcessFirst(hSnapshot, uProcess)

Do While rProcessFound
If uProcess.th32ProcessID = processID Then
i = InStr(1, uProcess.szexeFile, Chr(0))
If i > 0 Then szExename = Left$(uProcess.szexeFile, i - 1)
Exit Do
Else
rProcessFound = ProcessNext(hSnapshot, uProcess)
End If
Loop Call CloseHandle(hSnapshot)
GetExeFromHandle = szExename

End Function

наверх

12. Как отобразить список всех запущенных программ

(для работы примера надо поместить на форму кнопку и список)

Const TH32CS_SNAPPROCESS As Long = 2&
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

Private Sub Command1_Click()
List1.Clear
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Long
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapShot = 0 Then
Exit Sub
End If
uProcess.dwSize = Len(uProcess)
r = ProcessFirst(hSnapShot, uProcess)
Do While r
List1.AddItem uProcess.szExeFile
r = ProcessNext(hSnapShot, uProcess)
Loop
Call CloseHandle(hSnapShot)
End Sub

наверх

13. Как скачать файл из Internet не используя Winsock

Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Call URLDownloadToFile(0, " http://www.vbstreets.ru/default.asp, "c:file.asp", 0, 0)

наверх

14. Как установить горячие клавиши для вызова программ

Скопируйте следующий код и запустите программу
Затем запустите любое приложение, или сделайте, чтобы ваша программу стала неактивной
Нажмите клавишы Alt + z (горячая клавиши в этом примере) и вы увидите снова вашу программу
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_SETHOTKEY = &H32
Private Const WM_SHOWWINDOW = &H18
Private Const HK_SHIFTA = &H141 'Shift + A
Private Const HK_SHIFTB = &H142 'Shift + B
Private Const HK_CONTROLA = &H241 'Control + A
Private Const HK_ALTZ = &H45A
Private Sub Form_Load()
'Позволить узнать windows какая горячая клавиша в вашем приложении
erg& = SendMessage(Me.hwnd, WM_SETHOTKEY, HK_ALTZ, 0)
If erg& <> 1 Then MsgBox "You need another hotkey", vbOKOnly, "Error"
'Сказать windows что делать при нажатии на hotkey
'в данном случае - показать окно программы
erg& = DefWindowProc(Me.hwnd, WM_SHOWWINDOW, 0, 0)
End Sub

наверх

15. Как определить полную позицию курсора в TextBox

Private Function CursorPosition(Text As TextBox, Param As Byte) '********************************************************
'Если param=0 - функция возвращает позицию курсора в строке
'Если param=1 - функция возвращает номер строки, в которой находится курсор
'******************************************************** Dim i As Integer 'переменная для цикла
Dim j As Integer 'счётчик строк
Dim Cursor As Integer 'относительная позиция курсора Cursor = Text.SelStart + Text1.SelLength

For i = 1 To Cursor
If Mid(Text, i, 1) = Chr(13) Then j = j + 1
Next i If Param = 0 Then
CursorPosition = Cursor - InStrRev(Mid(Text, 1, Cursor), Chr(13))
If j = 0 Then CursorPosition = CursorPosition + 1
Else
CursorPosition = j + 1
End If

End Function

наверх

16. Как отправить данные на севрер по методам GET/POST

Надо добавь WinSock Control и кнопку. В код формы вставить:

Winsock1.Protocol = sckTCPProtocol 'Установка протокола
Winsock1.Connect "имя_сервера", 80 'подключение через порт 80
While Not Winsock1.State = 7 'Ждем, пока подключится.
DoEvents '
Wend '

Parametrs="параметр1=значение&параметр2=значение" 'сохраняем параметры в 'переменной

Далее все зависит от того, каким методом передавать. Если через метод POST, то:

Winsock1.SendData "POST /адрес_скрипта HTTP/1.1" & vbCrLf
Winsock1.SendData "Content-Type: application/x-www-form-urlencoded" & vbCrLf
Winsock1.SendData "Host: имя_сервера" & vbCrLf
Winsock1.SendData "Content-Length: " & len(Parametrs) & vbCrLf & vbCrLf
Winsock1.SendData Parametrs & vbCrLf

Если через метод GET, то:

Winsock1.SendData "GET /адрес_скрипта?" & Parametrs & " HTTP/1.0" & vbCrLf & vbCrLf

Далее сервер запустит скрипт и передаст данные, еоторые выдаст скрипт, т.е страницу, которая появилась бы в браузере. Если надо принять эти данные, то добавь еще это:

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
Winsock1.GetData Data
End Sub

В переменной Data будут только что принятые данные, сохрани их где-нибудь (например в другой переменной), можешь делать с ними, что захочешь. Сначала сервер выдаст ответ типа:

HTTP/1.1 200 OK
Server: Microsoft-IIS/5.0
Date: Fri, 22 Feb 2002 11:12:20 GMT
Connection: Keep-Alive
Content-Length: 8
Content-Type: text/html
Set-Cookie: ASPSESSIONIDQGQQQLBQ=DFPBBDBDJOGMHODFDFALACNK; path=/
Cache-control: private

После того, как параметры закончатся, будет пустая строка, а потом страница.
Количество символов указано в параметре Content-Length.

наверх

17. Какие инсталляторы использовать

CreateInstall (2000), Setup Generator , Setup Generator Pro
http://www.gentee.com

Инсталляторы написаны на VC и размер добавляемой части - 30 Кб. Есть несколько инсталляторов, включая бесплатный Setup Generator.

InnoSetup
http://www.jrsoftware.org

Написан на Delphi. Размер добавляемой части - 300 Кб. Бесплатный, с исходниками. Неплохой интерфейс создаваемых инсталляций.

NullSoft Installation System ( http://www.winamp.com ) бесплатная с исходниками на VC++. Добавляет совсем мало, все зависит от ваших настроек и размеров картинок.

Wise Installer и производные от него.

Приемущества, мощный, но легкий в настройках, VB образный скрипт,
Возможность инсталирования от шрифтов до DSN.
Инсталирование ADO, и других Runtime библиотек.

Одно погано, платный он. Но в инете полно лекарства.

Delphi. Kylix Delphi for Linux. Перехватчики событий, сигналы и слоты..

Cмешение цветов с помощью Delphi.

Бесконечные генераторы значений на Delphi + Ассемблер.

Как научить программу общаться.

Аналитика: Рынок средств разработки в 2006 году.

Главная » Delphi