Consultor Eletrônico

Status: Unverified

GOAL:

How to create a default key container and sets of public/private cryptography keys within a particular Cryptography Service Provider (CSP).

GOAL:

How to call the CryptAPI functions CryptAcquireContextA, CryptGetUserKey, CryptGenKey and CryptExportKey.

FIX:

The following 4GL code illustrates the following tasks:
1. Create a default key container if one does not exist. This uses the CryptAcquireContextA function.
2. If an exchange key pair does not exist in the key container, it creates one. This uses the CryptGetUserKey and CryptGenKey functions.
3. Export the cryptography key out of the CSP using the CryptExportKey function.


/*******************************************/
/******************* Main ******************/
/*******************************************/

DEFINE VARIABLE iHProv AS INTEGER NO-UNDO.
DEFINE VARIABLE iError AS INTEGER NO-UNDO.
DEFINE VARIABLE iReturn AS INTEGER NO-UNDO.
DEFINE VARIABLE iBufsize AS INTEGER INITIAL 200 NO-UNDO.
DEFINE VARIABLE iUsrkey AS INTEGER NO-UNDO.
DEFINE VARIABLE lMessage AS MEMPTR NO-UNDO.
DEFINE VARIABLE lKeyBlob AS MEMPTR NO-UNDO.
DEFINE VARIABLE lDataLength AS MEMPTR NO-UNDO.

&SCOPED-DEFINE PROV_NAME "Microsoft Base Cryptographic Provider v1.0"
&SCOPED-DEFINE PROV_RSA_FULL 1
&SCOPED-DEFINE CRYPT_NEWKEYSET 8
&SCOPED-DEFINE AT_KEYEXCHANGE 1
&SCOPED-DEFINE PUBLICKEYBLOB 6

SET-SIZE(lMessage) = iBufsize.


/*******************************************/
/* CryptAcquireContextA */
/*******************************************/
RUN CryptAcquireContextA (
OUTPUT iHProv,
INPUT "",
INPUT {&PROV_NAME},
INPUT {&PROV_RSA_FULL},
INPUT 0).

RUN GetLastError (OUTPUT iError).

/* Try to create a new default key container if there is an error */
IF iError <> 0 THEN DO:
RUN CryptAcquireContextA (
OUTPUT iHProv,
INPUT "",
INPUT {&PROV_NAME},
INPUT {&PROV_RSA_FULL},
INPUT {&CRYPT_NEWKEYSET}).
RUN GetLastError (OUTPUT iError).
END.

RUN FormatMessageA (
INPUT 4096,
INPUT 0,
INPUT iError,
INPUT 0,
GET-POINTER-VALUE(lMessage),
INPUT 200,
INPUT 0).

MESSAGE "CryptAcquireContextA" SKIP
"Provider = " iHProv SKIP
"Error = " GET-STRING(lMessage, 1) "(" iError ")"
VIEW-AS ALERT-BOX INFO BUTTONS OK.
/*******************************************/

/*******************************************/
/* CryptGetUserKey */
/*******************************************/
RUN CryptGetUserKey (
INPUT iHProv,
INPUT {&AT_KEYEXCHANGE},
OUTPUT iUsrkey).

RUN GetLastError (OUTPUT iError).

/* Create new key pair if the key does not exist */
IF iError = -2146893811 /* NTE_NO_KEY */ THEN DO:
RUN CryptGenKey (
INPUT iHProv,
INPUT {&AT_KEYEXCHANGE},
INPUT 0,
OUTPUT iUsrkey).
RUN GetLastError (OUTPUT iError).
END.

RUN FormatMessageA (
INPUT 4096,
INPUT 0,
INPUT iError,
INPUT 0,
GET-POINTER-VALUE(lMessage),
INPUT 200,
INPUT 0).

MESSAGE "CryptGetUserKey" SKIP
"UserKey = " iUsrkey SKIP
"Error = " GET-STRING(lMessage, 1) "(" iError ")"
VIEW-AS ALERT-BOX INFO BUTTONS OK.
/*******************************************/


/*******************************************/
/* CryptExportKey */
/*******************************************/

SET-SIZE (lDataLength) = 4.

/* Gets the size necessary to hold the encrypted session key */
RUN CryptExportKey (INPUT iUsrkey,
INPUT 0,
INPUT {&PUBLICKEYBLOB},
INPUT 0,
INPUT 0,
INPUT GET-POINTER-VALUE(lDataLength)).

