Работа с файлами или с людьми -- может проще дать по рукам?

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
[LEV&n]
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 113
Зарегистрирован: 17.10.2007 (Ср) 22:23
Откуда: Мариуполь

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение [LEV&n] » 15.05.2009 (Пт) 17:01

Хакер писал(а):О какой продвинутости идёт речь? О продвинутости можно говорить, скажем, когда есть 300 программ, и среди них твоя --- быстрейшая и наиболее надёжная. Когда речь идёт о банальном хранении данных в файле в бинарном виде, о какой продвинутости можно говорить? Можно говорить только об отсутствии знаний. Наличие которых, кстати, даже близко не ставит тебя к продвинутым.

И у нас вообще-то нет раздел для начинающих. :?

ОК. Пример чего ты хочешь получить? Только не говори, что пример всего.


А мне ты никогда примеры не предлагал...
2 причины, либо излишняя гениальность, либо излишний идиотизм... :?

К стати этот факт всегда побуждал меня искать решение проблемы в одиночку, может автору ту же пилюлину прописать? Прогрессивный метод. Пример бинарного кодирования поставлялся ещё в комплекте с VB4, пример с MDI form, старики должны помнить..
Последний раз редактировалось [LEV&n] 15.05.2009 (Пт) 17:04, всего редактировалось 1 раз.
Если исключить из всех производственных звеньев дураков, то актуальность обсуждения продуктов их жизнедеятельности (дороги, пр-во и т.п.) исчезнет сама по себе.

RayShade
Scarmarked
Scarmarked
Аватара пользователя
 
Сообщения: 5511
Зарегистрирован: 02.12.2002 (Пн) 17:11
Откуда: Russia, Saint-Petersburg

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение RayShade » 15.05.2009 (Пт) 17:03

Лаборатор, друг мой. Ты поставил слишком много восклицательных знаков. И наш умный форум автозаменил их, посчитав тебя, вполне обоснованно, идиотом.
I don't understand. Sorry.

Лаборатор
Обычный пользователь
Обычный пользователь
 
Сообщения: 55
Зарегистрирован: 21.03.2009 (Сб) 15:06
Откуда: Москва

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение Лаборатор » 15.05.2009 (Пт) 17:06

Хакер писал(а):О какой продвинутости идёт речь? О продвинутости можно говорить, скажем, когда есть 300 программ, и среди них твоя --- быстрейшая и наиболее надёжная. Когда речь идёт о банальном хранении данных в файле в бинарном виде, о какой продвинутости можно говорить? Можно говорить только об отсутствии знаний. Наличие которых, кстати, даже близко не ставит тебя к продвинутым.

И у нас вообще-то нет раздел для начинающих. :?

ОК. Пример чего ты хочешь получить? Только не говори, что пример всего.

Пример сохранения данных и их чтения, скажем в массив.
В сети бываю редко!
Своего интернета у меня нет...

Лаборатор
Обычный пользователь
Обычный пользователь
 
Сообщения: 55
Зарегистрирован: 21.03.2009 (Сб) 15:06
Откуда: Москва

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение Лаборатор » 15.05.2009 (Пт) 17:07

RayShade писал(а):Лаборатор, друг мой. Ты поставил слишком много восклицательных знаков. И наш умный форум автозаменил их, посчитав тебя, вполне обоснованно, идиотом.

Да, да искусственный интеллект, с замашками высокомерного админа!
В сети бываю редко!
Своего интернета у меня нет...

[LEV&n]
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 113
Зарегистрирован: 17.10.2007 (Ср) 22:23
Откуда: Мариуполь

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение [LEV&n] » 15.05.2009 (Пт) 17:12

RayShade писал(а):Лаборатор, друг мой. Ты поставил слишком много восклицательных знаков. И наш умный форум автозаменил их, посчитав тебя, вполне обоснованно, идиотом.


Ваш мозг выполнил невыполнимую задачу и будет закрыт...
Если исключить из всех производственных звеньев дураков, то актуальность обсуждения продуктов их жизнедеятельности (дороги, пр-во и т.п.) исчезнет сама по себе.

Лаборатор
Обычный пользователь
Обычный пользователь
 
Сообщения: 55
Зарегистрирован: 21.03.2009 (Сб) 15:06
Откуда: Москва

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение Лаборатор » 15.05.2009 (Пт) 17:14

