Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Пример: Получение информации о статусе пользова... Добавлено: 08.01.03 17:12  

Автор вопроса:  Millenium | Web-сайт: www.aliyev.us | ICQ: 629966 

Получение информации о статусе пользователя система

----- Модуль -----

 Declare Function GetCurrentProcess Lib "Kernel32" () As Long
Declare Function GetCurrentThread Lib "Kernel32" () As Long
Declare Function OpenProcessToken Lib "Advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Declare Function OpenThreadToken Lib "Advapi32" (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Declare Function GetTokenInformation Lib "Advapi32" (ByVal TokenHandle As Long, TokenInformationClass As Integer, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Declare Function AllocateAndInitializeSid Lib "Advapi32" ( pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long,
ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Declare Function RtlMoveMemory Lib "Kernel32" ( Dest As Any, Source As Any, ByVal lSize As Long) As Long
Declare Function IsValidSid Lib "Advapi32" (ByVal pSid As Long) As Long
Declare Function EqualSid Lib "Advapi32" (pSid1 As Any, pSid2 As Any) As Long
Declare Sub FreeSid Lib "Advapi32" (pSid As Any)
Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
 

Const ANYSIZE_ARRAY = 20 'Fixed at this size for comfort. Could be
 Const TokenUser = 1
 Const TokenGroups = 2
 Const TokenPrivileges = 3
 Const TokenOwner = 4
 Const TokenPrimaryGroup = 5
 Const TokenDefaultDacl = 6
 Const TokenSource = 7
 Const TokenType = 8
 Const TokenImpersonationLevel = 9
 Const TokenStatistics = 10
 Const TOKEN_ASSIGN_PRIMARY = &H1
 Const TOKEN_DUPLICATE = &H2
 Const TOKEN_IMPERSONATE = &H4
 Const TOKEN_QUERY = &H8
 Const TOKEN_QUERY_SOURCE = &H10
 Const TOKEN_ADJUST_PRIVILEGES = &H20
 Const TOKEN_ADJUST_GROUPS = &H40
 Const TOKEN_ADJUST_DEFAULT = &H80
 Const SECURITY_DIALUP_RID = &H1
 Const SECURITY_NETWORK_RID = &H2
 Const SECURITY_BATCH_RID = &H3
 Const SECURITY_INTERACTIVE_RID = &H4
 Const SECURITY_SERVICE_RID = &H6
 Const SECURITY_ANONYMOUS_LOGON_RID = &H7
 Const SECURITY_LOGON_IDS_RID = &H5
 Const SECURITY_LOCAL_SYSTEM_RID = &H12
 Const SECURITY_NT_NON_UNIQUE = &H15
 Const SECURITY_BUILTIN_DOMAIN_RID = &H20
 Const DOMAIN_ALIAS_RID_ADMINS = &H220
 Const DOMAIN_ALIAS_RID_USERS = &H221
 Const DOMAIN_ALIAS_RID_GUESTS = &H222
 Const DOMAIN_ALIAS_RID_POWER_USERS = &H223
 Const DOMAIN_ALIAS_RID_ACCOUNT_OPS = &H224
 Const DOMAIN_ALIAS_RID_SYSTEM_OPS = &H225
 Const DOMAIN_ALIAS_RID_PRINT_OPS = &H226
 Const DOMAIN_ALIAS_RID_BACKUP_OPS = &H227
 Const DOMAIN_ALIAS_RID_REPLICATOR = &H228
 Const SECURITY_NT_AUTHORITY = &H5

Public Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type

Type TOKEN_GROUPS
GroupCount As Long
Groups(ANYSIZE_ARRAY) As SID_AND_ATTRIBUTES
End Type

Type SID_IDENTIFIER_AUTHORITY
Value(0 To 5) As Byte
End Type