SET-SIZE (lKeyBlob) = GET-LONG(lDataLength, 1).

RUN CryptExportKey (
INPUT iUsrkey,
INPUT 0,
INPUT {&PUBLICKEYBLO.B},
INPUT 0,
INPUT GET-POINTER-VALUE(lKeyBlob),
INPUT GET-POINTER-VALUE(lDataLength)).

RUN GETLASTERROR (OUTPUT iError).
RUN FormatMessageA (
INPUT 4096,
INPUT 0,
INPUT iError,
INPUT 0,
GET-POINTER-VALUE(lMessage),
INPUT 200,
INPUT 0).

MESSAGE "CryptExportKey" SKIP
"KeyBlobData = " GET-POINTER-VALUE(lKeyBlob) SKIP
"KeyBlobDataLength = " GET-POINTER-VALUE(lDataLength) SKIP
"Error = " GET-STRING(lMessage, 1) "(" iError ")"
VIEW-AS ALERT-BOX INFO BUTTONS OK.
/*******************************************/


/*******************************************/
/* Cleanup */
/*******************************************/
RUN CryptDestroyKey (
INPUT iUsrKey).

RUN CryptReleaseContext (
INPUT iHProv,
INPUT 0).


/*******************************************/
/*************** End of Main ***************/
/*******************************************/


/*******************************************/
/* External Procedures */
/*******************************************/
PROCEDURE CryptAcquireContextA EXTERNAL "ADVAPI32.dll":
DEFINE OUTPUT PARAMETER phProv AS LONG.
DEFINE INPUT PARAMETER pszContainer AS CHARACTER.
DEFINE INPUT PARAMETER psxProvider AS CHARACTER.
DEFINE INPUT PARAMETER dwProvType AS LONG.
DEFINE INPUT PARAMETER dwFlags AS LONG.
END PROCEDURE.

PROCEDURE CryptGetUserKey EXTERNAL "ADVAPI32.dll":
DEFINE INPUT PARAMETER hProv AS LONG.
DEFINE INPUT PARAMETER dwKeySpec AS LONG.
DEFINE OUTPUT PARAMETER phUserKey AS LONG.
END PROCEDURE.

PROCEDURE CryptGenKey EXTERNAL "ADVAPI32.dll":
DEFINE INPUT PARAMETER h_Prov As LONG.
DEFINE INPUT PARAMETER ip_Algid As LONG.
DEFINE INPUT PARAMETER ip_dwFlags As LONG.
DEFINE OUTPUT PARAMETER op_phKey As LONG.
END PROCEDURE.

PROCEDURE CryptDestroyKey EXTERNAL "ADVAPI32.dll":
DEFINE INPUT PARAMETER hKeyProv AS LONG.
END PROCEDURE.

PROCEDURE CryptReleaseContext EXTERNAL "ADVAPI32.dll":
DEFINE INPUT PARAMETER hProv AS LONG.
DEFINE INPUT PARAMETER dwFlags AS LONG.
END PROCEDURE.

PROCEDURE CryptExportKey EXTERNAL "ADVAPI32.dll":
DEFINE INPUT PARAMETER hKey AS LONG.
DEFINE INPUT PARAMETER hExpKey AS LONG.
DEFINE INPUT PARAMETER dwBlobType AS LONG.
DEFINE INPUT PARAMETER dwFlags AS LONG.
DEFINE INPUT PARAMETER pbData AS LONG.
DEFINE INPUT PARAMETER pdwDataLen AS LONG.
END PROCEDURE.

PROCEDURE GetLastError EXTERNAL "kernel32.dll":
DEFINE RETURN PARAMETER lReturn AS LONG.
END PROCEDURE.

PROCEDURE FormatMessageA EXTERNAL "kernel32":
DEFINE INPUT PARAMETER dwFlags AS LONG.
DEFINE INPUT PARAMETER lpSource AS LONG.
DEFINE INPUT PARAMETER dwMessageId AS LONG.
DEFINE INPUT PARAMETER dwLanguageId AS LONG.
DEFINE INPUT PARAMETER lpBuffer AS LONG.
DEFINE INPUT PARAMETER nSize AS LONG.
DEFINE INPUT PARAMETER Arguments AS LONG.
END PROCEDURE.
.