Лингрин :: Резиденция Линды Кайе — @дневники: асоциальная сеть

среда, 17 марта 2010

13:19

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3521-13-30
#original-date: 17.03.2010 Wed
#original-time: 1:30 PM
#original-day: 3521
#original-host: WinXP Home SP3 (Build 2600)

Пля. Второй день уже МТС радует. Есть коннект, например, аська или почта получается. Инет есть, всё работает. Но! При этом на остальные коннекты сплошное 503 >_<

URL

13:19

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3521-13-08
#original-date: 17.03.2010 Wed
#original-time: 1:08 PM
#original-day: 3521
#original-host: WinXP Home SP3 (Build 2600)

Кстати, на ImageBam умилила подпись: no frogs or beavers inside. Это у них намёк на ImageShack и ImageBeaver ^^

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3521-03-29
#original-date: 17.03.2010 Wed
#original-time: 3:29 AM
#original-day: 3521
#original-host: WinXP Home SP3 (Build 2600)

На ImageBam открыли API. Помнится я хотела ImageShack Links сделать мультихостинговым и плагиновым. Но теперь врядли буду...

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3521-00-16
#original-date: 17.03.2010 Wed
#original-time: 12:16 AM
#original-day: 3521
#original-host: WinXP Home SP3 (Build 2600)

Снова начался ветер...

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-23-51
#original-date: 16.03.2010 Tue
#original-time: 11:51 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Пожалуй, прочие обойки тихо замолчу ^^ Кто знает - тот увидит ^^

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-23-46
#original-date: 16.03.2010 Tue
#original-time: 11:46 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

16.03.2010 в 22:46

Пишет Линда Кайе:

Автор: Линда Кайе
Рейтинг: NC - 17
Размер: 1280x750
Фендом: Ориджинал
От автора: Пока только одна рафинированая обойка ^^

Strong NSFW content!

URL записи

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-23-41
#original-date: 16.03.2010 Tue
#original-time: 11:41 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Хе-хе ^^

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-23-35
#original-date: 16.03.2010 Tue
#original-time: 11:35 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Хитрый вопрос. В Windows XP можно на WebDav папку повесить сетевой диск? А то толку с них нуль без палочки - читать читаем, а писать не пишем, ибо читается реально из Internet Temporary Files...

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-23-10
#original-date: 16.03.2010 Tue
#original-time: 11:10 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Обратите внимание на это! Вкратце - кто-то косплеит Мизоре!

Хммм... А поближе посмотреть - это рисунок...

http://danbooru.donmai.us/post/show/605324/bare_shoulders-blue_eyes-depth_of_field-herodees-i

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-22-23
#original-date: 16.03.2010 Tue
#original-time: 10:23 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

В Грузии весело, а я проспала такое...

http://top.rbc.ru/politics/13/03/2010/379757.shtml

#music: Scooter\Mind The Gap\Suavemente

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-20-51
#original-date: 16.03.2010 Tue
#original-time: 8:51 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Вау ^^ Сколько Куруму-чан ^^

http://www.world-art.ru/games/games_img.php?id=8702&type=screenshots

И всёже авторы анимэ - преступники, что не включили эпизод с тем слизнем. Так хоть ясно, что Куруму не просто так со всей толпой носится.

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-20-21
#original-date: 16.03.2010 Tue
#original-time: 8:21 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Вау! Оказывается нашлись герои, которые переводят Initial D на русский!

http://animanga.ru/manga.asp?id=189

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-19-32
#original-date: 16.03.2010 Tue
#original-time: 7:32 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

22
А вы думали если мужчина пропускает даму вперед, то он джентельмен? Неет,он просто хочет заценить вид сзади. Хотя есть и правда джентельмены, они просто пока не в курсе зачем это делается.

Теперь понятно что за паника на западе с "харасментами" =_=

23
Заместитель председателя Комитета по инвестициям и стратегическим проектам правительства Санкт-Петербурга И. А. Мартышко. А вы говорите... Это реальность.

Это не оно составило успешный бизнесс план? OO

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-19-25
#original-date: 16.03.2010 Tue
#original-time: 7:25 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

9
Ибо творец мира сего, когда мастерил мужчин, явно что-то перекосил в них; поэтому они всегда требуют от женщин обратное тому, что те им предлагают:если женщина легко отдается им, мужчины вместо благодарности уверяют, что они могут любить чистой любовью только невинность. А если женщина хочет соблюсти невинность, они только о том и думают, как бы вырвать у нее бережно хранимое сокровище. И никогда не находят они покоя, ибо противоречивость их желаний требует вечной борьбы между плотью и духом;
Стефан Цвейг

Немного сексизма ^^ Или антисексизма - как посмотреть. Собственно, про женщин можно сказать примерно тоже: страдают, что нежности в мужчине ни капли, что грубый и вообще мужлан. Появляется требуемый - начинаются страдания что "он не мужик".

Да, у бога что-то все модели кроме яблок вышли кривыми ^^

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-18-57
#original-date: 16.03.2010 Tue
#original-time: 6:57 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Я айтишник, посему словосочетание «вечер пятницы» для меня чуть ли не священно.

В Initial D вечер субботы был священным ^^

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-18-43
#original-date: 16.03.2010 Tue
#original-time: 6:43 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Мне больше незачем жить T_T Я столько времени хотела поиграть в Морской бой на игровом автомате, а тут и сайт с симулятором. С третьей игры уже лупила один и тот же кораблик, что заработала призовую игру, и там ни одного промаха. И это всего за три попытки... Мечта сбылась...

http://morskoy-boy.15kop.ru

Хотя нет. Хочу поиграть в живую. Ну и на самолётиках полетать ^^

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-18-11
#original-date: 16.03.2010 Tue
#original-time: 6:11 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Что за жизнь? Читаю про АПС в Википедии. В русском разделе написано всего ничего, зато в английской написали и про историю, и даже про то, что "The APS appears carried by this model of a character in the Black Lagoon manga comic series". Ну и ссылка на фигурку:

http://tomopop.com/ul/10328-/c097-550x.jpg

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-14-39
#original-date: 16.03.2010 Tue
#original-time: 2:39 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

NT жестока... Нашла константу ERROR_SEM_OWNER_DIED. Сочувствую...

#music: Scooter\The Stadium Techno Expirience\Maria (I Like It Loud)

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-14-22
#original-date: 16.03.2010 Tue
#original-time: 2:22 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Пока все спали, хороший человек написал восстановитель паролей из Оперы.

http://nirsoft.net/utils/operapassview.zip

#music: Scooter\Sheffield\Where Do We Go

URL

13:18

Тотальная неудачница и убийца жёстких дисков.

#post-id: 3520-13-45
#original-date: 16.03.2010 Tue
#original-time: 1:45 PM
#original-day: 3520
#original-host: WinXP Home SP3 (Build 2600)

Я опять никуда не лечу и занимаюсь этим:

Option Explicit

Type CRYPTPROTECT_PROMPTSTRUCT
  cbSize As Long
  dwPromptFlags As Long
  hwndApp As API_HANDLE
  szPrompt As LPWSTR_STRUCT
End Type

Type DATA_BLOB
  cbData As Long
  pbData As POINTER
End Type

Declare Function CryptProtectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptProtectDataByNum Lib "Crypt32.DLL" Alias "CryptProtectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectDataByNum Lib "Crypt32.DLL" Alias "CryptUnprotectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

