Le serveur Web de Cls

Cls · Message par **Cls** » mer. 06/juin/2007 13:38

Bonjour !

Voilà un programme un peu plus intéréssant que ceux - ci : http://www.purebasic.fr/french/viewtopic.php?t=6698

Il s'agit d'un serveur Web classique avec des fonctions avancées :
- Ban/DeBan en live des clients
- Filtre IP
- Configuration dynamique des pages
- Création de liste dynamique de fichiers via une page virtuelle
- Journalisation des connexions et requêtes clientes

Voici le lien (Sources + exe) : http://cyberquebec.ca/cls/cls_web_server.rar (37 ko)

Avec une petite capture d'écran c'est plus sympa :

Cordialement,
Cls

lionel_om · Message par **lionel_om** » jeu. 07/juin/2007 7:37

Peut-être utile et faire gagner du temps ce prog.
merci bien !!!

Lio

Kwai chang caine · Message par **Kwai chang caine** » jeu. 07/juin/2007 16:57

De la balle

Je l'ai testé rapidement sur le reseau de mon boulot.
Il marche super bien.

Merci et bravo

Ollivier · Message par **Ollivier** » ven. 29/juin/2007 23:14

J'ai une page blanche quand je clique sur le lien.
Il a été viré ou c'est mon explorateur qui n'accepte pas les fichiers RAR?

