Discussion :

[Asdorve]

Bonjour,

J'ai trouvé le code suivant pour convertir une chaine codée en rtf en texte brut, mais je n'arrive pas à l'adapter en VBS.
Est-ce que c'est possible?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
Option Explicit
 
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias _
                        "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String _
                        , ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long _
                        , ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long _
                        , ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long _
                        , lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const WC_RICHEDIT1 = "RichEdit"
Private Const WC_RICHEDIT2 = "RichEdit20A"
Private Const WS_CHILD = &H40000000
Private Const ES_MULTILINE = &H4&
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
 
 
Private Sub Form_Load()
 
Dim pRTF As String
 
pRTF = "{\rtf1\ansi\ansicpg1252\deff0\deflang1036{\fonttbl{\f0\fnil\fcharset0 MS Shell Dlg;}} {\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\f0\fs17 face A: 1 inter SA avec pr\'e9cablage \'e0 1300mm du sol  + cordon d'alim 3g1.5 5m etEnsto noir + d\'e9coupe pourluminaire \'e0 Ht1900mm\par face B: 3PC Norm RAL7035 sur cordon Ensto male lg5m HO7 3g2.5 \par } "
 
Debug.Print RTFtoTEXT(pRTF)
 
End Sub
 
 
Function RTFtoTEXT(pRTF As String) As String
    Dim lLen As Long
    Dim ltext As String
    Dim lClass As String
    Dim lHwnd As Long
    On Error GoTo Gestion_Erreurs
    ' Chargement librairie
    ' cf http://msdn2.microsoft.com/en-us/library/bb787873(VS.85).aspx
    If LoadLibrary("Riched20.dll") > 32 Then
        lClass = WC_RICHEDIT2
    ElseIf LoadLibrary("Riched32.dll") > 32 Then
        lClass = WC_RICHEDIT1
    End If
    ' Crée une fenêtre avec editeur de texte
    lHwnd = CreateWindowEx(0, lClass, vbNullString, _
                           WS_CHILD Or ES_MULTILINE, 0, 0, 0, 0, Me.hwnd, 0&, 0&, ByVal 0&)
    ' Injecte le texte dans le contrôle
    SendMessage lHwnd, WM_SETTEXT, Len(pRTF), ByVal pRTF
    ' Relit le texte sans balises RTF
    lLen = SendMessage(lHwnd, WM_GETTEXTLENGTH, 0, ByVal 0)
    ltext = Space(lLen + 1)
    ltext = Left(ltext, SendMessage(lHwnd, WM_GETTEXT, lLen + 1, ByVal ltext))
    RTFtoTEXT = ltext
Gestion_Erreurs:
    ' Supprime le contrôle
    DestroyWindow lHwnd
End Function

Merci d'avance,

[omen999]

bonjour,

Est-ce que c'est possible?

oui avec le wrapper DynamicWrapperX mais est-ce vraiment raisonnable pour simplement convertir quelques lignes de rtf en txt ?
sinon il y a aussi la technique de l'utilitaire de commande qui convertira le fichier rtf en txt comme UnRtf

[Asdorve]

Bonjour,

Merci pour cette réponse.
En fait, les codes rtf sont récupérés d'une base de donnée.

Quelle serait la solution la plus simple à mettre en place?

[omen999]

certainement l'outil en ligne de commande
il est peut-être possible de se passer de fichiers intermédiaires en passant par les pipes (StdIn et StdOut)
à voir

[Asdorve]

Bonjour,

Finalement, je suis en train de m'intéressr au wrapper.

Par contre, j'ai une erreur "Type incompatible" sur la denrière ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Const WC_RICHEDIT1 = "RichEdit"
Private Const WC_RICHEDIT2 = "RichEdit20A"
Private Const WS_CHILD = &H40000000
Private Const ES_MULTILINE = &H4&
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const CW_USEDEFAULT = &H80000000
dim lHwnd
dim res

pRTF = "{\rtf1\ansi\ansicpg1252\deff0\deflang1036{\fonttbl{\f0\fswiss\fprq2\fcharset0 Arial;}} {\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\f0\fs17 ne pas cliper les BOCD \par } "

set DX = CreateObject ("DynamicWrapperX")                  ' instancie l'objet
DX.Register "user32.dll", "MessageBoxW", "i=hwwu", "r=l"   ' référence la fonction de la dll
'res = DX.MessageBoxW(0, pRTF, "Test", 4)   ' appel de la fonction

DX.Register "kernel32", "LoadLibrary","i=s" ,"r=l"   ' référence la fonction de la dll

If DX.LoadLibrary("Riched30.dll") > 32 Then
        lClass = WC_RICHEDIT2
ElseIf DX.LoadLibrary("Riched32.dll") > 32 Then
        lClass = WC_RICHEDIT1
End If

 ' Crée une fenêtre avec editeur de texte
  
DX.Register "user32", "CreateWindowEx","i=lsslllllllll" ,"r=l"   ' référence la fonction de la dll
lHwnd = DX.CreateWindowEx(0, lClass, "", ES_MULTILINE, 0, 0, 0, 0, 0, 0, 0, 0)

 ' Injecte le texte dans le contrôle

DX.Register "user32", "SendMessage", "i=llll",  "r=l"
res = DX.SendMessage (lHwnd,WM_SETTEXT, 0, pRTF)

Une idée?

[omen999]

la fonction SendMessage est tellement générique qu'elle attend des paramètres différents selon le contexte
lorsque le lParam pointe sur une chaine unicode (format des chaines gérées par VBS) il faut utiliser cette syntaxe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DX.Register "user32","SendMessageW","i=hulW","r=l"

et utiliser la fonction SendMessageW qui gère l'unicode
un exemple de définition multiple de cette fonction se trouve dans mon composant xGUICOM
les liens de téléchargement ne fonctionnent plus

[Asdorve]

ok, super, ça marche.

Merci beaucoup pour ton aide.

A+