File: n_svc_crypto.sru
Size: 7497
Date: Mon, 07 Apr 2008 21:31:13 +0200
$PBExportHeader$n_svc_crypto.sru
$PBExportComments$MS Cryptography services
forward
global type n_svc_crypto from n_svc_base
end type
end forward

global type n_svc_crypto from n_svc_base
boolean #pooled = false
end type
global n_svc_crypto n_svc_crypto

type prototypes
Function ulong GetLastError( ) Library "kernel32.dll"

Function ulong FormatMessage( &
   ulong dwFlags, &
   ulong lpSource, &
   ulong dwMessageId, &
   ulong dwLanguageId, &
   Ref string lpBuffer, &
   ulong nSize, &
   ulong Arguments &
   ) Library "kernel32.dll" Alias For "FormatMessageW"

Function Boolean CryptAcquireContext ( &
   Ref ulong phProv, &
   string pszContainer, &
   string pszProvider, &
   ulong dwProvType, &
   ulong dwFlags &
   ) Library "advapi32.dll" Alias For "CryptAcquireContextW"

Function Boolean CryptCreateHash ( &
   ulong hProv, &
   ulong Algid, &
   ulong hKey, &
   ulong dwFlags, &
   Ref ulong phHash &
   ) Library "advapi32.dll" Alias For "CryptCreateHash"

Function Boolean CryptDecrypt ( &
   ulong hKey, &
   ulong hHash, &
   ulong Final, &
   ulong dwFlags, &
   Ref string pbData, &
   Ref ulong pdwDataLen &
   ) Library "advapi32.dll" Alias For "CryptDecrypt;Ansi"

Function Boolean CryptDeriveKey ( &
   ulong hProv, &
   ulong Algid, &
   ulong hBaseData, &
   ulong dwFlags, &
   Ref ulong phKey &
   ) Library "advapi32.dll" Alias For "CryptDeriveKey"

Function Boolean CryptDestroyHash ( &
   ulong hHash &
   ) Library "advapi32.dll" Alias For "CryptDestroyHash"

Function Boolean CryptDestroyKey ( &
   ulong hKey &
   ) Library "advapi32.dll" Alias For "CryptDestroyKey"

Function Boolean CryptEncrypt ( &
   ulong hKey, &
   ulong hHash, &
   ulong Final, &
   ulong dwFlags, &
   Ref string pbData, &
   Ref ulong pdwDataLen, &
   ulong dwBufLen &
   ) Library "advapi32.dll" Alias For "CryptEncrypt;Ansi"

Function Boolean CryptHashData ( &
   ulong hHash, &
   string pbData, &
   ulong dwDataLen, &
   ulong dwFlags &
   ) Library "advapi32.dll" Alias For "CryptHashData;Ansi"

Function Boolean CryptReleaseContext ( &
   ulong hProv, &
   ulong dwFlags &
   ) Library "advapi32.dll" Alias For "CryptReleaseContext"

end prototypes
type variables
Constant String SERVICE_PROVIDER = "Microsoft Base Cryptographic Provider v1.0"
Constant String KEY_CONTAINER = "Metallica"
Constant ULong PROV_RSA_FULL = 1
Constant ULong CRYPT_NEWKEYSET = 8
Constant ULong CALG_MD5 = 32771
Constant ULong ENCRYPT_ALGORITHM = 26625
end variables
forward prototypes
public subroutine of_getlasterror (ref unsignedlong aul_error, ref string as_msgtext)
private function string of_encryptdecrypt (string as_data, string as_password, boolean ab_encrypt)
public function string of_encryptdata (string as_data, string as_password)
public function string of_decryptdata (string as_data, string as_password)
end prototypes

public subroutine of_getlasterror (ref unsignedlong aul_error, ref string as_msgtext);// This function returns the most recent API error message

Constant ULong FORMAT_MESSAGE_FROM_SYSTEM = 4096
Constant ULong LANG_NEUTRAL = 0
ULong lul_rtn

aul_error = GetLastError()

as_msgtext = Space(200)

lul_rtn = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, &
            aul_error, LANG_NEUTRAL, as_msgtext, 200, 0)

end subroutine

private function string of_encryptdecrypt (string as_data, string as_password, boolean ab_encrypt);// This function is called by of_EncryptData and of_DecryptData
// because most of the API calls are identical for both.

ULong hCryptProv, hHash, hKey
String ls_value, ls_buffer, ls_msgtext
ULong lul_datalen, lul_buflen, lul_error

