Ob es mit meiner Methode sinnvoll ist, weiß ich zwar nicht, aber du könntest dafür sorgen, dass Windows dein Speicher bereinigt (WinAPI):
Code: Alles auswählen
EnableExplicit
;- Window Constants
;
Enumeration
#Main_Window
EndEnumeration
;- Gadget Constants
;
Enumeration
#Button_0
#Button_1
#Button_2
#Frame3D_0
#ListIcon_1
EndEnumeration
;- StatusBar Constants
;
Enumeration
#StatusBar_1
EndEnumeration
Procedure freeWorkingMemory()
Protected myProcessID,PHandle,Result
myProcessID=GetCurrentProcessId_()
PHandle = GetCurrentProcess_()
Result= SetProcessWorkingSetSize_(PHandle,-1,-1)
If Result
Else
; it failed
EndIf
EndProcedure
Procedure Open_Main_Window()
If OpenWindow(#Main_Window, 364, 223, 583, 555, "Queue-Spielerei", #PB_Window_SystemMenu | #PB_Window_TitleBar )
If CreateStatusBar(#StatusBar_1, WindowID(#Main_Window))
AddStatusBarField(380)
AddStatusBarField(200)
StatusBarText(#StatusBar_1, 0, "")
StatusBarText(#StatusBar_1, 1, "")
EndIf
If CreateGadgetList(WindowID(#Main_Window))
ButtonGadget(#Button_0, 470, 0, 110, 30, "Ende")
ButtonGadget(#Button_1, 0, 0, 110, 30, "Element hinzufügen")
ButtonGadget(#Button_2, 200, 0, 110, 30, "Speicher bereinigen")
Frame3DGadget(#Frame3D_0, 0, 40, 580, 490, "Queue-Inhalt")
;-
ListIconGadget(#ListIcon_1, 10, 60, 562, 460, "IP-Adresse", 100, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListIcon_1, 1, "Port", 50)
AddGadgetColumn(#ListIcon_1, 2, "Client-Name", 120)
AddGadgetColumn(#ListIcon_1, 3, "Client-Typ", 100)
AddGadgetColumn(#ListIcon_1, 4, "Token", 80)
AddGadgetColumn(#ListIcon_1, 5, "Letzter Kontakt", 90)
EndIf
EndIf
EndProcedure
Structure queue ; Struktur der Queue
IPAdresse.s ; IP-Adresse des Clients
Port.i ; Port des Clients
Clientname.s ; Name des Clients
Clienttype.i ; Art des Clients (1 = Supplier, 2 = Worker)
Clienttoken.i ; ID-Token des Clients
Lastcontact.i ; Letztes "Lebenssignal" des Clients
EndStructure
Global NewList client.queue() ; Client-Queue anlegen
Global Dim clienttyp.s(2) ; Klarschrift des Client-Typs
Global alive ; Zeit in Sek. in der der Client ein Lebenssignal abgeben muss
Global Event, WindowID, GadgetID, EventType
Global exitloop
Declare init()
Declare refresh_list()
Declare delete_outdated()
Open_Main_Window()
init()
exitloop = 0
Repeat ; Start of the event loop
Event = WaitWindowEvent(1000) ; Auf einen Windows-Event warten oder nach 1 Sek. weitermachen
WindowID = EventWindow() ; Aus welchem Fenster kommt der Event?
GadgetID = EventGadget() ; Ist es ein gadget-Event?
EventType = EventType() ; Was ist es für ein Event-Typ?
If delete_outdated() = 1 ; Abgelaufene Einträge entfernen
refresh_list() ; ...und wenn Einträge entfernt wurden, Listenanzeige auffrischen
EndIf
If Event = #PB_Event_Gadget
If GadgetID = #Button_1 ; Eintrag hinzufügen
AddElement(client())
client()\IPAdresse = Right("000" + Str(Random(255)),3) + "." + Right("000" + Str(Random(255)),3) + "." + Right("000" + Str(Random(255)),3) + "." + Right("000" + Str(Random(255)),3)
client()\Port = Random(65535)
client()\Clientname = "Test_" + Str(ListSize(client()))
client()\Clienttype = Random(2)
client()\Clienttoken = Random(9999999999)
client()\Lastcontact = Date()
refresh_list() ; Listenanzeige auffrischen
ElseIf GadgetID = #Button_0 ; Ende
exitloop = 1
ElseIf GadgetID = #Button_2
freeWorkingMemory()
EndIf
EndIf
Until Event = #PB_Event_CloseWindow Or exitloop = 1 ; End of the event loop
End
Procedure init()
clienttyp(0) = "*undefiniert*"
clienttyp(1) = "Supplier"
clienttyp(2) = "Worker"
alive = 10
EndProcedure
Procedure refresh_list()
ClearGadgetItems(#ListIcon_1)
FirstElement(client())
ForEach client()
AddGadgetItem(#ListIcon_1, -1, client()\IPAdresse + Chr(10) + Str(client()\Port) + Chr(10) + client()\Clientname + Chr(10) + clienttyp(client()\Clienttype) + Chr(10) + Str(client()\Clienttoken) + Chr(10) + Str(client()\Lastcontact))
Next
StatusBarText(#StatusBar_1, 0, Str(ListSize(client())))
EndProcedure
Procedure delete_outdated()
Protected action
action = 0
FirstElement(client())
ForEach client()
If Date() > client()\Lastcontact + alive
DeleteElement(client())
action = 1
EndIf
Next
ProcedureReturn action
EndProcedure