PureBasic Forums - English

Posted: **Fri Dec 10, 2010 1:18 am**

ce prg sert a voir qui est connecté sur le forum anglais
meme si nous ne sommes pas connecté !!
et peut nous avertir (par un beep() ) si un membre est connecté

savoir si Fred passe sur le forum par exemple

ou pour surveiller un robot spameur par exemple

Google Translate :
this prg is used to see who is logged on the forum English
although we are not connected!
and can we tell (by an beep() ) if someone is logged

whether Fred connecting on the forum for example

or an robot for the moderate ...

run this code and wait 10 secondes

; Spy_Pseudo
; by Dobro
; Purebasic 4.51

;-initialisation
Declare.S dobro_replace2(chaine$,chaine_cherche$,chaine_remplace$)
Declare.S Url2Text(Url.S)
Declare.S Url2Text2(Url.S, OpenType.b,ProxyAndPort.S)
Declare TimerProc(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
Declare.S recup_pseudo()
Declare.S Extract(phrase.S,balise_gauche.S,balise_droite.S,longueur)
Declare sonne(*bidon)
Global newlist liste_pseudo.S()
Global pseudo_alarme.S
;****************** exemple de phrase a recuperer **********************************************
; <td class="row1" width="100%">Au total il y a 17 utilisateurs en ligne :: 9 enregistrés, 0 invisible et 8 invités (basées sur les utilisateurs actifs des 5 dernières minutes) Le record du nombre d’utilisateurs en ligne est de 59, Le Dim 11/Juin/2006 19:10 utilisateurs enregistrés : <a href="./memberlist.php?mode=viewprofile&u=1659">Berfau</a>, <a href="./memberlist.php?mode=viewprofile&u=111">Dobro</a>, Exabot [Bot], <a href="./memberlist.php?mode=viewprofile&u=305">flaith</a>, Google [Bot], Google Adsense [Bot], <a href="./memberlist.php?mode=viewprofile&u=406">SPH</a>, <a href="./memberlist.php?mode=viewprofile&u=1570">Warkering</a>, Yahoo [Bot]</td>
;
;
; StringField(string$,1,">Dobro</a>" )
; ************************************************************************************************
Enumeration
 #Window
 #timer_1
 #editor
 #file
 #pseudo
 #text_pseudo
 #font
 #titre
EndEnumeration

Global Site.S= "index.php"

; *********************************************************************
If filesize ( "spy_pseudo" ) <>-1
 openfile ( #file , "spy_pseudo" )
 windowx = readlong ( #file )
 windowy = readlong ( #file )
 pseudo_alarme.S= readstring ( #file )
 closefile ( #file )
Else
 windowx =10
 windowy =10
EndIf
Global decalage=30

; ************************* interface *************************************
;-interface
openwindow ( #Window , windowx , windowy ,100,350, "Liste des Pseudo Connectés" , #PB_Window_SystemMenu )
stickywindow ( #Window , 1)
Handle = windowid ( #Window )
SetTimer_ (Handle, #timer_1 , 5000, @TimerProc()) ; toute les 1 minutes
textgadget ( #titre , 10, 5, 100, 50, "Spy_Pseudo" )
If loadfont ( #font , "Comic Sans MS" , 12, #PB_Font_Bold )
 setgadgetfont ( #titre , fontid ( #font ))
EndIf

editorgadget ( #editor , 10, 10+decalage, 100,200)
textgadget ( #text_pseudo , 10, 220+decalage, 90, 55, "nicklist monitor" + chr (10)+ "separated by a comma" )

stringgadget ( #pseudo , 10, 280+decalage, 90, 20, "" )
setgadgettext ( #pseudo ,pseudo_alarme.S)
; ************************************************************************²

; ****************** boucle principale ***************************************
;-bouce_principale
Repeat
 event= windowevent ()
 ; tout se passe dans le timer
 Select event
 Case #PB_Event_Gadget
 pseudo_alarme.S= getgadgettext ( #pseudo )
 EndSelect




Until event = #PB_Event_CloseWindow
 ; **************************************************************************
KillTimer_ (Handle, #timer_1 )
openfile ( #file , "spy_pseudo" )
X= windowx ( #Window ):Y= windowy ( #Window )
writelong ( #file , X)
writelong ( #file , Y)
pseudo_alarme.S= getgadgettext ( #pseudo )
writestringn ( #file ,pseudo_alarme.S)
closefile ( #file )

; ***************** Zone Procedures ****************************************************
;- les procedures
Procedure.S recup_pseudo()

 ; recupere les pseudo et les mets dans liste()
 text_page$=Url2Text(Site.S)
 For i2=1 To len (text_page$)
 ligne_page$= stringfield (text_page$,i2, chr (10))

 If findstring (ligne_page$, "gistered users" ,1)

 ok=1
 ; pos_debut1= FindString(ligne_page$,"tilisateurs enregistr",1)+35
 clearlist (liste_pseudo.S())
 Repeat
 pseudo.S=Extract(ligne_page$, chr (34)+ ">" , "</a>" ,15) ; on ne recupere que si inf a 15 carcteres d'ecart ²
 If pseudo.S<> "dobro_stop"
 If pseudo.S<> ""
 addelement (liste_pseudo())
 liste_pseudo()=pseudo.S
 EndIf
 EndIf

 Until pseudo.S= "dobro_stop"

 EndIf
 If ok=1
 ok=0
 Break
 EndIf
 Next i2
 ProcedureReturn
EndProcedure

ProcedureDLL.S Url2Text2(Url.S, OpenType.b,ProxyAndPort.S)
 ; 1 INTERNET_OPEN_TYPE_DIRECT Resolves all host names locally.
 ; 0 INTERNET_OPEN_TYPE_PRECONFIG Retrieves the proxy Or direct configuration from the registry.
 ; 4 INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY Retrieves the proxy Or direct configuration from the registry And prevents the use of a startup Microsoft JScript Or Internet Setup (INS) file.
 ; 3 INTERNET_OPEN_TYPE_PROXY Passes requests To the proxy unless a proxy bypass list is supplied And the name To be resolved bypasses the proxy. In this Case, the function uses INTERNET_OPEN_TYPE_DIRECT.

 isLoop.b=1
 INET_RELOAD.l = $80000000
 hInet.l=0
 hURL.l=0
 Bytes.l=0
 Buffer.S= space (2048 )
 res.S= ""


 hInet = InternetOpen_ ( "" , OpenType, ProxyAndPort, "" , 0)
 hURL = InternetOpenUrl_ (hInet, Url, #Null , 0, INET_RELOAD, 0)

 Repeat
 InternetReadFile_ (hURL,@Buffer, len (Buffer), @Bytes)
 If Bytes = 0
 isLoop=0
 Else
 res = res + left (Buffer, Bytes)
 EndIf
 Until isLoop=0

 InternetCloseHandle_ (hURL)
 InternetCloseHandle_ (hInet)
 ProcedureReturn res
EndProcedure

ProcedureDLL.S Url2Text(Url.S)
 ProcedureReturn Url2Text2(Url,1, "" )
EndProcedure

; **************************** Timer **********************************************
;-Timer
Procedure TimerProc(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
 Select uMsg
 Case #WM_TIMER
 Select idEvent
 Case #timer_1
 ; Ici, le code à executer toutes les 30 secondes
 ; AddGadgetItem(#editor, -1, Url2Text(Site.S))

 recup_pseudo()

 ClearGadgetItems( #editor )
 compteur= countstring (pseudo_alarme.S, "," )+1
 ForEach liste_pseudo.S()
 pseudo.S =liste_pseudo.S()
 For i=1 To compteur
 pseudo_test.S = stringfield (pseudo_alarme.S ,i, "," )
 If pseudo.S=pseudo_test.S
 createthread (@sonne(),*bidon)
 EndIf
 Next i
 addgadgetitem ( #editor , -1, pseudo.S )
 Next



 EndSelect
 EndSelect
EndProcedure

Procedure.S Extract(phrase.S,balise_gauche.S,balise_droite.S,longueur)
 ; by Dobro
 ; retourne l'extrait de chaine compris entre 2 balises
 ; les balises sont 1 caractere ou un mot.....
 ; utile pour extraire les infos d'une page web par exemple
 ; le parametre longueur , sert a determiner l'eccart entre 2 balises
 ; et de savoir si l'on recupere l'extrait si les balises sont trop éloigné
 ; si "dobro_stop" est renvoyé , fin de l'exploration du text$
 Static pointeur_debut
 Static pointeur_fin
 pointeur_debut= findstring (phrase.S,balise_gauche.S,pointeur_debut)+ len (balise_gauche.S)
 pointeur_fin= findstring (phrase.S,balise_droite.S,pointeur_debut)

 If (pointeur_debut- len (balise_gauche.S))=0 Or pointeur_fin=0
 extrait$= "dobro_stop" ; signale la fin du traitement²
 pointeur_debut=0
 pointeur_fin=0
 ProcedureReturn extrait$
 EndIf

 long=pointeur_fin-pointeur_debut
 extrait$= mid (phrase.S,pointeur_debut,long)

 If len (extrait$)<longueur
 pointeur_debut=pointeur_fin
 ProcedureReturn extrait$
 Else
 extrait$= ""
 ProcedureReturn extrait$
 EndIf
EndProcedure
Procedure sonne(*bidon)
 beep_ (880,1000)
EndProcedure

Posted: **Fri Dec 10, 2010 2:44 am**

if my windows freeze , it is because the verification is done every 5 seconds

takes 20 seconds in the timer

line 52

change

Code: Select all

SetTimer_(Handle, #timer_1, 5000, @TimerProc()); toute les 1 minutes

by

Code: Select all

SetTimer_(Handle, #timer_1, 20000, @TimerProc()); toute les 1 minutes

do not forget to compile thread safe

Posted: **Fri Dec 10, 2010 12:59 pm**

here is my (simple) version. No Threads, no Api

Code: Select all

InitNetwork()

#myWindow = 0
#myTextGadget = 0
#myListView = 1
#myTimer = 0

Global StripHtmlExpression
StripHtmlExpression = CreateRegularExpression(#PB_Any, "<(.|\n)*?>")

Procedure RefreshList()
  
  Protected FileContent.s
  Protected P1, P2, Counter
  
  If ReceiveHTTPFile("http://forums.purebasic.com/english/index.php", GetTemporaryDirectory() + "index.php")
    If ReadFile(0, GetTemporaryDirectory() + "index.php")
      FileContent = Space(Lof(0))
      ReadData(0, @FileContent, Len(FileContent))
      CloseFile(0)
    EndIf
  EndIf
  
  If FileContent
    
    FileContent = ReplaceRegularExpression(StripHtmlExpression, FileContent, "")
    
    P1 = FindString(FileContent, "Registered users:", 1)
    
    If P1
      
      P1 + Len("Registered users:")
      P2 = FindString(FileContent, "Legend", P1)
      FileContent=Mid(FileContent, P1, P2-P1)
      FileContent=RemoveString(FileContent, #LF$)
      FileContent=RemoveString(FileContent, #CR$)
      
      ClearGadgetItems(#myListView)
      
      For Counter = 1 To CountString(FileContent, ",") + 1
        AddGadgetItem(#myListView, -1, Trim(StringField(FileContent, Counter, ",")))
      Next
      
      SetGadgetText(#myTextGadget, "Last update: " + FormatDate("%hh:%ii:%ss", Date()))
      
    EndIf
    
  EndIf
  
EndProcedure

If OpenWindow(#myWindow, #PB_Ignore, #PB_Ignore, 200, 400, "UserSpy", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_Invisible)
  
  TextGadget(#myTextGadget, 5, 5, WindowWidth(#myWindow) - 10, 20, "", #PB_Text_Center)
  ListViewGadget(#myListView, 5, 25, WindowWidth(#myWindow) - 10, WindowHeight(#myWindow) - 30)
  AddWindowTimer(#myWindow, #myTimer, 5000)
  
  RefreshList()
  
  HideWindow(#myWindow, #False)
  
  Repeat
    
    WWE = WaitWindowEvent()
    
    Select WWE
      Case #PB_Event_Timer       : RefreshList()
      Case #PB_Event_CloseWindow : Break
    EndSelect
    
  ForEver
EndIf

Greetings ... Kiffi

Posted: **Fri Dec 10, 2010 1:25 pm**

in French :

oui

il manque l'alarme programmé (beep) sur un ou plusieurs noms séparé par des virgules
le but de ce prg etant de prévenir de la présence de quelqu'un en particulier , sur le Forum
pas seulement d'afficher la liste

j'ai pris l'habitude de l'Api pour le timer...

ma fonction Extract(phrase.S,balise_gauche.S,balise_droite.S,longueur)

est bien brave , et plus simple a comprendre que les Expressions régulières

mon prg n'écrit pas la page index.php sur le disque
pour fonctionner ..

La position de la fenetre est sauvegardé

mon prg filtre les robots ! [bot] , seul les membres m'interresse

Merci pour ta version , ça me rappel, que Purebasic
a reçut des nouvelles fonctions, mais que mes vielles
habitudes, sont tenaces ..

Google translate :

yes

it lacks the alarm set (beep) on one or more names separated by commas
The purpose of this prg being prevented by the presence of anyone in particular, on the Forum
not only to display the list:)

I got used to the API for the timer ...

my function Extract (phrase.S, balise_gauche.S, balise_droite.S, length)

is very brave, and easier to understand than regular expressions;)

prg does not write my index.php page on disk
to work ..

the position of the window is saved

my prg, filter robots[bots], only members interested

Thank you for your version, it reminds me that PureBasic
has received new features, but my old
habits die hard .. : Lol:

Posted: **Tue Jul 12, 2011 10:23 pm**

xD i see Artic Fox and magicjo :p

PureBasic Forums - English

Spy_nickname (spy_Pseudo)

Spy_nickname (spy_Pseudo)

Re: Spy_nickname (spy_Pseudo)

Re: Spy_nickname (spy_Pseudo)

Re: Spy_nickname (spy_Pseudo)

Re: Spy_nickname (spy_Pseudo)