// Get handle to CSP
If Not CryptAcquireContext(hCryptProv, &
            KEY_CONTAINER, SERVICE_PROVIDER, &
            PROV_RSA_FULL, CRYPT_NEWKEYSET) Then
   If Not CryptAcquireContext(hCryptProv, &
               KEY_CONTAINER, SERVICE_PROVIDER, &
               PROV_RSA_FULL, 0) Then
      of_GetLastError(lul_error, ls_msgtext)
      SignalError(lul_error, &
         "CryptAcquireContext:~r~n~r~n" + ls_msgtext)
   End If
End If

// Create a hash object
If Not CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash) Then
   of_GetLastError(lul_error, ls_msgtext)
   SignalError(lul_error, &
      "CryptCreateHash:~r~n~r~n" + ls_msgtext)
End If

// Hash the password
If Not CryptHashData(hHash, as_password, Len(as_password), 0) Then
   of_GetLastError(lul_error, ls_msgtext)
   SignalError(lul_error, &
      "CryptHashData:~r~n~r~n" + ls_msgtext)
End If

// Derive a session key from the hash object
If Not CryptDeriveKey(hCryptProv, ENCRYPT_ALGORITHM, hHash, 0, hKey) Then
   of_GetLastError(lul_error, ls_msgtext)
   SignalError(lul_error, &
      "CryptDeriveKey:~r~n~r~n" + ls_msgtext)
End If

lul_datalen = Len(as_data)
ls_buffer = as_data + Space(lul_datalen)
lul_buflen = Len(ls_buffer)

If ab_encrypt Then
   // Encrypt data
   If Not CryptEncrypt(hKey, 0, 1, 0, &
               ls_buffer, lul_datalen, lul_buflen) Then
      of_GetLastError(lul_error, ls_msgtext)
      SignalError(lul_error, &
         "CryptEncrypt:~r~n~r~n" + ls_msgtext)
  End If
Else
   // Decrypt data
   If Not CryptDecrypt(hKey, 0, 1, 0, ls_buffer, lul_datalen) Then
      of_GetLastError(lul_error, ls_msgtext)
      SignalError(lul_error, &
         "CryptDecrypt:~r~n~r~n" + ls_msgtext)
   End If
End If

ls_value = Mid(ls_buffer, 1, lul_datalen)

// Destroy session key
If hKey > 0 Then
   CryptDestroyKey(hKey)
End If

// Destroy hash object
If hHash > 0 Then
   CryptDestroyHash(hHash)
End If

// Release CSP handle
If hCryptProv > 0 Then
   CryptReleaseContext(hCryptProv, 0)
End If

Return ls_value

end function

public function string of_encryptdata (string as_data, string as_password);// This function will encrypt the data passed to it.

Constant Char TAB = Char(9)   // Tab
Constant Char LF  = Char(10)  // Linefeed
Constant Char CR  = Char(13)  // Carriage Return
String ls_encrypted, ls_newpass, ls_msgtext
Integer li_count = 1

// encrypt the data
ls_encrypted = this.of_EncryptDecrypt( &
                  as_data, as_password, True)

// try again if result contains a bad character
Do While Pos(ls_encrypted, LF,  1) > 0 &
      Or Pos(ls_encrypted, CR,  1) > 0 &
      Or Pos(ls_encrypted, TAB, 1) > 0 &
      Or Len(ls_encrypted) <> Len(as_data)

   // append counter to password
   If li_count = 1 Then
      li_count = 14
   Else
      If li_count = 255 Then
         ls_msgtext = "Unable to successfully encrypt this data"
         SignalError(999, &
            "of_EncryptData:~r~n~r~n" + ls_msgtext)
      Else
         li_count++
      End If
   End If
   ls_newpass = as_password + String(li_count)

   // try again to encrypt
   ls_encrypted = this.of_EncryptDecrypt( &
                     as_data, ls_newpass, True)
Loop

// prepend attempt count
If Len(ls_encrypted) > 0 Then
   ls_encrypted = Char(li_count) + ls_encrypted
End If

Return ls_encrypted

end function

public function string of_decryptdata (string as_data, string as_password);// This function will decrypt the data passed to it.

String ls_data, ls_decrypted, ls_newpass
Integer li_count

// first char is attempt count
ls_data = Mid(as_data, 2)

// get attempt count
li_count = Asc(Left(as_data, 1))

If li_count = 1 Then
   ls_decrypted = this.of_EncryptDecrypt( &
                     ls_data, as_password, False)
Else
   ls_newpass = as_password + String(li_count)
   ls_decrypted = this.of_EncryptDecrypt( &
                     ls_data, ls_newpass, False)
End If

Return ls_decrypted

end function

on n_svc_crypto.create
call super::create
end on

on n_svc_crypto.destroy
call super::destroy
end on