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

	F4 = ComparaisonNul

ElseIf MUpsKrn.Booleen2ComVariantBool(O1.Inferieur(O2)) Then

	F4 = ComparaisonAvant

ElseIf MUpsKrn.Booleen2ComVariantBool(O1.Superieur(O2)) Then

	F4 = ComparaisonApres

Else

	F4 = ComparaisonEgal

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
	
		Exit Do
	
	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