'====================================================================
Public Sub Main()
  'asRegisterAppPath
  'InitCommonControls
  'If Not asIsInIDE Then asSetWindowResIconAll asGetThunderMainHandle(), IDI_APPICON
  
  Dim InBuff() As Byte
  Dim InData As DATA_BLOB
  Dim OutBuff() As Byte
  Dim OutData As DATA_BLOB
  Dim UnpBuff() As Byte
  Dim UnpData As DATA_BLOB
  Dim DataDescription() As Byte
  Dim RC As C_BOOL
  
  InBuff = "Тайп сометхинг хере плиз!"
  InData.cbData = UBound(InBuff) - LBound(InBuff) + 1
  InData.pbData = VarPtr(InBuff(0))
  
  DataDescription = "Byaka!" & NUL
  
  RC = CryptProtectDataByNum(InData, DataDescription(0), 0, 0, 0, 0, OutData)
  If RC = 0 Then
    MsgBox "CryptProtectDataByNum() failed.", vbCritical
    Exit Sub
  End If
  
  ReDim OutBuff(0 To OutData.cbData - 1)
  CopyMemory OutBuff(0), ByVal OutData.pbData, OutData.cbData
  LocalFree OutData.pbData
  
  MsgBox asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(OutBuff) & CRLFCRLF, vbInformation
  
  InData.cbData = UBound(OutBuff) - LBound(OutBuff) + 1
  InData.pbData = VarPtr(OutBuff(0))
  
  RC = CryptUnprotectDataByNum(InData, DataDescription(0), 0, 0, 0, 0, UnpData)
  If RC = 0 Then
    MsgBox "CryptUnprotectDataByNum() failed.", vbCritical
    Exit Sub
  End If
  
  ReDim UnpBuff(0 To UnpData.cbData - 1)
  CopyMemory UnpBuff(0), ByVal UnpData.pbData, UnpData.cbData
  LocalFree UnpData.pbData
  
  MsgBox """" & CStr(InBuff) & """" & CRLFCRLF & _
         asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(UnpBuff) & CRLFCRLF & _
         """" & CStr(UnpBuff) & """" & CRLFCRLF & _
         "Buffers equal: " & asIsBuffersEqual(InBuff, UnpBuff), vbInformation
End Sub

Кто бы мне ещё сказал, есть ли тоже самое в версиях ниже Win2000?

#upd: Добавила UI ^^ Но он крив как никогда. Кроме того, если данные шифровались с UI, то и расшифровываться должны также. Иначе диалог нам покажут, а вот расшифровать - нет.

Да, значения констант я пока не знаю... И, кстати, CryptUnprotectData() в MSDN я ещё не видела. Просто переименовала исходную функцию...

Option Explicit

Type CRYPTPROTECT_PROMPTSTRUCT
  cbSize As Long
  dwPromptFlags As Long
  hwndApp As API_HANDLE
  szPrompt As LPWSTR_STRUCT
End Type

Type DATA_BLOB
  cbData As Long
  pbData As POINTER
End Type

Declare Function CryptProtectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptProtectDataByNum Lib "Crypt32.DLL" Alias "CryptProtectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptProtectDataByNum2 Lib "Crypt32.DLL" Alias "CryptProtectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectDataByNum Lib "Crypt32.DLL" Alias "CryptUnprotectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectDataByNum2 Lib "Crypt32.DLL" Alias "CryptUnprotectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