[LEV&n] писал(а):
RayShade писал(а):Лаборатор, друг мой. Ты поставил слишком много восклицательных знаков. И наш умный форум автозаменил их, посчитав тебя, вполне обоснованно, идиотом.


Ваш мозг выполнил невыполнимую задачу и будет закрыт...

Вот за что надо банить! И куда админы смотрят?
В сети бываю редко!
Своего интернета у меня нет...

arvitaly
Постоялец
Постоялец
 
Сообщения: 485
Зарегистрирован: 12.04.2009 (Вс) 0:30
Откуда: Казань

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение arvitaly » 15.05.2009 (Пт) 17:17

Код: Выделить всё
Option Explicit

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (phProv As Long, pszContainer As String, pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, phKey As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
Private Declare Function CryptExportKey Lib "advapi32.dll" (ByVal hKey As Long, ByVal hExpKey As Long, ByVal dwBlobType As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
Private Declare Function CryptGenKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal dwFlags As Long, phKey As Long) As Long
Private Declare Function CryptGetProvParam Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetUserKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwKeySpec As Long, phUserKey As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptSignHash Lib "advapi32.dll" Alias "CryptSignHashA" (ByVal hHash As Long, ByVal dwKeySpec As Long, ByVal sDescription As String, ByVal dwFlags As Long, ByVal pbSignature As String, pdwSigLen As Long) As Long
Private Declare Function CryptVerifySignature Lib "advapi32.dll" Alias "CryptVerifySignatureA" (ByVal hHash As Long, ByVal pbSignature As String, ByVal dwSigLen As Long, ByVal hPubKey As Long, ByVal sDescription As String, ByVal dwFlags As Long) As Long

'API error function
Private Declare Function GetLastError Lib "kernel32" () As Long

'API memory functions
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CpyMemValAdrFromRefAdr Lib "kernel32" Alias "RtlMoveMemory" (ByVal hpvDest As Any, hpvSource As Any, ByVal cbcopy As Long)
Private Declare Sub CpyMemRefAdrFromValAdr Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Any, ByVal cbcopy As Long)

'constants for API memory functions
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

'constants for Cryptography API functions
Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL = 1
Private Const CRYPT_NEWKEYSET = &H8
Private Const PP_CONTAINER = 6
Private Const AT_KEYEXCHANGE = 1
Private Const AT_SIGNATURE = 2

Private Const SIMPLEBLOB = 1

Private Const ALG_CLASS_DATA_ENCRYPT = 24576
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536
Private Const ALG_TYPE_STREAM = 2048
Private Const ALG_SID_RC2 = 2
Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_MD5 = 3

Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or ALG_SID_RC2)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)

'constants from WinErr.h
Private Const NTE_NO_KEY As Long = -2146893811  '0x8009000DL
Private Const NTE_BAD_SIGNATURE As Long = -2146893818

'clsCryptoFilterBox constants
Private Const CFB_BUSY = 0
Private Const CFB_READY = 1
Private Const CFB_VALID = 2

Private Const ENCRYPT_ALGORITHM = CALG_RC4
Private Const ENCRYPT_BLOCK_SIZE = 1

Private Const CRYPT_EXPORTABLE = 1

'private property buffers
Private sInBuffer As String
Private sOutBuffer As String
Private sPassword As String
Private sSignature As String
Private lStatus As Long
Public Property Get InBuffer() As String
    InBuffer = sInBuffer
End Property
Public Property Let InBuffer(vNewValue As String)
    sInBuffer = vNewValue
End Property
Public Property Get OutBuffer() As String
    OutBuffer = sOutBuffer
End Property
Public Property Get Signature() As String
    Signature = sSignature
End Property
Public Property Let Signature(vNewValue As String)
    sSignature = vNewValue
End Property
Public Sub Sign()
'Create a signature for Inbuffer and place in Signature

Dim sContainer As String, sDescription As String, sProvider As String, lHCryptprov As Long
Dim lHHash As Long, lResult As Long, lSignatureLen As Long

On Error GoTo ErrSign

'switch Status property
lStatus = CFB_BUSY

'init Signature property
sSignature = ""

'Get handle to the default provider.
sContainer = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
    ''MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
    GoTo ReleaseHandles:
End If

'Create a hash object.
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
    GoTo ReleaseHandles:
End If

