J'ai un gros soucis avec une application de gestion de réseau, mais cela pourrait-être dans un autre domaine.
Le code qui suit crée a la première exécution un fichier hosts "hosts.127.0.0.1.txt"
La fenêtre s'affiche et on peut rechercher un nœud par son ip ou son nom.
Sans rien modifier, cliquer plusieurs fois sur le bouton Search.
Avec un peu de chance, l'application va cracher avec un Invalid memory access.
Après avoir fait un millier de tests, le problème vient du fait que le Timer affiche du texte dans le titre de l'application toutes les secondes.
Si on désactive cette écriture, le problème disparait.
Par moment, c'est une partie de la recherche qui s'affiche dans le titre.
Il semble qu'il y ait un recouvrement en mémoire entre les zones textes.
Peut importe la solution utilisée pour gérer le Timer, même avec BindEvent(#PB_Event_Timer,..)
Une grosse poignée de main a qui me donnera une (la) solution pour continuer a afficher l'heure même pendant une recherche.
Dans la procédure du Timer, en commenté la façon de contourner le problème.
Mais j'aimerais bien comprendre, bug PB ou autre.
Place au code:
Code : Tout sélectionner
OnErrorGoto(?ErrorHandler)
#WinAppWidth = 553
#WinAppHeight = 416
#WinApp = 999
#TITLE$ = "MYAPP Light Edition"
#search$ = "Search"
#seeker$ = "192.168.9"
Global maxrows=2048
Global Message$, server$="127.0.0.1"
Enumeration Menus
#MenuApp
EndEnumeration
Enumeration FormMenu
#KeyEnter
#MenuAppQuit
EndEnumeration
Enumeration Gadgets
#stringSearch
#buttonSearch
#buttonClear
#listingHosts
EndEnumeration
Procedure.a fileExist(f$)
If FileSize(f$) = -1
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure makeHostsFile()
count=0 : s1$="192" : s2$="168" : file$="hosts."+server$+".txt"
If Not fileExist(file$)
If CreateFile(0,file$)
For s3 = 92 To 200
s3$ = Str(s3)
net$ = s1$+"."+s2$+"." + s3$
host$ = "node-"+s1$+"-"+s2$+"-"+s3$+"-"
For s4 = 0 To 255
s4$ = Str(s4)
line$ = LSet(net$+"."+s4$,15)+Chr(9)+host$+s4$
WriteStringN(0, line$)
Next
count+256
Next
CloseFile(0)
EndIf
EndIf
; Debug "lines:"+Str(count)
EndProcedure
Procedure messageBox(request = #False)
Protected flag = #PB_MessageRequester_Ok ;|#MB_ICONINFORMATION
If request
flag = #PB_MessageRequester_YesNo ; |#MB_ICONQUESTION
EndIf
ProcedureReturn MessageRequester(#TITLE$, Message$, flag | #MB_TOPMOST)
EndProcedure
Procedure threadSearchEntry(request=#True)
Static isRunning.b
If isRunning
ProcedureReturn -1
Else
isRunning = #True
searching = #True
SetWindowTitle(#WinApp, #TITLE$ + " - " + "Searching...")
EndIf
SetMenuTitleText(#MenuApp, 1, Space(60)+"Processing...")
Protected in, result , count.l=0, index.l, entry.s, field.s, file.s
Protected search.s = Trim(GetGadgetText(#stringSearch))
Protected GadgetList.a = #listingHosts
SetGadgetText(#buttonSearch, "Searching")
ClearGadgetItems(#listingHosts)
file = "hosts." + server$ + ".txt"
If Not fileExist(file) : Goto EndSearching : EndIf
result = CountString(search, "|")
NewList search.s()
If result = 0
AddElement(search()) : search() = search
Else
For index = 1 To result + 1
field = Trim(StringField(search, index, "|"))
If field <> #Null$
AddElement(search()) : search() = field
EndIf
Next
EndIf
in = ReadFile(#PB_Any, file, #PB_Ascii)
If in
Protected tabs.s = Chr(9)
Protected space1.s = Space(1)
Protected space2.s = Space(2)
NewMap node.s()
DisableGadget(#buttonSearch, #True)
DisableGadget(#listingHosts, #True)
While Eof(in) = 0
entry = ReadString(in)
entry = Trim(entry)
ForEach search()
If search() = space1 : entry + space1 : EndIf
If FindString(entry, search(), 1, #PB_String_NoCase)
If Val(Left(entry,1)) <> 0
While CountString(entry, tabs)
entry = ReplaceString(entry, tabs, space1, #PB_String_NoCase, 1)
Wend
While CountString(entry, space2)
entry = ReplaceString(entry, space2, space1, #PB_String_NoCase, 1)
Wend
entry = ReplaceString(entry, space1, Chr(10), #PB_String_NoCase, 1)
;AddGadgetItem(GadgetList, -1, entry)
node(Str(count))=entry
count + 1
EndIf
EndIf
Next
If count > maxrows : Break : EndIf
Wend
CloseFile(in)
If count
SetGadgetText(#buttonSearch, Str(count))
RemoveGadgetColumn(#listingHosts, 3) ; bug affichage
ForEach node()
AddGadgetItem(GadgetList, -1, node())
Next
EndIf
FreeList(search())
FreeMap(node())
If count > maxrows
Message$ = "Max rows reached. ("+Str(maxrows)+")"
messageBox()
EndIf
DisableGadget(#buttonSearch, #False)
DisableGadget(#listingHosts, #False)
EndIf
EndSearching:
SetGadgetText(#buttonSearch, Str(count))
SetActiveGadget(#stringSearch)
SetMenuTitleText(#MenuApp, 1, #Null$)
SetWindowTitle(#WinApp, #TITLE$ + " - ")
isRunning = #False
searching = #False
ProcedureReturn count
EndProcedure
Procedure clearListing()
SetGadgetText(#buttonSearch, #search$)
SetGadgetText(#stringSearch, #Null$)
ClearGadgetItems(#listingHosts)
RemoveGadgetColumn(#listingHosts, 3) ; correction bug affichage séparation
AddGadgetColumn(#listingHosts , 3 , "" , 1) ; correction bug affichage séparation
SetActiveGadget(#stringSearch)
EndProcedure
Procedure runThreadSE()
If Not IsThread(threadSearchEntry)
ClearGadgetItems(#listingHosts)
threadSearchEntry = CreateThread(@threadSearchEntry(), 0)
EndIf
SetActiveGadget(#stringSearch)
EndProcedure
Procedure threadTimerTimers(t)
Repeat
Static autoUpdate.a, loop.a
Static minute.a, previous.a
Static now$
; If initialized
; If Not searching
now$ = FormatDate("%yyyy.%mm.%dd - %hh:%ii:%ss", Date())
SetWindowTitle(#WinApp, #TITLE$ + " - " + now$)
; EndIf
; Else
; If loop = 10 : initialized = #True : EndIf
; loop+1
; EndIf
minute = Minute(Date())
Select minute
Case 20
If autoUpdate <> 20
autoUpdate = 20
If Not IsThread(threadUpdateHosts)
;;;;;;;;;;;;threadUpdateHosts = CreateThread(@threadUpdateHosts(), #False)
EndIf
EndIf
Case 50
If autoUpdate <> 50
autoUpdate = 50
If Not IsThread(threadUpdateHosts)
;;;;;;;;;;;;threadUpdateHosts = CreateThread(@threadUpdateHosts(), #False)
EndIf
EndIf
EndSelect
If previous <> minute
previous = minute
If Not IsThread(threadPingServers)
;;;;;;;;threadPingServers = CreateThread(@threadPingServers(), 1)
EndIf
EndIf
Delay(t)
ForEver
EndProcedure
makeHostsFile()
Define Flags = #PB_Window_TitleBar|#PB_Window_ScreenCentered|#PB_Window_Minimize|#PB_Window_SystemMenu
If OpenWindow(#WinApp, X, Y, #WinAppWidth, #WinAppHeight, #TITLE$, Flags)
If CreateImageMenu(#MenuApp, WindowID(#WinApp), #PB_Menu_ModernLook)
MenuTitle("File")
MenuItem(#MenuAppQuit, "Exit")
MenuTitle("")
EndIf
Define WID = #WinAppWidth - 6
Define HIG, H, X, Y, X1, W1, W2, W3
Y=0 : H=19
X1=2 : W1=222 : W2=55 : W3=50
;; , .X. , .Y. , .W. , .H. ,
StringGadget(#stringSearch , X1 , Y+1, W1 , H-2, #Null$, #PB_String_UpperCase); 246
ButtonGadget(#buttonSearch , X1+W1+2 , Y , W2 , H , #search$) ; 250
ButtonGadget(#buttonClear , X1+W1+W2+2*2 , Y , W3 , H , "Clear" ) ; 306
Define Flags = #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_MultiSelect
X=2 : Y=21 : HIG=354 : WID=WID+2
ListIconGadget(#listingHosts , X , Y , WID , HIG , "IP Address", 125, Flags)
AddGadgetColumn(#listingHosts , 1 , "Hostname" , 280)
AddGadgetColumn(#listingHosts , 2 , "Flags" , 80)
AddGadgetColumn(#listingHosts , 3 , "" , 1) ; correction bug affichage séparation
If LoadFont(1, "Consolas", 10)
SetGadgetFont(#listingHosts , FontID(1))
EndIf
SetGadgetAttribute(#stringSearch, #PB_String_MaximumLength, 200)
SetGadgetColor(#listingHosts, #PB_Gadget_BackColor , RGB(220,220,220))
SetGadgetColor(#listingHosts, #PB_Gadget_FrontColor, RGB(0,0,0))
SetWindowState(#WinApp, #PB_Window_Normal)
HideWindow(#WinApp, #False, #PB_Window_ScreenCentered)
SetGadgetText(#stringSearch, #seeker$)
SetActiveGadget(#stringSearch)
AddKeyboardShortcut(#WinApp, #PB_Shortcut_Return, #KeyEnter)
BindEvent(#PB_Event_Gadget , @runThreadSE(), #WinApp, #buttonSearch)
threadTimerTimers = CreateThread(@threadTimerTimers(),1000)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Menu
indexMenu = EventMenu()
If indexMenu = #KeyEnter
If GetActiveGadget() = #stringSearch
If GetGadgetText(#stringSearch) <> #Null$
runThreadSE()
SetActiveGadget(#stringSearch)
EndIf
EndIf
EndIf
Select indexMenu
Case #MenuAppQuit : Break
EndSelect
Case #PB_Event_Gadget
indexGadget = EventGadget()
Select indexGadget
; Case #buttonSearch
; SetActiveGadget(#stringSearch)
; If GetGadgetText(#stringSearch) <> #Null$ : runThreadSE()
; SetActiveGadget(#stringSearch)
; EndIf
Case #buttonClear : clearListing()
EndSelect
Case #PB_Event_CloseWindow : Break
EndSelect
ForEver
ErrorHandler:
If IsThread(threadSearchEntry) : KillThread(threadSearchEntry) : EndIf
If IsThread(threadTimerTimers) : KillThread(threadTimerTimers) : EndIf
CloseFile(#PB_All)
EndIf