'====================================================================
Public Sub Main()
  'asRegisterAppPath
  'InitCommonControls
  'If Not asIsInIDE Then asSetWindowResIconAll asGetThunderMainHandle(), IDI_APPICON
  
  Dim InBuff() As Byte
  Dim InData As DATA_BLOB
  Dim OutBuff() As Byte
  Dim OutData As DATA_BLOB
  Dim UnpBuff() As Byte
  Dim UnpData As DATA_BLOB
  Dim DataDescription() As Byte
  Dim RC As C_BOOL
  
  InBuff = "Ariel mermaid forever and ever!!!"
  InData.cbData = UBound(InBuff) - LBound(InBuff) + 1
  InData.pbData = VarPtr(InBuff(0))
  
  DataDescription = "No?iea n oaenoii iaecaanoiiai niaa??aiey" & NUL
  
  Dim CPS As CRYPTPROTECT_PROMPTSTRUCT
  Dim Prompt() As Byte
  CPS.cbSize = Len(CPS)
  CPS.dwPromptFlags = 1 Or 2
  CPS.hwndApp = GetActiveWindow()
  Prompt = App.Title & NUL
  CPS.szPrompt = VarPtr(Prompt(0))
  
  RC = CryptProtectDataByNum2(InData, DataDescription(0), 0, 0, CPS, 0, OutData)
  If RC = 0 Then
    ajpMain.ErrorDisplayAPI Err.LastDllError, , , "CryptProtectDataByNum() failed."
    Exit Sub
  End If
  
  ReDim OutBuff(0 To OutData.cbData - 1)
  CopyMemory OutBuff(0), ByVal OutData.pbData, OutData.cbData
  LocalFree OutData.pbData
  
  MsgBox asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(OutBuff) & CRLFCRLF, vbInformation
  
  InData.cbData = UBound(OutBuff) - LBound(OutBuff) + 1
  InData.pbData = VarPtr(OutBuff(0))
  
  RC = CryptUnprotectDataByNum2(InData, DataDescription(0), 0, 0, CPS, 0, UnpData)
  If RC = 0 Then
    ajpMain.ErrorDisplayAPI Err.LastDllError, , , "CryptUnprotectDataByNum() failed."
    Exit Sub
  End If
  
  ReDim UnpBuff(0 To UnpData.cbData - 1)
  CopyMemory UnpBuff(0), ByVal UnpData.pbData, UnpData.cbData
  LocalFree UnpData.pbData
  
  MsgBox """" & CStr(InBuff) & """" & CRLFCRLF & _
         asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(UnpBuff) & CRLFCRLF & _
         """" & CStr(UnpBuff) & """" & CRLFCRLF & _
         "Buffers equal: " & asIsBuffersEqual(InBuff, UnpBuff), vbInformation
End Sub

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

#upd: А вот шифровать 160 тыс. нул. оказалось фатальной ошибкой... А вот расшифровал он их вмиг! =_=

#upd: Идём дальше ^^ Теперь у нас две функции всем красиво занимаются ^^

Option Explicit

Type CRYPTPROTECT_PROMPTSTRUCT
  cbSize As Long
  dwPromptFlags As Long
  hwndApp As API_HANDLE
  szPrompt As LPWSTR_STRUCT
End Type

Type DATA_BLOB
  cbData As Long
  pbData As POINTER
End Type

Declare Function CryptProtectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptProtectDataByNum Lib "Crypt32.DLL" Alias "CryptProtectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptProtectDataByNum2 Lib "Crypt32.DLL" Alias "CryptProtectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectDataByNum Lib "Crypt32.DLL" Alias "CryptUnprotectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectDataByNum2 Lib "Crypt32.DLL" Alias "CryptUnprotectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

'====================================================================
Public Sub Main()
  asRegisterAppPath
  InitCommonControls
  If Not asIsInIDE Then asSetWindowResIconAll asGetThunderMainHandle(), IDI_APPICON
  
  Dim lpErrNumber As Long
  Dim InBuff() As Byte
  Dim OutBuff() As Byte
  Dim UnpBuff() As Byte
  
  InBuff = "Почему всё так печально и грустно? А?"
  
  If Not ProtectDataB(InBuff, OutBuff, "Строка с текстом неизвестного содержания", _
                      True, App.Title, GetActiveWindow(), lpErrNumber) Then
    ajpMain.ErrorDisplayAPI lpErrNumber, , , "Can't protect data."
    Exit Sub
  End If
  
  MsgBox asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(OutBuff) & CRLFCRLF, vbInformation
  
  If Not UnProtectDataB(OutBuff, UnpBuff, _
                        True, App.Title, GetActiveWindow(), lpErrNumber) Then
    ajpMain.ErrorDisplayAPI lpErrNumber, , , "Can't unprotect data."
    Exit Sub
  End If
  
  MsgBox """" & CStr(InBuff) & """" & CRLFCRLF & _
         asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(UnpBuff) & CRLFCRLF & _
         """" & CStr(UnpBuff) & """" & CRLFCRLF & _
         "Buffers equal: " & asIsBuffersEqual(InBuff, UnpBuff), vbInformation
End Sub

