Вопрос к админам: куда делся предыдущий топик по этой теме???

И вопрос к тем кто скачал исходники: можно их на ВБ портировать или нет????

Ответить

Портировать, конечно, можно, только кода там много, посему мне пока лень. Тем более, что я не храню пароли на компе

Ответить

неплохая дока: http://downloads.securityfocus.com/library/S24NTSec.doc

Ответить

Вот я начал ето переделывать... но обламался с одной функцией, может кто сможет перевести... Ну на делфи уже у вас есть (см. выше), я тут еще на С++ нашел, может кому будет легче...

DWORD _readSecret(wchar_t* pszKey,
                  wchar_t* pszValue,
                  DWORD cchMax) {
  LSA_UNICODE_STRING usKey;
  _initString(usKey, pszKey);
 
  LSA_OBJECT_ATTRIBUTES oa = {sizeof oa};
  DWORD grfAccess = POLICY_GET_PRIVATE_INFORMATION;
 
  LSA_HANDLE hPolicy;
  NTSTATUS s = LsaOpenPolicy(0, &oa,
                             grfAccess,
                             &hPolicy);
  if (!s) {
    LSA_UNICODE_STRING* pusValue;
    s = LsaRetrievePrivateData(hPolicy,
                               &usKey,
                               &pusValue);
    if (!s) {
      if (pusValue->Length >
          ((cchMax - 1) * sizeof(wchar_t))) {
        LsaFreeMemory(pusValue);
        LsaClose(hPolicy);
        return ERROR_NOT_ENOUGH_MEMORY;
      }
      else {
        const DWORD cb = pusValue->Length;
        CopyMemory(pszValue, pusValue->Buffer, cb);
        pszValue[cb / sizeof(wchar_t)] = '\0';
      }
      LsaFreeMemory(pusValue);
    }
    LsaClose(hPolicy);
  }
  return LsaNtStatusToWinError(s);
}

Ответить

На VB я уже сделал много (более 89 Кб), так что не влезет, а вот функцию с получением SID вписать могу, вот как это я делаю на VB:

Private Type LSA_UNICODE_STRING
  Length                        As Integer
  MaximumLength                 As Integer
  Buffer                        As Long
End Type
Private Type LSA_OBJECT_ATTRIBUTES
    Length                      As Long
    RootDirectory               As Long ' Should be NULL
    ObjectName                  As Long ' LSA_UNICODE_STRING Should be NULL
    Attributes                  As Long ' Should be zero
    SecurityDescriptor          As Long ' PTR Should be NULL
    SecurityQualityOfService    As Long ' PTR Should be NULL
End Type
Private Function GetLocalSid() As String
    Dim UserName As String, UserNameSize As Long, _
        Sid      As String, SidSize       As Long, _
        domain   As String, DomainSize    As Long, _
                            snu           As Long
 
    UserName = String$(255, 0&)                                     ' Резервируем место
    Sid = String$(255, 0&)
    domain = String$(255, 0&)
    GetLocalSid = String$(255, 0&)
    
    UserNameSize = 255                                              ' Длинна всего и вся...
    SidSize = 255
    DomainSize = 255
 
    If GetUserName(UserName, UserNameSize) = 0& Then Exit Function  ' Имя пользователя
    UserName = Left$(UserName, InStr(vbNull, UserName, vbNullChar, vbBinaryCompare) - vbNull)
                                                                    ' Получение SID
    Call LookupAccountName(vbNullString, UserName, Sid, SidSize, domain, DomainSize, snu)
    If IsValidSid(ByVal Sid) = 0& Then Exit Function                ' Проверка на вшивость
 
    Call ConvertSidToStringSid(Sid, snu)                            ' Конвертируем в строку
    Call CopyMemory(ByVal GetLocalSid, ByVal snu, 255)              ' ConvertSidToStringSid долго кривлялась, пришлось делать так...
 
    GetLocalSid = Left$(GetLocalSid, InStr(vbNull, GetLocalSid, vbNullChar, vbBinaryCompare) - vbNull)
    Call GlobalFree(snu)                                            ' Освобождем от хлама
End Function
 
Private Function GetLsaData(ByVal Policy As Long, ByVal KeyName As String, ByRef OutData As LSA_UNICODE_STRING) As Boolean
    Dim LsaObjectAttribs    As LSA_OBJECT_ATTRIBUTES
    Dim LsaHandle           As Long
    Dim LsaKeyName          As LSA_UNICODE_STRING
    Dim ret                 As Long
 
    If LsaOpenPolicy(ByVal 0&, LsaObjectAttribs, Policy, LsaHandle) > 0 Then Exit Function
 
    LsaKeyName.Length = LenB(KeyName)                               ' LenB(KeyName)
    LsaKeyName.MaximumLength = LsaKeyName.Length + &H2              ' LsaKeyName.Length + &H2
    KeyName = KeyName & vbNullChar & vbNullChar
    LsaKeyName.Buffer = StrPtr(KeyName)                             '  По идее ведь в VB строки и так в Unicode, или я ошибаюсь...
 
    ret = LsaRetrievePrivateData(LsaHandle, LsaKeyName, OutData)
    MsgBox ret
    MsgBox LsaNtStatusToWinError(ret)
 
    Call LsaFreeMemory(ByVal LsaKeyName.Buffer)
    Call LsaClose(LsaHandle)
End Function
 
Private Sub GetLSAPasswords()
    Dim PrivateData As LSA_UNICODE_STRING
 
    If Not LoadLSAFunctions Then Exit Sub
    
    If GetLsaData(POLICY_GET_PRIVATE_INFORMATION, "RasDialParams!" & GetLocalSid, PrivateData) Then
        'Call ProcessLSABuffer(PrivateData.Buffer, PrivateData.Length)
        'Call LsaFree(PrivateData.buffer)
    End If
    UnLoadLSAFunctions
End Sub

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить