PureBasic Forums - English

Code: Select all

#DATA_BUFFER_LENGHT=8192 ; change according to your needs
#SERVER_HEADER_SHIFT=191 ; change according to your needs

Declare InsertList(IDS_lista$, DTM_fine$, STR_titolo$, STR_destinazione$, DTM_partenza$, STR_nominativo_1$, STR_nominativo_2$, STR_telefono$, STR_email$)
Declare.s URLEncode(String$)

Procedure InsertList(IDS_lista$, DTM_fine$, STR_titolo$, STR_destinazione$, DTM_partenza$, STR_nominativo_1$, STR_nominativo_2$, STR_telefono$, STR_email$)
  Shared server_HTTP$, Directory_Server$
  Protected i=0, l, res=1
  Protected *BUFFER_connection, *p
  Protected tmp$=""

  *BUFFER_connection=AllocateMemory(#DATA_BUFFER_LENGHT)
  If *BUFFER_connection

    l=OpenNetworkConnection(server_HTTP$,80)
    If l
    ; invia la richiesta

      ; sostituisce i caratteri non accettati
      STR_titolo$=URLEncode(STR_titolo$)
      STR_destinazione$=URLEncode(STR_destinazione$)
      STR_nominativo_1$=URLEncode(STR_nominativo_1$)      
      STR_nominativo_2$=URLEncode(STR_nominativo_2$)
      STR_telefono$=URLEncode(STR_telefono$)
      STR_email$=URLEncode(STR_email$)

      POST$="IDS_lista="+IDS_lista$+"&DTM_fine="+DTM_fine$+"&STR_titolo="+STR_titolo$+"&STR_destinazione="+STR_destinazione$+"&DTM_partenza="+DTM_partenza$+"&STR_nominativo_1="+STR_nominativo_1$+"&STR_nominativo_2="+STR_nominativo_2$+"&STR_telefono="+STR_telefono$+"&STR_email="+STR_email$

      tmp$="POST "+Directory_Server$+"insert_list.php HTTP/1.1"+#CRLF$
      tmp$+"Host: "+server_HTTP$+#CRLF$
      tmp$+"Content-Type: application/x-www-form-urlencoded"+#CRLF$
      tmp$+"Content-Length: "+Str(Len(POST$))+#CRLF$
      tmp$+#CRLF$+POST$

;     tmp$="GET "+Directory_Server$+"insert_list.php?IDS_lista="+IDS_lista$+"&DTM_fine="+DTM_fine$+"&STR_titolo="+STR_titolo$+"&STR_destinazione="+STR_destinazione$+"&DTM_partenza="+DTM_partenza$+"&STR_nominativo_1="+STR_nominativo_1$+"&STR_nominativo_2="+STR_nominativo_2$+"&STR_telefono="+STR_telefono$+"&STR_email="+STR_email$+" HTTP/1.1"+#CRLF$
;     tmp$+"Host: "+server_HTTP$+#CRLF$+#LF$

      Debug tmp$
      Debug "["+Str(Len(tmp$))+"]"

      If SendNetworkString(l,tmp$)
        Repeat
          i=NetworkClientEvent(l)
        Until i<>0
        If i=#PB_NetworkEvent_Data
          i=ReceiveNetworkData(l,*BUFFER_connection,#DATA_BUFFER_LENGHT)
        EndIf

        tmp$=""
        If i<>-1
          If PeekS(*BUFFER_connection,15,#PB_Ascii)="HTTP/1.1 200 OK"
            *p=*BUFFER_connection+#SERVER_HEADER_SHIFT
            ; controllo risorse aperte
            If PeekS(*p,14,#PB_Ascii)="Resource id #1"
              *p+18
              Debug "Resource id #1"
              If PeekS(*p,14,#PB_Ascii)="Resource id #2"
;               *p+17
                Debug "Resource id #2"
              Else
              ; risorsa '2' non aperta
                res=0              
              EndIf
            Else
            ; risorsa '1' non aperta
              res=0            
            EndIf
          Else
          ; messaggio HTTP erroneo
            res=0
          EndIf
        Else
        ; nessun dato disponibile
          res=0        
        EndIf

        CloseNetworkConnection(l)

      Else
      ; impossibile inviare il messaggio
        res=0      
      EndIf
    Else
    ; impossibile aprire una connessione
      res=0    
    EndIf
  Else
  ; impossibile allocare la memoria
    res=0
  EndIf
  ProcedureReturn(res)
EndProcedure

Procedure.s URLEncode(String$)
  Protected indirizzo_ultimo_carattere
  Protected URLString$
  
  indirizzo_ultimo_carattere=@String$+Len(String$)
  *Seeker.BYTE=@String$
  
  While *Seeker<indirizzo_ultimo_carattere
    Select *Seeker\b
      Case 32 ; 'SPAZIO'
        URLString$+"+"
      Case 48 To 57 ; cifre
        URLString$+Chr(*Seeker\b)
      Case 65 To 90, 97 To 122 ; 'A..Z' 'a..z'
        URLString$+Chr(*Seeker\b)
      Case '-','_','.','~'
        URLString$+Chr(*Seeker\b)
      Case '!','*',39,'(',')',';',':','@','&','=','+','$',',','/','?','%','#','[',']'
        URLString$+"%"+Right(Hex(*Seeker\b),2)
;     Default
    EndSelect
    *Seeker+1
  Wend

  ProcedureReturn(URLString$)
EndProcedure