(Aujourd'hui, c'est mon 1er jour sur ce forum et je suis aux anges avec PureBasic, c'est un sacré logiciel)

nico · Message par **nico** » sam. 30/juin/2007 11:36

J'ai hâte de le tester en réseau, bon boulot!

Ollivier · Message par **Ollivier** » sam. 30/juin/2007 12:07

Ah! Si, j'ai réussi à le télécharger.
Par contre, j'ai rien pour le décompresser

Backup · Message par **Backup** » sam. 30/juin/2007 16:53

Ollivier a écrit :Ah! Si, j'ai réussi à le télécharger.
Par contre, j'ai rien pour le décompresser

http://www.7-zip.org/fr/

Ollivier · Message par **Ollivier** » sam. 30/juin/2007 17:59

Malgré tes efforts Dobro, je n'ai pas de fichier exécutable qui se soit décompressé. Tant pis!
Je verrai ça une autre fois. En tout cas, ça a l'air nickel.

Cls · Message par **Cls** » mar. 03/juil./2007 10:15

Merci à tous,
Pour infos je prépare (tranquillement) la version 1.3.

Au menu :
- Nouvelle interface
- Listing dynamique + évolué (listing de plusieurs répertoires, présentation de la page renvoyée personnalisable via CSS...)
- Installer
- Bugs

Cordialement,
Cls

Droopy · Message par **Droopy** » mar. 03/juil./2007 15:59

félicitation, bon boulot

MetalOS · Message par **MetalOS** » dim. 08/nov./2009 4:03

Le lien ne marche plus Cls

Cls · Message par **Cls** » lun. 16/nov./2009 12:23

Voilà la source (non testée depuis un bon moment) :

Attention aux inclusions de fichier, notamment

Code : Tout sélectionner

data1:IncludeBinary "cws.ico"

. Il te faudra une icône.
Il faut également créer un répertoire 'WWW' contenant les pages :

ban.html
erreur_404.html
index.html

C'est une vieille source (2006)... Donc à utiliser avec précaution (quand je regarde le code je trouve pas ça top...).

Code : Tout sélectionner

;+-----------------------------------------------------------------------------+
;|  Cls Web Serveur                                                            |
;+-----------------------------------------------------------------------------+
;| Auteur : Cls                                                     | 
;| Version : 1.2 - Septembre 2006                                              |
;| Desc : Application permettant la création d'un serveur Web                  |
;+-----------------------------------------------------------------------------+
;| Fonctions : Ban/DeBan en live des clients                                   |
;|             Filtre IP                                                       |
;|             Configuration dynamique des pages                               |
;|             Création de liste dynamique de fichiers via page virtuelle      |
;|             Journalisation des connexions et requêtes clientes              |
;+-----------------------------------------------------------------------------+

;- Window Constants
;
Enumeration
  #Window_0
  #Window_2
  #Window_3
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Listview_0
  #Listview_1
  #Frame3D_0
  #Frame3D_1
  #Frame3D_3
  #Frame3D_5
  #Editor_0
  #Button_0
  #Button_1
  #Button_2
  #Button_5
  #Button_6
  #Button_8
  #Button_10
  #Button_11
  #Button_13
  #Button_14
  #Button_15
  #Button_16
  #Button_18 
  #CheckBox_1
  #CheckBox_2
  #CheckBox_3
  #CheckBox_4
  #CheckBox_5
  #CheckBox_6
  #CheckBox_7
  #Frame3D_8
  #String_0
  #String_1
  #String_2
  #String_4
  #String_6
  #String_8
  #String_10
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #Text_5
  #Text_6
  #Text_8
  #Text_9
  #Text_10
  #Text_11
  #IPAddress_0
  #IPAddress_1
  #Icon
EndEnumeration

Global EOL$
EOL$ = Chr(13)+Chr(10)

Structure BannedClient
  ClientID.l
  Ip.l
EndStructure

Structure BannedIP
  Plage.l
  From.l
  To.l
EndStructure

NewList Ban.BannedClient()
NewList BannedIp.BannedIP()

Global Port = 80
Global BaseDirectory$ = "www\"
Global DefaultPage$   = "index.html"
Global ListingPage$ = "liste.html"
Global AtomicTitle$   = "Cls Web Serveur 1.2"
Global BanPage$ = "ban.html"
Global Erreur404Page$ = "erreur_404.html"
Global ListingDirectory$ = "www\"
Global FilterPage$ = ""

*Buffer = AllocateMemory(10000)

; -------------------------------------[ Procedures ]------------------------------------
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 266, 113, 800, 595, AtomicTitle$,  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    If CreateGadgetList(WindowID(#Window_0))
      Frame3DGadget(#Frame3D_0, 10, 5, 400, 355, " Journal ")
      Frame3DGadget(#Frame3D_1, 10, 365, 400, 100, " Clients en ligne ")
      Frame3DGadget(#Frame3D_3, 420, 5, 370, 200, " Options")
      Frame3DGadget(#Frame3D_5, 420, 215, 370, 290, " Filtres IP ")
      EditorGadget(#Editor_0, 20, 25, 380, 290, #PB_Editor_ReadOnly)
      SetGadgetFont(#Editor_0,LoadFont(1,"Arial",8)) 
      

      TextGadget(#Text_1, 440, 25, 250, 20, "Port d'écoute (vous devrez redémarrer le serveur) : ")
      StringGadget(#String_0, 720, 25, 50, 20, "", #PB_String_Numeric)
      CheckBoxGadget(#CheckBox_1, 440, 45, 240, 20, "Afficher les requêtes complètes dans le journal")
      CheckBoxGadget(#CheckBox_2, 440, 65, 240, 20, "Démarrer avec Windows")
      CheckBoxGadget(#CheckBox_3, 440, 85, 240, 20, "Réduire dans la barre des tâches au démarrage")
      CheckBoxGadget(#CheckBox_4, 440, 105, 160, 20, "Activer le Listing dynamique  ")
      TextGadget(#Text_2, 470, 135, 120, 20, "Page virtuelle utilisée :")
      StringGadget(#String_1, 615, 130, 125, 20, "")
      CheckBoxGadget(#CheckBox_5, 440, 175, 230, 20, "Me prévenir à chaque nouvelle connexion")
      TextGadget(#Text_3, 30, 495, 170, 20, "Page Index (défault : index.html) :")
      Frame3DGadget(#Frame3D_8, 10, 475, 400, 110, " Configuration des pages ")
      StringGadget(#String_2, 235, 495, 130, 20, "") ; index.html
      TextGadget(#Text_4, 30, 525, 180, 20, "Erreur 404 (défault : erreur_404.html) :")
      StringGadget(#String_4, 235, 525, 130, 20, "") ; erreur_404.html
      TextGadget(#Text_6, 30, 555, 180, 20, "Bannissement (défault : ban.html) :")
      StringGadget(#String_6, 235, 555, 130, 20, "") ; ban.html
      CheckBoxGadget(#CheckBox_6, 440, 235, 150, 20, "Activer le filtrage des IPs")
      
      TextGadget(#Text_8, 450, 325, 90, 20, "IP(s) à bloquer :")
      IPAddressGadget(#IPAddress_0, 530, 265, 120, 20)
      
      ListViewGadget(#Listview_0, 450, 345, 210, 70)
      SetGadgetFont(#Listview_0,LoadFont(2,"Arial",8))
      
      TextGadget(#Text_9, 450, 265, 70, 20, "Adresse IP :")
      CheckBoxGadget(#CheckBox_7, 450, 290, 60, 20, "Plage IP :")
      IPAddressGadget(#IPAddress_1, 530, 290, 120, 20)
      TextGadget(#Text_10, 450, 425, 180, 30, "Page à envoyer aux clients filtrés (vide si aucune) :")
      StringGadget(#String_8, 640, 435, 130, 20, "") ; page
      
      ListViewGadget(#Listview_1, 30, 385, 210, 70)
      SetGadgetFont(#Listview_1,LoadFont(3,"Arial",9))
      
      TextGadget(#Text_11, 470, 155, 120, 20, "Répertoire à lister :")
      StringGadget(#String_10, 615, 155, 110, 20, "", #PB_String_ReadOnly) ; path
      
      ButtonGadget(#Button_0, 260, 385, 110, 30, "Bannir") ;ok
      ButtonGadget(#Button_1, 420, 555, 130, 30, "A propos ...") ;ok
      ButtonGadget(#Button_2, 660, 555, 130, 30, "Quitter") ; ok
      ButtonGadget(#Button_6, 30, 320, 110, 30, "Sauver ...") ;ok
      
      ButtonGadget(#Button_8, 670, 465, 100, 30, "Effacer tout")
      
      ButtonGadget(#Button_15, 670, 265, 100, 30, "Ajouter")
      ButtonGadget(#Button_11, 670, 385, 100, 30, "Retirer sélection")
      
      ButtonGadget(#Button_13, 280, 320, 110, 30, "Effacer") ;ok
      
      ButtonGadget(#Button_5, 450, 465, 100, 30, "Charger ...")
      ButtonGadget(#Button_14, 560, 465, 100, 30, "Sauver ...")
      
      ButtonGadget(#Button_16, 260, 425, 110, 30, "Information client ...")
      ButtonGadget(#Button_18, 730, 155, 40, 20, "...")   
    EndIf
  EndIf
EndProcedure


Procedure Open_Window_2()
  If OpenWindow(#Window_2, 307, 348, 435, 201, AtomicTitle$,  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_WindowCentered )
    If CreateGadgetList(WindowID(#Window_2))
      TextGadget(#Text_1, 10, 10, 420, 30, "Cls Web Serveur", #PB_Text_Center)
      TextGadget(#Text_2, 30, 40, 70, 20, "Auteur : Cls")
      TextGadget(#Text_3, 100, 40, 90, 20, "Version : 1.0")
      TextGadget(#Text_4, 20, 80, 380, 70, "Cls Web  Serveur (r) est un outil permettant de créer un serveur Web chez vous. Son utilisation très simple sans configuration préalable en fait un utilitaire très pratique pour les particuliers comme pour les petites entreprises. Cls Web Serveur (r) est doté d'une fonction permettant le listing dynamique de votre répertoire racine très pratique pour le transfert de fichiers via Internet.", #PB_Text_Center)
      ButtonGadget(#Button_10, 160, 160, 120, 30, "OK")
      TextGadget(#Text_5, 230, 40, 190, 20, "Programme écrit avec Purebasic 4.0")
      
    EndIf
  EndIf
EndProcedure

Procedure.q GetIpHash(Ip.l)
  f1.l = IPAddressField(Ip, 1)
  f2.l = IPAddressField(Ip, 2)
  f3.l = IPAddressField(Ip, 3)
  f4.l = IPAddressField(Ip, 4)
  
  Result.q = f1 * 1000000000
  Result = Result + f2 * 1000000
  Result = Result + f3 * 1000
  Result = Result + f4
  
  ProcedureReturn Result
EndProcedure

Procedure.l GetIpFromString(Ip.s)
  f1.l = Val(StringField(Ip, 1, "."))
  f2.l = Val(StringField(Ip, 2, "."))
  f3.l = Val(StringField(Ip, 3, "."))
  f4.l = Val(StringField(Ip, 4, "."))
  
  Result = MakeIPAddress(f1, f2, f3, f4)
  
  ProcedureReturn Result
EndProcedure

Procedure DisplayPopUpWindow(Val)
  #s_width = 300
  #s_height = 100
  w = OpenWindow(#PB_Any, 1, 1, 1, 1, "")
  
  StickyWindow(w, 1) ; Toujours au premier plan
  
  For x = 0 To #s_height
    ResizeWindow(w, 0, 0, x * 3, x)
    Delay(6)
  Next
  
  SetWindowTitle(w, "Cls Web Server - Information")
  Font1 = LoadFont(#PB_Any, "Arial"  ,  16, #PB_Font_Bold)
  If CreateGadgetList(WindowID(w))
    TextGadget(100, 10, 30, 280, 60, "Un nouveau client s'est connecté", #PB_Text_Center)
    SetGadgetFont(100, Font1)
  EndIf
  Delay(3000)
  CloseWindow(w)

EndProcedure

Procedure.l DeleteRegValue(topKey.l, sKeyName.s, sValueName.s)  
    GetHandle.l  
    hKey.l  
    lReturnCode.l  
    lhRemoteRegistry.l  
     
    If Left(sKeyName, 1) = "\"  
        sKeyName = Right(sKeyName, Len(sKeyName) - 1)  
    EndIf  
     
    GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)  

    If GetHandle = #ERROR_SUCCESS  
        GetHandle = RegDeleteValue_(hKey, @sValueName)  
        If GetHandle = #ERROR_SUCCESS  
            DeleteValue = #True  
        Else  
            DeleteValue = #False  
        EndIf  
    EndIf  
    RegCloseKey_(hKey)  
    ProcedureReturn DeleteValue  
EndProcedure 

Procedure.l CreateRegKey(topKey, sKeyName.s)  
    hNewKey.l  
    lpSecurityAttributes.SECURITY_ATTRIBUTES  
    GetHandle.l  
    lReturnCode.l  
    lhRemoteRegistry.l  
 
    If Left(sKeyName, 1) = "\"  
        sKeyName = Right(sKeyName, Len(sKeyName) - 1)  
    EndIf  
     
    GetHandle = RegCreateKeyEx_(topKey, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hNewKey, @GetHandle)  

    If GetHandle = #ERROR_SUCCESS  
        GetHandle = RegCloseKey_(hNewKey)  
        CreateKey = #True  
    Else  
        CreateKey = #False  
    EndIf  
    ProcedureReturn CreateKey  
EndProcedure

Procedure.l SetRegValue(topKey.l, sKeyName.s, sValueName.s, vValue.s, lType.l)  
  GetHandle.l  
  hKey.l  
  lType.l  
  lpcbData.l  
  lpData.s  
  lReturnCode.l  
  lhRemoteRegistry.l  
   
  If Left(sKeyName, 1) = "\"  
    sKeyName = Right(sKeyName, Len(sKeyName) - 1)  
  EndIf   

  GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)  
 
  If GetHandle = #ERROR_SUCCESS  
    lpcbData = 255  
    lpData = Space(255)  
       
    Select lType  
      Case #REG_SZ  
        GetHandle = RegSetValueEx_(hkey, sValueName, 0, #REG_SZ, @vValue, Len(vValue) + 1)  
      Case #REG_DWORD  
        lValue = Val(vValue)  
        GetHandle = RegSetValueEx_(hKey, sValueName, 0, #REG_DWORD, @lValue, 4)  
    EndSelect  
       
    RegCloseKey_(hkey)  
    ergebnis = 1  
    ProcedureReturn ergebnis  
  Else  
      
    RegCloseKey_(hKey)  
    ergebnis  = 0  
    ProcedureReturn ergebnis  
  EndIf  
EndProcedure 

Procedure.s GetRegValue(topKey, sKeyName.s, sValueName.s)  
   GetHandle.l  
   hKey.l  
   lpData.s  
   lpDataDWORD.l  
   lpcbData.l  
   lType.l  
   lReturnCode.l  
   lhRemoteRegistry.l  
   Shared getRegValue.s  
     
   If Left(sKeyName, 1) = "\"  
       sKeyName = Right(sKeyName, Len(sKeyName) - 1)  
   EndIf  

   GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)  
            
   If GetHandle = #ERROR_SUCCESS  
       lpcbData = 255  
       lpData = Space(255)  
         
       GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)  
             
       If GetHandle = #ERROR_SUCCESS  
           Select lType  
               Case #REG_SZ  
                   GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)  
                 
                   If GetHandle = 0  
                       getRegValue = Left(lpData, lpcbData - 1)  
                   Else  
                       getRegValue = ""  
                   EndIf  
                     
               Case #REG_DWORD  
                   GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lpType, @lpDataDWORD, @lpcbData)  
                     
                   If GetHandle = 0  
                       getRegValue = Str(lpDataDWORD)  
                   Else  
                       getRegValue = "0"  
                   EndIf  
                 
           EndSelect  
       EndIf  
   EndIf  
   RegCloseKey_(hKey)  
   ProcedureReturn GetRegValue  
EndProcedure 


Procedure.l BuildRequestHeader(*Buffer, DataLength.l, ContentType$)

  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 07 Aug 1996 11:15:43 GMT"+EOL$) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Cls Web Server 1.0"+EOL$)          : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+EOL$)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+EOL$)         : *Buffer+Length
  Length = PokeS(*Buffer, EOL$)                                       : *Buffer+Length

  ; Length = PokeS(*Buffer, "Last-modified: Thu, 27 Jun 1996 16:40:50 GMT"+Chr(13)+Chr(10)  , *Buffer) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Accept-Ranges: bytes"+EOL$                 , *Buffer) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Connection: close"+EOL$) : *Buffer+Length

  ProcedureReturn *Buffer
EndProcedure

Procedure SendHtmlFile(File.s, ClientID.l)
  If ReadFile(0, BaseDirectory$ + File.s)
    FileLength = Lof(0)
    ContentType$ = "text/html"

    *FileBuffer   = AllocateMemory(FileLength+200)
    *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)


    ReadData(0, *BufferOffset, FileLength)
    CloseFile(0)
   
    SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
    FreeMemory(*FileBuffer)
  EndIf
EndProcedure

Procedure.l LoadParameter()

  a.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check1")
  b.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check2")
  c.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check3")
  d.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check4")
  f.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check5")
  e.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "ListeningPage")
  g.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "IndexPage")
  h.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "ErrorPage")
  i.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "BanPage")
  j.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "ListingDirectory")
  k.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "IpFiltre")
  l.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "FilterPage")
  
  SetGadgetState(#CheckBox_1, Val(a))
  SetGadgetState(#CheckBox_2, Val(b))
  SetGadgetState(#CheckBox_3, Val(c))
  SetGadgetState(#CheckBox_4, Val(d))
  SetGadgetState(#CheckBox_5, Val(f))
  SetGadgetState(#CheckBox_6, Val(k))
  
  If d = "0"
    DisableGadget(#String_1, 1)
  EndIf
  
  If e = "" : e = "liste.html" : EndIf
  SetGadgetText(#String_1, e)
  ListingPage$ = e

  If g = "" : g = "index.html" : EndIf  
  SetGadgetText(#String_2, g)
  DefaultPage$ = g
  
  If h = "" : h = "erreur_404.html" : EndIf
  SetGadgetText(#String_4, h)
  Erreur404Page$ = h
  
  If i = "" : i = "ban.html" : EndIf
  SetGadgetText(#String_6, i)
  BanPage$ = i
  
  If l = "" : l = "filtre.html" : EndIf
  SetGadgetText(#String_8, l)
  FilterPage$ = l
  
  If j = "" : j = GetPathPart(ProgramFilename()) + "WWW\" : EndIf
  SetGadgetText(#String_10, j)
  ListingDirectory$ = j
  
  
  ProcedureReturn Val(c)
EndProcedure

Procedure SaveParameter()
  
  CreateRegKey(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server")
  
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check1", Str(GetGadgetState(#CheckBox_1)), #REG_DWORD)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check2", Str(GetGadgetState(#CheckBox_2)), #REG_DWORD)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check3", Str(GetGadgetState(#CheckBox_3)), #REG_DWORD) 
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check4", Str(GetGadgetState(#CheckBox_4)), #REG_DWORD) 
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Check5", Str(GetGadgetState(#CheckBox_5)), #REG_DWORD)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "IpFiltre", Str(GetGadgetState(#CheckBox_6)), #REG_DWORD)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "ListeningPage", GetGadgetText(#String_1), #REG_SZ) 
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Port", GetGadgetText(#String_0), #REG_SZ) 
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "IndexPage", GetGadgetText(#String_2), #REG_SZ)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "ErrorPage", GetGadgetText(#String_4), #REG_SZ)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "BanPage", GetGadgetText(#String_6), #REG_SZ)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "FilterPage", GetGadgetText(#String_8), #REG_SZ)
  SetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "ListingDirectory", GetGadgetText(#String_10), #REG_SZ)
EndProcedure

Procedure.s Heure()

  ProcedureReturn FormatDate("%hh:%ii", Date()) + " "
EndProcedure

Procedure Editor_Select(Gadget.l, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)     
  sel.CHARRANGE  
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1  
   
  If LineEnd = -1  
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1  
  EndIf  
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)  
   
  If CharEnd = -1  
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)  
  Else  
    sel\cpMax + CharEnd - 1  
  EndIf  
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)  
EndProcedure  
 
Procedure Editor_Color(Gadget.l, Color.l)  
  format.CHARFORMAT  
  format\cbSize = SizeOf(CHARFORMAT)  
  format\dwMask = #CFM_COLOR  
  format\crTextColor = Color  
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure

Procedure Editor_Format(Gadget, Flags.l)  
  format.CHARFORMAT  
  format\cbSize = SizeOf(CHARFORMAT)  
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE  
  format\dwEffects = Flags  
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure 

; ----------------------[ Corps de programme ]------------------------------------------
If InitNetwork() = 0
  MessageRequester("Erreur", "Impossible d'initialiser les fonctions réseaux !", 0)
  End
EndIf


;SetCurrentDirectory(GetPathPart(ProgramFilename()))
If ElapsedMilliseconds() < 15000 : Delay(3000) : EndIf


; -----------------------[ Démarrage du serveur et de l'interface ]---------------------------------------
; Vérifie le port d'écoute du serveur
f.s = GetRegValue(#HKEY_LOCAL_MACHINE, "Software\Cls Web Server", "Port")
Port = Val(f)

If Port = 0 : Port = 80 : EndIf

err = 0
If CreateNetworkServer(0, Port) = 0
  err = 1
  MessageRequester("Erreur", "Impossible de créer le serveur sur le port " + Str(Port) + ". Ce port est peut-être déjà utilisé par une autre application.", 0)
EndIf 
   
  Open_Window_0()
  
  ;Charge les paramètres a partir de la base de registre
  SetGadgetText(#String_0, Str(Port))
  If LoadParameter() = 1
    SendMessage_(WindowID(#Window_0),#WM_CLOSE,0,0)
  EndIf
  
  
  AddGadgetItem(#Editor_0, -1, "Cls Web Serveur")
  AddGadgetItem(#Editor_0, -1, "Version : 1.2")
  AddGadgetItem(#Editor_0, -1, "Auteur : Cls (clepsos2003[@]yahoo.fr)")
  AddGadgetItem(#Editor_0, -1, "----------------------------------------------------------------------------------------")
  
  Editor_Select(#Editor_0, 0, 1, 3, -1) : Editor_Color(#Editor_0, RGB(249, 91, 6)) : Editor_Format(#Editor_0, #CFM_BOLD)
  Editor_Select(#Editor_0, 0, 0, 0, 0) : Editor_Color(#Editor_0, RGB(0,0,0)) : Editor_Format(#Editor_0, 0)
  
  AddGadgetItem(#Editor_0, -1, "Bonjour, nous sommes le " + FormatDate("%dd/%mm/%yy", Date()))
  
  If err <> 1
    AddGadgetItem(#Editor_0, -1, "Serveur créé sur le port " + Str(Port) + " de l'ordinateur " + Hostname() + " à " + Heure())
    AddGadgetItem(#Editor_0, -1, "Adresse(s) IP disponible(s) :")
  
    ExamineIPAddresses()
    tmp = NextIPAddress()
  
    While tmp <> 0
      AddGadgetItem(#Editor_0, -1, "  > " + IPString(tmp))
      tmp = NextIPAddress()
    Wend  
    
    AddGadgetItem(#Editor_0, -1, "---------------------------------------------------------------------------------------")
    AddGadgetItem(#Editor_0, -1, Heure() + "En attente d'une connexion ...")
    
    Lines = CountGadgetItems(#Editor_0) - 1
    Editor_Select(#Editor_0, Lines, 1, Lines, -1) : Editor_Color(#Editor_0, RGB(0, 187, 0))
    Editor_Select(#Editor_0, 0, 0, 0, 0)
  EndIf
  
  If GetGadgetState(#CheckBox_6) = 0
    DisableGadget(#Button_5, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#Button_8, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#Button_15, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#Button_11, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#Button_14, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#IpAddress_0, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#IpAddress_1, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#CheckBox_7, GetGadgetState(#CheckBox_6) - 1)
    DisableGadget(#String_8, GetGadgetState(#CheckBox_6) - 1)
  EndIf
  
  Repeat
    
    Repeat
      WEvent = WindowEvent()
      
      Select WEvent
        Case #PB_Event_CloseWindow
          
          ; Si ca provient de la fenêtre principale
          If EventWindow() = #Window_0
            HideWindow(#Window_0, 1)
          
            ;Ajout d'un systray lorsque l'on ferme
            CatchImage(#Icon, ?data1)
            res = AddSysTrayIcon(#PB_Any, WindowID(#Window_0), ImageID(#Icon))
            SysTrayIconToolTip(res, "Cliquer pour restaurer Cls Web Serveur")
          ElseIf EventWindow() = #Window_2
            CloseWindow(#Window_2)
          ElseIf EventWindow() = 5
            CloseWindow(5)
          EndIf 
        
        ; Gestion de l'interface
        ; ----------------------------------------------------------------------------------
        Case #PB_Event_Gadget
        
          ; On a cliqué sur un bouton
          ;----------------------------------
          Select EventGadget()
            ; --------------------------------------[ Boutons ]--------------------------
            Case #Button_0
              If GetGadgetText(#Button_0) <> "Débannir"
                If GetGadgetText(#Listview_1) <> ""
                  t$ = StringField(GetGadgetText(#Listview_1), 1, "|")
                  u$ = StringField(GetGadgetText(#Listview_1), 2, "|")
                  v$ = Trim(Right(t$, Len(t$) - 5))
                  w$ = Trim(Right(u$, Len(u$) - 5))

                  AddElement(Ban()) : Ban()\ClientID = Val(v$)
                                      Ban()\Ip = MakeIPAddress(Val(StringField(w$, 1, ".")), Val(StringField(w$, 2, ".")), Val(StringField(w$, 3, ".")), Val(StringField(w$, 4, ".")))
                
                  SetGadgetItemText(#Listview_1, GetGadgetState(#Listview_1), GetGadgetText(#Listview_1) + " [banned]", 1)
                EndIf
              Else
                  t$ = StringField(ReplaceString(GetGadgetText(#Listview_1), "[banned]", ""), 1, "|")
                  u$ = StringField(ReplaceString(GetGadgetText(#Listview_1), "[banned]", ""), 2, "|")
                  v$ = Trim(Right(t$, Len(t$) - 5))
                  w$ = Trim(Right(u$, Len(u$) - 5))
                  
                  ForEach Ban()
                    If Ban()\ClientID = Val(v$) Or Ban()\Ip = MakeIPAddress(Val(StringField(w$, 1, ".")), Val(StringField(w$, 2, ".")), Val(StringField(w$, 3, ".")), Val(StringField(w$, 4, ".")))
                      DeleteElement(Ban())
                      SetGadgetItemText(#Listview_1, GetGadgetState(#Listview_1), ReplaceString(GetGadgetText(#Listview_1), "[banned]", ""), 1)
                    EndIf
                  Next
                  
              EndIf
              
            Case #Button_1
              Open_Window_2()
              
            Case #Button_2
              SaveParameter()
              Quit = 1
              
            Case #Button_5 ; charger
              rFile.s = OpenFileRequester("Sélectionner un fichier à ouvrir", "", "Fichier Cls Web Serveur(*.cws)|*.cws|Tous les fichiers (*.*)|*.*", 0)
              If rFile <> ""
                If ReadFile(0, rFile)
                  ;Efface les données de la liste
                  ClearList(BannedIp())
                  ClearGadgetItemList(#Listview_0)
                  
                  rLine.s = Trim(ReadString(0))
                  While rLine <> ""
                    If CountString(rLine, ".") = 3
                      AddElement(BannedIp()) : BannedIp()\Plage = 0
                                               BannedIp()\From = getIpFromString(rLine)
                                               BannedIp()\To = 0
                      AddGadgetItem(#Listview_0, -1, rLine)
                      
                    ElseIf CountString(rLine, ".") = 6
                      ip3.l = GetIpFromString(StringField(rLine, 1, "-"))
                      ip4.l = GetIpFromString(StringField(rLine, 2, "-"))
                      
                      AddElement(BannedIp()) : BannedIp()\Plage = 1
                                               BannedIp()\From = ip3
                                               BannedIp()\To = ip4
                      AddGadgetItem(#Listview_0, -1, rLine)
                    
                    Else
                      MessageRequester("Cls Web Serveur Erreur", "Format du fichier non - valide !")
                      Break
                    EndIf
                    rLine.s = ReadString(0)
                  Wend
                  
                  CloseFile(0)
                EndIf
              EndIf  
              
            Case #Button_14 ; sauver
              wFile.s = SaveFileRequester("Choisir le fichier à sauvegarder", "", "Fichier Cls Web Serveur(*.cws)|*.cws|Tous les fichiers (*.*)|*.*", 0)
              If GetExtensionPart(wFile) <> "cws" : wFile + ".cws" : EndIf
              If wFile <> ""
                If OpenFile(0, wFile)
                  For x = 0 To CountGadgetItems(#Listview_0) - 1
                    WriteStringN(0, GetGadgetItemText(#Listview_0, x, 1))
                  Next
                
                  CloseFile(0)
                EndIf
              EndIf
              
              
              
            Case #Button_6 ; sauvegarde du journal
              ChoixFichier:
              a.s = FormatDate("%dd-%mm-%yy", Date())
              a = "CWS " + a + ".log"
              Fichier.s = SaveFileRequester("Enregistrer le journal", a, "Journal (*.log)|*.log |Tous les fichiers (*.*)|*.* ", 0)
              
              If Fichier <> ""
              
                If FileSize(Fichier) > 0
                  If MessageRequester("Cls Web Serveur 1.0", "Voulez - vous écraser le fichier " + Fichier + " ?", #PB_MessageRequester_YesNo) = 6
                    If CreateFile(0, Fichier)
                      WriteStringN(0, GetGadgetText(#Editor_0))
                    EndIf
                    CloseFile(0)
                  
                  Else
                    Goto ChoixFichier
                  EndIf
                Else
                  If CreateFile(0, Fichier)
                    WriteStringN(0, GetGadgetText(#Editor_0))
                  EndIf
                  CloseFile(0)
                EndIf
              EndIf  
              
            Case #Button_8
              ClearGadgetItemList(#Listview_0)
              ClearList(BannedIp())
              SetGadgetText(#IpAddress_0, "")
              SetGadgetText(#IpAddress_1, "")
              
            Case #Button_10
              CloseWindow(#Window_2)  
              
            Case #Button_11 ; retirer sélection
              tmppo.s = Trim(GetGadgetText(#Listview_0))
              ok = 0
              
              If FindString(tmppo, "-", 1) > 6 ; plage d'ips
                ip1.l = GetIpFromString(StringField(tmppo, 1, "-"))
                ip2.l = GetIpFromString(StringField(tmppo, 2, "-"))
                
                ForEach BannedIp()
                  If BannedIp()\Plage = 1 And BannedIp()\From = ip1 And BannedIp()\To = ip2 
                    DeleteElement(BannedIp()) 
                    ok = 1 
                  EndIf
                Next
                
                
              Else ; ip seule
                ip.l = GetIpFromString(tmppo)
                
                ForEach BannedIp()
                  If BannedIp()\From = ip : DeleteElement(BannedIp()) : ok = 1 : EndIf
                Next

              EndIf
              
              If ok
                RemoveGadgetItem(#Listview_0, GetGadgetState(#Listview_0))
              EndIf       
              
            Case #Button_13
              ClearGadgetItemList(#Editor_0) 
              
            Case #Button_15 ; ajouter une ip ou une plage d'ip a filtrer
              If GetGadgetState(#Checkbox_7) = 1 ;plage d'ip
                fromIp.l = GetGadgetState(#IpAddress_0)
                toIp.l = GetGadgetState(#IpAddress_1)
                
                AddElement(BannedIp()) : BannedIp()\Plage = 1
                                         BannedIp()\From = fromIp
                                         BannedIp()\To = toIp
                AddGadgetItem(#Listview_0, -1, IPString(fromIp) + "-" + IPString(toIp))
              Else ; une seule ip
                ip.l = GetGadgetState(#IpAddress_0)
                ;verifie que cette ip n'est pas deja filtrée
                ok = 1
;                 ForEach BannedIp()
;                   If BannedIp()\Plage = 1 And BannedIp()\From <= ip And BannedIp()\To >= ip
;                     ok = 0  
;                     AlertWindow("Cls Web Serveur - Attention", "L'adresse IP spécifiée est déjà filtrée"
;                   EndIf
;                   
;                   If ok And BannedIp()\plage = 0 And BannedIp()\From = ip
;                       ok = 0
;                   EndIf
;                 Next
                
                If ok
                  AddElement(BannedIp()) : BannedIp()\Plage = 0
                                           BannedIp()\From = ip
                                           BannedIp()\To = 0
                  AddGadgetItem(#Listview_0, -1, IPString(ip))
                EndIf                        
              
              EndIf    
              
            Case #Button_16
              If GetGadgetState(#Listview_1) <> -1
                t$ = StringField(GetGadgetText(#Listview_1), 1, "|")
                u$ = StringField(GetGadgetText(#Listview_1), 2, "|")
                v$ = Trim(Right(t$, Len(t$) - 5))
                w$ = Trim(Right(u$, Len(u$) - 5))
                AddGadgetItem(#Editor_0, -1, ">>> Informations pour le client " + v$)
                AddGadgetItem(#Editor_0, -1, "> Adresse IP : " + w$)
                AddGadgetItem(#Editor_0, -1, "> Port utilisé : " + Str(GetClientPort(Val(v$))))
                
                Lines = CountGadgetItems(#Editor_0) - 1
                Editor_Select(#Editor_0, Lines - 2, 1, Lines, -1) : Editor_Color(#Editor_0, RGB(0,0,0)) 
                Editor_Select(#Editor_0, 0, 0, 0, 0) : Editor_Color(#Editor_0, RGB(0,0,0)) : Editor_Format(#Editor_0, 0)
                ;Auto scroll
                SendMessage_(GadgetID(#Editor_0),#EM_LINESCROLL,0,3)
  
              EndIf
              
              
              
            Case #Button_18
              File2.s = PathRequester("Veuillez sélectionner le répertoire à lister :", GetPathPart(ProgramFilename()))
              If Right(File2, 1) <> "/" And Right(File2, 1) <> "\": File2 + "/" : EndIf
              If Len(File2) > 2
                SetGadgetText(#String_10, File2)
                SaveParameter()
              EndIf
             
            ; --------------------------------[ CheckBox ] ------------------------------------
            Case #CheckBox_1                 
              SaveParameter()  
     
            Case #CheckBox_2 ; demarrer avec Windows
              If GetGadgetState(#CheckBox_2) = 1
                If RegCreateKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @NewKey, @KeyInfo) = #ERROR_SUCCESS  
                  StringBuffer$ = ProgramFilename() 
                  RegSetValueEx_(NewKey, "Cls Web Server", 0, #REG_SZ,  StringBuffer$, Len(StringBuffer$)+1)   ; change "Programname" to your individual name 
                  RegCloseKey_(NewKey)  
                EndIf
                
              Else
                DeleteRegValue(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "Cls Web Server")  
              EndIf  
              
              SaveParameter()
            
            Case #CheckBox_3              
              SaveParameter()
              
            Case #CheckBox_4
              DisableGadget(#String_1, GetGadgetState(#CheckBox_4) - 1)
              SaveParameter() 
               
            Case #CheckBox_5
              SaveParameter()
              
            Case #CheckBox_6
              DisableGadget(#Button_5, GetGadgetState(#CheckBox_6) - 1)
              DisableGadget(#Button_8, GetGadgetState(#CheckBox_6) - 1)
              DisableGadget(#Button_15, GetGadgetState(#CheckBox_6) - 1)
              DisableGadget(#Button_11, GetGadgetState(#CheckBox_6) - 1)
              DisableGadget(#Button_14, GetGadgetState(#CheckBox_6) - 1)
              DisableGadget(#IpAddress_0, GetGadgetState(#CheckBox_6) - 1)
              DisableGadget(#CheckBox_7, GetGadgetState(#CheckBox_6) - 1)
              DisableGadget(#String_8, GetGadgetState(#CheckBox_6) - 1)
              If GetGadgetState(#CheckBox_7) - 1 = -1
                DisableGadget(#IpAddress_1, GetGadgetState(#CheckBox_6) - 1)
              EndIf
              
            Case #CheckBox_7
              DisableGadget(#IpAddress_1, GetGadgetState(#CheckBox_7) - 1)
            
            ; ------------------------[ Zone de saisie ]------------------------------------------  
            Case #String_0
              SaveParameter()
            
            Case #String_1
              ListingPage$ = GetGadgetText(#String_1)
              SaveParameter()
              
            Case #String_2
              DefaultPage$ = GetGadgetText(#String_2)
              SaveParameter()
              
            Case #String_4
              Erreur404Page$ = GetGadgetText(#String_4)
              SaveParameter()
              
            Case #String_6
              BanPage$ = GetGadgetText(#String_6)
              SaveParameter()
              
            Case #String_8
              FilterPage$ = GetGadgetText(#String_8)
              SaveParameter()
            
            Case #String_10
              ListingDirectory$ = GetGadgetText(#String_10)
              SaveParameter()
              
            Case #Listview_1
              If FindString(GetGadgetText(#Listview_1), "[banned]", 1)
                SetGadgetText(#Button_0, "Débannir")
              Else
                SetGadgetText(#Button_0, "Bannir") 
              EndIf
                  
          EndSelect  
          
        ; Gestion de la systray
        ;-------------------------------------  
        Case #PB_Event_SysTray
          HideWindow(#Window_0, 0)
          RemoveSysTrayIcon(res)
      EndSelect
        
    Until WEvent = 0
    
    SEvent = NetworkServerEvent()
  
    If SEvent
      ClientID.l = EventClient()
  
      Select SEvent
      
        Case 1  ; When a new client has been connected...
        
          RemoteIp$ = IPString(GetClientIP(ClientID))
          
          AddGadgetItem(#Editor_0, -1, Heure() + "Nouveau client connecté (ID : " + Str(ClientID) + " | IP : " + RemoteIp$ +")")
          AddGadgetItem(#Listview_1, -1, "ID : " + Str(ClientID) + " | IP : " + RemoteIp$ )
          
          Lines = CountGadgetItems(#Editor_0) - 1
          Editor_Select(#Editor_0, Lines, 1, Lines, -1) : Editor_Color(#Editor_0, RGB(0, 187, 0)) : Editor_Format(#Editor_0, #CFM_BOLD)
          Editor_Select(#Editor_0, 0, 0, 0, 0) : Editor_Format(#Editor_0, 0)
          
          SendMessage_(GadgetID(#Editor_0),#EM_LINESCROLL,0, 2)
          If GetGadgetState(#CheckBox_5) = 1
            
            thid = CreateThread(@DisplayPopUpWindow(), 45)
            
          EndIf
          
        Case 4  ; When a client has closed the connection...
          
          ;Journal
          AddGadgetItem(#Editor_0, -1, Heure() + "Client déconnecté (ID : " + Str(ClientID) + " | IP : " + RemoteIp$ + ")" )
          
          Lines = CountGadgetItems(#Editor_0) - 1
          Editor_Select(#Editor_0, Lines, 1, Lines, -1) : Editor_Color(#Editor_0, RGB(255, 136, 0)) : Editor_Format(#Editor_0, #CFM_BOLD)
          Editor_Select(#Editor_0, 0, 0, 0, 0) : Editor_Format(#Editor_0, 0)
          
          SendMessage_(GadgetID(#Editor_0),#EM_LINESCROLL,0, 1)
          
          ; Supprime l'ID et l'IP client du combobox
          For x = 0 To CountGadgetItems(#Listview_1)
            If FindString(GetGadgetItemText(#Listview_1, x, 0), Str(ClientID), 0)
              RemoveGadgetItem(#Listview_1, x)
            EndIf
          Next
          
          
        Default
          RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
          Gosub ProcessRequest
          
      EndSelect
      
      NothingToDo:

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
        
  Until Quit = 1 
    
  CloseNetworkServer(0)
  
End 


; Gestion d'une requete
; -------------------------------------------------------------------------------------
ProcessRequest:

  a$ = PeekS(*Buffer)
  ClientIp.l = GetClientIP(ClientID)
  RemoteIp$ = IPString(ClientIp)
    
  ; Vérifie que l'Ip n'est pas filtrée
  ClientIpHash.q = GetIpHash(ClientIp)
  IsFiltred = 0
  
  If GetGadgetState(#CheckBox_6) = 1 ; Activer le fitrage IP
    ForEach BannedIp()
      Select BannedIp()\Plage
        Case 0 ; une seul Ip à tester
          If ClientIp = BannedIp()\From : IsFiltred = 1 : EndIf
        
        Case 1
          Debug Str(GetIpHash(BannedIp()\From))
          If ClientIpHash >= GetIpHash(BannedIp()\From) And ClientIpHash <= GetIpHash(BannedIp()\To) : IsFiltred = 1 : EndIf
          
      EndSelect
    
      ;Quitte la boucle si l'ip est filtré
      If IsFiltred : Break : EndIf
    
    Next
  
    ; Si l'Ip est filtrée, on envoit une page (si elle est spécifiée) et on quitte le ProcessRequest
    If IsFiltred
      If FilterPage$ <> "" : SendHtmlFile(FilterPage$, ClientID) : EndIf
        
        ;MAJ du journal
        AddGadgetItem(#Editor_0, -1, Heure() + "* Requête bloquée : filtre IP activé (ID : " + Str(ClientID) + " | IP : " + RemoteIp$ + ")")
        Lines = CountGadgetItems(#Editor_0) - 1
        Editor_Select(#Editor_0, Lines, 1, Lines, -1) : Editor_Color(#Editor_0, RGB(255, 0, 0))
        If GetGadgetState(#CheckBox_1) = 1
          AddGadgetItem(#Editor_0, -1, a$)
          lines = CountString(a$, Chr(13)) - 1
          xLines = CountGadgetItems(#Editor_0) - 1
          Editor_Select(#Editor_0, xLines - lines - 1, 1, xLines - 1, -1) : Editor_Color(#Editor_0, RGB(46, 118, 145))
        EndIf
        Editor_Select(#Editor_0, 0, 0, 0, 0)
        
        ; Obligatoire pour quitter le Gosub ProcessRequest
        FakeReturn
        Goto NothingToDo
    EndIf
   
  EndIf
  
  ; Vérifie que le client n'est pas banni
  ClientIP.l = GetClientIP(ClientID)

  ForEach Ban()
    If Ban()\ClientID = ClientID Or Ban()\Ip = ClientIP
      SendHtmlFile(BanPage$, ClientID)
      
      ; Obligatoire pour quitter le Gosub ProcessRequest 
      FakeReturn
      Goto NothingToDo
    EndIf
  Next
 
  ;Journalisation
  lines = 0
  AddGadgetItem(#Editor_0, -1, Heure() + "# Requête (ID : " + Str(ClientID) + " | IP : " + RemoteIp$ + ")")
  Lines = CountGadgetItems(#Editor_0) - 1
  Editor_Select(#Editor_0, Lines, 1, Lines, -1) : Editor_Color(#Editor_0, RGB(0, 0, 255))
  If GetGadgetState(#CheckBox_1) = 1
    AddGadgetItem(#Editor_0, -1, a$)
    lines = CountString(a$, Chr(13)) - 1
    xLines = CountGadgetItems(#Editor_0)
    Editor_Select(#Editor_0, xLines - lines - 2, 1, -1, -1) : Editor_Color(#Editor_0, RGB(46, 118, 145))
  EndIf
  Editor_Select(#Editor_0, 0, 0, 0, 0)
  ;Auto scroll 
  SendMessage_(GadgetID(#Editor_0),#EM_LINESCROLL,0, 1 + lines) 
  
  ;EndJournalisation
  
  If Left(a$, 3) = "GET"

    MaxPosition = FindString(a$, Chr(13), 5)
    Position = FindString(a$, " ", 5)
    If Position < MaxPosition
      RequestedFile$ = Mid(a$, 6, Position-5)      ; Automatically remove the leading '/'
      RequestedFile$ = RTrim(RequestedFile$)
    Else
      RequestedFile$ = Mid(a$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
    EndIf

      ; The following routine transforme all '/' in '\' (Windows format)
      ;
      Structure tmp
        a.b
      EndStructure

      If RequestedFile$ = ""
        RequestedFile$ = DefaultPage$
      Else
        *t.tmp = @RequestedFile$
        While *t\a <> 0
          If *t\a = '/' : *t\a = '\' : EndIf
          *t+1
        Wend
      EndIf

      ; 
      If GetGadgetState(#CheckBox_4) = 1 And RequestedFile$ = ListingPage$
        ; On liste ici tous les fichiers du répertoire WWW (BaseDirectory$)
        *DataMem = AllocateMemory(10000)
        *Debut = *DataMem
        Length = PokeS(*DataMem, "<HTML>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "<BODY>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "<CENTER>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "<H2>Liste des fichiers du répertoire " + ListingDirectory$ + "</H2>" + EOL$) : *DataMem + Length          
        Length = PokeS(*DataMem, "<TABLE BORDER=1 >" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "<TH> Nom du fichier </TH>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "<TH> Date de création </TH>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "<TH> Taille du fichier (octets) </TH>" + EOL$) : *DataMem + Length     
        Length = PokeS(*DataMem, "<TH> Téléchargement </TH>" + EOL$) : *DataMem + Length    
        
        
        If ExamineDirectory(0, ListingDirectory$, "*.*")  
          While NextDirectoryEntry(0)
            If DirectoryEntryType(0) = #PB_DirectoryEntry_File
              Length = PokeS(*DataMem, "<TR>" + EOL$) : *DataMem + Length
              Length = PokeS(*DataMem, "<TD>" + DirectoryEntryName(0) + "</TD>" + EOL$) : *DataMem + Length
              Length = PokeS(*DataMem, "<TD>" + FormatDate("Le %dd/%mm/%yyyy à %hh:%ii:%ss", DirectoryEntryDate(0, #PB_Date_Accessed)) + "</TD>" + EOL$) : *DataMem + Length
              Length = PokeS(*DataMem, "<TD>" + Str(DirectoryEntrySize(0)) + "</TD>" + EOL$) : *DataMem + Length
              Length = PokeS(*DataMem, "<TD><A HREF=" + Chr(34) + DirectoryEntryName(0) +Chr(34) + "> Download it !</TD>" + EOL$) : *DataMem + Length
              Length = PokeS(*DataMem, "</TR>" + EOL$) : *DataMem + Length
            EndIf
          Wend
          FinishDirectory(0)
        EndIf
        Length = PokeS(*DataMem, "</TABLE>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "</CENTER>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "</BODY>" + EOL$) : *DataMem + Length
        Length = PokeS(*DataMem, "</HTML>" + EOL$) : *DataMem + Length
        Fin = *DataMem
        
        ; Envoi du Buffer de données
          
          
        FileLength = Fin - *Debut
        ContentType$ = "text/html"
          
        *FileBuffer = AllocateMemory(FileLength + 200)
        *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

        CopyMemory(*Debut, *BufferOffset, FileLength)
   
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
        FreeMemory(*FileBuffer)
        FreeMemory(*DataMem)
      
      Else
      If ReadFile(0, BaseDirectory$+RequestedFile$)
      
        FileLength = Lof(0)

        Select Right(RequestedFile$,4)
          Case ".gif"
            ContentType$ = "image/gif"

          Case ".jpg"
            ContentType$ = "image/jpeg"

          Case ".txt"
            ContentType$ = "text/plain"

          Case ".zip"
            ContentType$ = "application/zip"

          Default
            ContentType$ = "text/html"

        EndSelect
        
        *FileBuffer   = AllocateMemory(FileLength+200)
        *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

        ReadData(0, *BufferOffset, FileLength)

        CloseFile(0)
 
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
        FreeMemory(*FileBuffer)
      Else
        SendHtmlFile(Erreur404Page$, ClientID)
      EndIf
    EndIf ; end ListingPage$
      
  EndIf

Return

;-------------------------------[ Données annexes et fichiers ]-------------------------------------

data1:IncludeBinary "cws.ico"


;-------------------------------[ Fin du programme ]------------------------------------------------

MetalOS · Message par **MetalOS** » mer. 18/nov./2009 17:53

Cool merci Cls, je test et je te tiens au jus.

totorcalais · Message par **totorcalais** » dim. 31/janv./2010 1:24

Bonjour,

Je me permets de remettre cette discussion au premier rang car j'aurai quelques questions sur l'utilisation d'un tel serveur.

En testant par hasard cette application, il m'est venu une idée qui peut être pourrait paraître saugrenue. Je la soumets à votre sagacité:

Peut on envisager que sur l'ordi où serait installé un tel serveur web, on ait une application web (du flash par exemple) avec un formulaire (jusque là, pas de probleme car testée).

Ce dernier poste des données.

Le serveur les intercepte (script? et si oui, propre au serveur ou doit on implémenter un langage particulier pour ce faire?)

Une fois ces données, rien n'interdit que le serveur communique avec une application en purebasic qui gère une base de type sqllite et les stocke après traitement?

Et pour l'opération inverse, comment procéder pour communiquer des données à l'application flash?

Cela est il possible où une des conditions sera manquante et fera que cette démarche relève du rêve?

Merci de vos réponses.

cha0s · Message par **cha0s** » dim. 31/janv./2010 2:45

avec actionscript 3 il est possible de communiquer via les sockets (je suppose que c'était la méthode utilisé par DOFUS avant de passer au JAVA), ce qui est aussi possible aussi via PB, après l'ont retrouve l'architecture classique client/serveur. everything is possible :p

PureBasic

Le serveur Web de Cls

Le serveur Web de Cls

Re: Le serveur Web de Cls

Re: Le serveur Web de Cls

Re: Le serveur Web de Cls

Re: Le serveur Web de Cls

Re: Le serveur Web de Cls