You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 

408 lines
11 KiB

EnableExplicit
XIncludeFile "Wnd.pbf"
If Not InitNetwork()
MessageRequester("Fehler", "Netzwerkfehler")
End
EndIf
Macro Version()
"V" + Str(1) + "." + FormatDate("%yy%mm.%dd", Date()) + Str(#PB_Editor_BuildCount) + "." + Str(#PB_editor_CompileCount)
EndMacro
Enumeration Events #PB_Event_FirstCustomValue
#EVENT_ThreadFinished
EndEnumeration
Enumeration Menu
#MENU_PopUp
EndEnumeration
Enumeration MenuItem
#MENUITEM_Copy
#MENUITEM_Cut
#MENUITEM_Paste
#MENUITEM_SelectAll
#MENUITEM_Undo
EndEnumeration
Structure ThreadData
ID.i
Exit.i
Url.s
Query.s
Format.i
Modus.i
GetRaw.i
Timeout.i
Interval.i
EndStructure
Global ThreadData.ThreadData
Global PopupMenuGadget
Procedure WriteLog(String.s, TimeStamp = #True)
If TimeStamp
AddGadgetItem(#EDIT_Log, -1, FormatDate("%yy-%mm-%dd %hh:%ii:%ss -> ", Date()) + String)
Else
AddGadgetItem(#EDIT_Log, -1, String)
EndIf
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
; NICHT in der DEMO-Version
SendMessage_(GadgetID(#EDIT_Log), #EM_SETSEL, -1, -1) ; Automatisch weiter scrollen
CompilerEndIf
; While WindowEvent() : Wend ; Quick'n Dirty
EndProcedure
Procedure.s CheckUrl(Url.s)
If FindString(Url, "://", 1, #PB_String_NoCase) < 1
Url = "none://" + Url
EndIf
ProcedureReturn Url
EndProcedure
Procedure.s GetQuery()
Protected Ret.s
Ret = GetGadgetText(#EDIT_Own)
Ret = RemoveString(Ret, #CR$)
Ret = RemoveString(Ret, #LF$)
Ret = UnescapeString(Ret)
ProcedureReturn Ret
EndProcedure
Procedure.s ReceiveHTTP(Url.s, Format = #PB_UTF8)
Protected Ret.s, *RecData, Size
WriteLog("Anfrage " + Url + " senden ...")
*RecData = ReceiveHTTPMemory(Url)
If *RecData
Size = MemorySize(*RecData)
Ret = PeekS(*RecData, Size, Format)
WriteLog(Str(Size) + " Bytes empfangen")
Else
WriteLog("Verbindungsfehler")
EndIf
ProcedureReturn Ret
EndProcedure
Procedure.s ReceiveRaw(Url.s, Query.s, Format = #PB_UTF8, Modus = #PB_Network_TCP|#PB_Network_IPv4, TimeOut = 5000)
Protected Server.s, Port, *Query, QueryBytes
Protected NetID, Bytes, *Buff, StartTime, Ret.s
Url=CheckUrl(Url)
Server.s = GetURLPart(Url, #PB_URL_Site)
Port = Val(GetURLPart(Url, #PB_URL_Port))
If Port = 0
Port = 80
EndIf
QueryBytes = StringByteLength(Query, Format)
*Query = AllocateMemory(QueryBytes + 2)
If *Query
PokeS(*Query, Query, -1, Format)
*Buff = AllocateMemory(100000) ; 100 KB Puffer
If *Buff
WriteLog("Verbinde mit " + Server + ":" + Str(Port) + " ...")
NetID = OpenNetworkConnection(Server, Port, Modus, TimeOut)
If NetID
WriteLog("Verbindung erfolgreich")
WriteLog("Sende Anfrage ...")
Bytes = SendNetworkData(NetID, *Query, QueryBytes)
WriteLog(Str(Bytes) + " Bytes gesendet")
WriteLog("Warte " + Str(TimeOut) + " ms auf Antwort ...")
Bytes = 0
StartTime = ElapsedMilliseconds()
Repeat
Select NetworkClientEvent(NetID)
Case #PB_NetworkEvent_Data
WriteLog("Empfange Daten ...")
Bytes = ReceiveNetworkData(NetID, *Buff, MemorySize(*Buff))
If Bytes
WriteLog(Str(Bytes) + " Bytes empfangen")
Ret = PeekS(*Buff, Bytes, Format|#PB_ByteLength)
Break
EndIf
Case #PB_NetworkEvent_Disconnect
WriteLog("Verbindung wurde getrennt")
Break
Default
If (ElapsedMilliseconds() - StartTime) > TimeOut
WriteLog("Timeout erreicht")
Break
Else
Delay(5)
EndIf
EndSelect
ForEver
CloseNetworkConnection(NetID)
Else
WriteLog("Verbindung fehlgeschlagen")
EndIf
FreeMemory(*Buff)
Else
WriteLog("Nicht genug freier Speicher")
Debug "ReceiveRaw: Nicht genug freier Speicher"
EndIf
FreeMemory(*Query)
Else
WriteLog("Nicht genug freier Speicher")
Debug "ReceiveRaw: Nicht genug freier Speicher"
EndIf
ProcedureReturn Ret
EndProcedure
Procedure THREAD_Receive(*TData.ThreadData)
Protected Ret.s, StartTime = ElapsedMilliseconds(), Run = #True, Loop
With *TData
Repeat
; Abrufen
If Run
WriteLog(RSet(#Empty$, 20, "=") + " AbfrageNr.: " + Str(Loop) + " " + RSet(#Empty$, 20, "="), #False)
If \GetRaw
Ret = ReceiveRaw(\Url, \Query, \Format, \Modus, \Timeout)
Else
Ret = ReceiveHTTP(\Url, \Format)
EndIf
If Ret <> #Empty$
WriteLog("Antwort vom Server: ")
WriteLog(RSet(#Empty$, 25, "-"), #False)
WriteLog(Ret, #False)
WriteLog(RSet(#Empty$, 25, "-"), #False)
EndIf
Run = #False
EndIf
; Intervallrechnung
If \Interval > 0
If (ElapsedMilliseconds() - StartTime) > \Interval
Loop + 1
Run = #True
StartTime = ElapsedMilliseconds()
EndIf
Else ; kein Interval, keine Wiederholung
Break
EndIf
; Beenden-Anforderung, Resourcen freigeben
If \Exit
Break
Else
Delay(10)
EndIf
ForEver
EndWith
PostEvent(#EVENT_ThreadFinished, #WND, #Null)
EndProcedure
Procedure ThreadCleanUp()
DisableGadget(#BTN_Start, #True)
If ThreadData\ID
ThreadData\Exit = #True
If IsThread(ThreadData\ID)
WriteLog("Warte auf Thread ...")
If WaitThread(ThreadData\ID, ThreadData\Timeout) = 0
WriteLog("Kill Thread ...")
KillThread(ThreadData\ID)
EndIf
EndIf
WriteLog(">>>>>>>>>> Thread beendet <<<<<<<<<<")
EndIf
ResetStructure(@ThreadData, ThreadData)
DisableGadget(#BTN_Start, #False)
EndProcedure
Procedure CALLBACK_Gadgets()
Protected EventType = EventType()
Protected EventGadget = EventGadget()
Select EventGadget
Case #BTN_Start
If GetGadgetState(#BTN_Start)
If GetGadgetState(#CHK_Repeat)
ThreadData\Interval = GetGadgetState(#SPIN_ms)
SetGadgetText(#BTN_Start, "STOP")
Else
ThreadData\Interval = 0
SetGadgetState(#BTN_Start, #False)
EndIf
ThreadData\Exit = #False
ThreadData\Url = GetGadgetText(#STR_Url)
ThreadData\Format = #PB_UTF8
ThreadData\GetRaw = GetGadgetState(#OPT_Own)
ThreadData\Modus = #PB_Network_TCP|#PB_Network_IPv4
ThreadData\Query = GetQuery()
ThreadData\Timeout = 10000
ThreadData\ID = CreateThread(@THREAD_Receive(), @ThreadData)
WriteLog(">>>>>>>>>> Starte Thread ... <<<<<<<<<<")
Else
ThreadData\Exit = #True ;ThreadCleanUp()
SetGadgetText(#BTN_Start, "START")
EndIf
Case #BTN_DelLog
SetGadgetText(#EDIT_Log, #Empty$)
Case #EDIT_Info
If EventType = #PB_EventType_RightClick
PopupMenuGadget = EventGadget
DisableMenuItem(#MENU_PopUp, #MENUITEM_Cut, #True)
DisableMenuItem(#MENU_PopUp, #MENUITEM_Paste, #True)
DisableMenuItem(#MENU_PopUp, #MENUITEM_Undo, #True)
DisplayPopupMenu(#MENU_PopUp, WindowID(#WND))
EndIf
Case #EDIT_Log
If EventType = #PB_EventType_RightClick
PopupMenuGadget = EventGadget
DisableMenuItem(#MENU_PopUp, #MENUITEM_Cut, #True)
DisableMenuItem(#MENU_PopUp, #MENUITEM_Paste, #True)
DisableMenuItem(#MENU_PopUp, #MENUITEM_Undo, #True)
DisplayPopupMenu(#MENU_PopUp, WindowID(#WND))
EndIf
Case #EDIT_Own
If EventType = #PB_EventType_RightClick
PopupMenuGadget = EventGadget
DisableMenuItem(#MENU_PopUp, #MENUITEM_Cut, #False)
DisableMenuItem(#MENU_PopUp, #MENUITEM_Paste, #False)
DisableMenuItem(#MENU_PopUp, #MENUITEM_Undo, #False)
DisplayPopupMenu(#MENU_PopUp, WindowID(#WND))
EndIf
Default
If GetGadgetState(#CHK_Repeat)
DisableGadget(#SPIN_ms, #False)
Else
DisableGadget(#SPIN_ms, #True)
EndIf
If GetGadgetState(#OPT_Own)
DisableGadget(#EDIT_Own, #False)
Else
DisableGadget(#EDIT_Own, #True)
EndIf
EndSelect
EndProcedure
Procedure CALLBACK_Menu()
Select EventMenu()
Case #MENUITEM_Undo
SendMessage_(GadgetID(PopupMenuGadget), #WM_UNDO, 0, 0)
Case #MENUITEM_Cut
SendMessage_(GadgetID(PopupMenuGadget), #WM_CUT, 0, 0)
Case #MENUITEM_Copy
SendMessage_(GadgetID(PopupMenuGadget), #WM_COPY, 0, 0)
Case #MENUITEM_Paste
SendMessage_(GadgetID(PopupMenuGadget), #WM_PASTE, 0, 0)
Case #MENUITEM_SelectAll
;lang = Len(GetGadgetText(EventGadget))
SendMessage_(GadgetID(PopupMenuGadget), #EM_SETSEL, 0, -1)
EndSelect
EndProcedure
Procedure CALLBACK_Wnd(hWnd, Msg, wParam, lParam)
If Msg = #WM_CONTEXTMENU
Select wParam
Case GadgetID(#EDIT_Info)
PostEvent(#PB_Event_Gadget, #WND, #EDIT_Info, #PB_EventType_RightClick)
Case GadgetID(#EDIT_Own)
PostEvent(#PB_Event_Gadget, #WND, #EDIT_Own, #PB_EventType_RightClick)
Case GadgetID(#EDIT_Log)
PostEvent(#PB_Event_Gadget, #WND, #EDIT_Log, #PB_EventType_RightClick)
EndSelect
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure Create_WND()
; Fenster öffnen und Standartwerte setzen
OpenWND()
SetWindowTitle(#WND, "Connection Test " + Version())
WindowBounds(#WND, WindowWidth(#WND), WindowHeight(#WND), #PB_Ignore, #PB_Ignore)
BindEvent(#PB_Event_SizeWindow, @ResizeGadgetsWND(), #WND)
BindEvent(#PB_Event_Gadget, @CALLBACK_Gadgets(), #WND)
BindEvent(#PB_Event_Menu, @CALLBACK_Menu(), #WND)
BindEvent(#EVENT_ThreadFinished, @ThreadCleanUp(), #WND)
SetWindowCallback(@CALLBACK_Wnd(), #WND)
CALLBACK_Gadgets()
SetGadgetText(#EDIT_Own,"GET /file.xxx HTTP/1.1\r\n" + #LF$ +
"Host: server\r\n" + #LF$ +
"Connection: close\r\n" + #LF$ +
;"User-Agent: Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:47.0) Gecko/20100101 Firefox/47.0" + #LF$ +
"\r\n\r\n")
SetGadgetState(#OPT_Internal, #True)
SetGadgetState(#CHK_Repeat, #False)
SetGadgetState(#SPIN_ms, 5000)
If CreatePopupMenu(#MENU_PopUp)
MenuItem(#MENUITEM_Undo, "Rückgängig")
MenuBar()
MenuItem(#MENUITEM_Copy, "Kopieren")
MenuItem(#MENUITEM_Cut, "Ausschneiden")
MenuItem(#MENUITEM_Paste, "Einfügen")
MenuBar()
MenuItem(#MENUITEM_SelectAll, "Alles Auswählen")
EndIf
; Info hinzufügen
AddGadgetItem(#EDIT_Info, -1, "Escape-Sequenzen:")
AddGadgetItem(#EDIT_Info, -1, ~"\\a\tAscii: 7\tBeep")
AddGadgetItem(#EDIT_Info, -1, ~"\\b\tAscii: 8\tBackSpace")
AddGadgetItem(#EDIT_Info, -1, ~"\\t\tAscii: 9\tH-Tab")
AddGadgetItem(#EDIT_Info, -1, ~"\\n\tAscii: 10\tLineFeed")
AddGadgetItem(#EDIT_Info, -1, ~"\\v\tAscii: 11\tV-Tab")
AddGadgetItem(#EDIT_Info, -1, ~"\\f\tAscii: 12\tFormFeed")
AddGadgetItem(#EDIT_Info, -1, ~"\\r\tAscii: 13\tCarriageReturn")
AddGadgetItem(#EDIT_Info, -1, ~"\\\"\tAscii: 34\tDoubleQuote")
AddGadgetItem(#EDIT_Info, -1, ~"\\\\\tAscii: 92\tBackSlash")
EndProcedure
;_ INIT
Create_WND()
HideWindow(#WND, #False)
;_ MAIN
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
;Aufräumen
HideWindow(#WND, #True)
ThreadCleanUp()
; IDE Options = PureBasic 5.62 (Windows - x86)
; CursorPosition = 9
; Folding = LA9
; EnableXP
; CompileSourceDirectory
; EnableCompileCount = 0
; EnableBuildCount = 0
; EnableExeConstant

Impressum | Datenschutz