Public Function Administrator() As Boolean
Dim hProcessToken, BufferSize, psidAdmin, Result As Long, X As Integer
Dim tpTokens As TOKEN_GROUPS, tpSidAuth As SID_IDENTIFIER_AUTHORITY
Administrator = False
tpSidAuth.Value(5) = SECURITY_NT_AUTHORITY
If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hProcessToken) Then
Call OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hProcessToken)
End If
If hProcessToken Then
Call GetTokenInformation(hProcessToken, ByVal TokenGroups, 0, 0, BufferSize)
If BufferSize Then
ReDim InfoBuffer((BufferSize \ 4) - 1) As Long
lResult = GetTokenInformation(hProcessToken, ByVal TokenGroups, InfoBuffer(0), BufferSize, BufferSize)
If lResult <> 1 Then Exit Function
Call RtlMoveMemory(tpTokens, InfoBuffer(0), Len(tpTokens))
lResult = AllocateAndInitializeSid(tpSidAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, _
DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdmin)
If lResult <> 1 Then Exit Function
If IsValidSid(psidAdmin) Then
For X = 0 To tpTokens.GroupCount 'Проверяем для каждого значения
If IsValidSid(tpTokens.Groups(X).Sid) Then
If EqualSid(ByVal tpTokens.Groups(X).Sid, ByVal psidAdmin) Then
Administrator = True
Exit For
End If
End If
Next
End If
If psidAdmin Then Call FreeSid(psidAdmin)
End If
Call CloseHandle(hProcessToken)
End If
End Function


----- Событие загрузки формы -----

 Sub Form_Load()
If Administrator Then
Me.Print "Добро пожаловать, администратор." 'Поставьте Autoredraw = True
Else
MsgBox "Вы должны иметь права администратора, для запуска этой программы", vbCritical, "Нет прав"
End
End If
End Sub
 

Это очень старый, проверенный способ, работает для NT/2000 просто замечательно.

Ответить

  Ответы Всего ответов: 8  

Номер ответа: 1
Автор ответа:
 SAVok



ICQ: 155153916 

Вопросов: 2
Ответов: 126
  Профиль | | #1 Добавлено: 08.01.03 17:58
Спасибо, уважаемый доброжелатель, но слать такие весчи надо в библиотеку кодов!

Ответить

Номер ответа: 2
Автор ответа:
 Millenium



ICQ: 629966 

Вопросов: 118
Ответов: 903
  Web-сайт: www.aliyev.us
 Профиль | | #2 		Добавлено: 14.06.07 01:15
А как? Админу на мыло не доходило

Ответить

Номер ответа: 3
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
  Web-сайт: sharpc.livejournal.com
 Профиль | | #3 		Добавлено: 14.06.07 17:43
RA проснулся после четырехлетней спячки, и еще не успел заметить, что на дворе 2007 год

Ответить

Номер ответа: 4
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #4 		Добавлено: 15.06.07 09:45
А в чем, собственно вопрос?

Ответить

Номер ответа: 5
Автор ответа:
 SAVok



ICQ: 155153916 

Вопросов: 2
Ответов: 126
  Профиль | | #5 Добавлено: 15.06.07 11:51
Я вижу тут собрание археологов.
Может вам, парни, род деятельности сменить? Бросайте программерство. Откапывать такие артефакты не каждому дано.

з.ы. Как-то довелось мне познакомится с человеком по фамилии Глючевский. 2-3 раза в неделю он звонил нам в отдел и жаловался что у него неработает какой-то фрагмент кода(причем как правило дело касалось тривиальных вещей). Так и зудило сказать ему, чтобы он менял профессию :)

з.ы.ы.
Пользуясь случаем передаю привет Павлу и User Unknown. Года 4 я тут не появлялся. Спасибо археологам.

Ответить

Номер ответа: 6
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
  Web-сайт: sharpc.livejournal.com
 Профиль | | #6 		Добавлено: 15.06.07 18:36
Ого. А я помню этого человека.

Ответить

Номер ответа: 7
Автор ответа:
 Millenium



ICQ: 629966 

Вопросов: 118
Ответов: 903
  Web-сайт: www.aliyev.us
 Профиль | | #7 		Добавлено: 18.06.07 12:54
И только помниш?
Хотя были хорошие времена у этого домена. Форум работал, примеры активно посылалиь...

Жалко...

Ответить

Номер ответа: 8
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
  Web-сайт: sharpc.livejournal.com
 Профиль | | #8 		Добавлено: 18.06.07 14:23
Даа, когда-то и программы писали на VB6...

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам