PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Detecter par le pointeur d'un tableau si il est UNICODE

http://forums.purebasic.com/french/viewtopic.php?t=9811

Page 1 sur 1

Detecter par le pointeur d'un tableau si il est UNICODE

Publié : mer. 07/oct./2009 15:44
par Kwai chang caine
Bonjour a tous.

Devinez de quoi je vais parler ???? :D
De rembrand :lol:

Dans une fonction je reçois le pointeur d'un tableau qui m'est envoyé soit de VB, soit de PB
Hors l'un est en unicode, et l'autre en ASCII

Y'a t'il un moyen de detecter le format a coup sur ???
Moi j'avais fais un truc bidon, car j'avais remarqué que quand on essaye de lire de l'UNICODE avec une fonction ASCII on obtenait des "?????"
Alors j'avais mis, "if premier caractere = "?"

Mais ca m'a valu une journée de travail de perdu, car ma comparaison a foiré, et ça m'a induit en erreur, etant sur qu'elle marchait :?

Code : Tout sélectionner

Procedure ArrayExe2Local(*strPtr.INTEGER, Array Array2Modify.s(1), ArraySize)
 
 #ArrayPB = 1
 #ArrayVB = 2
 Global TypeArray
 ReDim Array2Modify(ArraySize)   
 
 For i = 1 To ArraySize ; Start to 1 for not replace the lengh of array
  
  *strPtr + SizeOf(INTEGER)
             
  If Not TypeArray
   
   Donnee$ = PeekS(*strPtr\i, - 1, #PB_Unicode) ; Array from VB
   
   If Left(Donnee$, 1) = "?"
    TypeArray = #ArrayPB
   Else 
    TypeArray = #ArrayVB
   EndIf
    
  EndIf 
    
  Select TypeArray
  
   Case #ArrayPB 
   Array2Modify(i) = PeekS(*strPtr\i, - 1, #PB_Ascii)
   Case #ArrayVB
     Array2Modify(i) = PeekS(*strPtr\i, - 1, #PB_Unicode)
  
  EndSelect
    
 Next
 
EndProcedure
Merci et bonne journée

Re: Detecter par le pointeur d'un tableau si il est UNICODE

Publié : mer. 07/oct./2009 16:01
par flaith
Aurais-tu un code un peu plus complet, histoire de pouvoir tester :mrgreen:

Re: Detecter par le pointeur d'un tableau si il est UNICODE

Publié : mer. 07/oct./2009 16:08
par Kwai chang caine
Bah justement j'ai toute la purée, et j'ai demandé si "quinquin" y pouvait tester pour comme a l'ecole me mettre une note....enfin mieux qu'a l'ecole parce que j'avais toujours max 10 :D

Mais je pense pas que tu ai VB :cry:
Si tu as pas VB je met tous le code PB

Si tu arrive a me detecter a coup sur que c'est de l'ASCI qui appelle, ca voudra dire que c'est pas PB :mrgreen:

Code de l'exe

Code : Tout sélectionner

; This procedure convert the array DLL memory to a local array 
Procedure ArrayDll2Local(*strPtr.INTEGER, Array ArrayModified.s(1))
 
 SizeArray = Val(PeekS(*strPtr\i, - 1, #PB_Ascii))
 Dim ArrayModified.s(SizeArray)
 Line = 0
  
 For i = 0 To SizeArray
  ArrayModified(i) = PeekS(*strPtr\i,  - 1, #PB_Ascii)
  *strPtr + SizeOf(INTEGER)
 Next
  
EndProcedure
 
;                Create original array

Dim ArrayString.s(10)

For i = 1 To 10
 ArrayString(i) = "Sentence " + Str(i)
Next

;                  Modify the array

If OpenLibrary(0, "Test2.dll")

 For o = 1 To 2
  
  *PoinTerArray = CallFunction(0, "ChangeNameAndAddLine", ArrayString(), "Sentence", "Kcc", ArraySize(ArrayString()))
  ArrayDll2Local(*PoinTerArray, ArrayString())
  
  For i = 0 To ArraySize(ArrayString())
   Debug ArrayString(i)
  Next
   
   
 Next

 CloseLibrary(0)
 
EndIf
Code de la DLL

Code : Tout sélectionner

; Written by KCC with precious help of SROD and also CPLBATOR, CLS, IDLE, DENIS, XOMBIE, GEBONET, FLAITH, DJES

; This is THE procedure for modify the array
; In this example i want replace the big word "Sentence" by little "Kcc" :-)
; And add two lines
 
Procedure ArrayExe2Local(*strPtr.INTEGER, Array Array2Modify.s(1), ArraySize)
 
 #ArrayPB = 1
 #ArrayVB = 2
 Global TypeArray
 ReDim Array2Modify(ArraySize)   
 
 For i = 1 To ArraySize ; Start to 1 for not replace the lengh of array
  
  *strPtr + SizeOf(INTEGER)
             
  If Not TypeArray
   
   Donnee$ = PeekS(*strPtr\i, - 1, #PB_Unicode) ; Array from VB
   
   If Left(Donnee$, 1) = "?"
    TypeArray = #ArrayPB
   Else 
    TypeArray = #ArrayVB
   EndIf
    
  EndIf 
    
  Select TypeArray
  
   Case #ArrayPB 
   Array2Modify(i) = PeekS(*strPtr\i, - 1, #PB_Ascii)
   Case #ArrayVB
     Array2Modify(i) = PeekS(*strPtr\i, - 1, #PB_Unicode)
  
  EndSelect
    
 Next
 
EndProcedure

ProcedureDLL ChangeNameAndAddLine(*strPtr.INTEGER, NameToChange.s, NameToReplace.s, ArraySize)
 
 Static Dim ArrayModified.s(0)
 ArrayExe2Local(*strPtr.INTEGER, ArrayModified(), ArraySize)
 
 For i = 1 To 5
  ArrayModified(i) = ReplaceString(ArrayModified(i), Trim(NameToChange), Trim(NameToReplace))
 Next
 
 OldSizeArray2Modify = ArraySize(ArrayModified())
 ReDim ArrayModified(ArraySize(ArrayModified()) + 2)
  
 For i = OldSizeArray2Modify + 1 To ArraySize(ArrayModified())
  ArrayModified(i) = "KCC add the line number " + Str(i)
 Next
 
 ArrayModified(0) = Str(ArraySize(ArrayModified()))
 ProcedureReturn @ArrayModified()
 
EndProcedure

Re: Detecter par le pointeur d'un tableau si il est UNICODE

Publié : mer. 07/oct./2009 16:24
par Kwai chang caine
Ouahh j'ai une nouvelle baise pour vous...
Je viens de voir que mon code il est polyglote 8O

Il parle le VBA, comme je parle l'anglais :lol:

Bref il suffit de demarrer EXCEL puis faire un petit ALT + F11
Copier ce lanceur de sardine...pardon macro dans "ThisWorkbook"

Code : Tout sélectionner

Private Sub Workbook_Open()
 Feuil1.Form_Load
End Sub
Copier/coller le grand code VB dans VBA dans "Feuil1(Feuil1)"
Refermez la gamelle...relancer le fichier excell et ça marche 8O

Code : Tout sélectionner

Private Declare Function ChangeNameAndAddLine Lib "test2.dll" (ByVal PointerArray As Long, ByVal NameToChange As String, ByVal NameToReplace As String, ByVal ArraySize As Integer) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Bytes As Long)
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString1 As Any) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long 'Détermine la longeur d'une chaine passée en argument.

Public Sub Form_Load()
 
 ChDir ThisWorkbook.Path
 Dim ArrayString() As String, IdMemory As Long
 ReDim ArrayString(10)
 
 ' Construction du tableau
 For i = 1 To UBound(ArrayString())
  ArrayString(i) = "Sentence " + Str(i)
  Phrase = Phrase + ArrayString(i) + Chr(13)
 Next
   
 ' Affichage du tableau original
 MsgBox Phrase, vbOKOnly, "Tableau depart"
 Phrase = ""
 
 ' Modification du tableau "Sentence" remplacé par "Kcc" et rajout de deux lignes
 LongTablo = TabloDllEnLocal(ChangeNameAndAddLine(VarPtr(ArrayString(0)), "Sentence", "Kcc", UBound(ArrayString())), ArrayString)
 
 ' Premier affichage du tableau modifié "Sentence" remplacé par "Kcc"
 For i = 0 To LongTablo
  a = a + ArrayString(i) + Chr(13)
 Next
  
 MsgBox a
 a = ""
 
 ' Modification du tableau "Kcc" remplacé par "Sentence" et rajout de deux lignes
 LongTablo = TabloDllEnLocal(ChangeNameAndAddLine(VarPtr(ArrayString(0)), "Kcc", "Sentence", UBound(ArrayString())), ArrayString)
 
 ' Second affichage du tableau modifié "Kcc" remplacé par "Sentence"
 For i = 0 To LongTablo
  a = a + ArrayString(i) + Chr(13)
 Next
  
 MsgBox a
 End
    
End Sub

Public Function TabloDllEnLocal(ByVal AdresseTabloDll As Long, ByRef TabloAModifier)
 
 Dim TabloTemp() As Long
 Dim AdrLongTabloTemp As Long
 Dim LongTabloTemp As Integer
 Dim Temp As String
 
 ' Recuperation de la longueur du tableau a l'enregistrement zero
 CopyMemory AdrLongTabloTemp, ByVal AdresseTabloDll, 4
 Temp = Space$(lstrlen(AdrLongTabloTemp))
 lstrcpy Temp, AdrLongTabloTemp
 LongTabloTemp = Val(Temp)
 
 ' Copie de la memoire dans le tablo temporaire local
 ReDim TabloTemp(LongTabloTemp)
 CopyMemory TabloTemp(0), ByVal AdresseTabloDll, (LongTabloTemp + 1) * 4
 
 ' Effacement du tableau original, redimentionnage, et remplissage par le tableau temporaire
 Erase TabloAModifier
 ReDim TabloAModifier(LongTabloTemp)
 
 For i = 0 To LongTabloTemp
  Temp = Space$(lstrlen(TabloTemp(i)))
  lstrcpy ByVal Temp, TabloTemp(i)
  TabloAModifier(i) = Temp
 Next
  
 TabloDllEnLocal = LongTabloTemp
 
End Function
Si "quinquin" y peut regarder l'etat de ses memoires apres le passage du rouleau compresseur KCC
Sauvegarde fortement recommandée de toutes vos apllis...la KCC corporation decline toute responsabilité en cas d'incendie dans votre maison :mrgreen:

Re: Detecter par le pointeur d'un tableau si il est UNICODE

Publié : mer. 07/oct./2009 20:55
par Kwai chang caine
J'ai fait un ZIP ou tout le jus est dedans, le fichier excell, l'exe, le code VB, et le PB
Si ça dit a "quinquin" de regarder si KCC, il a bien travaillé, et il a pas "niqué" la mémoire :oops:

Je remercie d'avance les futures victimes 8)
http://erdsjb.free.fr/PureStorage/Passi ... gArray.zip

Re: Detecter par le pointeur d'un tableau si il est UNICODE

Publié : mer. 07/oct./2009 21:54
par flaith
Ben chez moi ca fonctionne sans plantage pour le moment :mrgreen:

Re: Detecter par le pointeur d'un tableau si il est UNICODE

Publié : mer. 07/oct./2009 23:18
par djes
Bah, l'unicode en VB, c'est de la rigolade! :D Voir là : http://www.cyberactivex.com/UnicodeTutorialVb.htm

Re: Detecter par le pointeur d'un tableau si il est UNICODE

Publié : jeu. 08/oct./2009 9:02
par Kwai chang caine
Merci d'avoir pris le temps de faire des essais.
Je suis content de voir que ça marche aussi chez vous

Mais la question que je me pose...enfin que je vous pose serait un peu plus juste :mrgreen:
A vous les maitres de l'assembleur qui pouvez regarder sous les jupes de la mémoire :D

C'est a votre avis...dans VB, j'utilise RtlMoveMemory et est ce que je l'utilise bien ....est ce que je deplace pas les pointeurs du tableau provenant de la DLL
Car dans ce cas ...ne devrais je pas .....les retablir en rappelant la meme fonction dans l'autre sens :roll:

Car en fait, j'avais abandonné ce genre de code

Code : Tout sélectionner

Procedure TransfertTableau(Parametre)
 Static DIM TabloDll.s(10) 
 Bla bla bla
 .
 . 
 ProcedureReturn @TabloDll()
EndProcedure
Ou je renvois a VB l'adresse du tablo de la DLL et c'est exactement ce qu'il ne fallait pas faire car derriere VB deplacait les pointeurs de "TabloDll()" avec son CopyMemory qui n'est autre que RTLMoveMemory ..
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru