home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / An_Interne213918132009.psc / Client / BanUser.bas next >
BASIC Source File  |  2004-03-15  |  8KB  |  251 lines
  1. Attribute VB_Name = "BanUser"
  2. Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
  3. Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  4. Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
  5. Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
  6.     Public Const RSP_SIMPLE_SERVICE = 1
  7.     Public Const RSP_UNREGISTER_SERVICE = 0
  8.  
  9. Public Type SECURITY_ATTRIBUTES
  10. nLength As Long
  11. lpSecurityDescriptor As Long
  12. bInheritHandle As Long
  13. End Type
  14.  
  15. Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
  16. (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
  17. ByVal samDesired As Long, phkResult As Long) As Long
  18. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  19. Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
  20. (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As _
  21. Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  22. Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal _
  23. hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal _
  24. dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
  25. Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  26. (ByVal hKey As Long, ByVal lpValueName As String) As Long
  27. Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
  28. (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
  29. ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  30. lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
  31. lpdwDisposition As Long) As Long
  32. Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  33. (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  34. Public Enum T_KeyClasses
  35. HKEY_CLASSES_ROOT = &H80000000
  36. HKEY_CURRENT_CONFIG = &H80000005
  37. HKEY_CURRENT_USER = &H80000001
  38. HKEY_LOCAL_MACHINE = &H80000002
  39. HKEY_USERS = &H80000003
  40. End Enum
  41.  
  42.  
  43. Private Const SYNCHRONIZE = &H100000
  44. Private Const STANDARD_RIGHTS_ALL = &H1F0000
  45. Private Const KEY_QUERY_VALUE = &H1
  46. Private Const KEY_SET_VALUE = &H2
  47. Private Const KEY_CREATE_LINK = &H20
  48. Private Const KEY_CREATE_SUB_KEY = &H4
  49. Private Const KEY_ENUMERATE_SUB_KEYS = &H8
  50. Private Const KEY_EVENT = &H1
  51. Private Const KEY_NOTIFY = &H10
  52. Private Const READ_CONTROL = &H20000
  53. Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
  54. Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
  55. Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
  56. KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
  57. Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) _
  58. And (Not SYNCHRONIZE))
  59. Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
  60. KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
  61. And (Not SYNCHRONIZE))
  62. Private Const KEY_EXECUTE = (KEY_READ)
  63. Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
  64. KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
  65. Private Const REG_BINARY = 3
  66. Private Const REG_CREATED_NEW_KEY = &H1
  67. Private Const REG_DWORD = 4
  68. Private Const REG_DWORD_BIG_ENDIAN = 5
  69. Private Const REG_DWORD_LITTLE_ENDIAN = 4
  70. Private Const REG_EXPAND_SZ = 2
  71. Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
  72. Private Const REG_LINK = 6
  73. Private Const REG_MULTI_SZ = 7
  74. Private Const REG_NONE = 0
  75. Private Const REG_SZ = 1
  76. Private Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
  77. Private Const REG_NOTIFY_CHANGE_LAST_SET = &H4
  78. Private Const REG_NOTIFY_CHANGE_NAME = &H1
  79. Private Const REG_NOTIFY_CHANGE_SECURITY = &H8
  80. Private Const REG_OPTION_BACKUP_RESTORE = 4
  81. Private Const REG_OPTION_CREATE_LINK = 2
  82. Private Const REG_OPTION_NON_VOLATILE = 0
  83. Private Const REG_OPTION_RESERVED = 0
  84. Private Const REG_OPTION_VOLATILE = 1
  85. Private Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME _
  86. Or REG_NOTIFY_CHANGE_ATTRIBUTES Or _
  87. REG_NOTIFY_CHANGE_LAST_SET Or _
  88. REG_NOTIFY_CHANGE_SECURITY)
  89. Private Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or _
  90. REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or _
  91. REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
  92.  
  93. Public Sub DeleteRegistryKey(rClass As T_KeyClasses, Path As String)
  94.     Dim res As Long
  95.     
  96.     res = RegDeleteKey(rClass, Path)
  97. End Sub
  98.  
  99. Public Sub DeleteValue(rClass As T_KeyClasses, Path As String, sKey As String)
  100.     Dim hKey As Long
  101.     Dim res As Long
  102.     
  103.     res = RegOpenKeyEx(rClass, Path, 0, KEY_ALL_ACCESS, hKey)
  104.     res = RegDeleteValue(hKey, sKey)
  105.     RegCloseKey hKey
  106. End Sub
  107.  
  108. Public Sub CreateRegistryKey(rClass As T_KeyClasses, Path As String)
  109.     Dim hKey As Long
  110.     Dim res As Long
  111.     Dim y As SECURITY_ATTRIBUTES
  112.     Dim Operation As Long
  113.     
  114.     res = RegCreateKeyEx(rClass, Path, 0, "", 0, KEY_ALL_ACCESS, y, hKey, Operation)
  115.     RegCloseKey hKey
  116. End Sub
  117.  
  118. Public Function GetRegValue(KeyRoot As T_KeyClasses, Path As String, _
  119.             sKey As String) As String
  120.     Dim hKey As Long
  121.     Dim KeyValType As Long
  122.     Dim KeyValSize As Long
  123.     Dim KeyVal As String
  124.     Dim tmpVal As String
  125.     Dim res As Long
  126.     Dim i As Integer
  127.     
  128.     res = RegOpenKeyEx(KeyRoot, Path, 0, KEY_ALL_ACCESS, hKey)
  129.     
  130.     If res <> 0 Then GoTo Errore
  131.     
  132.     tmpVal = String(1024, 0)
  133.     KeyValSize = 1024
  134.     res = RegQueryValueEx(hKey, sKey, 0, KeyValType, tmpVal, KeyValSize)
  135.     
  136.     If res <> 0 Then GoTo Errore
  137.     
  138.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
  139.         tmpVal = Left(tmpVal, KeyValSize - 1)
  140.     Else
  141.         tmpVal = Left(tmpVal, KeyValSize)
  142.     End If
  143.     
  144.     Select Case KeyValType
  145.     Case REG_SZ
  146.         KeyVal = tmpVal
  147.     Case REG_DWORD
  148.         For i = Len(tmpVal) To 1 Step -1
  149.         KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
  150.     Next
  151.         KeyVal = Format("&h" + KeyVal)
  152.     End Select
  153.     
  154.     GetRegValue = KeyVal
  155.     RegCloseKey hKey
  156.     
  157.     Exit Function
  158.     
  159. Errore:
  160.     GetRegValue = ""
  161.     RegCloseKey hKey
  162. End Function
  163.  
  164. Public Function SetRegValue(KeyRoot As T_KeyClasses, Path As String, sKey As _
  165.             String, NewValue As String) As Boolean
  166.     Dim hKey As Long
  167.     Dim KeyValType As Long
  168.     Dim KeyValSize As Long
  169.     Dim KeyVal As String
  170.     Dim tmpVal As String
  171.     Dim res As Long
  172.     Dim i As Integer
  173.     Dim x As Long
  174.     
  175.     res = RegOpenKeyEx(KeyRoot, Path, 0, KEY_ALL_ACCESS, hKey)
  176.     
  177.     If res <> 0 Then GoTo Errore
  178.     
  179.     tmpVal = String(1024, 0)
  180.     KeyValSize = 1024
  181.     res = RegQueryValueEx(hKey, sKey, 0, KeyValType, tmpVal, KeyValSize)
  182.     
  183.     Select Case res
  184.     Case 2
  185.         KeyValType = REG_SZ
  186.     Case Is <> 0
  187.         GoTo Errore
  188.     End Select
  189.     
  190.     Select Case KeyValType
  191.     Case REG_SZ
  192.         tmpVal = NewValue
  193.     Case REG_DWORD
  194.         x = Val(NewValue)
  195.         tmpVal = ""
  196.         For i = 0 To 3
  197.             tmpVal = tmpVal & Chr(x Mod 256)
  198.             x = x \ 256
  199.         Next
  200.     End Select
  201.     
  202.     KeyValSize = Len(tmpVal)
  203.     res = RegSetValueEx(hKey, sKey, 0, KeyValType, tmpVal, KeyValSize)
  204.     
  205.     If res <> 0 Then GoTo Errore
  206.     
  207.     SetRegValue = True
  208.     RegCloseKey hKey
  209.     
  210.     Exit Function
  211.     
  212. Errore:
  213.     SetRegValue = False
  214.     RegCloseKey hKey
  215. End Function
  216.  
  217.  
  218. Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
  219.     Static WindowText As String
  220.     Static nRet As Long
  221.     WindowText = Space$(256)
  222.     nRet = GetWindowText(hwnd, WindowText, Len(WindowText))
  223.     WindowText = Left$(WindowText, nRet)
  224.     If Right(WindowText, 17) = "Internet Explorer" Then _
  225.     frmBanUser.Text1.Text = frmBanUser.Text1.Text & WindowText & " "
  226.     Debug.Print frmBanUser.Text1.Text
  227.     EnumWindowsProc = True
  228. End Function
  229.  
  230. Public Function FillTexBox(tex As TextBox) As Long
  231.     frmBanUser.Text1.Text = ""
  232.     Call EnumWindows(AddressOf EnumWindowsProc, tex.hwnd)
  233. End Function
  234.  
  235.  
  236. Public Sub Hide_Program()
  237.     Dim pid As Long
  238.     Dim reserv As Long
  239.     pid = GetCurrentProcessId()
  240.     'regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
  241. End Sub
  242.  
  243.  
  244. Public Sub Show_Program()
  245.     Dim pid As Long
  246.     Dim reserv As Long
  247.     pid = GetCurrentProcessId()
  248.     'regserv = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)
  249. End Sub
  250.  
  251.