'====================================================================
Public Function ProtectDataB(ByRef SourceData() As Byte, _
                             ByRef DestinationData() As Byte, _
                             Optional ByVal DataDescription As BStr, _
                             Optional ByVal ShowPrompt As Boolean, _
                             Optional ByVal PromptText As BStr, _
                             Optional ByVal hWndParent As BStr, _
                             Optional ByRef lpErrorNumber As Long) As Boolean
  Dim InData As DATA_BLOB
  Dim OutData As DATA_BLOB
  Dim RC As Long
  Dim CPS As CRYPTPROTECT_PROMPTSTRUCT
  Dim Prompt() As Byte
  Dim bDataDescription() As Byte
  
  ' Сначала проверим версию Windows...
  If Not asIsHostWin2000_OrHigher() Then
    lpErrorNumber = ERROR_OLD_WIN_VERSION
    DestinationData = ""
    ProtectDataB = False
    Exit Function
  End If
  
  On Error Resume Next
  
  ' Теперь проверим, правильные ли данные нам дали...
  RC = UBound(SourceData) - LBound(SourceData) + 1
  If Err Or RC <= 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    ProtectDataB = False
    Exit Function
  End If
  
  ' Теперь формируем BLOB.
  InData.cbData = UBound(SourceData) - LBound(SourceData) + 1
  InData.pbData = VarPtr(SourceData(0))
  
  bDataDescription = DataDescription & NUL
  
  ' UI...
  If ShowPrompt Then
    CPS.cbSize = Len(CPS)
    CPS.dwPromptFlags = 1 Or 2
    CPS.hwndApp = hWndParent
    Prompt = PromptText & NUL
    CPS.szPrompt = VarPtr(Prompt(0))
    
    RC = CryptProtectDataByNum2(InData, bDataDescription(0), 0, 0, CPS, 0, OutData)
  Else
    RC = CryptProtectDataByNum(InData, bDataDescription(0), 0, 0, 0, 0, OutData)
  End If
  
  If RC = 0 Then
    lpErrorNumber = Err.Number
    DestinationData = ""
    ProtectDataB = False
    Exit Function
  End If
  
  If OutData.cbData = 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    ProtectDataB = True
    Exit Function
  End If
  
  ReDim DestinationData(0 To OutData.cbData - 1)
  CopyMemory DestinationData(0), ByVal OutData.pbData, OutData.cbData
  LocalFree OutData.pbData
  
  ProtectDataB = True
End Function

'====================================================================
Public Function UnProtectDataB(ByRef SourceData() As Byte, _
                               ByRef DestinationData() As Byte, _
                               Optional ByVal ShowPrompt As Boolean, _
                               Optional ByVal PromptText As BStr, _
                               Optional ByVal hWndParent As BStr, _
                               Optional ByRef lpErrorNumber As Long) As Boolean
  Dim InData As DATA_BLOB
  Dim OutData As DATA_BLOB
  Dim RC As Long
  Dim CPS As CRYPTPROTECT_PROMPTSTRUCT
  Dim Prompt() As Byte
  
  ' Сначала проверим версию Windows...
  If Not asIsHostWin2000_OrHigher() Then
    lpErrorNumber = ERROR_OLD_WIN_VERSION
    DestinationData = ""
    UnProtectDataB = False
    Exit Function
  End If
  
  On Error Resume Next
  
  ' Теперь проверим, правильные ли данные нам дали...
  RC = UBound(SourceData) - LBound(SourceData) + 1
  If Err Or RC <= 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    UnProtectDataB = False
    Exit Function
  End If
  
  ' Теперь формируем BLOB.
  InData.cbData = UBound(SourceData) - LBound(SourceData) + 1
  InData.pbData = VarPtr(SourceData(0))
  
  ' UI...
  If ShowPrompt Then
    CPS.cbSize = Len(CPS)
    CPS.dwPromptFlags = 1 Or 2
    CPS.hwndApp = hWndParent
    Prompt = PromptText & NUL
    CPS.szPrompt = VarPtr(Prompt(0))
    
    RC = CryptUnprotectDataByNum2(InData, ByVal 0&, 0, 0, CPS, 0, OutData)
  Else
    RC = CryptUnprotectDataByNum(InData, ByVal 0&, 0, 0, 0, 0, OutData)
  End If
  
  If RC = 0 Then
    lpErrorNumber = Err.Number
    DestinationData = ""
    UnProtectDataB = False
    Exit Function
  End If
  
  If OutData.cbData = 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    UnProtectDataB = True
    Exit Function
  End If
  
  ReDim DestinationData(0 To OutData.cbData - 1)
  CopyMemory DestinationData(0), ByVal OutData.pbData, OutData.cbData
  LocalFree OutData.pbData
  
  UnProtectDataB = True
End Function

Зачем нужен UI? Да для того чтобы в зашифрованных данных можно было установить пароль ^^ Потом его спросят ^^

/* Надо будет пару функций написать для имперсонации... */

#upd: Версию со строками добавила ^^

Option Explicit

Type CRYPTPROTECT_PROMPTSTRUCT
  cbSize As Long
  dwPromptFlags As Long
  hwndApp As API_HANDLE
  szPrompt As LPWSTR_STRUCT
End Type

Type DATA_BLOB
  cbData As Long
  pbData As POINTER
End Type

Declare Function CryptProtectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptProtectDataByNum Lib "Crypt32.DLL" Alias "CryptProtectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptProtectDataByNum2 Lib "Crypt32.DLL" Alias "CryptProtectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectData Lib "Crypt32.DLL" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByRef pOptionalEntropy As DATA_BLOB, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectDataByNum Lib "Crypt32.DLL" Alias "CryptUnprotectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByVal pPromptStruct As Long, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

Declare Function CryptUnprotectDataByNum2 Lib "Crypt32.DLL" Alias "CryptUnprotectData" ( _
            ByRef pDataIn As DATA_BLOB, _
            ByRef szDataDescr As Any, _
            ByVal pOptionalEntropy As Long, _
            ByVal pvReserved As Long, _
            ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Long, _
            ByRef pDataOut As DATA_BLOB) As C_BOOL

'====================================================================
Public Sub Main()
  asRegisterAppPath
  InitCommonControls
  If Not asIsInIDE Then asSetWindowResIconAll asGetThunderMainHandle(), IDI_APPICON
  
  'BinaryTest
  StringTest
End Sub

'====================================================================
Private Sub BinaryTest()
  Dim lpErrNumber As Long
  Dim InBuff() As Byte
  Dim OutBuff() As Byte
  Dim UnpBuff() As Byte
  
  InBuff = "Почему всё так печально и грустно? А?"
  
  If Not ProtectDataB(InBuff, OutBuff, "Строка с текстом неизвестного содержания", _
                      True, App.Title, GetActiveWindow(), lpErrNumber) Then
    ajpMain.ErrorDisplayAPI lpErrNumber, , , "Can't protect data."
    Exit Sub
  End If
  
  MsgBox asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(OutBuff) & CRLFCRLF, vbInformation
  
  If Not UnProtectDataB(OutBuff, UnpBuff, _
                        True, App.Title, GetActiveWindow(), lpErrNumber) Then
    ajpMain.ErrorDisplayAPI lpErrNumber, , , "Can't unprotect data."
    Exit Sub
  End If
  
  MsgBox """" & CStr(InBuff) & """" & CRLFCRLF & _
         asExpandByteBuffer(InBuff) & CRLFCRLF & _
         asExpandByteBuffer(UnpBuff) & CRLFCRLF & _
         """" & CStr(UnpBuff) & """" & CRLFCRLF & _
         "Buffers equal: " & asIsBuffersEqual(InBuff, UnpBuff), vbInformation
End Sub

