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
EcrireEcran MUpsKrn.Caractere2ComBStr(C)
If C.Identique(L.DernierElement()) Then
End If
Set C = L.Suivant(0)
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