SendToHost Function freezes rarely

[beo6]

Hi everyone.

i am using this function in my application:

Code: Select all

Procedure.s SendToHost(Host$, File$, _Data$, _Cookie$)
  ;InitNetwork()
  
  Define ConnectionID = OpenNetworkConnection(Host$, 80)
  Define string.s, Text.s
  
  If ConnectionID
  
    Define String$ = ""
    If _Data$ <> ""
      String$ + "POST " + File$ + " HTTP/1.1" + Chr(13) + Chr(10)

      String$ + "Content-Length: " + Str(Len(_Data$)) + Chr(13) + Chr(10)
    Else
      String$ + "GET " + File$ + " HTTP/1.1" + Chr(13) + Chr(10)
    EndIf
  
    String$ + "Host: " + Host$ + Chr(13) + Chr(10)
    If _Cookie$ <> ""
      String$ + "Cookie: " + _Cookie$ + Chr(13) + Chr(10)
    EndIf
    String$ + "Content-Type: application/x-www-form-urlencoded" + Chr(13) + Chr(10)
    String$ + "Connection: close" + Chr(13) + Chr(10)
    String$ + Chr(13) + Chr(10)
    String$ + _Data$ + Chr(13) + Chr(10)
  
    SendNetworkString(ConnectionID, String$)
    While NetworkClientEvent(ConnectionID) <> 2
      Delay(1)
    Wend
    Define size = 100000
    Define *Buffer = AllocateMemory(size)
    
    Define laenge.l = 1
    While laenge <> 0
      laenge.l = ReceiveNetworkData(ConnectionID, *Buffer, size)
      If laenge <> 0 And Len(string.s)+laenge < 63999
        string.s = string.s + PeekS(*Buffer, laenge)
      EndIf
    Wend
  
    Text.s = string.s
    FreeMemory(*Buffer)
    Define Start = FindString(Text, Chr(13)+Chr(10)+Chr(13)+Chr(10), 0)+9
    CloseNetworkConnection(ConnectionID)
    ;ProcedureReturn Mid(Text, Start+1, (Len(Text)-Start)-1)
    
    Define html$ = Mid(Text, Start+0, (Len(Text)-Start)-1)
    ;zeilenumbrueche entfernen
    html$ = RemoveString(html$, Chr(10), #PB_String_NoCase)
    html$ = RemoveString(html$, Chr(13), #PB_String_NoCase)
    html$ = LCase(html$)
    html$ = ReplaceString(html$, "&auml;", "ä", #PB_String_NoCase) 
    html$ = ReplaceString(html$, "&uuml;", "ü", #PB_String_NoCase) 
    html$ = ReplaceString(html$, "&ouml;", "ö", #PB_String_NoCase) 
    html$ = ReplaceString(html$, "&", "&", #PB_String_NoCase)
    
    ProcedureReturn html$
  EndIf
  
EndProcedure

but the code freezes my application rarely.
I found the Code here
http://www.purearea.net/pb/CodeArchiv/I ... dToHost.pb
and modified it somewhat to allow cookie sending and to communicate with a php-script.
it seems that the code is cutting of some charactes off from the begin and end of the html too.

does someone know what is wrong with it?

thanks

[STARGÅTE]

Problem is here:

Code: Select all

    Define laenge.l = 1
    While laenge <> 0
      laenge.l = ReceiveNetworkData(ConnectionID, *Buffer, size)
      If laenge <> 0 And Len(string.s)+laenge < 63999
        string.s = string.s + PeekS(*Buffer, laenge)
      EndIf
    Wend

it musst be:

Code: Select all

    Define laenge.l
    Repeat
      laenge.l = ReceiveNetworkData(ConnectionID, *Buffer, size)
      If laenge > 0 And Len(string.s)+laenge < 63999
        string.s + PeekS(*Buffer, laenge)
      EndIf
    Until laenge <> size

[beo6]

Thank you a lot.
I will try it and see if it still freezes sometimes.

If i understand your change right it happened sometimes that laenge never reached 0 and was stuck in the loop.

i now changed the function a bit more and now i also get the full html without something missing from the begin and end. But i need to look if it still works with other webservers.

i changed

Code: Select all

    Define Start = FindString(Text, Chr(13)+Chr(10)+Chr(13)+Chr(10), 0)+9
    CloseNetworkConnection(ConnectionID)
    Define html$ = Mid(Text, Start+0, (Len(Text)-Start)-1)

to

Code: Select all

    Define Start = FindString(Text, Chr(13)+Chr(10)+Chr(13)+Chr(10), 0)
    CloseNetworkConnection(ConnectionID)
    Define html$ = Mid(Text, Start)

[beo6]

hi everyone.

After the change from STARGÅTE worked even less than my original function

i think i finaly got it working.

I tried a lot,
like adding the functionality to an own thread that is checked by the main thread and when it does not finish the operation after some time it kills the thread so on a new thread start it would work.

But even that didn't worked.

Then i looked again at the very beginning and stumbled over the InitNetwork().

i thought the meaning in the help file is like:
do the Init once on the Application start, and it should work because it is before all the other network functions.

But now i have put the InitNetwork() into the thread again so it will be called each time something gets loaded, and it seems to work now.

Is this the way it is meant to work?

what is to do when there are many different functions that do some network stuff?
put InitNetwork() into each function?

Thanks

[infratec]

Hi beo6,

no, that's not the way to use InitNetwork().

It is called only once.

So the fault is at an other location.

I found one fault in your code. Maybe tis results in a memory corruption:

Code: Select all

Start = FindString(String$, #CRLF$ + #CRLF$, 0)

is wrong.
The second parameter should be 1 and not 0.

Maybe this works

Code: Select all

Procedure.s SendToHost(Host$, File$, _Data$, _Cookie$)
  
  html$ = ""
 
  ConnectionID = OpenNetworkConnection(Host$, 80)
  
  If ConnectionID
    
    ;Build header
    String$ = ""
    If _Data$ <> ""
      String$ + "POST " + File$ + " HTTP/1.1" + #CRLF$
      String$ + "Content-Length: " + Str(Len(_Data$)) + #CRLF$
    Else
      String$ + "GET " + File$ + " HTTP/1.1" + #CRLF$
    EndIf
 
    String$ + "Host: " + Host$ + #CRLF$
    If _Cookie$ <> ""
      String$ + "Cookie: " + _Cookie$ + #CRLF$
    EndIf
    String$ + "Content-Type: application/x-www-form-urlencoded" + #CRLF$
    String$ + "Connection: close" + #CRLF$
    String$ + #CRLF$
    ; header is finished
    
    String$ + _Data$ + #CRLF$
 
    SendNetworkString(ConnectionID, String$)
    TimeOutCounter = 100
    Repeat
      If NetworkClientEvent(ConnectionID) = #PB_NetworkEvent_Data
        Break
      EndIf
      Delay(10)
      TimeOutCounter -1
    Until TimeOutCounter = 0
    
    If TimeOutCounter <> 0
      #Size = 100000
      *Buffer = AllocateMemory(#Size)
      
      If *Buffer
        String$ = ""      
        Repeat
          Laenge = ReceiveNetworkData(ConnectionID, *Buffer, #Size)
          If Laenge > 0
            String$ + PeekS(*Buffer, Laenge)
          EndIf
        Until Laenge <> #Size
        
        FreeMemory(*Buffer)
        
        BodyStart = FindString(String$, #CRLF$ + #CRLF$, 1)
        
        html$ = Mid(String$, BodyStart)
        
        ;zeilenumbrueche entfernen
        html$ = RemoveString(html$, #LF$, #PB_String_NoCase)
        html$ = RemoveString(html$, #CR$, #PB_String_NoCase)
        html$ = LCase(html$)
        html$ = ReplaceString(html$, "&auml;", "ä", #PB_String_NoCase)
        html$ = ReplaceString(html$, "&uuml;", "ü", #PB_String_NoCase)
        html$ = ReplaceString(html$, "&ouml;", "ö", #PB_String_NoCase)
        html$ = ReplaceString(html$, "&", "&", #PB_String_NoCase)
      Else
        Debug "SendToHost(): Was not able to allocate Buffer")
      EndIf
    Else
      Debug "SendToHost(): Timeout")
    EndIf
      
    CloseNetworkConnection(ConnectionID)
    
  Else
    Debug "SendToHost(): Was not able to establish connection to " + Host$
  EndIf
  
  ProcedureReturn html$
  
EndProcedure

Best regards,

Bernd

[beo6]

Thank you.
you are right about FindString. Never checked it.

so i was going to check some other functions and i have found in the help that ReceiveNetworkData()
can handle only up to 65536 as databuffer length.
So i changed that too.

with the initNetwork()
i am not supposed to start it in a thread when i am using threads for the data loading?
because it seems the debugger is not complaining when i start it like when i use it more than once in the main application.

i do need #PB_Ascii in the PeekS function because i build the application as Unicode.

here is my small modified function from your:

Code: Select all

Procedure.s SendToHost(Host$, File$, _Data$, _Cookie$)
  
  Define html$ = ""
  Define String$ = ""
  Define BodyStart
  Define ConnectionID, TimeOutCounter
  Define Laenge

  ConnectionID = OpenNetworkConnection(Host$, 80)
  
  If ConnectionID
    
    ;Build header
    
    If _Data$ <> ""
      String$ + "POST " + File$ + " HTTP/1.1" + #CRLF$
      String$ + "Content-Length: " + Str(Len(_Data$)) + #CRLF$
    Else
      String$ + "GET " + File$ + " HTTP/1.1" + #CRLF$
    EndIf

    String$ + "Host: " + Host$ + #CRLF$
    If _Cookie$ <> ""
      String$ + "Cookie: " + _Cookie$ + #CRLF$
    EndIf
    String$ + "Content-Type: application/x-www-form-urlencoded" + #CRLF$
    String$ + "Connection: close" + #CRLF$
    String$ + #CRLF$
    ; header is finished
    
    String$ + _Data$ + #CRLF$
    
    SendNetworkString(ConnectionID, String$)
    TimeOutCounter = 100
    Repeat
      If NetworkClientEvent(ConnectionID) = #PB_NetworkEvent_Data
        Break
      EndIf
      Delay(10)
      TimeOutCounter -1
    Until TimeOutCounter = 0
    
    If TimeOutCounter <> 0
      #Size = 65536
      Define *Buffer = AllocateMemory(#Size)
      
      If *Buffer
        String$ = ""      
        Repeat
          Laenge = ReceiveNetworkData(ConnectionID, *Buffer, #Size)
          If Laenge > 0
            String$ + PeekS(*Buffer, Laenge, #PB_Ascii)
          EndIf
        Until Laenge <> #Size
        
        FreeMemory(*Buffer)
        
        BodyStart = FindString(String$, #CRLF$ + #CRLF$, 1)
        
        html$ = Mid(String$, BodyStart)
        
        ;zeilenumbrueche entfernen
        html$ = RemoveString(html$, #LF$, #PB_String_NoCase)
        html$ = RemoveString(html$, #CR$, #PB_String_NoCase)
        ;html$ = LCase(html$)
        html$ = ReplaceString(html$, "&auml;", "ä", #PB_String_NoCase)
        html$ = ReplaceString(html$, "&uuml;", "ü", #PB_String_NoCase)
        html$ = ReplaceString(html$, "&ouml;", "ö", #PB_String_NoCase)
        html$ = ReplaceString(html$, "&", "&", #PB_String_NoCase)
        html$ = ReplaceString(html$, """, Chr(34), #PB_String_NoCase)
        html$ = ReplaceString(html$, "></option>", "> </option>", #PB_String_NoCase) ; optionfelder ohne textinhalt fix
      Else
        Debug "SendToHost(): Was not able to allocate Buffer"
        StatusBarText(#StatusBar_0, 0, "Lesebuffer konnte nicht zugewiesen werden")
      EndIf
    Else
      Debug "SendToHost(): Timeout"
      StatusBarText(#StatusBar_0, 0, "Verbindung timed out")
    EndIf
      
    CloseNetworkConnection(ConnectionID)
    
  Else
    Debug "SendToHost(): Was not able to establish connection to " + Host$
    StatusBarText(#StatusBar_0, 0, "Fehler beim verbinden zu "+ Host$)
  EndIf
  
  ProcedureReturn html$
  
EndProcedure

(the "optionfelder ohne textinhalt fix" is only for a later regex i am doing on the html data)

now i need some time to test it and to see if the problem happens again.
(just a note because of the freezing. i always build it with threadSafe enabled since i am using the function now in a thread.)