If Not CBool(CryptHashData(lHHash, sInBuffer, Len(sInBuffer), 0)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
    GoTo ReleaseHandles:
End If

'Sign hash object.
'Determine size of signature.
sDescription = vbNullChar
lResult = CryptSignHash(lHHash, AT_SIGNATURE, sDescription, 0, sSignature, lSignatureLen)

sSignature = String(lSignatureLen, vbNullChar)

'Sign hash object (with signature key).
If Not CBool(CryptSignHash(lHHash, AT_SIGNATURE, sDescription, 0, sSignature, lSignatureLen)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError()) & " during CryptSignHash")
    GoTo ReleaseHandles:
End If

ReleaseHandles:
'Destroy hash object.
If lHHash Then lResult = CryptDestroyHash(lHHash)
'Release provider handle.
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

'switch Status property
lStatus = CFB_READY

Exit Sub

ErrSign:
''MsgBox ("ErrSign " & Error$)
GoTo ReleaseHandles
End Sub

Public Sub Validate()
'Validate InBuffer with Signature and assign Status with result
Dim bValid As Boolean, sContainer As String, sDescription As String, sProvider As String
Dim lDataLen As Long, lDataPoint As Long, lHCryptprov As Long, lHHash As Long
Dim lResult As Long, lSignatureLen As Long, lHCryptKey As Long

ReDim aByteData(0) As Byte

On Error GoTo ErrValidate

'switch Status property
lStatus = CFB_BUSY

'init internal valid flag
bValid = True

'Get handle to the default provider.
sContainer = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
    bValid = False
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
    GoTo ReleaseHandles:
End If

'Create a hash object.
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
    bValid = False
  ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
    GoTo ReleaseHandles:
End If

'Add data to hash object.
If Not CBool(CryptHashData(lHHash, sInBuffer, Len(sInBuffer), 0)) Then
    bValid = False
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
    GoTo ReleaseHandles:
End If

'Determine size of signature.
'sDescription = vbNullChar
'lResult = CryptSignHash(lHHash, AT_SIGNATURE, sDescription, 0, 0, lSignatureLen)

'Get handle to signature key.
If Not CBool(CryptGetUserKey(lHCryptprov, AT_SIGNATURE, lHCryptKey)) Then
    bValid = False
  '  'MsgBox ("Error " & CStr(GetLastError) & " during CryptGetUserKey!")
    GoTo ReleaseHandles:
End If

lSignatureLen = Len(sSignature)

'Verify signature.
If Not CBool(CryptVerifySignature(lHHash, sSignature, lSignatureLen, lHCryptKey, sDescription, 0)) Then

    If GetLastError = NTE_BAD_SIGNATURE Then
        bValid = False
        GoTo ReleaseHandles:
    Else
        bValid = False
       ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptVerifySignature!")
        GoTo ReleaseHandles:
    End If

End If

ReleaseHandles:
'Release signature key.
If lHCryptKey Then lResult = CryptDestroyKey(lHCryptKey)
'Destroy hash object.
If lHHash Then lResult = CryptDestroyHash(lHHash)
'Release provider handle.
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

Select Case bValid
    Case True
        lStatus = CFB_VALID
    Case Else
        lStatus = CFB_READY
End Select

Exit Sub

ErrValidate:
''MsgBox ("ErrValidate " & Error$)
Resume

End Sub
Public Sub Encrypt()
'Encrypt InBuffer into OutBuffer

Dim lHExchgKey As Long, lHCryptprov As Long, lHHash As Long, lHkey As Long
Dim lResult As Long, sContainer As String, sProvider As String, sCryptBuffer As String
Dim lCryptLength As Long, lCryptBufLen As Long

On Error GoTo ErrEncrypt

'switch Status property
lStatus = CFB_BUSY

'Get handle to the default provider
sContainer = vbNullChar
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
    GoTo Done
End If

'Create a hash object.
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
  '  'MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
    GoTo Done
End If

'Hash in the password data.
If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
  '  'MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
    GoTo Done
End If

'Derive a session key from the hash object.
If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
    GoTo Done
End If

'Destroy the hash object.
CryptDestroyHash (lHHash)
lHHash = 0

