Visual Basic 6.0 - Реестp

H!, _[Terekhin]_!


Сапасибо.

g'bye and g'luck, _[Terekhin]_!
* Origin: S2k - http://www.revengecrew.org (2:5054/29.33)


H!, _[Terekhin]_!


А что вне этого ключа никак не записать?
Т.е. можно как-нить в LOCAL_Machine?

g'bye and g'luck, _[Terekhin]_!
* Origin: Файловый Обменник - [SVALKA.TK] (2:5054/29.33)




Hello, Alexander!
You wrote in conference fido7.ru.visual.basic to "A.Skrobov"

19:37:30 +0400:







=========Beginning of the citation==============
Private Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal
dwProcessId As Long, ByVal dwType As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Sub Main()
RegisterServiceProcess GetCurrentProcessId, 1
End Sub

=========The end of the citation================


With best regards, A. Skrobov. E-mail: tyomitch [@] r66.ru
--
* Origin: Talk.Mail.Ru (2:5020/400)


Пpиветствyю, Alexander

21 Апp 04 вижy толкают yмные вещи Alexander Belinsky и Alexander Abramencov. Дай дyмаю, покомментиpyю:


'В модyле пишем:

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

'Возвpащает значения записанные в ключе
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 a As Integer
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

'Опpеделение pазмеpа и типа считываемых данных
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)


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
'Для остальных не поддеpжанных типов данных
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

В пpимеpе написан полный код pаботы с pеестpом, если необходимо только записать данные, то лишнее можно yбpать.
Пpименение:

Private Sub Command1_Click()
Dim path As String
path = "Software\Microsoft\Windows\CurrentVersion\Run"
CreateNewKey HKEY_LOCAL_MACHINE, path
SetKeyValue HKEY_LOCAL_MACHINE, path, "Hазавание пpогpаммы", "здесь пишешь полный пyть пpогpаммы", REG_SZ
End Sub

Good luck, Alexander...
np: Enya - The Longships
* Origin: Тяжелее побед даются только поpажения. (2:5054/76.44)




Hello, Alexander!
You wrote in conference fido7.ru.visual.basic to "All"

+0400:




==========================================================================

* Newsgroup: fido7.ru.visual.basic

* Date: Sun, 01 Feb 2004 17:19:49 +0300

* To: All
* Subj: Я как-то спрашивал... - fido7.ru.visual.basic
==========================================================================

Приветствую тебя, _All_ !


сабж про inputbox с шифрованием символов, многие ответили что не
возможно, но возможно, берите и пользуйтесь:


Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal
lpsz2 As
String) As Long
Public Declare Function SetTimer& Lib "user32" (ByVal hwnd&, ByVal
nIDEvent&,
ByVal uElapse&, ByVal lpTimerFunc&)
Public Declare Function KillTimer& Lib "user32" (ByVal hwnd&, ByVal
nIDEvent&)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long
Public Const NV_INPUTBOX As Long = &H5000&
Public Const EM_SETPASSWORDCHAR = &HCC
Public Sub TimerProc(ByVal hwnd&, ByVal uMsg&, ByVal idEvent&, ByVal
dwTime&)
Dim myHwnd As Long myHwnd = FindWindowEx(FindWindow("#32770",
App.Title), 0, "Edit", "")
Call SendMessage(myHwnd, EM_SETPASSWORDCHAR, 42, 0)
KillTimer hwnd, idEvent
End Sub




Private Sub Command1_Click()
SetTimer hwnd, NV_INPUTBOX, 10, AddressOf TimerProc xxx =
InputBox("Привет")
End Sub


Hе скучай,_All_. С уважением,Виталий.
==========================================================================


With best regards, A. Skrobov. E-mail: tyomitch [@] r66.ru
--
* Origin: Talk.Mail.Ru (2:5020/400)




Hello, Roman!
You wrote in conference fido7.ru.visual.basic to "A.Skrobov"

21:06:49 +0400:





Значит, что я запустил установку, увидел много-много квадратиков, испугался
и вышел.
Hаверное, с установленными японскими шрифтами это не так страшно.


Hет, конечно. Емнип, его майкрософт раздавала на халяву в рамках продвижения
технологии ActiveX


With best regards, A. Skrobov. E-mail: tyomitch [@] r66.ru
--
* Origin: Talk.Mail.Ru (2:5020/400)




Hello, Dmitry!
You wrote in conference fido7.ru.visual.basic to "Dmitry Viazowkin"

2004 13:11:44 +0000 (UTC):





Расплываюсь в довольной улыбке... Рад был помочь :-)


With best regards, A. Skrobov. E-mail: tyomitch [@] r66.ru
--
* Origin: Talk.Mail.Ru (2:5020/400)




Hi!



Благодабря (с) нашей уважаемой компании, и особенно лично товарища A. Skrobov-а,
нам удалось поднять межпроцессное взаимодействие на новую, ранее недосягаемую
высоту! (с) лозунг


Все удовольствие выглядит как
Public mSh(0 To 0) As tShare ' подстановку указателя удается осуществить только
в массиве...

Private tmpArrPointer As Long ' старый адрес данных массива
private Declare Function ArrPtr Lib "msvbvm60.dll" Alias "VarPtr" (arr() As Any)
As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any,
pSource As Any, ByVal ByteLen As Long)


Private Sub LinkMapArray(ByVal pMem As Long)' на входе, после получения
указателя
Dim aptr As Long
CopyMemory aptr, ByVal ArrPtr(mSh()), 4 ' переписываем адрес ссылки на
массив
CopyMemory tmpArrPointer, ByVal (aptr + 12), 4 ' запоминаем старый указатель
CopyMemory ByVal (aptr + 12), hM, 4 ' исправляем указатель данных на маппинг
DbgBox "hMap=" & hMap & " &mSh(0)=" & VarPtr(mSh(0)) & " & mSh(0).sz=" &
VarPtr(mSh(0).sz)
End Sub

Private Sub RestoreMapArray()' перед выходом
Dim aptr As Long
CopyMemory aptr, ByVal ArrPtr(mSh()), 4 ' переписываем адрес ссылки на
массив
CopyMemory ByVal (aptr + 12), tmpArrPointer, 4 ' восстанавливаем старый
указатель
End Sub
А ведь два года вопрос висел...


--
With best regards
Dmitry Viazowkin


* Origin: Me? Organized??? (2:5020/400)




Доброго времени суток Alexander!
Thu, 22 Apr 2004 19:55:17 +0400 Вы писали to Terekhin Alexandr



[cut]



SaveSetting работает только внутри злосчастно ключа,
кстаи, там удобно держать всякие мелочи ;)

А вот CreateObject("WScript.Shell")
пишет куда душе угодно ;)

P.S. Если интересно повозиться с API и сделать модуль класса,
посмотри здесь:
http://www.codenet.ru/progr/vbasic/registry.php
_____________________________________________________
Истина где-то рядом... Terekhin Alexandr. E-mail: didinst [@] rol.ru

* Origin: Алт (2:5020/400)




Доброго времени суток Alexander!
Thu, 22 Apr 2004 09:10:47 +0400 Вы писали to All




Есть решение для TextBox:
В свойствах установи PasswordChar = "*"
Dim pswd As String
Private Sub Text1_KeyPress(KeyAscii As Integer)
pswd = pswd + Chr(KeyAscii)
KeyAscii = Asc("*")
End Sub

Получаешь пароль в переменную pswd,
По-моему такую штуку взломщики не берут...
_____________________________________________________
Истина где-то рядом... Terekhin Alexandr. E-mail: didinst [@] rol.ru


* Origin: Алт (2:5020/400)