SET PROCEDURE TO crypto ADDITIVE
 
LOCAL oForm
oForm = CREATEOBJECT("Tform")
oForm.Show(1)
* end of main
 
DEFINE CLASS Tform As Form
#define PP_VERSION              5
#define PP_IMPTYPE              3
#define PP_CONTAINER            6
#define PP_PROVTYPE             16
#define PP_SYM_KEYSIZE          19
#define PP_KEYSET_TYPE          27
#define PP_ADMIN_PIN            31
#define PP_SIGNATURE_PIN        33
#define PP_UNIQUE_CONTAINER     36
#define PP_SGC_INFO             37
PROTECTED providers, provider
    Width=500
    Height=330
    BorderStyle=2
    MaxButton=.F.
    MinButton=.F.
    Caption="Crypto API Providers"
    Autocenter=.T.
 
    ADD OBJECT lst As ListBox WITH Top=0, Left=0,;
    Width=500, Height=140
 
    ADD OBJECT params As ListBox WITH Top=150, Left=0,;
    Width=240, Height=70, ColumnCount=2, ColumnWidths="100,160"
 
    ADD OBJECT conts As ListBox WITH Top=224, Left=0,;
    Width=240, Height=70
 
    ADD OBJECT algs As ListBox WITH Top=150, Left=244,;
    Width=256, Height=144, ColumnCount=3, ColumnWidths="60,60,300"
 
    ADD OBJECT sbar As Tbar WITH Left=0, Height=21, Width=685
 
PROCEDURE Init
    THIS.GetProviders
 
PROCEDURE lst.InteractiveChange
    ThisForm.ShowProvider
 
PROCEDURE ShowProvider
#DEFINE SCARD_E_NO_SERVICE 0x8010001D
#DEFINE NTE_BAD_ALGID 0x80090008
    LOCAL cProvider
    cProvider = THIS.lst.Value
    THIS.provider = Null
    THIS.provider = THIS.providers.GetProvider(m.cProvider)
    THIS.provider.AcquireContext()  && default container
 
    IF THIS.provider.context <> 0
        THIS.sbar.Panels(1).Text = "context: " +;
            TRANSFORM(THIS.provider.context)
    ELSE
        THIS.sbar.Panels(1).Text = "error: " +;
            TRANSFORM(THIS.provider.errorcode, "@0")
    ENDIF
 
    THIS.ShowParameters
    THIS.ShowContainers
    THIS.ShowAlgorithms
 
PROTECTED PROCEDURE GetProviders
    THIS.lst.Clear
    LOCAL provider
    THIS.providers = CREATEOBJECT("providers")
    FOR EACH provider IN THIS.providers
        THIS.lst.AddItem(provider.provname)
    ENDFOR
    WITH THIS.lst
        .ListIndex=1
        .InteractiveChange
    ENDWITH
 
PROCEDURE ShowAlgorithms
    THIS.algs.Clear
    LOCAL oAlg
    FOR EACH oAlg IN THIS.provider.algorithms
        WITH THIS.algs
            .AddItem(TRANSFORM(oAlg.algid))
            .List(.ListCount, 2) = TRANSFORM(oAlg.bitlen)
            .List(.ListCount, 3) = oAlg.algname
        ENDWITH
    ENDFOR
 
PROCEDURE ShowContainers
    THIS.conts.Clear
    LOCAL oCont
    FOR EACH oCont IN THIS.provider.keycontainers
        THIS.conts.AddItem(oCont.containername)
    ENDFOR
 
PROCEDURE ShowParameters
    THIS.params.Clear
    THIS.ShowParameter("Implement.", PP_IMPTYPE, "N")
    THIS.ShowParameter("Version", PP_VERSION, "N")
    THIS.ShowParameter("Container", PP_CONTAINER)
    THIS.ShowParameter("Type", PP_PROVTYPE, "N")
    THIS.ShowParameter("Unique cont.", PP_UNIQUE_CONTAINER)
 
PROTECTED PROCEDURE ShowParameter(cName, nId, cType)
    LOCAL vValue
    vValue = THIS.provider.GetProvParam(nId, cType)
    WITH THIS.params
        .AddItem(cName)
        .List(.ListCount,2) = " "+TRANSFORM(m.vValue)
    ENDWITH
ENDDEFINE
 
DEFINE CLASS Tbar As OleControl
    OleClass="MSComctlLib.SBarCtrl.2"
PROCEDURE Init
    THIS.Height=21
    THIS.Panels.Add()
    THIS.Panels.Add()
    THIS.Panels(1).Width = 140
    THIS.Panels(2).Width = 120
    THIS.Panels(3).Width = 400
ENDDEFINE