'Prepare a string buffer for the CryptEncrypt function
lCryptLength = Len(sInBuffer)
lCryptBufLen = lCryptLength * 2
sCryptBuffer = String(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = sInBuffer

'Encrypt data
If Not CBool(CryptEncrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptLength, lCryptBufLen)) Then
    ''MsgBox ("bytes required:" & CStr(lCryptLength))
    ''MsgBox ("Error " & CStr(GetLastError) & " during CryptEncrypt!")
    'GoTo Done
End If

sOutBuffer = Mid$(sCryptBuffer, 1, lCryptLength)

Done:

'Destroy session key.
If (lHkey) Then lResult = CryptDestroyKey(lHkey)

'Release key exchange key handle.
If lHExchgKey Then CryptDestroyKey (lHExchgKey)

'Destroy hash object.
If lHHash Then CryptDestroyHash (lHHash)

'Release provider handle.
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

'switch Status property
lStatus = CFB_READY

Exit Sub

ErrEncrypt:

''MsgBox ("ErrEncrypt " & Error$)
Resume

End Sub
Public Sub Decrypt()
'Decrypt InBuffer into OutBuffer
Dim lHExchgKey As Long, lHCryptprov As Long, lHHash As Long, lHkey As Long
Dim lResult As Long, sContainer As String, sProvider As String
Dim sCryptBuffer As String, lCryptBufLen As Long, lCryptPoint As Long
Dim lPasswordPoint As Long, lPasswordCount As Long

On Error GoTo ErrDecrypt

'switch Status property
lStatus = CFB_BUSY

'Init sOutBuffer
sOutBuffer = ""

'Get handle to the default provider.
sContainer = vbNullChar
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
    GoTo Done
End If

'Create a hash object.
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
    GoTo Done
End If

'Hash in the password data.
If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
   ' 'MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
    GoTo Done
End If

'Derive a session key from the hash object.
If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
    'MsgBox ("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
    GoTo Done
End If

'Destroy the hash object.
CryptDestroyHash (lHHash)
lHHash = 0

'Prepare sCryptBuffer for CryptDecrypt
lCryptBufLen = Len(sInBuffer) * 2
sCryptBuffer = String(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = sInBuffer

'Decrypt data
If Not CBool(CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen)) Then
    'MsgBox ("bytes required:" & CStr(lCryptBufLen))
    'MsgBox ("Error " & CStr(GetLastError) & " during CryptDecrypt!")
    GoTo Done
End If

'Apply decrypted string from sCryptBuffer to private buffer for OutBuffer property
sOutBuffer = Mid$(sCryptBuffer, 1, Len(sInBuffer))

Done:

'Destroy session key.
If (lHkey) Then lResult = CryptDestroyKey(lHkey)

'Release key exchange key handle.
If lHExchgKey Then CryptDestroyKey (lHExchgKey)

'Destroy hash object.
If lHHash Then CryptDestroyHash (lHHash)

'Release provider handle.
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

'switch Status property
lStatus = CFB_READY

Exit Sub

ErrDecrypt:
'MsgBox ("ErrDecrypt " & Error$)
GoTo Done

End Sub
Public Property Get Status() As Long
    Status = lStatus
End Property
Private Function InitUser() As Long
    Dim lHCryptprov As Long, lHCryptKey As Long, avProviderData(1000) As Byte
    Dim lProviderDataAddress As Long, lProviderDataLen As Long, lDataSize As Long
    Dim lResult As Long, sContainer As String, sProvider As String
    Dim sUserName As String, lPoint As Long, lMemHandle As Long
    Dim lReturn As Long, sBuffer As String

    On Error GoTo ErrInitUser
    'prepare string buffers

    sContainer = vbNullChar
    sProvider = MS_DEF_PROV & vbNullChar

    'Attempt to acquire a handle to the default key container.
    If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then

        'Create default key container.
        If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)) Then
            'MsgBox ("Error creating key container! " & CStr(GetLastError))
            Exit Function
        End If

        'Get name of default key container.
        lProviderDataLen = Len(avProviderData(0)) * (UBound(avProviderData) + 1)
        If Not CBool(CryptGetProvParam(lHCryptprov, PP_CONTAINER, avProviderData(0), lProviderDataLen, 0)) Then
            'MsgBox ("Error getting user name! " & CStr(GetLastError))
            avProviderData(0) = 0
        End If

        'Get sUserName from avProviderData()
        lPoint = LBound(avProviderData)
        While lPoint <= UBound(avProviderData)
            If avProviderData(lPoint) <> 0 Then
                sUserName = sUserName & Chr$(avProviderData(lPoint))
            Else
                lPoint = UBound(avProviderData)
            End If
            lPoint = lPoint + 1
        Wend

        'MsgBox ("Create key container " & sUserName)

    End If

    'Attempt to get handle to signature key
    If Not CBool(CryptGetUserKey(lHCryptprov, AT_SIGNATURE, lHCryptKey)) Then
        If GetLastError = NTE_NO_KEY Then
            'MsgBox ("Create key exchange key pair")
            If Not CBool(CryptGenKey(lHCryptprov, AT_SIGNATURE, 0, lHCryptKey)) Then
                'MsgBox ("Error during CryptGenKey! " & CStr(GetLastError))
                Exit Function
            Else
                lResult = CryptDestroyKey(lHCryptprov)
            End If
        Else
            'MsgBox ("Error during CryptGetUserKey! " & CStr(GetLastError))
            Exit Function
        End If
    End If

    'Attempt to get handle to exchange key
    If Not CBool(CryptGetUserKey(lHCryptprov, AT_KEYEXCHANGE, lHCryptKey)) Then
        If GetLastError = NTE_NO_KEY Then
            'MsgBox ("Create key exchange key pair")
            If Not CBool(CryptGenKey(lHCryptprov, AT_KEYEXCHANGE, 0, lHCryptKey)) Then
                'MsgBox ("Error during CryptGenKey! " & CStr(GetLastError))
                Exit Function
            Else
                lResult = CryptDestroyKey(lHCryptprov)
            End If
        Else
            'MsgBox ("Error during CryptGetUserKey! " & CStr(GetLastError))
            Exit Function
        End If
    End If

    'release handle to provider
    lResult = CryptReleaseContext(lHCryptprov, 0)
    InitUser = True

Exit Function

ErrInitUser:
    ''MsgBox ("ErrInitUser " & Error$)
    Resume

End Function
Private Sub Class_Initialize()
    If InitUser = True Then
       ' 'MsgBox ("InitUser OK")
    Else
       ' 'MsgBox ("InitUser failed")
    End If
End Sub
Public Property Get Password() As String
    Password = sPassword
End Property
Public Property Let Password(vNewValue As String)
    sPassword = vNewValue
End Property


Пример использования
Код: Выделить всё
dim crypt As New clsCryptoFilterBox,typeDo  as boolean, password as string
password="test1"
crypt.InBuffer = strCoderTemp
            crypt.Password = Password
            If typeDo = False Then crypt.Decrypt Else crypt.Encrypt
            strCoderTemp = crypt.OutBuffer

[LEV&n]
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 113
Зарегистрирован: 17.10.2007 (Ср) 22:23
Откуда: Мариуполь

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение [LEV&n] » 15.05.2009 (Пт) 17:20

Лаборатор писал(а):
[LEV&n] писал(а):
RayShade писал(а):Лаборатор, друг мой. Ты поставил слишком много восклицательных знаков. И наш умный форум автозаменил их, посчитав тебя, вполне обоснованно, идиотом.


Ваш мозг выполнил невыполнимую задачу и будет закрыт...

Вот за что надо банить! И куда админы смотрят?


Если Вы не в состоянии оценить русский юмор, то не стоит указывать, что кому делать..
Если исключить из всех производственных звеньев дураков, то актуальность обсуждения продуктов их жизнедеятельности (дороги, пр-во и т.п.) исчезнет сама по себе.

Лаборатор
Обычный пользователь
Обычный пользователь
 
Сообщения: 55
Зарегистрирован: 21.03.2009 (Сб) 15:06
Откуда: Москва

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение Лаборатор » 15.05.2009 (Пт) 17:23

Вот спасибо arvitaly! Хоть что то реальное!
Пойду пробовать, если получится отпишусь...когда выйду в интернет!
В сети бываю редко!
Своего интернета у меня нет...

Лаборатор
Обычный пользователь
Обычный пользователь
 
Сообщения: 55
Зарегистрирован: 21.03.2009 (Сб) 15:06
Откуда: Москва

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение Лаборатор » 15.05.2009 (Пт) 17:25

[LEV&n] писал(а):Если Вы не в состоянии оценить русский юмор, то не стоит указывать, что кому делать..

Зачем засорять тему юмором - это ведь и есть самый настоящий спам!
В сети бываю редко!
Своего интернета у меня нет...

