Lisp

Commande de compilation

Dans le menu Project - References de Visual Basic, il faut importer les déclarations du module Up ! Kernel en cochant la case correspondante.

Commande d'enregistrement des ActiveX

upsvtm Com=Charger

Commande d'exécution

lisp.exe

Fichiers sources

Source du module

Public Const ComparaisonAvant As Integer = 1
Public Const ComparaisonEgal As Integer = 2
Public Const ComparaisonApres As Integer = 3
Public Const ComparaisonNul As Integer = 4
Public MUpsKrn As Object

Public Sub EcrireEcran(ByVal Libelle As String)
' =============================================
Form1.Ecran.AddItem Libelle
End Sub

Public Sub P1(ByVal O As IUpsKrnCaractere)
' ========================================
On Error GoTo GestionErreur

EcrireEcran MUpsKrn.Caractere2ComBStr(O)

Exit Sub

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Sub

Public Sub P2(ByVal O1 As IUpsKrnCaractere, ByVal O2 As IUpsKrnEntier)
' ====================================================================
On Error GoTo GestionErreur

EcrireEcran MUpsKrn.Caractere2ComBStr(O1.Additionner(MUpsKrn.ComBStr2Caractere(" ")).Additionner(MUpsKrn.Caractere5(O2)))

Exit Sub

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Sub

Public Function F1(ByVal O As IUpsKrnCaractere) As IUpsKrnCaractere
' =================================================================
On Error GoTo GestionErreur

Set F1 = O.Majuscule()

Exit Function

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Function

Public Function F2(ByVal O1 As IUpsKrnCaractere, ByVal O2 As IUpsKrnEntier) As IUpsKrnCaractere
' =============================================================================================
On Error GoTo GestionErreur

Set F2 = O1.Majuscule().Additionner(MUpsKrn.ComBStr2Caractere(" ")).Additionner(MUpsKrn.Caractere5(O2))

Exit Function

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Function

Public Function F3(ByVal O1 As IUpsKrnCaractere) As IUpsKrnBooleen
' ================================================================
On Error GoTo GestionErreur

Set F3 = O1.InferieurOuEgal(MUpsKrn.ComBStr2Caractere("hello!!!"))

Exit Function

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Function

Public Function F4(ByVal O1 As IUpsKrnCaractere, ByVal O2 As IUpsKrnCaractere) As Integer
' =======================================================================================
On Error GoTo GestionErreur

If MUpsKrn.EstNul(O1) Or MUpsKrn.EstNul(O2) Then ElseIf MUpsKrn.Booleen2ComVariantBool(O1.Inferieur(O2)) Then ElseIf MUpsKrn.Booleen2ComVariantBool(O1.Superieur(O2)) Then Else End If

Exit Function

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Function

Source de la fenêtre principale

Private Sub EcrireListe(ByVal L As IUpsKrnListe)
' ==============================================
Dim C As IUpsKrnCaractere

On Error GoTo GestionErreur

Set C = L.ParcoursAuDebut(0)
Do Loop
Exit Sub

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Sub

Private Sub Form_Load()
' =====================
Dim L1 As IUpsKrnListe
Dim L2 As IUpsKrnListe
Dim L3 As IUpsKrnListe

On Error GoTo GestionErreur

Set MUpsKrn = CreateObject("UpsApp.UpsKrn")

Set L1 = MUpsKrn.Liste1(MUpsKrn.Caractere, MUpsKrn.ComBStr2Caractere("bonjour"))
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hello")
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("guten tag")
Set L2 = MUpsKrn.Liste1(MUpsKrn.Caractere, MUpsKrn.ComInt2Entier(1))
L2.AdditionnerAffecter MUpsKrn.ComInt2Entier(2)
L2.AdditionnerAffecter MUpsKrn.ComInt2Entier(3)

EcrireEcran "P1:"
L1.Appliquer MUpsKrn.ComAppel2Appel("HRESULT P1([in] IUpsKrn::Objet *O)", AddressOf P1)
EcrireEcran "P2:"
L1.Appliquer2 MUpsKrn.ComAppel2Appel(HRESULT P2([in] IUpsKrn::Objet *O1, [in] IUpsKrn::Objet *O2)", AddressOf P2), L2

EcrireEcran "F1:"
Set L3 = L1.Appliquer3(MUpsKrn.ComAppel2Appel(HRESULT F1([in] IUpsKrn::Objet *O, [out, retval] IUpsKrn::Objet **retval)", AddressOf F1))
EcrireListe L3
EcrireEcran "F2:"
Set L3 = L1.Appliquer4(MUpsKrn.ComAppel2Appel(HRESULT F2([in] IUpsKrn::Objet *O1, [in] IUpsKrn::Objet *O2, [out, retval] IUpsKrn::Objet **retval)", AddressOf F2), L2)
EcrireListe L3

EcrireEcran "F3:"
Set L3 = L1.Filtrer(MUpsKrn.ComAppel2Appel(HRESULT F3([in] IUpsKrn::Objet *O1, [out, retval] IUpsKrn::Objet **retval)", AddressOf F3))
EcrireListe L3

EcrireEcran "F4:"
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hello")
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("bonjour")
Set L3 = L1.Grouper(MUpsKrn.ComAppel2Appel(HRESULT F4([in] IUpsKrn::Objet *O1, [in] IUpsKrn::Objet *O2, [out, retval] short *retval)", AddressOf F4))
EcrireListe L3

EcrireEcran "F4Bis:"
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("coucou">)
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("salut")
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hie")
L1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("schluss")
Set L3 = L1.Trier(MUpsKrn.ComAppel2Appel(HRESULT F4([in] IUpsKrn::Objet *O1, [in] IUpsKrn::Objet *O2, [out, retval] short *retval)", AddressOf F4), True)
EcrireListe L3
Set L3 = L1.Trier(MUpsKrn.ComAppel2Appel(HRESULT F4([in] IUpsKrn::Objet *O1, [in] IUpsKrn::Objet *O2, [out, retval] short *retval)", AddressOf F4), False)
EcrireListe L3

Set L1 = Nothing
Set L2 = Nothing
Set L3 = Nothing
Set MUpsKrn = Nothing
Exit Sub

GestionErreur:
'=============
EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le source '" + Err.Source + "' :"
EcrireEcran Err.Description
End Sub