Форумы на Хакер

Добро пожаловать! Это — архивная версия форумов на «Хакер.Ru». Она работает в режиме read-only.

DialUp пароли, исходники

Пользователи, просматривающие топик: none

Зашли как: Guest

Все форумы >> [Компилируемые языки] >> DialUp пароли, исходники

Имя

Сообщение

<< Старые топики Новые топики >>

DialUp пароли, исходники - 2007-08-28 14:17:24.536666

ChooseDeath

Сообщений: 19
Оценки: 0
Присоединился: 2007-07-30 15:13:05.753333

Вопсчем тут такая трабла -
решил написать прогу для просмотра свойсв подключений, логин, пароль и т.п.,
но 3 дня мучая яндекс я нашёл ОДИН бесплатный и реально работающий исходник, и он на бейсике…
Может кто-нить поделица исходнивом на С++ или, на крайняк, на дельфях?
У мя моск распух после попыток перенести всё это на С++…
Нет ни одной структуры, всё через байтовый массив, ужос…
Кому интересно вот исходник, можете попробывать портировать эт на С++, буду крайне благодарен


 Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal lpcstr As String, ByVal lpcstr As String, ByRef lprasentrynamea As Any, ByRef lpdword As Long, ByRef lpdword As Long) As Long
 Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As Byte, ByRef lpbool As Long) As Long
 Private Declare Function RasGetEntryProperties Lib "rasapi32.dll" Alias "RasGetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, ByRef lpRasEntry As Any, ByRef lpdwEntryInfoSize As Long, ByRef lpbDeviceInfo As Any, ByRef lpdwDeviceInfoSize As Long) As Long
 Private Declare Function LsaOpenPolicy Lib "ADVAPI32.dll" (ByRef SystemName As Long, ByRef ObjectAttributes As LSA_OBJECT_ATTRIBUTES, ByVal DesiredAccess As Long, ByRef PolicyHandle As Long) As Long
 Private Declare Function LsaRetrievePrivateData Lib "ADVAPI32.dll" (ByVal PolicyHandle As Long, ByRef KeyName As LSA_UNICODE_STRING, ByVal PrivateData As Long) As Long
 Private Declare Function LsaClose Lib "ADVAPI32.dll" (ByVal ObjectHandle As Long) As Long
 Private Declare Function LsaFreeMemory Lib "ADVAPI32.dll" (ByVal Buffer As Long) As Long
 ' Это если вдруг ошибки кто захочет отлавливать в LSA...
 'Private Declare Function LsaNtStatusToWinError Lib "ADVAPI32.dll" (ByRef Status As Long) As Long
 Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
 Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
 Private Declare Function ConvertSidToStringSid Lib "ADVAPI32.dll" Alias "ConvertSidToStringSidA" (ByVal Sid As String, ByRef lpStringSid As Long) As Long
 Private Declare Function IsValidSid Lib "ADVAPI32.dll" (ByRef pSid As Any) As Long
 Private Declare Function LookupAccountName Lib "ADVAPI32.dll" Alias "LookupAccountNameA" (ByVal lpSystemName As String, ByVal lpAccountName As String, ByVal Sid As String, ByRef cbSid As Long, ByVal ReferencedDomainName As String, ByRef cbReferencedDomainName As Long, ByRef peUse As Long) As Long
 Private Declare Function GetPrivateProfileInt Lib "kernel32.dll" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
 Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal csidl As Long, ByVal fCreate As Long) As Long
 Private Declare Function GetUserName Lib "ADVAPI32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
 Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
 Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
 Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
 Private Declare Function LocalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
 Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
 Private Type OSVERSIONINFO
 &nbsp;&nbsp;&nbsp; dwOSVersionInfoSize&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; dwMajorVersion&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; dwMinorVersion&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; dwBuildNumber&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; dwPlatformId&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; szCSDVersion&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String * 128
 End Type
 ' §§§§§§§§§§§§§§§§§§§§§§§§§§ LSA §§§§§§§§§§§§§§§§§§§§§§§§§§
 Private Type LSA_UNICODE_STRING
 &nbsp; Length&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Integer&nbsp; ' WORD
 &nbsp; MaximumLength&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Integer&nbsp; ' WORD
 &nbsp; Buffer&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long&nbsp;&nbsp;&nbsp;&nbsp; ' PWCHAR - pointer
 End Type
 Private Type LSA_OBJECT_ATTRIBUTES
 &nbsp;&nbsp;&nbsp; Length&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; RootDirectory&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long&nbsp;&nbsp;&nbsp;&nbsp; ' Should be NULL
 &nbsp;&nbsp;&nbsp; ObjectName&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long&nbsp;&nbsp;&nbsp;&nbsp; ' LSA_UNICODE_STRING Should be NULL
 &nbsp;&nbsp;&nbsp; Attributes&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long&nbsp;&nbsp;&nbsp;&nbsp; ' Should be zero
 &nbsp;&nbsp;&nbsp; SecurityDescriptor&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long&nbsp;&nbsp;&nbsp;&nbsp; ' PTR Should be NULL
 &nbsp;&nbsp;&nbsp; SecurityQualityOfService&nbsp;&nbsp;&nbsp; As Long&nbsp;&nbsp;&nbsp;&nbsp; ' PTR Should be NULL
 End Type
 ' §§§§§§§§§§§§§§§§§§§§§§§§§§ RAS §§§§§§§§§§§§§§§§§§§§§§§§§§
 Private Const RAS_MaxEntryName As Long = &amp;H100
 Private Type RASENTRYNAME&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Получение имен соединений
 &nbsp;&nbsp; dwSize&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp; szEntryName(RAS_MaxEntryName) As Byte
 End Type
 Public Type VBHWRasDialParams&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' В этой сруктуре будут храниться "выходные" данные
 &nbsp;&nbsp;&nbsp; ConnectionID&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; EntryName&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String
 &nbsp;&nbsp;&nbsp; PhoneNumber&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String
 &nbsp;&nbsp;&nbsp; CallbackNumber&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String
 &nbsp;&nbsp;&nbsp; UserName&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String
 &nbsp;&nbsp;&nbsp; Password&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String
 &nbsp;&nbsp;&nbsp; Domain&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String
 End Type
 ' §§§§§§§§§§§§§§§§§§§§§§§§§§ Константы §§§§§§§§§§§§§§§§§§§§§§§§§§
 Private Const LMEM_ZEROINIT&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long = &amp;H40
 Private Const POLICY_GET_PRIVATE_INFORMATION&nbsp;&nbsp;&nbsp; As Long = &amp;H4&amp;
 Private Const MAX_PATH&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long = 260
 Private Const ERROR_BUFFER_TOO_SMALL&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long = 603
 Private Const VER_PLATFORM_WIN32_NT&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long = &amp;H2
 Private Function GetRasEntrLst(ByRef soutArray() As String) As Long
 &nbsp;&nbsp;&nbsp; Dim rsname()&nbsp; As RASENTRYNAME
 &nbsp;&nbsp;&nbsp; Dim lSize&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; ReDim rsname(0) As RASENTRYNAME
 &nbsp;&nbsp;&nbsp; rsname(0).dwSize = &amp;H108
 &nbsp;&nbsp;&nbsp; lSize = rsname(0).dwSize
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Select case для получения сведений о необходимом размере буфера
 &nbsp;&nbsp;&nbsp; Select Case RasEnumEntries(vbNullString, vbNullString, rsname(0), lSize, GetRasEntrLst)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case Is = ERROR_BUFFER_TOO_SMALL&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Ошибка, места мало, а соединений много
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim rsname(GetRasEntrLst - vbNull)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; rsname(0).dwSize = &amp;H108&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Размер структуры, не знаю почему, но реальный - не подходит...
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lSize = GetRasEntrLst * rsname(0).dwSize
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If RasEnumEntries(vbNullString, vbNullString, rsname(0), lSize, GetRasEntrLst) Then GoTo err
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case Is = 0&amp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Редчайший случай, у человека одно подключение ;)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case Else&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Какая-то неизведанная ошибка ...
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo err
 &nbsp;&nbsp;&nbsp; End Select
 &nbsp;&nbsp;&nbsp; ReDim soutArray(GetRasEntrLst - vbNull)
 &nbsp;&nbsp;&nbsp; For lSize = 0 To GetRasEntrLst - vbNull&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Не создавать же ради цикла еще одну переменную !?
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; soutArray(lSize) = StrConv(rsname(lSize).szEntryName, vbUnicode)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; soutArray(lSize) = Left$(soutArray(lSize), InStr(vbNull, soutArray(lSize), vbNullChar, vbBinaryCompare) - vbNull)
 &nbsp;&nbsp;&nbsp; Next
 Exit Function
 err:
 &nbsp;&nbsp;&nbsp; Erase soutArray
 &nbsp;&nbsp;&nbsp; GetRasEntrLst = 0&amp;
 End Function
 ' §§§§§§§§§§§§§§§§§§§§§§§§§§ LSA §§§§§§§§§§§§§§§§§§§§§§§§§§
 '&nbsp;&nbsp; Обработка буфера...
 Private Function ProcessLSABuffer(ByRef sBuffer As String, ByVal BufferLen As Integer) As String
 &nbsp;&nbsp;&nbsp; Dim i&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long, sPos&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long, wchar&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Integer&nbsp; ' Integer не совсем то что надо для wchar, но и так сойдет... Т.к. в юникоде используется, пока, только около 30 000 симвоов...
 &nbsp;&nbsp;&nbsp; Dim BookID&nbsp; As String, sTmpBuff As String
 &nbsp;&nbsp;&nbsp; For i = 0 To BufferLen Step 2&amp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Юникод
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call CopyMemory(wchar, ByVal Mid$(sBuffer, i + 1&amp;, 2&amp;), 2&amp;) ' Копирование очередного Unicode символа в wchar
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If wchar = 0&amp; Then
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sPos = sPos + vbNull
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Select Case sPos
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case Is = 1&amp;
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; BookID = sTmpBuff
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case Is = 7&amp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Заносим ID и пароль
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Len(sTmpBuff) Then ProcessLSABuffer = ProcessLSABuffer &amp; BookID &amp; vbNullChar &amp; _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sTmpBuff &amp; vbNullChar &amp; vbNullChar
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End Select
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sTmpBuff = vbNullString
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sTmpBuff = sTmpBuff &amp; ChrW$(wchar)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If sPos = 9&amp; Then sPos = 0&amp;: BookID = vbNullString
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If
 &nbsp;&nbsp;&nbsp; Next
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 2 последних символа - лишние
 &nbsp;&nbsp;&nbsp; ProcessLSABuffer = Left$(ProcessLSABuffer, Len(ProcessLSABuffer) - 2&amp;)
 End Function
 '&nbsp;&nbsp; Получение SID
 Private Function GetLocalSid() As String
 &nbsp;&nbsp;&nbsp; Dim UserName As String, UserNameSize As Long, _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sid&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String, SidSize&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long, _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Domain&nbsp;&nbsp; As String, DomainSize&nbsp;&nbsp;&nbsp; As Long, _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; snu&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; UserName = String$(255, 0&amp;)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Резервируем место
 &nbsp;&nbsp;&nbsp; Sid = String$(255, 0&amp;)
 &nbsp;&nbsp;&nbsp; Domain = String$(255, 0&amp;)
 &nbsp;&nbsp;&nbsp; GetLocalSid = String$(255, 0&amp;)
 &nbsp;&nbsp;&nbsp; 
 &nbsp;&nbsp;&nbsp; UserNameSize = 255&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Длинна всего и вся...
 &nbsp;&nbsp;&nbsp; SidSize = 255
 &nbsp;&nbsp;&nbsp; DomainSize = 255
 &nbsp;&nbsp;&nbsp; If GetUserName(UserName, UserNameSize) = 0&amp; Then Exit Function&nbsp; ' Имя пользователя
 &nbsp;&nbsp;&nbsp; UserName = Left$(UserName, InStr(vbNull, UserName, vbNullChar, vbBinaryCompare) - vbNull)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Получение SID
 &nbsp;&nbsp;&nbsp; Call LookupAccountName(vbNullString, UserName, Sid, SidSize, Domain, DomainSize, snu)
 &nbsp;&nbsp;&nbsp; If IsValidSid(ByVal Sid) = 0&amp; Then Exit Function&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Проверка на вшивость
 &nbsp;&nbsp;&nbsp; Call ConvertSidToStringSid(Sid, snu)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Конвертируем в строку
 &nbsp;&nbsp;&nbsp; Call CopyMemory(ByVal GetLocalSid, ByVal snu, 255)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' ConvertSidToStringSid долго кривлялась, пришлось делать так...
 &nbsp;&nbsp;&nbsp; GetLocalSid = Left$(GetLocalSid, InStr(vbNull, GetLocalSid, vbNullChar, vbBinaryCompare) - vbNull)
 &nbsp;&nbsp;&nbsp; Call GlobalFree(snu)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Освобождем от хлама
 End Function
 '&nbsp;&nbsp; Получение LSA данных
 Private Function GetLsaData(ByVal Policy As Long, ByVal KeyName As String, ByRef lpOutData As LSA_UNICODE_STRING) As Boolean
 &nbsp;&nbsp;&nbsp; Dim LsaObjectAttribs&nbsp;&nbsp;&nbsp; As LSA_OBJECT_ATTRIBUTES
 &nbsp;&nbsp;&nbsp; Dim LsaHandle&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; Dim LsaKeyName&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As LSA_UNICODE_STRING
 &nbsp;&nbsp;&nbsp; Dim hMem&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long
 &nbsp;&nbsp;&nbsp; If Not LsaOpenPolicy(ByVal 0&amp;, LsaObjectAttribs, Policy, LsaHandle) = 0 Then Exit Function
 &nbsp;&nbsp;&nbsp; LsaKeyName.Length = LenB(KeyName)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' LenB(KeyName)
 &nbsp;&nbsp;&nbsp; LsaKeyName.MaximumLength = LsaKeyName.Length + &amp;H2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' LsaKeyName.Length + &amp;H2
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Мучался недели двe... Что я только сюда не передавал (массивы, строки), все не работало, пришлось через АПИ
 &nbsp;&nbsp;&nbsp; LsaKeyName.Buffer = LocalAlloc(LMEM_ZEROINIT, &amp;HFF)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' &amp;HFF - кажется, максимальная длинна...
 &nbsp;&nbsp;&nbsp; Call MultiByteToWideChar(0&amp;, 0&amp;, KeyName, Len(KeyName), LsaKeyName.Buffer, LsaKeyName.MaximumLength)
 &nbsp;&nbsp;&nbsp; If Not LsaRetrievePrivateData(LsaHandle, LsaKeyName, VarPtr(hMem)) = 0&amp; Then
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call LsaClose(LsaHandle)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Надо бы закрыть...
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Function
 &nbsp;&nbsp;&nbsp; Else
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call CopyMemory(lpOutData, ByVal hMem, Len(lpOutData))
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GetLsaData = True
 &nbsp;&nbsp;&nbsp; End If
 &nbsp;&nbsp;&nbsp; Call LsaFreeMemory(LsaKeyName.Buffer)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Call LocalFree(LsaKeyName.Buffer) Как ни странно, использовать можно и то, и другое
 &nbsp;&nbsp;&nbsp; Call LsaClose(LsaHandle)
 End Function
 '&nbsp;&nbsp; Функция, использующая предыдущие... Возвращает ID и пароли...
 Private Function GetLSAPasswords() As String&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Получение паролей, затем обработка данных
 &nbsp;&nbsp;&nbsp; Dim PrivateData As LSA_UNICODE_STRING
 &nbsp;&nbsp;&nbsp; Dim sNormBuffer As String
 &nbsp;&nbsp;&nbsp; If GetLsaData(POLICY_GET_PRIVATE_INFORMATION, "RasDialParams!" &amp; GetLocalSid &amp; "#0", PrivateData) Then _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo wrk
 &nbsp;&nbsp;&nbsp; If GetLsaData(POLICY_GET_PRIVATE_INFORMATION, "L$_RasDefaultCredentials#0", PrivateData) Then _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo wrk
 Exit Function
 wrk:&nbsp;&nbsp;&nbsp; ' Тут можно оказаться только одним из способов, см. выше (1 - ХР, 2 - 2к)
 &nbsp;&nbsp;&nbsp; sNormBuffer = String$(PrivateData.MaximumLength, 0&amp;)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Забираем строку из указателя
 &nbsp;&nbsp;&nbsp; Call CopyMemory(ByVal sNormBuffer, ByVal PrivateData.Buffer, PrivateData.Length)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Кому не нравится такой вариант, пусть используют WideCharToMultiByte
 &nbsp;&nbsp;&nbsp; GetLSAPasswords = ProcessLSABuffer(sNormBuffer, PrivateData.Length)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Обработка данных, помещение их в читабельную строку...
 &nbsp;&nbsp;&nbsp; Call LsaFreeMemory(PrivateData.Buffer)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Дестроим буфер
 End Function
 ' §§§§§§§§§§§§§§§§§§§§§§§§§§ RAS §§§§§§§§§§§§§§§§§§§§§§§§§§
 Private Function MakePhoneBookPath(ByVal sValue As String) As String
 &nbsp;&nbsp;&nbsp; MakePhoneBookPath = Left$(sValue, InStr(vbNull, sValue, vbNullChar, vbBinaryCompare) - vbNull)
 &nbsp;&nbsp;&nbsp; 
 &nbsp;&nbsp;&nbsp; If Not Right$(MakePhoneBookPath, vbNull) = "\" Then MakePhoneBookPath = MakePhoneBookPath &amp; "\"
 &nbsp;&nbsp;&nbsp; MakePhoneBookPath = MakePhoneBookPath &amp; "Microsoft\Network\Connections\pbk\rasphone.pbk"
 End Function
 Public Function GetRasEntries2k(outArray() As VBHWRasDialParams) As Long
 &nbsp;&nbsp;&nbsp; Dim RasArray()&nbsp; As String, i&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long, j As Long&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Имена Ras соединений
 &nbsp;&nbsp;&nbsp; Dim btArray()&nbsp;&nbsp; As Byte, DialParamsUID&nbsp; As Long&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Хороший байтовый массив, заменет абсолютно любую структуру (UDT) :)))
 &nbsp;&nbsp;&nbsp; Dim Book1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String, Book2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As String
 &nbsp;&nbsp;&nbsp; Dim LSA_Pass()&nbsp; As String, sTempBuffer&nbsp; As String
 &nbsp;&nbsp;&nbsp; Dim osi&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As OSVERSIONINFO
 &nbsp;&nbsp;&nbsp; GetRasEntries2k = GetRasEntrLst(RasArray) - vbNull&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Получение названий всех соединений и их кол-ва
 &nbsp;&nbsp;&nbsp; ReDim outArray(GetRasEntries2k)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Ресайзим выходной массив
 &nbsp;&nbsp;&nbsp; osi.dwOSVersionInfoSize = Len(osi)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Получение версии ОС
 &nbsp;&nbsp;&nbsp; Call GetVersionEx(osi)
 &nbsp;&nbsp;&nbsp; Book1 = String$(MAX_PATH + vbNull, 0&amp;)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Подготовка...
 &nbsp;&nbsp;&nbsp; Book2 = String$(MAX_PATH + vbNull, 0&amp;)
 &nbsp;&nbsp;&nbsp; If (osi.dwPlatformId = VER_PLATFORM_WIN32_NT) And (osi.dwMajorVersion &gt;= 5) Then
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If (SHGetSpecialFolderPath(0&amp;, Book1, &amp;H1A, False)) Then _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Book1 = MakePhoneBookPath(Book1)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If (SHGetSpecialFolderPath(0, Book2, &amp;H23, False)) Then _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Book2 = MakePhoneBookPath(Book2)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sTempBuffer = GetLSAPasswords&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Теперь нам известны пароли и ID... идем дальше...
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Len(sTempBuffer) = 0&amp; Then GoTo err
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; LSA_Pass = Split(sTempBuffer, vbNullChar &amp; vbNullChar)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Разбиение строки на массив
 &nbsp;&nbsp;&nbsp; End If
 &nbsp;&nbsp;&nbsp; For i = 0 To GetRasEntries2k
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim btArray(1060&amp;)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Т.к. WINVER &gt;= 0x401, берем наибольший размер, а заодно и обнуляем прежние данные
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call CopyMemory(btArray(0), 1060&amp;, 4&amp;)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' dwSize псевдо структуры
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call CopyMemory(btArray(4), ByVal RasArray(i), Len(RasArray(i)))&nbsp;&nbsp;&nbsp; ' szEntryName, макс. длинна 256 символов
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call RasGetEntryDialParams(vbNullString, btArray(0), vbNull)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Ну, скажем, получили параметры дозвона, но без пароля!...
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If (osi.dwPlatformId = VER_PLATFORM_WIN32_NT) And (osi.dwMajorVersion &gt;= 5) Then
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sTempBuffer = StrToUTF8(RasArray(i))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Получение ID по имени есоединения
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DialParamsUID = GetPrivateProfileInt(RasArray(i), "DialParamsUID", 0&amp;, Book1)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If DialParamsUID = 0 Then _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DialParamsUID = GetPrivateProfileInt(RasArray(i), "DialParamsUID", 0&amp;, Book2)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If DialParamsUID = 0 Then _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DialParamsUID = GetPrivateProfileInt(sTempBuffer, "DialParamsUID", 0&amp;, Book1)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If DialParamsUID = 0 Then _
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DialParamsUID = GetPrivateProfileInt(sTempBuffer, "DialParamsUID", 0&amp;, Book2)
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Not DialParamsUID = 0 Then
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For j = 0 To UBound(LSA_Pass)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Методом перебора находим ID и задаем пароль
 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Len(LSA_Pass(j)) Then&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;

Post #: 1

RE: DialUp пароли, исходники - 2007-08-28 21:12:19.170000

int21h

Сообщений: 105
Оценки: 0
Присоединился: 2007-08-25 12:05:16.730000

А чем тебе VB не нравицо ?
Я на нём кодил в далёком 2004-ом - нормально …

p.s. Кажицо если этот код скампилить и сунить камунить , при открытии на другом комне прога попросит библиотеку ;-(

Post #: 2

RE: DialUp пароли, исходники - 2007-08-28 23:17:46.580000

Yashin

Сообщений: 964
Оценки: 0
Присоединился: 2007-05-09 20:18:01.153333

Это импорт функций из RasApi, кроме статического импорта она больше ничего не делает. Поищи в инете RasApi. Эта библиотека нужная для дозвона, разрыва соединения или управления подключениями.

Post #: 3

RE: DialUp пароли, исходники - 2007-08-29 15:35:27.890000

ChooseDeath

Сообщений: 19
Оценки: 0
Присоединился: 2007-07-30 15:13:05.753333

quote:

ORIGINAL: int21h

А чем тебе VB не нравицо ?
Я на нём кодил в далёком 2004-ом - нормально …

p.s. Кажицо если этот код скампилить и сунить камунить , при открытии на другом комне прога попросит библиотеку ;-(

Мне нужен исходник на Си, а не на ВБ,
я на ВБ ни строчки не написал, в этом исходнике сложновато разобраца..

quote:

ORIGINAL: Yashin

Это импорт функций из RasApi, кроме статического импорта она больше ничего не делает. Поищи в инете RasApi. Эта библиотека нужная для дозвона, разрыва соединения или управления подключениями.

Я искал, там, по сути дела, нада только 2 функции - RasEnumEntries и RasGetEntryDialParams,
так вот вторая чёт уплямица, работать не хотит..

Post #: 4

RE: DialUp пароли, исходники - 2007-08-29 23:08:45.980000

Yashin

Сообщений: 964
Оценки: 0
Присоединился: 2007-05-09 20:18:01.153333

вот zip архив с примером на Делфи

Post #: 5

RE: DialUp пароли, исходники - 2007-08-30 13:57:05.110000

ChooseDeath

Сообщений: 19
Оценки: 0
Присоединился: 2007-07-30 15:13:05.753333

Пасиб конешь, но мнужны пароли в чистом виде, из LSA,
но в том исходнике них непонятна…

Post #: 6

Страниц: [1]

Все форумы >> [Компилируемые языки] >> DialUp пароли, исходники

Связаться:
Вопросы по сайту / xakep@glc.ru

Предупреждение: использование полученных знаний в противозаконных целях преследуется по закону.