PureBasic

Code : Tout sélectionner

Declare OpenWindow_Window_0()
Declare.s GetMyIP()
Declare Get_Avis(a)
Declare sendfiles(asd.s)
Declare.s send()

Enumeration
  #Window_0
  #Button_SendMessage
  #Text_Name
  #Text_eMail
  #String_Name
  #String_Mail
  #Editor_Message
  #Editor_OldMessage
  #Button_Close
  #Button_Reload
  #Text_Title
  #Frame3D
  #Text_Opinion
EndEnumeration

; Config
Global host.s="purebasic.site11.com"
Global username.s="a7468621"
Global pass.s="jojo123"
Global DistantFolder.s="public_html/avisnew"
Global DistantFile.s="tg.tg"
Global URLdistantfile$="http://purebasic.site11.com/avisnew/tg.tg"
Global localfolder.s=GetEnvironmentVariable("temp")+"\avis\"
Global localfile.s=localfolder+"tg.tg"
Global localfile2.s=localfolder+"tg2.tg"
Global Separator.s="$"

CreateDirectory(localfolder)
InitNetwork()
OpenWindow_Window_0()
CreateThread(@Get_Avis(),154)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button_SendMessage:send()
        Case #Button_Close:quit=1
        Case #Button_Reload:Get_Avis(154)
      EndSelect
    Case #PB_Event_CloseWindow:quit=1
  EndSelect
Until quit=1
DeleteDirectory(localfolder,"")
End


Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 386, 36, 303, 405, "Avis sur le programme", #PB_Window_ScreenCentered| #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar)
    ButtonGadget(#Button_SendMessage, 85, 150, 95, 20, "Send Opinion")
    TextGadget(#Text_Name, 65, 40, 30, 15, "Nom :")
    TextGadget(#Text_eMail, 65, 60, 32, 15, "eMail :")
    StringGadget(#String_Name, 100, 35, 100, 20, "")
    StringGadget(#String_Mail, 100, 60, 100, 20, "")
    EditorGadget(#Editor_Message, 50, 100, 180, 47)
    EditorGadget(#Editor_OldMessage, 5, 190, 290, 185, #PB_Editor_ReadOnly)
    ButtonGadget(#Button_Close, 185, 380, 70, 20, "Close")
    ButtonGadget(#Button_Reload, 10, 380, 90, 20, "Reload Opinions")
    TextGadget(#Text_Title, 65, 5, 160, 20, "Opinions on the program")
    Frame3DGadget(#Frame3D, 45, 30, 190, 145, "Gadget_10", #PB_Frame3D_Double)
    TextGadget(#Text_Opinion, 110, 85, 44, 15, "Opinion :")
    SetGadgetFont(#Text_Title, LoadFont(1, "Minion Pro Cond", 12, #PB_Font_Bold|#PB_Font_HighQuality))
  EndIf
EndProcedure

Procedure.s GetMyIP()
  MyIP.s = StringField(GetHTTPHeader("http://www.anotherprophecy.com/system/scripts/getip.php"),2, Chr(34))
  ProcedureReturn MyIP
EndProcedure

Procedure Get_Avis(a)
  ReceiveHTTPFile(URLdistantfile$,localfile)
  If OpenFile(0,localfile)
    ClearGadgetItems(#Editor_OldMessage)
    Repeat
      aw.s=ReadString(0)
      nom.s=ReplaceString(StringField(aw,1,Separator),"_"," ")
      date.s=StringField(aw,2,Separator)
      heure.s=StringField(aw,3,Separator)
      AddGadgetItem(#Editor_OldMessage,-1,nom+" le "+date+" a "+heure)
      For k=6 To CountString(aw,Separator)+1
        AddGadgetItem(#Editor_OldMessage,-1,StringField(aw,k,Separator))
      Next
      AddGadgetItem(#Editor_OldMessage,-1,"")
    Until Eof(0)
  EndIf
EndProcedure

Procedure sendfiles(asd.s)
  If OpenFTP(0,host,username,pass)
    If SetFTPDirectory(0,DistantFolder)
      If ReceiveFTPFile(0,DistantFile,localfile2)
        If OpenFile(2,localfile2)
          FileSeek(2,Lof(2))
          WriteStringN(2,Mid(asd,1,Len(asd)-2))
          CloseFile(2)
          If SendFTPFile(0,localfile2,DistantFile)
            MessageRequester("Envoi d'avis","Avis envoye")
          Else
            MessageRequester("Opinions","Can't connect to server"+Chr(10)+"Please check your Internet connection and try again")
          EndIf
        Else
          MessageRequester("Opinions","Can't connect to server"+Chr(10)+"Please check your Internet connection and try again")
        EndIf
      Else
        MessageRequester("Opinions","Can't connect to server"+Chr(10)+"Please check your Internet connection and try again")
      EndIf
    Else
      MessageRequester("Opinions","Can't connect to server"+Chr(10)+"Please check your Internet connection and try again")
    EndIf
    CloseFTP(0)
  Else
    MessageRequester("Opinions","Can't connect to server"+Chr(10)+"Please check your Internet connection and try again")
  EndIf
EndProcedure

Procedure.s send()
  NewOpinion.s=GetGadgetText(#String_Name)+Separator
  NewOpinion+FormatDate("%dd/%mm/%yyyy", Date())+Separator
  NewOpinion+FormatDate("%hh:%ii:%ss", Date())+Separator
  NewOpinion+GetGadgetText(#String_Mail)+Separator
  NewOpinion+GetMyIP()+Separator
  Debug CountGadgetItems(#Editor_Message)
  For k=0 To CountGadgetItems(#Editor_Message)
    NewOpinion+GetGadgetItemText(#Editor_Message,k)+Separator
  Next
  sendfiles(NewOpinion)
EndProcedure