'====================================================================
Private Sub StringTest()
  Dim lpErrNumber As Long
  Dim InBuff As BStr
  Dim OutBuff As BStr
  Dim UnpBuff As BStr
  
  InBuff = "Почему всё так печально и грустно? А?"
  
  If Not ProtectData(InBuff, OutBuff, "Строка с текстом неизвестного содержания", _
                     True, App.Title, GetActiveWindow(), lpErrNumber) Then
    ajpMain.ErrorDisplayAPI lpErrNumber, , , "Can't protect data."
    Exit Sub
  End If
  
  MsgBox InBuff & CRLFCRLF & _
         asExpandByteBuffer(asStrConvB(OutBuff)) & CRLFCRLF, vbInformation
  
  If Not UnProtectData(OutBuff, UnpBuff, _
                       True, App.Title, GetActiveWindow(), lpErrNumber) Then
    ajpMain.ErrorDisplayAPI lpErrNumber, , , "Can't unprotect data."
    Exit Sub
  End If
  
  MsgBox """" & InBuff & """" & CRLFCRLF & _
         """" & UnpBuff & """" & CRLFCRLF & _
         "Buffers equal: " & CBool(StrComp(InBuff, UnpBuff, vbBinaryCompare) = 0), vbInformation
End Sub

'====================================================================
Public Function ProtectDataB(ByRef SourceData() As Byte, _
                             ByRef DestinationData() As Byte, _
                             Optional ByVal DataDescription As BStr, _
                             Optional ByVal ShowPrompt As Boolean, _
                             Optional ByVal PromptText As BStr, _
                             Optional ByVal hWndParent As BStr, _
                             Optional ByRef lpErrorNumber As Long) As Boolean
  Dim InData As DATA_BLOB
  Dim OutData As DATA_BLOB
  Dim RC As Long
  Dim CPS As CRYPTPROTECT_PROMPTSTRUCT
  Dim Prompt() As Byte
  Dim bDataDescription() As Byte
  
  ' Сначала проверим версию Windows...
  If Not asIsHostWin2000_OrHigher() Then
    lpErrorNumber = ERROR_OLD_WIN_VERSION
    DestinationData = ""
    ProtectDataB = False
    Exit Function
  End If
  
  On Error Resume Next
  
  ' Теперь проверим, правильные ли данные нам дали...
  RC = UBound(SourceData) - LBound(SourceData) + 1
  If Err Or RC <= 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    ProtectDataB = False
    Exit Function
  End If
  
  ' Теперь формируем BLOB.
  InData.cbData = UBound(SourceData) - LBound(SourceData) + 1
  InData.pbData = VarPtr(SourceData(0))
  
  bDataDescription = DataDescription & NUL
  
  ' UI...
  If ShowPrompt Then
    CPS.cbSize = Len(CPS)
    CPS.dwPromptFlags = 1 Or 2
    CPS.hwndApp = hWndParent
    Prompt = PromptText & NUL
    CPS.szPrompt = VarPtr(Prompt(0))
    
    RC = CryptProtectDataByNum2(InData, bDataDescription(0), 0, 0, CPS, 0, OutData)
  Else
    RC = CryptProtectDataByNum(InData, bDataDescription(0), 0, 0, 0, 0, OutData)
  End If
  
  If RC = 0 Then
    lpErrorNumber = Err.Number
    DestinationData = ""
    ProtectDataB = False
    Exit Function
  End If
  
  If OutData.cbData = 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    ProtectDataB = True
    Exit Function
  End If
  
  ReDim DestinationData(0 To OutData.cbData - 1)
  CopyMemory DestinationData(0), ByVal OutData.pbData, OutData.cbData
  LocalFree OutData.pbData
  
  ProtectDataB = True
End Function