arvitaly
Постоялец
Постоялец
 
Сообщения: 485
Зарегистрирован: 12.04.2009 (Вс) 0:30
Откуда: Казань

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение arvitaly » 15.05.2009 (Пт) 17:26

Зачем засорять тему юмором - это ведь и есть самый настоящий спам!


Это флуд, спам обычно имеет рекламный характер

И в отличии от флудеров, спамеры - это настоящая проблема для всемирной паутины
Последний раз редактировалось arvitaly 15.05.2009 (Пт) 17:27, всего редактировалось 1 раз.

Лаборатор
Обычный пользователь
Обычный пользователь
 
Сообщения: 55
Зарегистрирован: 21.03.2009 (Сб) 15:06
Откуда: Москва

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение Лаборатор » 15.05.2009 (Пт) 17:27

arvitaly писал(а):
Зачем засорять тему юмором - это ведь и есть самый настоящий спам!


Это флуд, спам обычно имеет рекламный характер

Ты прав!
В сети бываю редко!
Своего интернета у меня нет...

[LEV&n]
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 113
Зарегистрирован: 17.10.2007 (Ср) 22:23
Откуда: Мариуполь

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение [LEV&n] » 15.05.2009 (Пт) 17:30

Лаборатор писал(а):
arvitaly писал(а):
Зачем засорять тему юмором - это ведь и есть самый настоящий спам!


Это флуд, спам обычно имеет рекламный характер

Ты прав!


Теперь, я могу полагать, что спор пришёл к логическому завершению? Это не спам, - это действительно флуд, флудом называются те топики, которые не имеют никакого отношения к обсуждаемой теме. Я плохой, правосудие да восторжествует! Теперь успокоились?
Если исключить из всех производственных звеньев дураков, то актуальность обсуждения продуктов их жизнедеятельности (дороги, пр-во и т.п.) исчезнет сама по себе.

arvitaly
Постоялец
Постоялец
 
Сообщения: 485
Зарегистрирован: 12.04.2009 (Вс) 0:30
Откуда: Казань

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение arvitaly » 15.05.2009 (Пт) 17:35

Теперь, я могу полагать, что спор пришёл к логическому завершению? Это не спам, - это действительно флуд, флудом называются те топики, которые не имеют никакого отношения к обсуждаемой теме. Я плохой, правосудие да восторжествует! Теперь успокоились?


Нет, спляши, пожалуйста, лезгинку

[LEV&n]
Продвинутый пользователь
Продвинутый пользователь
Аватара пользователя
 
Сообщения: 113
Зарегистрирован: 17.10.2007 (Ср) 22:23
Откуда: Мариуполь

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение [LEV&n] » 15.05.2009 (Пт) 17:41

arvitaly писал(а):
Теперь, я могу полагать, что спор пришёл к логическому завершению? Это не спам, - это действительно флуд, флудом называются те топики, которые не имеют никакого отношения к обсуждаемой теме. Я плохой, правосудие да восторжествует! Теперь успокоились?


Нет, спляши, пожалуйста, лезгинку


Теперь концепция такова, меня не интересуют основы ваших желаний, мне нужен результат и результат желательно в программном коде. Так что оставьте эту мерзкую лезгинку себе. И не имейте тенденции заниматься тем, погрешность чего констатировали n-минут назад.
Если исключить из всех производственных звеньев дураков, то актуальность обсуждения продуктов их жизнедеятельности (дороги, пр-во и т.п.) исчезнет сама по себе.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16478
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение Хакер » 15.05.2009 (Пт) 17:42

Тема превратилась в помойку. Закрываю.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

RayShade
Scarmarked
Scarmarked
Аватара пользователя
 
Сообщения: 5511
Зарегистрирован: 02.12.2002 (Пн) 17:11
Откуда: Russia, Saint-Petersburg

Re: Работа с файлами или с людьми -- может проще дать по рукам?

Сообщение RayShade » 15.05.2009 (Пт) 17:57

Лаборатор, пользуясь тем что я могу сюда писать, а ты нет, скажу тебе -- да, админы тут высокомерные. То есть я хотел, сказать что то типа, я админ а ты идиот -- такие дела, да.
Какая я иногда все-таки сволочь, а :)
I don't understand. Sorry.

Пред.

Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Google-бот и гости: 26

    TopList