Code : Tout sélectionner
; Démonstration d'un curieux bug de SetGadgetText
;
; Avec Zapman dans le rôle d'Emile Zola (celui qui accuse)
;
; Le bug démontré est alléatoire et peut ne se produire qu'au bout d'un long moment.
;
; Quand il survient, un fenêtre portant le titre "Ouch !" apparait.
;
; Si le bug ne se produit pas chez vous, faites passez une autre application
; devant cette là et refaites passer celle là au premier plan, ou alors laissez tourner le programme en arrière plan et patientez
Global temoin$
Global Mode$
Mode$ = "Unsafe" ; Mode$ = "Safe"
Enumeration
#Defiltext1
#Defiltext2
#CheckMode
EndEnumeration
;
Procedure SetGadgetTextSafe(NoGadget,Txt$)
; Sous cette forme, ça ne marche pas, et cette procédure safe porte mal son nom
; ne la recopiez pas dans vos programmes
SendMessage_(GadgetID(NoGadget), #WM_SETTEXT, 0, @Txt$)
EndProcedure
;
Procedure DefilThread1(txdefil1$)
Repeat
txdefil1$ = Right(txdefil1$,Len(txdefil1$)-1)+Left(txdefil1$,1)
If Mode$ = "Safe"
Txt$ = Left(txdefil1$,36)
SendMessage_(GadgetID(#Defiltext1), #WM_SETTEXT, 0, @Txt$) ; comme ça, ça marche
Else
SetGadgetText(#Defiltext1,Left(txdefil1$,36)) ; !!!!!!!! create a thread bug with text buffer because PB is not thread safe ?
EndIf
Delay(150)
ForEver
EndProcedure
;
Procedure.s RotateLeft(text$)
Delay(50) ; sans ce petit délai, le bug ne se produit quasimment jamais
text$ = Right(text$,1)+Left(text$,Len(text$)-1)
temoin$ = text$
ProcedureReturn temoin$
EndProcedure
;
Procedure.s VerifieRotateLeft(text$)
text$ = RotateLeft(text$)
If text$<>temoin$
MessageRequester("Ouch !!!",text$+Chr(13)+temoin$,0)
EndIf
ProcedureReturn temoin$
EndProcedure
;
Procedure DefilThread2(txdefil2$)
Repeat
txdefil2$ = VerifieRotateLeft(txdefil2$)
If Mode$ = "Safe"
Txt$ = Left(txdefil2$,36)
SendMessage_(GadgetID(#Defiltext2), #WM_SETTEXT, 0, @Txt$) ; comme ça, ça marche
Else
SetGadgetText(#Defiltext2,Left(txdefil2$,36)) ; !!!!!!!! create a thread bug with text buffer because PB is not thread safe ?
EndIf
Delay(100)
ForEver
EndProcedure
LargeurFenetre = 220
hWnd=OpenWindow(#Pb_Any,100,200,LargeurFenetre,80,#PB_Window_TitleBar|#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget,"Démo de bug")
If hWnd=0 Or CreateGadgetList(WindowID(hWnd))=0:End:EndIf
posH = 15
TextGadget(#Defiltext1,10,posH,LargeurFenetre-20,14,"")
posH + 20
TextGadget(#Defiltext2,10,posH,LargeurFenetre-20,14,"")
posH + 20
CheckBoxGadget(#CheckMode, 10,posH, LargeurFenetre-20, 14, "Safe mode")
;
CreateThread(@DefilThread2(),UCase("Démonstration du bug créé par SetGadgetText - "))
CreateThread(@DefilThread1(),"SetGadgetText abime les données du buffer text - ")
Quit = 0
Repeat
UseWindow(hWnd)
UseGadgetList(WindowID())
EventID = WindowEvent()
If EventID=#PB_EventCloseWindow
Quit = 1
ElseIf EventID=#PB_EventGadget
If EventGadgetID()=#CheckMode
If GetGadgetState(#CheckMode)
Mode$ = "Safe"
Else
Mode$ = "UnSafe"
EndIf
Debug Mode$
EndIf
EndIf
Delay(50)
Until Quit
Merci de tester ça chez vous pour me dire ce que ça donne.
Et en bonus, un autre bug détecté chez GetGadgetText : quand le texte à récupérer dans le gadget a une longueur supérieure à 32 000, il est tronqué au 32 000 premiers caractères.
Voici une version corrigée de GetGadgetText :
Code : Tout sélectionner
#MaxSize=1000000
;
Procedure SetStringManipulationBufferSize(Bytes)
; Ca, c'est une procédure proposée par Fred
PBStringBase.l = 0
PBMemoryBase.l = 0
!MOV eax, dword [PB_StringBase]
!MOV [esp+4],eax
!MOV eax, dword [PB_MemoryBase]
!MOV [esp+8],eax
HeapReAlloc_(PBMemoryBase, #GMEM_ZEROINIT, PBStringBase, Bytes)
!MOV dword [_PB_StringBase],eax
EndProcedure
; Set the buffer size for all strings to #MaxSize.
SetStringManipulationBufferSize(#MaxSize)
Procedure.s XGetGadgetText(Gadget) ; pour les textes de plus 32000 caractères
; By Zapman
*ADR = AllocateMemory(#MaxSize)
SendMessage_(GadgetID(Gadget), #WM_GETTEXT, #MaxSize, *ADR) ;Get the Content
tx2$ = PeekS(*ADR)
FreeMemory(*ADR)
ProcedureReturn tx2$
EndProcedure
! 