'====================================================================
Public Function UnProtectDataB(ByRef SourceData() As Byte, _
                               ByRef DestinationData() As Byte, _
                               Optional ByVal ShowPrompt As Boolean, _
                               Optional ByVal PromptText As BStr, _
                               Optional ByVal hWndParent As BStr, _
                               Optional ByRef lpErrorNumber As Long) As Boolean
  Dim InData As DATA_BLOB
  Dim OutData As DATA_BLOB
  Dim RC As Long
  Dim CPS As CRYPTPROTECT_PROMPTSTRUCT
  Dim Prompt() As Byte
  
  ' Сначала проверим версию Windows...
  If Not asIsHostWin2000_OrHigher() Then
    lpErrorNumber = ERROR_OLD_WIN_VERSION
    DestinationData = ""
    UnProtectDataB = False
    Exit Function
  End If
  
  On Error Resume Next
  
  ' Теперь проверим, правильные ли данные нам дали...
  RC = UBound(SourceData) - LBound(SourceData) + 1
  If Err Or RC <= 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    UnProtectDataB = False
    Exit Function
  End If
  
  ' Теперь формируем BLOB.
  InData.cbData = UBound(SourceData) - LBound(SourceData) + 1
  InData.pbData = VarPtr(SourceData(0))
  
  ' UI...
  If ShowPrompt Then
    CPS.cbSize = Len(CPS)
    CPS.dwPromptFlags = 1 Or 2
    CPS.hwndApp = hWndParent
    Prompt = PromptText & NUL
    CPS.szPrompt = VarPtr(Prompt(0))
    
    RC = CryptUnprotectDataByNum2(InData, ByVal 0&, 0, 0, CPS, 0, OutData)
  Else
    RC = CryptUnprotectDataByNum(InData, ByVal 0&, 0, 0, 0, 0, OutData)
  End If
  
  If RC = 0 Then
    lpErrorNumber = Err.Number
    DestinationData = ""
    UnProtectDataB = False
    Exit Function
  End If
  
  If OutData.cbData = 0 Then
    lpErrorNumber = 0
    DestinationData = ""
    UnProtectDataB = True
    Exit Function
  End If
  
  ReDim DestinationData(0 To OutData.cbData - 1)
  CopyMemory DestinationData(0), ByVal OutData.pbData, OutData.cbData
  LocalFree OutData.pbData
  
  UnProtectDataB = True
End Function

'====================================================================
Public Function ProtectData(ByRef SourceData As BStr, _
                            ByRef DestinationData As BStr, _
                            Optional ByVal DataDescription As BStr, _
                            Optional ByVal ShowPrompt As Boolean, _
                            Optional ByVal PromptText As BStr, _
                            Optional ByVal hWndParent As BStr, _
                            Optional ByRef lpErrorNumber As Long) As Boolean
  Dim bSourceData() As Byte
  Dim bDestinationData() As Byte
  
  bSourceData = asStrConvB(SourceData)
  bDestinationData = asStrConvB(DestinationData)
  
  ProtectData = ProtectDataB(bSourceData, bDestinationData, DataDescription, _
                             ShowPrompt, PromptText, hWndParent, lpErrorNumber)
  
  SourceData = asStrConvW(bSourceData)
  DestinationData = asStrConvW(bDestinationData)
End Function

Public Function UnProtectData(ByRef SourceData As BStr, _
                              ByRef DestinationData As BStr, _
                              Optional ByVal ShowPrompt As Boolean, _
                              Optional ByVal PromptText As BStr, _
                              Optional ByVal hWndParent As BStr, _
                              Optional ByRef lpErrorNumber As Long) As Boolean
  Dim bSourceData() As Byte
  Dim bDestinationData() As Byte
  
  bSourceData = asStrConvB(SourceData)
  bDestinationData = asStrConvB(DestinationData)
  
  UnProtectData = UnProtectDataB(bSourceData, bDestinationData, ShowPrompt, _
                                 PromptText, hWndParent, lpErrorNumber)
  
  SourceData = asStrConvW(bSourceData)
  DestinationData = asStrConvW(bDestinationData)
End Function

Теперь осталось вооружиться одной умной книжкой и написать алгоритм для шифровки между машинами и юзерами ^^ Тогда можно будет начать писать свой простой менеджер паролей взамен тому, что есть.

KeePass - хорошая штука, но меня не устраивает. Мне нужна кастомизабельность полей, а не навороты в виде плагинов при ограниченном наборе...

#music: Scooter\The Ultimate Aural Orgasm\Imaginary Battle

URL


Запомнить