Surveillance du forum

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Je me suis fait un petit programme de surveillance du forum, qui d'un clic me donne les derniers messages déposés, avec sujet, date/heure et auteur.
En fait le programme télécharge la page d'accueil du forum, qui contient tout ça.
J'ai essayé de me faire une conversion html -> texte simple pour l'exploiter, mais j'ai abandonné, trop compliqué.
Je n'ai trouvé qu'un utilitaire gratuit et qui fonctionne (très bien) en ligne de commande: HtmlAsText, tous les autres sont payants ou avec interface graphique.
J'enregistre la situation actuelle, et la fois suivante je compare pour détecter les changements (nouveaux messages), que je surligne, donc je sais que ça vaut le coup de me connecter pour voir les nouvelles.
La par exemple, je viens de mettre ce nouveau message:

Ce qui me gêne c'est ce programme externe à appeler, ça doit être possible de convertir du html en texte simplifié, mais il y a tellement de cas particuliers...

Je pense que ça doit être automatisable avec les dernières fonctions ajoutées par Klaus et un peu d'analyse. Perso, je ne m'y suis pas penché mais d'autres ont creusés le sujet.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Probablement, je n'ai pas cherché plus loin...

Invité

Bon c'est ce qu'on a fait avec Klaus dernièrement.
Je suis désolé mais j'ai pas le temps de programmer. J'ai plus d'un mois à rattraper en dehors de mes propres programmes.

Regarde le code qui est celui de Klaus, et ajuste les chemins. Juste pour voir les sujets, on peut bien simplifier. Reste à ne garder que ce qui est près "Derniers sujets".

Code:

Code:: dim url$, res%, WB%, hnd%, car$
label lancer, tables, elements, url

full_space 0 : color 0,230,242,222

dll_on "h:\KGF.dll"

combo 1 : top 1,310 : left 1,10 : width 1,400 : color 1,240,240,100
item_add 1,"http://panoramic.1fr1.net/"
item_add 1,"http://www.klaus49.5gbfree.com/klauspanoramic/index.html"
item_add 1,"http://www.pcastuces.com/pratique/bureautique/openoffice/openoffice.htm"
item_add 1,"file://C:/Users/klausgunther/Downloads/table.html"
item_add 1,"http://television.telerama.fr/tele/grille.php"
text 1,item_read$(1,1)
on_click 1,url
url$ = text$(1)

memo 2 : top 2,360 : left 2,10 : width 2,400 : height 2,300 :bar_both 2 : hide 2
' ============
main_menu 9 : sub_menu 8 : parent 8,9 : caption 8,"commande"
sub_menu 10 :parent 10,8: caption 10,"Lancer..." :on_click 10,lancer
sub_menu 11 :parent 11,8: caption 11,"Tables" : on_click 11,tables
sub_menu 13 :parent 13,8: caption 13,"Eléments" :on_click 13,elements
' inactive 8
' ============
memo 3 : top 3,360 : left 3,450 -440: width 3,width(0)-50-left(3) : height 3,400 :bar_both 3
font_name 3,"Courier"
memo 4 :hide 4 : width 4,300 : bar_both 4

combo 21 : top 21,310 :left 21,430 : width 21,110 : color 21,240,110,240
item_add 21,"Lier par AND"
item_add 21,"Lier par OR"
text 21,item_read$(21,1)

combo 22 : top 22,310 :left 22,550 : width 22,110 : color 22,110,240,240
item_add 22,"Longueur mini = 0"
item_add 22,"Longueur mini = 1"
item_add 22,"Longueur mini = 2"
item_add 22,"Longueur mini = 3"
text 22,item_read$(22,1)

combo 23 : top 23,310 : left 23,660 : width 23,100 : color 23,230,230,120
item_add 23,"Exclure"
item_add 23,"Inclure"
text 23,item_read$(23,1)

edit 24 : top 24,310 : left 24,770 : width 24,400
text 24,"[-!-script-option-]"

WB% = dll_call1("WB_Create",handle(0))
res% = dll_call5("WB_Locate",WB%,10,10,width(0)-50,300)
hnd% = dll_call2("WB_Function",WB%,8)
res% = dll_call2("WB_Url",WB%,adr(url$))
' width 0,width(0) -5
active 8
gosub tables : ' ajouté pour automatiser et voir les sujets. Il suffit de reprendre le contenu du memo et rechercer depuis: DERNIERS SUJET6S
end

url:
' inactive 8
  url$ = text$(1)
  res% = dll_call2("WB_Url",WB%,adr(url$))
  active 8
return

lancer:
  inactive 8
  res% = dll_call2("WB_Function",WB%,9) : ' équivalent de ctrl/A
  res% = dll_call2("WB_Function",WB%,10) : ' équivalent de ctrl/C
  clipboard_paste 2
  res% = DLL_call3("GetHtmlFromURL",adr(url$),handle(2),1) : ' code HTML intérieur
  active 8
return

tables:
  inactive 8
  color 0,95,95,250
  res% = dll_call3("WB_GetInfo",WB%,1,handle(3))
  color 0,230,242,222 : active 8
return

elements:
  color 0,95,95,250 : inactive 8
  item_add 4,text$(21)
  item_add 4,text$(22)
  item_add 4,text$(23)
  item_add 4,text$(24)
  res% = dll_call3("WB_GetInfo",WB%,2,handle(4)) : ' charger les paramètres
  res% = dll_call3("WB_GetInfo",WB%,3,handle(3)) : ' récupérer les éléments filtrés
  color 0,230,242,222 : active 8
return

Invité

Pendant le petit-déjeuner, j'ai pris le temps de faire un programme de départ, tout à l'heure.

Code:: dim url$, res%, WB%, hnd%, car$ , bloc%
dim a% , b$
label tables , url , tables1

height 0,screen_y : width 0,1100 : color 0,230,242,222

dll_on "h:\KGF.dll"

url$ ="http://panoramic.1fr1.net/"

memo 2 : top 2,360 : left 2,10 : width 2,400 : height 2,300 :bar_both 2 : hide 2
' ============
main_menu 9 :' sub_menu 8 : parent 8,9 : caption 8,"commande"
sub_menu 11 :parent 11,9: caption 11,"Contrôle des sujets" : on_click 11,tables1

' ============
memo 3 : top 3,0 : left 3,250: width 3,410 : height 3,800 :bar_both 3
font_name 3,"Courier"
memo 4 : top 4,0 : left 4,680: width 4,400 : height 4,800 :bar_both 4 : font_name 4,"Courier"
memo 5 : top 5,0 : left 5,1090:width 5,400 : height 5,800 :bar_both 5 : font_name 5,"Courier" : hide 5

WB% = dll_call1("WB_Create",handle(0))
res% = dll_call5("WB_Locate",WB%,10,10,240,350)
hnd% = dll_call2("WB_Function",WB%,8)
res% = dll_call2("WB_Url",WB%,adr(url$))
pause 2000
gosub tables
end

url:
  res% = dll_call2("WB_Url",WB%,adr(url$))
return

tables:
  color 0,95,95,250
  res% = dll_call3("WB_GetInfo",WB%,1,handle(2))
  color 0,230,242,222
  bloc%=0
  clear 3
  if count(2) > 0
   for a% = 1 to count(2)
   b$ = item_read$(2,a%)
   if b$ = "Navigation" then bloc% = 0
   if bloc% = 1
   item_add 3,b$ : item_add 4,b$
   end_if
   if b$ = "Derniers sujets" then bloc% = 1
   next a%
  end_if
return

tables1:
  color 0,95,95,250
  res% = dll_call3("WB_GetInfo",WB%,1,handle(2))
  color 0,230,242,222
  bloc%=0

  clear 5
  if count(2) > 0
   for a% = 1 to count(2)
   b$ = item_read$(2,a%)
   if b$ = "Navigation" then bloc% = 0
   if bloc% = 1
   item_add 5,b$
   end_if
   if b$ = "Derniers sujets" then bloc% = 1
   next a%
  end_if
  ' -----------------
  if count(3)> 1 and count(5) > 1
   if item_read$(3,1) <> item_read$(5,1) OR item_read$(3,2) <> item_read$(5,2)
   clear 3
   for a% = 1 to count(5)
   item_add 3 , item_read$(4,a%)
   item_delete 4,a%
   item_insert 4 , a%, item_read$(5,a%)
   next a%
   BEEP : MESSAGE "sujets modifiés"
   end_if
  end_if
return

Reste à mettre éventuellement un timer avec un intervalle important, et éventuellement revoir la présentation.

On pourrait aussi faire un contrôle sur un sujet particulier, et ne tester que celui-ci.

Toutefois, si je ne me trompe pas, si on a mis des blocages sur des suivis de navigation ou de pub, normalement ça ne marche pas, ceux-ci ne seront pas actifs.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Intéressant cosmos, ~~mais apparemment tu affiches la page telle quelle, avec son formatage~~ (~~et en plus j'ai une erreur de script:~~

Ce que je voulais c'est récupérer un fichier en texte pur, et faire les recherches dans ce texte pour afficher ce qui m'intéresse.
Et pour ça il faut une conversion html -> texte pur, que je n'ai pas (encore) réussi à faire: supprimer la plupart des balises html, c'est à dire toute la mise en forme, interpréter peut-être quand même les sauts de ligne et les caractères spéciaux (accentués, et genre   » ...).
Je ne désespère pas d'arriver à faire une sub qui fasse ça.

Et non pas laisser le programme tourner avec un timer, mais l'interroger au coup par coup.

PS autant pour moi pour l'erreur de script, je n'avais pas la dernière version de kgf.dll, et de même pour la présentation, il y a bien les deux listes comme pour moi.

Invité

J'ai apporté une modification.
Je sauvegarde la dernière vue dans le fichier temps. Ainsi le programme n'a ps besoin d'être ouvet tout le temps.

Si il y a une différence, il le dit. Si personne ne veut reprendre le programme, j'essayerai ce soir de reprendre la sortie écran.

Code:: dim url$, res%, WB%, hnd%, car$ , bloc% , forum$
forum$ = "c:\temp\forum.txt"
url$ ="http://panoramic.1fr1.net/"
dll_on "h:\KGF.dll"
dim a% , b$ , teste%
label url , tables1 , fin

height 0,screen_y : width 0,1100 : color 0,230,242,222
memo 2 : top 2,360 : left 2,10 : width 2,400 : height 2,300 :bar_both 2 : hide 2
' ============
main_menu 9
sub_menu 11 :parent 11,9: caption 11,"Contrôle des sujets" : on_click 11,tables1

' ============
memo 3 : top 3,0 : left 3,250: width 3,410 : height 3,800 :bar_both 3 :font_name 3,"Courier"
memo 4 : top 4,0 : left 4,680: width 4,400 : height 4,800 :bar_both 4 : font_name 4,"Courier"

if file_exists(forum$) = 1
  file_load 3,forum$ : file_load 4,forum$: teste% = 1
  if count(3) = 0 then teste% = 0
end_if

memo 5 : top 5,0 : left 5,1090:width 5,400 : height 5,800 :bar_both 5 : font_name 5,"Courier" : hide 5
on_close 0,fin
WB% = dll_call1("WB_Create",handle(0))
res% = dll_call5("WB_Locate",WB%,10,10,240,350)
hnd% = dll_call2("WB_Function",WB%,8)
res% = dll_call2("WB_Url",WB%,adr(url$))
pause 2000
gosub tables1
end

url:
  res% = dll_call2("WB_Url",WB%,adr(url$))
return

tables1:
  color 0,95,95,250
  res% = dll_call3("WB_GetInfo",WB%,1,handle(2))
  bloc%=0

  clear 5
  if count(2) > 0
   for a% = 1 to count(2)
   b$ = item_read$(2,a%)
   if b$ = "Navigation" then bloc% = 0
   if bloc% = 1
   item_add 5,b$
   end_if
   if b$ = "Derniers sujets" then bloc% = 1
   next a%
  end_if
  ' -----------------
  if count(3)> 1 and count(5) > 1
   if item_read$(3,1) <> item_read$(5,1) OR item_read$(3,2) <> item_read$(5,2)
   clear 3
   for a% = 1 to count(5)
   item_add 3 , item_read$(4,a%)
   item_delete 4,a%
   item_insert 4 , a%,item_read$(5,a%)
   next a%
   BEEP : MESSAGE "sujets modifiés"
   file_save 5,forum$
   clear 3
   for a% = 1 to count(5)
   item_add 3,item_read$(5,a%)
   next a%
   else
   file_save 5,forum$
   end_if
  end_if
  color 0,230,242,222
return

fin:
  res% = dll_call1("WB_Delete",WB%)
  dll_off
  terminate

Invité

Bon. Voila une version qui me convient.

Code:: dim url$, res%, WB%, hnd%, car$ , bloc% , forum$ , flg%

forum$ = "c:\temp\forum.txt"
url$ ="http://panoramic.1fr1.net/"

dll_on "h:\KGF.dll" : ' voir l'adresse

dim a% , b$ , teste% , lig%
label tables1 , fin

height 0,640 : width 0,screen_x : color 0,230,242,222
memo 2 : top 2,360 : left 2,10 : width 2,400 : height 2,300 :bar_both 2 : hide 2
' ============
main_menu 9
sub_menu 11 :parent 11,9: caption 11,"Contrôle des sujets" : on_click 11,tables1

' ============
memo 3 : top 3,0 : left 3,250: width 3,410 : height 3,800 :bar_both 3 :font_name 3,"Courier" : hide 3
memo 4 : top 4,0 : left 4,680: width 4,400 : height 4,800 :bar_both 4 : font_name 4,"Courier" : hide 4

if file_exists(forum$) = 1
  file_load 3,forum$ : file_load 4,forum$: teste% = 1
  if count(3) = 0 then teste% = 0
end_if

memo 5 : top 5,0 : left 5,1090:width 5,400 : height 5,800 :bar_both 5 : font_name 5,"Courier" : hide 5

picture 6:top 6,360:width 6,1200 : height 6,210 : font_name 6,"courier New":font_size 6,10 : font_bold 6
print_target_is 6 : 2d_target_is 6 : 2d_pen_color 230,0,0 : 2d_pen_width 1

on_close 0,fin
WB% = dll_call1("WB_Create",handle(0))
res% = dll_call5("WB_Locate",WB%,10,10,width(0) - 50,350) :' dimentions
hnd% = dll_call2("WB_Function",WB%,8)
res% = dll_call2("WB_Url",WB%,adr(url$))
pause 2000
gosub tables1
end

tables1:
  color 0,95,95,250
  res% = dll_call3("WB_GetInfo",WB%,1,handle(2))
  bloc%=0

  clear 5
  if count(2) > 0
   for a% = 1 to count(2)
   b$ = item_read$(2,a%)
   if b$ = "Navigation" then bloc% = 0
   if bloc% = 1
   item_add 5,b$
   end_if
   if b$ = "Derniers sujets" then bloc% = 1
   next a%
  end_if

  ' -----------------
  if count(3)> 1 and count(5) > 1
   if item_read$(3,1) <> item_read$(5,1) OR item_read$(3,2) <> item_read$(5,2)
   clear 3 : color 0,180,180,180

   for a% = 1 to count(5)
   item_add 3 , item_read$(4,a%)
   item_delete 4,a%
   item_insert 4 , a%,item_read$(5,a%)
   next a%
   affichage(3)
   BEEP : MESSAGE "sujets modifiés"
   file_save 5,forum$

   clear 3
   for a% = 1 to count(5)
   item_add 3,item_read$(5,a%)
   next a%
   if count(5) > 27
   for a% = 27 to count(5)
   item_delete 5,27
   next a%
   file_save 5,forum$
   end_if
   affichage(3)
   else
   file_save 5,forum$
   affichage(4)
   end_if
   color 0,230,242,222
  end_if
return

sub affichage(n%)

  flg% = 0 : lig% = 0 : 2d_clear :' hide 3 : hide 4
  for a% = 1 to count(n%)
   b$ = item_read$(n%,a%)
   if flg% = 0
   font_color 6,0,0,200 : print_locate 10,lig% *20 +10: flg% = 1
   else
   print_locate 700,lig%*20 +10: font_color 6,0,0,0 : flg% = 0
   end_if

   if b$ <> ""
   print b$ : 2d_line 0,lig% *20+10,width(6),lig%*20+10
   else
   flg% = 0 : lig% = lig% +1
   end_if
   if a% = 27 then exit_for
  next a%
  2d_line 0,9 *20+10,width(6),9*20+10
end_sub

fin:
  res% = dll_call1("WB_Delete",WB%)
  dll_off
  terminate

On peut d'ailleurs cliquer sur un lien dans le navigateur pour voir si un sujet (seulement pour contrôle).

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

? Chez moi ton programme affiche, après un temps de chargement assez long, la page d'accueil du forum, avec défilement, telle que je peux la voir si je me connecte (et même plus puisque je récupère aussi la pub que j'élimine en consultation avec Adblock Plus).

Je cherchais seulement à faire un résumé succinct de la page (dernières interventions) au format texte pur, compact, en signalant les nouveautés par rapport à l'état enregistré précédemment.

Invité

Que puis-je te dire?

Chez moi l'affichage est plus rapide qu'avec Chrome. On pourrait éviter de voir l'affichage, mais la dll de Klaus doit la lire pour faire un ctrl A et C pour prendre les informations. Je trouve dommage de ne pas pouvoir mettre les filtres sur l'outils webBrowser. Du moment qu'on ne regarde que Panoramic, on ne risque pas grand chose. Personnellement j'y trouve un avantage d'afficher la page html. Si il y a un changement, en cliquant sur le titre de la liste déroulante, on peut voir si on ouvre ou non son navigateur pour plus d'infos.

Tu as la possibilité de faire ton choix, puisses tu as une autre solution qu'on ne connait pas, vu que tu as gardé l'information.

Maintenant j'ignore si Klaus sait comment contourné tes remarques . Je m'y suis mis pour deux raisons:; lorsque Klaus a proposé ses fonctions, en mettant le lien de Panoramic, j'ai tout de suite pensé qu'on pourrait surveiller le forum, mais c'était pas le problème du moment. Ensuite lorsque vous avez parlé que cela devait pouvoir être fait en Panoramic, j'avais un petit programme tout fait de Klaus, qui le montrait.

Maintenant sur ton bureau, tu as une poubelle bien pratique pour ce qu'on ne veut pas pirat

Voila! voila! voila.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Finalement j'ai fait quelque chose qui correspond exactement à l'image qui est en tête (état précédent, état actuel), avec une sub de conversion Html -> Texte, qui ne nécessite donc aucune ressource externe, ni programme de conversion, ni dll, tout en pur Panoramic.

La sub de conversion est très rustique et un peu adaptée au forum: on supprime le contenu de toutes les balises html pour ne garder que le texte brut, bien plus facile à analyser. Cette sub pourrait être grandement améliorée pour tenir compte des subtilités du langage html, mais telle qu'elle est elle fait le travail pour le forum panoramic.

Je rappelle qu'on ne tient compte que des derniers messages du forum (apparemment systématiquement les 9 derniers), on archive l'état actuel, et à l'appel suivant on compare pour signaler s'il y a du changement. Ce sont donc des appels ponctuels, sur demande, sans périodicité fixée (facile à rajouter, mais ça supposerait le programme actif en permanence).

Voici:

Code:: LABEL LoadPage, Transfert, Crelist, Compare, Connect
DIM url$,frec$,rect$,fref$,recf$,f$,a$,b$,i%,k%,m%,cat$,suj$,mes$,der$,aut$
DIM Titref$(20),Datref$(20),Titact$(20),Datact$(20),nref%,nact%,tr%,nl%,wf%,hf%,n%
DIM lf%,tp%

url$ = "http://panoramic.1fr1.net/"
frec$ = "C:\TEMP\Forum.htm"
rect$ = "C:\TEMP\Forum.txt"
fref$ = "C:\TEMP\Forum_ref.htm"
recf$ = "C:\TEMP\Forum_ref.txt"

WIDTH 0,637: HEIGHT 0,400: BORDER_SMALL 0: COLOR 0,190,255,255
font_name 0,"Arial": font_bold 0: font_color 0,0,0,255
CAPTION 0," - SURVEILLANCE DU FORUM PANORAMIC -"

MEMO 5: HIDE 5: WIDTH 5,400: HEIGHT 5,300: ' memo de manoeuvre
ALPHA 11: TOP 11,5: LEFT 11,100: CAPTION 11," PRÉCÉDENT ": COLOR 11,255,255,0
ALPHA 12: TOP 12,5: LEFT 12,400: CAPTION 12," ACTUEL ": COLOR 12,255,255,0
BUTTON 15: TOP 15,0: LEFT 15,520: WIDTH 15,100: CAPTION 15,"Se connecter"
ON_CLICK 15,Connect

IF FILE_EXISTS(recf$) = 0
f$ = fref$: GOSUB LoadPage
Html2Txt(fref$,recf$): ' conversion htm -> texte pur
FILE_DELETE fref$
f$ = recf$: GOSUB Transfert
m% = 2: nref% = nact%: GOSUB Crelist
FILE_OPEN_WRITE 1,recf$
ITEM_ADD 20, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FILE_WRITELN 1, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FOR i% = 1 TO nact%
ITEM_ADD 20+i%,Titact$(i%): FILE_WRITELN 1,Titact$(i%)
ITEM_ADD 20+i%,Datact$(i%): FILE_WRITELN 1,Datact$(i%)
NEXT i%
FILE_CLOSE 1
MESSAGE "Référence créée !"
ELSE
FILE_OPEN_READ 1,recf$
FILE_READLN 1,b$: ' date/heure
nref% = 0
WHILE FILE_EOF(1) = 0
FILE_READLN 1, a$
IF LEFT$(a$,1) = CHR$(187)
nref% = nref%+1: Titref$(nref%) = a$
ELSE
Datref$(nref%) = a$
END_IF
END_WHILE
FILE_CLOSE 1
m% = 1: GOSUB Crelist
ITEM_ADD 20,b$: ' date/heure de la référence
FOR i% = 1 TO nref%
ITEM_ADD 20+i%,Titref$(i%): ITEM_ADD 20+i%,Datref$(i%)
NEXT i%
' téléchargement de l'état actuel:
f$ = frec$: GOSUB LoadPage
Html2Txt(frec$,rect$): ' conversion htm -> texte pur
FILE_DELETE frec$
f$ = rect$: GOSUB Transfert
FILE_DELETE rect$
m% = 2: GOSUB Crelist
FILE_OPEN_WRITE 1,recf$: ' devient la nouvelle référence
ITEM_ADD 60, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FILE_WRITELN 1, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FOR i% = 1 TO nact%
ITEM_ADD 60+i%,Titact$(i%): FILE_WRITELN 1,Titact$(i%)
ITEM_ADD 60+i%,Datact$(i%): FILE_WRITELN 1,Datact$(i%)
NEXT i%
FILE_CLOSE 1
' comparaison de l'état actuel avec le précédent
GOSUB Compare
END_IF

END
' ==============================================================================
LoadPage:
PageWeb(url$,f$)
RETURN
' ==============================================================================
Transfert:
' nettoyage du fichier texte, transfert dans les tables
FILE_OPEN_READ 1,f$
nact% = 0
WHILE FILE_EOF(1) = 0
FILE_READLN 1, a$: a$ = TRIM$(a$)
IF a$ <> ""
IF INSTR(a$,"Derniers sujets") > 0
FILE_READLN 1, a$: a$ = TRIM$(a$)
WHILE INSTR(a$,"Navigation") = 0
k% = INSTR(a$,CHR$(187))
IF k% > 0: ' caractère >>
a$ = MID$(a$,k%,LEN(a$))
nact% = nact%+1
Titact$(nact%) = a$
FILE_READLN 1,a$
Datact$(nact%) = a$
END_IF
FILE_READLN 1,a$: WHILE TRIM$(a$)="": FILE_READLN 1,a$: END_WHILE
END_WHILE
END_IF
END_IF
END_WHILE
FILE_CLOSE 1
RETURN
' ==============================================================================
Crelist:
wf% = 310: hf% = 40
IF m% = 1
nl% = 20: lf% = 0: n% = nref%
ELSE
nl% = 60: lf% = wf%: n% = nact%
END_IF
LIST nl%: TOP nl%, 20: LEFT nl%,lf%: WIDTH nl%,wf%: HEIGHT nl%,20
COLOR nl%,180,255,180: FONT_SIZE nl%,10: FONT_COLOR nl%,0,0,0
tp% = 40
FOR i% = 1 TO n%
k% = nl%+i%
LIST k%: TOP k%,tp%: LEFT k%,lf%: WIDTH k%,wf%: HEIGHT k%,hf%
tp% = tp% + hf%
NEXT i%
i% = tp%+40: IF i%>HEIGHT(0) THEN HEIGHT 0,i%: ' ajuste fenêtre principale
RETURN
' ==============================================================================
Compare:
FOR i% = 1 TO nact%
a$ = Titact$(i%): b$ = Datact$(i%): tr% = 0
FOR k% = 1 TO nref%
IF a$ = Titref$(k%)
tr% = 1
IF b$ <> Datref$(k%): ' sujet existant, nouveau message
COLOR 60+i%,255,255,0
END_IF
END_IF
NEXT k%
IF tr% = 0: ' nouveau sujet
COLOR 60+i%,255,255,0: ' en jaune
END_IF
NEXT i%
RETURN
' ==============================================================================
Connect:
EXECUTE url$
WAIT 2000
TERMINATE
' ==============================================================================
SUB Html2Txt(f$,ft$)
' conversion fichier html f$ en fichier texte brut dans ft$
DIM_LOCAL a$,s$,ba$,k%,k1%,ns%,csp$(20),crm$(20)
DATA "Carspe": ' caractères spéciaux, à remplacer (à compléter éventuellement)
DATA " ","<",">","&",""","»","F": ' caractère à remplacer
DATA " ","<",">","&",CHR$(34),CHR$(13)+CHR$(10)+CHR$(187): ' caractère(s) de remplacement
ns% = 0: RESTORE: READ a$: WHILE a$<>"Carspe": message a$: READ a$: END_WHILE: READ a$
WHILE a$<>"F": ns%=ns%+1: csp$(ns%) = a$: READ a$: END_WHILE
FOR k% = 1 TO ns%: READ a$: crm$(k%) = a$: NEXT k%
' lecture intégrale du fichier htm dans la variable a$
FILEBIN_OPEN_READ 9,f$: k% = FILEBIN_SIZE(9): FILEBIN_CLOSE 9
FILE_OPEN_READ 9,f$: FILE_READBUF 9,a$,k%: FILE_CLOSE 9
k% = INSTR(a$,"</head>"): IF k%=0 THEN message "Pas de balise </head>": EXIT_SUB
a$ = MID$(a$,k%+7,LEN(a$))
' suppression des balises <script...>...</script> et <style...>...</style> et de
' leur contenu
k% = INSTR(a$,"<script")
WHILE k%>0
k1% =INSTR(a$,"</script>"): a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+9,LEN(a$))
k% = INSTR(a$,"<script")
END_WHILE
k% = INSTR(a$,"<style")
WHILE k%>0
k1% =INSTR(a$,"</style>"): a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+8,LEN(a$))
k% = INSTR(a$,"<style")
END_WHILE
' suppression de toutes les balises (on garde les sauts de lignes, pour lisibilité)
k% = INSTR(a$,"<")
WHILE k% > 0
k1% = INSTR_POS(a$,">",k%): ba$ = MID$(a$,k%,k1%-k%+1): ' balise trouvée
IF LEFT$(ba$,3) = "<br": ' saut de ligne
a$ = LEFT$(a$,k%-1)+CHR$(13)+CHR$(10)+MID$(a$,k1%+1,LEN(a$))
ELSE
a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+1,LEN(a$)): ' suppression
END_IF
k% = INSTR(a$,"<")
END_WHILE
' remplacement des caractères spéciaux
FOR k% = 1 TO ns%
s$ = csp$(k%): k1% = INSTR(a$,s$)
WHILE k1%>0
a$ = LEFT$(a$,k1%-1)+crm$(k%)+MID$(a$,k1%+LEN(s$),LEN(a$))
k1% = INSTR(a$,s$)
END_WHILE
NEXT k%
FILE_OPEN_WRITE 9,ft$: FILE_WRITELN 9,a$: FILE_CLOSE 9
END_SUB
' ==============================================================================
SUB PageWeb(url$,f$)
' capture d'une page web ou d'un fichier quelconque (image) donné(e) par son url
DIM_LOCAL pwa$, fscr$, gui$: gui$ = CHR$(34)
fscr$ = "C:\Temp\Scrdnl.vbs": ' script vbs (temporaire)
DATA "Debscr"
DATA "HTTPDownload "+gui$+URL$+gui$+", "+gui$+f$+gui$
DATA "Sub HTTPDownload( URL, Path )"
DATA "Dim i, objFile, objFSO, objHTTP, strFile, strMsg"
DATA "Const ForReading = 1, ForWriting = 2, ForAppending = 8"
DATA "Set objFSO = CreateObject( "+gui$+"Scripting.FileSystemObject"+gui$+" )"
DATA "strFile = Path"
DATA "Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )"
DATA "Set objHTTP = CreateObject( "+gui$+"WinHttp.WinHttpRequest.5.1"+gui$+" )"
DATA "objHTTP.Open "+gui$+"GET"+gui$+", URL, False"
DATA "objHTTP.Send"
DATA "For i = 1 To LenB( objHTTP.ResponseBody )"
DATA " objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )"
DATA "Next"
DATA "objFile.Close( )"
DATA "End Sub"
DATA "Finscr"
RESTORE: READ pwa$: WHILE pwa$ <> "Debscr": READ pwa$: END_WHILE
FILE_OPEN_WRITE 9, fscr$
READ pwa$: WHILE pwa$ <> "Finscr": FILE_WRITELN 9, pwa$: READ pwa$: END_WHILE
FILE_CLOSE 9
EXECUTE_WAIT "WSCRIPT.exe " + fscr$: ' exécution du script
FILE_DELETE fscr$: ' nettoyage
END_SUB
' ==============================================================================

Une petite remarque: La sub de conversion procède de la manière suivante: on transfère l'intégralité du fichier html dans une variable unique, à l'aide de la fonction FILE_READBUF, pour analyse par des INSTR.
Cette fonction ReadBuf (prévue apparemment pour des fichier 'texte') comporte un inconvénient gênant, elle se bloque sur un caractère de code Ascii 26 (&h1A), ce qui est bien embêtant pour un fichier binaire, mais je n'ai pas trouvé le cas dans un fichier html.
(dommage pour les fichiers binaires, cette fonction serait bien utile également, mais bon, il y a une dll de Klaus qui fait ça).

Edit: ajout du bouton Connecter, pour se connecter pendant la consultation.

Edit 19/7 une sub de conversion Html un peu plus élaborée (je la mets également dans 'Vos sources...'

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

On s'est croisés cosmos, maintenant tu as ma solution ! j'hésitais à la mettre à cause de ce programme externe de conversion, mais je l'ai supprimé, du coup j'ai moins de scrupules.

On peut évidemment envisager d'afficher autre chose que les derniers messages, on dispose de toute la page, mais j'ai voulu faire assez compact. Et le but est simplement de voir rapidement s'il y a du nouveau d'intéressant à regarder, par exemple sur un sujet que l'on est en train de suivre, et dans ce cas on se connectera par le navigateur habituel.

J'y pense maintenant, mais j'aurais pu lancer la connexion depuis le programme lui-même, sur demande.
PS voilà, c'est fait, avec un bouton 'Se connecter', on se connecte au forum et le programme se ferme.

Invité

Bon.
Je viens d'essayer ton programme, et cela ne me convient pas.

Tu n'y es pour rien, j'ai un problème avec mon ordi, et celui-ci je l'ai eu avec mon programme de création de site. En faisant execute url$, le programme tourne en rond. Avec Chrome cela marche parfois, mais normalement je peux rester une heure sans que la page ne puisse être chargée. Il est bien dans le sens, où les filtres du navigateur agissent.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Désolé cosmos, pour moi c'est rapide et sans problème (sous Firefox, mais ça ne doit pas changer grand chose),
il me faut environ 5 secondes depuis le lancement du programme pour récupérer et afficher les infos de manière transparente.

Invité

Je fais avec.
Ce que je ne comprend pas, est le temps d'affichage pour toi de mon programme.

J'ai un chrono découpé en 100ème de minute, et en 5/100, la page est affichée avec le texte du picture chez moi.
Sleep

J'ai mis les deux versions sur mon site. étant donné qu'on est dans Présentation et bavardage, il ne serait pas simple de retrouver ses programmes.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Salut cosmos, j'espère que tu as bien dormi (malgré la chaleur infernale !)
J'ai réessayé ton programme, l'affichage est très long la 1ère fois (12 ou 13 s), et bien plus rapide les fois suivantes (quelques secondes, 2 ou 3).
Ce n'est pas tout à fait la même philosophie, toi c'est graphique, moi texte pur. Et ton programme est bien plus court que le mien ! forcément, avec les fonctions traitées par dll interposée.

Je vais essayer d'améliorer ma sub de conversion html en texte pour la rendre un peu plus universelle.

C'est fait, j'ai mis à jour et je la mets aussi dans 'vos sources...', elle est loin dêtre parfaite, mais ça peut être une base de départ pour quelque chose de plus sophistiqué.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Finalement j'ai ajouté une surveillance automatique du forum, ça peut être pratique si on attend une réponse et qu'on ne veut pas se connecter toutes les cinq minutes:
On lance le programme qui affiche côte à côte l'état précédent et l'état actuel.
On a alors la possibilité de lancer une surveillance périodique du forum, avec un intervalle donné, en minutes.
La fenêtre du programme est cachée pendant l'intervalle d'attente.
- Si l'état au moment du réveil est identique au précédent, il ne se passe rien, ça repart silencieusement pour l'intervalle donné.
- S'il y a une différence (nouveau message), elle est affichée et la périodicité est annulée.
On a alors le choix soit de relancer la surveillance, soit de se connecter au forum, soit de quitter sans rien faire.

Il faut évidemment avoir créé un exécutable du programme, c'est lui qui est lancé (avec éventuellement une icône sur le bureau).

Code:: ' Surveillance du forum Panoramic
LABEL Surveil, Transfert, Crelist, Compare, Connect, Lancer, Quitter
DIM url$,frec$,rect$,fref$,recf$,f$,a$,b$,i%,k%,m%,cat$,suj$,mes$,der$,aut$,gui$
DIM Titref$(20),Datref$(20),Titact$(20),Datact$(20),nref%,nact%,tr%,nl%,wf%,hf%,n%
DIM lf%,tp%,srv%,df%,fscr$

url$ = "http://panoramic.1fr1.net/"
frec$ = "C:\TEMP\Forum.htm"
rect$ = "C:\TEMP\Forum.txt"
fref$ = "C:\TEMP\Forum_ref.htm"
recf$ = "C:\TEMP\Forum_ref.txt"

fscr$ = "C:\Temp\Scrdnl.vbs": ' script vbs
gui$ = CHR$(34)
' Script vbs de lecture de la page web url$ dans un fichier html (frec$)
DATA "Debscr"
DATA "HTTPDownload "+gui$+url$+gui$+", "+gui$+frec$+gui$
DATA "Sub HTTPDownload( URL, Path )"
DATA "Dim i, objFile, objFSO, objHTTP, strFile, strMsg"
DATA "Const ForReading = 1, ForWriting = 2, ForAppending = 8"
DATA "Set objFSO = CreateObject( "+gui$+"Scripting.FileSystemObject"+gui$+" )"
DATA "strFile = Path"
DATA "Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )"
DATA "Set objHTTP = CreateObject( "+gui$+"WinHttp.WinHttpRequest.5.1"+gui$+" )"
DATA "objHTTP.Open "+gui$+"GET"+gui$+", URL, False"
DATA "objHTTP.Send"
DATA "For i = 1 To LenB( objHTTP.ResponseBody )"
DATA " objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )"
DATA "Next"
DATA "objFile.Close( )"
DATA "End Sub"
DATA "Finscr"
RESTORE: READ a$: WHILE a$ <> "Debscr": READ a$: END_WHILE
FILE_OPEN_WRITE 9, fscr$
READ a$: WHILE a$ <> "Finscr": FILE_WRITELN 9, a$: READ a$: END_WHILE
FILE_CLOSE 9

WIDTH 0,637: HEIGHT 0,430: BORDER_SMALL 0: COLOR 0,190,255,255
font_name 0,"Arial": font_bold 0: font_color 0,0,0,255
CAPTION 0," - SURVEILLANCE DU FORUM PANORAMIC -"

MEMO 5: HIDE 5: WIDTH 5,400: HEIGHT 5,300: ' memo de manoeuvre
ALPHA 11: TOP 11,5: LEFT 11,100: CAPTION 11," PRÉCÉDENT ": COLOR 11,255,255,0
ALPHA 12: TOP 12,5: LEFT 12,400: CAPTION 12," ACTUEL ": COLOR 12,255,255,0
BUTTON 15: TOP 15,0: LEFT 15,520: WIDTH 15,100: CAPTION 15,"Se connecter"
ON_CLICK 15,Connect
ALPHA 100: TOP 100,HEIGHT(0)-60

CAPTION 100,"Lancer la surveillance périodique, délai: minutes"
SPIN 101: TOP 101,TOP(100)-3: LEFT 101,225: WIDTH 101,40
POSITION 101,10
BUTTON 102: TOP 102,TOP(101): LEFT 102,LEFT(101)+90: WIDTH 102,140
CAPTION 102,"Lancer ou relancer"
ON_CLICK 102,Lancer
BUTTON 104: TOP 104,TOP(102): LEFT 104,LEFT(102)+220: CAPTION 104,"Quitter"
ON_CLICK 104,Quitter

GOSUB Surveil
srv% = 0
END
' ==============================================================================
Surveil:
IF FILE_EXISTS(recf$) = 0
EXECUTE_WAIT "WSCRIPT.exe " + fscr$: ' capture de la page, -> frec$ (htm)
IF FILE_EXISTS(fref$) = 1 THEN FILE_DELETE fref$
FILE_COPY frec$,fref$: ' fichier référence
Html2Txt(fref$,recf$): ' conversion htm -> texte pur
FILE_DELETE fref$
f$ = recf$: GOSUB Transfert
m% = 2: nref% = nact%: IF srv% = 0 THEN GOSUB Crelist
FOR i% = 60 TO 60+nact%: CLEAR i%: NEXT i%
FILE_OPEN_WRITE 1,recf$
ITEM_ADD 20, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FILE_WRITELN 1, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FOR i% = 1 TO nact%
ITEM_ADD 20+i%,Titact$(i%): FILE_WRITELN 1,Titact$(i%)
ITEM_ADD 20+i%,Datact$(i%): FILE_WRITELN 1,Datact$(i%)
NEXT i%
FILE_CLOSE 1
MESSAGE "Référence créée !"
ELSE
FILE_OPEN_READ 1,recf$
FILE_READLN 1,b$: ' date/heure
nref% = 0
WHILE FILE_EOF(1) = 0
FILE_READLN 1, a$
IF LEFT$(a$,1) = CHR$(187)
nref% = nref%+1: Titref$(nref%) = a$
ELSE
Datref$(nref%) = a$
END_IF
END_WHILE
FILE_CLOSE 1
m% = 1: IF srv% = 0 THEN GOSUB Crelist
FOR i% = 20 TO 20+nref%: CLEAR i%: NEXT i%
ITEM_ADD 20,b$: ' date/heure de la référence
FOR i% = 1 TO nref%
ITEM_ADD 20+i%,Titref$(i%): ITEM_ADD 20+i%,Datref$(i%)
NEXT i%
' téléchargement de l'état actuel:
EXECUTE_WAIT "WSCRIPT.exe " + fscr$: ' capture de la page actuelle -> frec$
Html2Txt(frec$,rect$): ' conversion htm -> texte pur
FILE_DELETE frec$
f$ = rect$: GOSUB Transfert
FILE_DELETE rect$
m% = 2: IF srv% = 0 THEN GOSUB Crelist
FOR i% = 60 TO 60+nact%: CLEAR i%: NEXT i%
FILE_OPEN_WRITE 1,recf$: ' devient la nouvelle référence
ITEM_ADD 60, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FILE_WRITELN 1, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
FOR i% = 1 TO nact%
ITEM_ADD 60+i%,Titact$(i%): FILE_WRITELN 1,Titact$(i%)
ITEM_ADD 60+i%,Datact$(i%): FILE_WRITELN 1,Datact$(i%)
NEXT i%
FILE_CLOSE 1
' comparaison de l'état actuel avec le précédent
GOSUB Compare
END_IF
RETURN
' ==============================================================================
Transfert:
' nettoyage du fichier texte, transfert dans les tables
FILE_OPEN_READ 1,f$
nact% = 0
WHILE FILE_EOF(1) = 0
FILE_READLN 1, a$: a$ = TRIM$(a$)
IF a$ <> ""
IF INSTR(a$,"Derniers sujets") > 0
FILE_READLN 1, a$: a$ = TRIM$(a$)
WHILE INSTR(a$,"Navigation") = 0
k% = INSTR(a$,CHR$(187))
IF k% > 0: ' caractère >>
a$ = MID$(a$,k%,LEN(a$))
nact% = nact%+1
Titact$(nact%) = a$
FILE_READLN 1,a$
Datact$(nact%) = a$
END_IF
FILE_READLN 1,a$: WHILE TRIM$(a$)="": FILE_READLN 1,a$: END_WHILE
END_WHILE
END_IF
END_IF
END_WHILE
FILE_CLOSE 1
RETURN
' ==============================================================================
Crelist:
wf% = 310: hf% = 35
IF m% = 1
nl% = 20: lf% = 0: n% = nref%
ELSE
nl% = 60: lf% = wf%: n% = nact%
END_IF
LIST nl%: TOP nl%, 20: LEFT nl%,lf%: WIDTH nl%,wf%: HEIGHT nl%,20
COLOR nl%,180,255,180: FONT_SIZE nl%,10: FONT_COLOR nl%,0,0,0
tp% = 40
FOR i% = 1 TO n%
k% = nl%+i%
LIST k%: TOP k%,tp%: LEFT k%,lf%: WIDTH k%,wf%: HEIGHT k%,hf%
tp% = tp% + hf%
NEXT i%
i% = tp%+40: IF i%>HEIGHT(0) THEN HEIGHT 0,i%: ' ajuste fenêtre principale
RETURN
' ==============================================================================
Compare:
df% = 0
FOR i% = 1 TO nact%
a$ = Titact$(i%): b$ = Datact$(i%): tr% = 0
FOR k% = 1 TO nref%
IF a$ = Titref$(k%)
tr% = 1
IF b$ <> Datref$(k%): ' sujet existant, nouveau message
COLOR 60+i%,255,255,0
df% = 1
END_IF
END_IF
NEXT k%
IF tr% = 0: ' nouveau sujet
COLOR 60+i%,255,255,0: ' en jaune
df% = 1
END_IF
NEXT i%
RETURN
' ==============================================================================
Connect:
EXECUTE url$
WAIT 2000
TERMINATE
' ==============================================================================
Lancer:
HIDE 0
srv% = 1
WHILE srv% = 1
i% = 60000*POSITION(101): ' délai, en ms
k% = i%/30000
FOR i% = 1 TO k%
WAIT 30000: ' maximum autorisé
NEXT i%
GOSUB Surveil
IF df% = 1 THEN SHOW 0: srv% = 0: EXIT_WHILE
END_WHILE
RETURN
' ==============================================================================
Poursuivre:
GOTO Lancer
RETURN
' ==============================================================================
Quitter:
TERMINATE
' ==============================================================================
SUB Html2Txt(f$,ft$)
' conversion approximative fichier html f$ en fichier texte brut dans ft$
DIM_LOCAL a$,s$,ba$,cr$,k%,k1%,ns%,csp$(20),crm$(20)
cr$ = CHR$(13)+CHR$(10): ' saut de ligne
DATA "Carspe": ' caractères spéciaux, à remplacer (à compléter éventuellement)
DATA " ","<",">","&",""","»","F": ' caractère à remplacer
DATA " ","<",">","&",CHR$(34),CHR$(13)+CHR$(10)+CHR$(187): ' caractère(s) de remplacement
ns% = 0: RESTORE: READ a$: WHILE a$<>"Carspe": READ a$: END_WHILE: READ a$
WHILE a$<>"F": ns%=ns%+1: csp$(ns%) = a$: READ a$: END_WHILE
FOR k% = 1 TO ns%: READ a$: crm$(k%) = a$: NEXT k%
' lecture intégrale du fichier htm dans la variable a$
FILEBIN_OPEN_READ 9,f$: k% = FILEBIN_SIZE(9): FILEBIN_CLOSE 9
FILE_OPEN_READ 9,f$: FILE_READBUF 9,a$,k%: FILE_CLOSE 9
k% = INSTR(a$,"</head>"): IF k%=0 THEN message "Pas de balise </head>": EXIT_SUB
a$ = MID$(a$,k%+7,LEN(a$))
' suppression des balises <script...>...</script> et <style...>...</style> et de
' leur contenu
k% = INSTR(a$,"<script")
WHILE k%>0
k1% =INSTR(a$,"</script>"): a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+9,LEN(a$))
k% = INSTR(a$,"<script")
END_WHILE
k% = INSTR(a$,"<style")
WHILE k%>0
k1% =INSTR(a$,"</style>"): a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+8,LEN(a$))
k% = INSTR(a$,"<style")
END_WHILE
' remplacement des balises </tr> par des sauts de ligne
k% = INSTR(a$,"</tr>")
WHILE k%>0: a$=LEFT$(a$,k%-1)+cr$+MID$(a$,k%+5,LEN(a$)): k%=INSTR(a$,"</tr>"): END_WHILE
' suppression de toutes les balises (on garde les sauts de lignes, pour lisibilité)
k% = INSTR(a$,"<")
WHILE k% > 0
k1% = INSTR_POS(a$,">",k%): ba$ = MID$(a$,k%,k1%-k%+1): ' balise trouvée
IF LEFT$(ba$,3) = "<br": ' saut de ligne
a$ = LEFT$(a$,k%-1)+CHR$(13)+CHR$(10)+MID$(a$,k1%+1,LEN(a$))
ELSE
a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+1,LEN(a$)): ' suppression
END_IF
k% = INSTR(a$,"<")
END_WHILE
' remplacement des caractères spéciaux
FOR k% = 1 TO ns%
s$ = csp$(k%): k1% = INSTR(a$,s$)
WHILE k1%>0
a$ = LEFT$(a$,k1%-1)+crm$(k%)+MID$(a$,k1%+LEN(s$),LEN(a$))
k1% = INSTR(a$,s$)
END_WHILE
NEXT k%
' suppression des rc/al redondants
k% = INSTR(a$,CHR$(13)+CHR$(10)+CHR$(13)+CHR$(10))
WHILE k%>0
a$ = LEFT$(a$,k%-1)+MID$(a$,k%+2,LEN(a$))
k% = INSTR(a$,CHR$(13)+CHR$(10)+CHR$(13)+CHR$(10))
END_WHILE
FILE_OPEN_WRITE 9,ft$: FILE_WRITELN 9,a$: FILE_CLOSE 9
END_SUB
' ==============================================================================

Il y a plusieurs moyens d'arrêter le programme pendant sa période de veille, le plus simple étant peut-être de déposer un message sur le forum, et d'attendre son prochain réveil ! Very Happy

Il est peut-être prudent d’utiliser la commande PAUSE N au lieu de WAIT N.

Ces deux commandes arrêtent l’exécution du programme pendant N millisecondes, mais avec une différence qu’on doit prendre en considération.
En effet la première commande PAUSE N arrête le programme mais les événements en attente sont exécutés ; tandis que la seconde commande WAIT N arrête tout : et le programme en cours et les événements en attente.

A part cette remarque qui vaut ce qu'elle vaut (une broutille et encore !), bravo pour ce code.

J’ai analysé le code de près pour essayer de le reformuler à ma manière (utilisation exclusive des SUBs, pas des sous-programmes avec GOSUB / RETURN).
J’ai un faible pour les SUBs I love you

tandis que les GOSUBs ça ne m’emballe pas !
J’ai remarqué la présence (lignes 204 à 206) du sous-programme

Code:: Poursuivre:
GOTO Lancer
RETURN

Qui n’est jamais appelé par qui que ce soit (peut-être un vestige de la mise au point du programme).
Je l’ai donc viré.

Je vous livre ma cuisine (plutôt ma version) dans laquelle j’ai suivi à la lettre (et non à la virgule !) la construction du code de JL35.

Code:: REM ============================================================================
REM Surveillance du forum Panoramic
REM AUTEUR : JL35
rem Reformulé par : papydall
REM ============================================================================
Init()
Make_Script()
GUI()
end
rem ============================================================================
SUB Init()
   LABEL clic
   DIM url$,frec$,rect$,fref$,recf$,f$,a$,b$,i%,k%,m%,cat$,suj$,mes$,der$,aut$,gui$
   DIM Titref$(20),Datref$(20),Titact$(20),Datact$(20),nref%,nact%,tr%,nl%,wf%,hf%,n%
   DIM lf%,tp%,srv%,df%,fscr$

   url$ = "http://panoramic.1fr1.net/"
   frec$ = "C:\TEMP\Forum.htm"
   rect$ = "C:\TEMP\Forum.txt"
   fref$ = "C:\TEMP\Forum_ref.htm"
   recf$ = "C:\TEMP\Forum_ref.txt"

   fscr$ = "C:\Temp\Scrdnl.vbs": ' script vbs
   gui$ = CHR$(34)
END_SUB
REM ============================================================================
' Script vbs de lecture de la page web url$ dans un fichier html (frec$)
DATA "Debscr"
DATA "HTTPDownload "+gui$+url$+gui$+", "+gui$+frec$+gui$
DATA "Sub HTTPDownload( URL, Path )"
DATA "Dim i, objFile, objFSO, objHTTP, strFile, strMsg"
DATA "Const ForReading = 1, ForWriting = 2, ForAppending = 8"
DATA "Set objFSO = CreateObject( "+gui$+"Scripting.FileSystemObject"+gui$+" )"
DATA "strFile = Path"
DATA "Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )"
DATA "Set objHTTP = CreateObject( "+gui$+"WinHttp.WinHttpRequest.5.1"+gui$+" )"
DATA "objHTTP.Open "+gui$+"GET"+gui$+", URL, False"
DATA "objHTTP.Send"
DATA "For i = 1 To LenB( objHTTP.ResponseBody )"
DATA " objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )"
DATA "Next"
DATA "objFile.Close( )"
DATA "End Sub"
DATA "Finscr"
REM ============================================================================
SUB Make_Script()
   RESTORE: READ a$: WHILE a$ <> "Debscr": READ a$: END_WHILE
   FILE_OPEN_WRITE 9, fscr$
   READ a$: WHILE a$ <> "Finscr": FILE_WRITELN 9, a$: READ a$: END_WHILE
   FILE_CLOSE 9
END_SUB
REM ============================================================================
SUB GUI()
   WIDTH 0,637: HEIGHT 0,430: BORDER_SMALL 0: COLOR 0,190,255,255
   font_name 0,"Arial": font_bold 0: font_color 0,0,0,255
   CAPTION 0," - SURVEILLANCE DU FORUM PANORAMIC -"

   MEMO 5: HIDE 5: WIDTH 5,400: HEIGHT 5,300: ' memo de manoeuvre
   ALPHA 11: TOP 11,5: LEFT 11,100: CAPTION 11," PRÉCÉDENT ": COLOR 11,255,255,0
   ALPHA 12: TOP 12,5: LEFT 12,400: CAPTION 12," ACTUEL ": COLOR 12,255,255,0
   BUTTON 15: TOP 15,0: LEFT 15,520: WIDTH 15,100: CAPTION 15,"Se connecter"
   ON_CLICK 15,clic : ' Connect
   ALPHA 100: TOP 100,HEIGHT(0)-60

   CAPTION 100,"Lancer la surveillance périodique, délai: minutes"
   SPIN 101: TOP 101,TOP(100)-3: LEFT 101,225: WIDTH 101,40
   POSITION 101,10
   BUTTON 102: TOP 102,TOP(101): LEFT 102,LEFT(101)+90: WIDTH 102,140
   CAPTION 102,"Lancer ou relancer"
   ON_CLICK 102,clic : ' Lancer
   BUTTON 104: TOP 104,TOP(102): LEFT 104,LEFT(102)+220: CAPTION 104,"Quitter"
   ON_CLICK 104,clic : ' Quitter

   Surveil()
   srv% = 0
END_SUB
REM ============================================================================
clic:
   select number_click
   case 15 : Connect()
   case 102 : Lancer()
   case 104 : Quitter()
   end_select
RETURN
REM ============================================================================
SUB Surveil()
   IF FILE_EXISTS(recf$) = 0
   EXECUTE_WAIT "WSCRIPT.exe " + fscr$: ' capture de la page, -> frec$ (htm)
   IF FILE_EXISTS(fref$) = 1 THEN FILE_DELETE fref$
   FILE_COPY frec$,fref$: ' fichier référence
   Html2Txt(fref$,recf$): ' conversion htm -> texte pur
   FILE_DELETE fref$
   f$ = recf$: Transfert()
   m% = 2: nref% = nact%: IF srv% = 0 THEN Crelist()
   FOR i% = 60 TO 60+nact%: CLEAR i%: NEXT i%
   FILE_OPEN_WRITE 1,recf$
   ITEM_ADD 20, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
   FILE_WRITELN 1, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
   FOR i% = 1 TO nact%
   ITEM_ADD 20+i%,Titact$(i%): FILE_WRITELN 1,Titact$(i%)
   ITEM_ADD 20+i%,Datact$(i%): FILE_WRITELN 1,Datact$(i%)
   NEXT i%
   FILE_CLOSE 1
   MESSAGE "Référence créée !"
   ELSE
   FILE_OPEN_READ 1,recf$
   FILE_READLN 1,b$: ' date/heure
   nref% = 0
   WHILE FILE_EOF(1) = 0
   FILE_READLN 1, a$
   IF LEFT$(a$,1) = CHR$(187)
   nref% = nref%+1: Titref$(nref%) = a$
   ELSE
   Datref$(nref%) = a$
   END_IF
   END_WHILE
   FILE_CLOSE 1
   m% = 1: IF srv% = 0 THEN Crelist()
   FOR i% = 20 TO 20+nref%: CLEAR i%: NEXT i%
   ITEM_ADD 20,b$: ' date/heure de la référence
   FOR i% = 1 TO nref%
   ITEM_ADD 20+i%,Titref$(i%): ITEM_ADD 20+i%,Datref$(i%)
   NEXT i%
   ' téléchargement de l'état actuel:
   EXECUTE_WAIT "WSCRIPT.exe " + fscr$: ' capture de la page actuelle -> frec$
   Html2Txt(frec$,rect$): ' conversion htm -> texte pur
   FILE_DELETE frec$
   f$ = rect$: Transfert()
   FILE_DELETE rect$
   m% = 2: IF srv% = 0 THEN Crelist()
   FOR i% = 60 TO 60+nact%: CLEAR i%: NEXT i%
   FILE_OPEN_WRITE 1,recf$: ' devient la nouvelle référence
   ITEM_ADD 60, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
   FILE_WRITELN 1, " ********** "+DATE$+" à " +LEFT$(TIME$,5)+" **********"
   FOR i% = 1 TO nact%
   ITEM_ADD 60+i%,Titact$(i%): FILE_WRITELN 1,Titact$(i%)
   ITEM_ADD 60+i%,Datact$(i%): FILE_WRITELN 1,Datact$(i%)
   NEXT i%
   FILE_CLOSE 1
   ' comparaison de l'état actuel avec le précédent
   Compare()
   END_IF
END_SUB
REM ============================================================================
' nettoyage du fichier texte, transfert dans les tables
SUB Transfert()
   FILE_OPEN_READ 1,f$
   nact% = 0
   WHILE FILE_EOF(1) = 0
   FILE_READLN 1, a$: a$ = TRIM$(a$)
   IF a$ <> ""
   IF INSTR(a$,"Derniers sujets") > 0
   FILE_READLN 1, a$: a$ = TRIM$(a$)
   WHILE INSTR(a$,"Navigation") = 0
   k% = INSTR(a$,CHR$(187))
   IF k% > 0: ' caractère >>
   a$ = MID$(a$,k%,LEN(a$))
   nact% = nact%+1
   Titact$(nact%) = a$
   FILE_READLN 1,a$
   Datact$(nact%) = a$
   END_IF
   FILE_READLN 1,a$: WHILE TRIM$(a$)="": FILE_READLN 1,a$: END_WHILE
   END_WHILE
   END_IF
   END_IF
   END_WHILE
   FILE_CLOSE 1
END_SUB
REM ===========================================================================
SUB Crelist()
   wf% = 310: hf% = 35
   IF m% = 1
   nl% = 20: lf% = 0: n% = nref%
   ELSE
   nl% = 60: lf% = wf%: n% = nact%
   END_IF
   LIST nl%: TOP nl%, 20: LEFT nl%,lf%: WIDTH nl%,wf%: HEIGHT nl%,20
   COLOR nl%,180,255,180: FONT_SIZE nl%,10: FONT_COLOR nl%,0,0,0
   tp% = 40
   FOR i% = 1 TO n%
   k% = nl%+i%
   LIST k%: TOP k%,tp%: LEFT k%,lf%: WIDTH k%,wf%: HEIGHT k%,hf%
   tp% = tp% + hf%
   NEXT i%
   i% = tp%+40: IF i%>HEIGHT(0) THEN HEIGHT 0,i%: ' ajuste fenêtre principale
END_SUB
REM ============================================================================
SUB Compare()
   df% = 0
   FOR i% = 1 TO nact%
   a$ = Titact$(i%): b$ = Datact$(i%): tr% = 0
   FOR k% = 1 TO nref%
   IF a$ = Titref$(k%)
   tr% = 1
   IF b$ <> Datref$(k%): ' sujet existant, nouveau message
   COLOR 60+i%,255,255,0
   df% = 1
   END_IF
   END_IF
   NEXT k%
   IF tr% = 0: ' nouveau sujet
   COLOR 60+i%,255,255,0: ' en jaune
   df% = 1
   END_IF
   NEXT i%
END_SUB
REM ============================================================================
SUB Connect()
   EXECUTE url$
   pause 2000
   TERMINATE
END_SUB
REM ============================================================================
SUB Lancer()
   HIDE 0
   srv% = 1
   WHILE srv% = 1
   i% = 60000*POSITION(101): ' délai, en ms
   k% = i%/30000
   FOR i% = 1 TO k%
   pause 30000 : ' maximum autorisé
   NEXT i%
   Surveil()
   IF df% = 1 THEN SHOW 0: srv% = 0: EXIT_WHILE
   END_WHILE
END_SUB
REM ============================================================================
SUB Quitter()
   TERMINATE
END_SUB
REM ============================================================================
SUB Html2Txt(f$,ft$)
' conversion approximative fichier html f$ en fichier texte brut dans ft$
   DIM_LOCAL a$,s$,ba$,cr$,k%,k1%,ns%,csp$(20),crm$(20)
   cr$ = CHR$(13)+CHR$(10): ' saut de ligne
   DATA "Carspe": ' caractères spéciaux, à remplacer (à compléter éventuellement)
   DATA " ","<",">","&",""","»","F": ' caractère à remplacer
   DATA " ","<",">","&",CHR$(34),CHR$(13)+CHR$(10)+CHR$(187): ' caractère(s) de remplacement
   ns% = 0: RESTORE: READ a$: WHILE a$<>"Carspe": READ a$: END_WHILE: READ a$
   WHILE a$<>"F": ns%=ns%+1: csp$(ns%) = a$: READ a$: END_WHILE
   FOR k% = 1 TO ns%: READ a$: crm$(k%) = a$: NEXT k%
' lecture intégrale du fichier htm dans la variable a$
   FILEBIN_OPEN_READ 9,f$: k% = FILEBIN_SIZE(9): FILEBIN_CLOSE 9
   FILE_OPEN_READ 9,f$: FILE_READBUF 9,a$,k%: FILE_CLOSE 9
   k% = INSTR(a$,"</head>"): IF k%=0 THEN message "Pas de balise </head>": EXIT_SUB
   a$ = MID$(a$,k%+7,LEN(a$))
' suppression des balises <script...>...</script> et <style...>...</style> et de
' leur contenu
   k% = INSTR(a$,"<script")
   WHILE k%>0
   k1% =INSTR(a$,"</script>"): a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+9,LEN(a$))
   k% = INSTR(a$,"<script")
   END_WHILE
   k% = INSTR(a$,"<style")
   WHILE k%>0
   k1% =INSTR(a$,"</style>"): a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+8,LEN(a$))
   k% = INSTR(a$,"<style")
   END_WHILE
' remplacement des balises </tr> par des sauts de ligne
   k% = INSTR(a$,"</tr>")
   WHILE k%>0: a$=LEFT$(a$,k%-1)+cr$+MID$(a$,k%+5,LEN(a$)): k%=INSTR(a$,"</tr>"): END_WHILE
' suppression de toutes les balises (on garde les sauts de lignes, pour lisibilité)
   k% = INSTR(a$,"<")
   WHILE k% > 0
   k1% = INSTR_POS(a$,">",k%): ba$ = MID$(a$,k%,k1%-k%+1): ' balise trouvée
   IF LEFT$(ba$,3) = "<br": ' saut de ligne
   a$ = LEFT$(a$,k%-1)+CHR$(13)+CHR$(10)+MID$(a$,k1%+1,LEN(a$))
   ELSE
   a$ = LEFT$(a$,k%-1)+MID$(a$,k1%+1,LEN(a$)): ' suppression
   END_IF
   k% = INSTR(a$,"<")
   END_WHILE
' remplacement des caractères spéciaux
   FOR k% = 1 TO ns%
   s$ = csp$(k%): k1% = INSTR(a$,s$)
   WHILE k1%>0
   a$ = LEFT$(a$,k1%-1)+crm$(k%)+MID$(a$,k1%+LEN(s$),LEN(a$))
   k1% = INSTR(a$,s$)
   END_WHILE
   NEXT k%
' suppression des rc/al redondants
   k% = INSTR(a$,CHR$(13)+CHR$(10)+CHR$(13)+CHR$(10))
   WHILE k%>0
   a$ = LEFT$(a$,k%-1)+MID$(a$,k%+2,LEN(a$))
   k% = INSTR(a$,CHR$(13)+CHR$(10)+CHR$(13)+CHR$(10))
   END_WHILE
   FILE_OPEN_WRITE 9,ft$: FILE_WRITELN 9,a$: FILE_CLOSE 9
END_SUB
' ==============================================================================

Programme édité pour corriger un bug signalé par Ygeronimi

Message d' erreur sur la ligne 242 :

J'ai édité le programme : bug corrigé.

Essaie à nouveau stp.

Je testerais ça ce week end. Sympa l'idée.

@Ygeronimi
Tu as peut-être relancé le programme alors qu’il est en cours d’exécution (choix : Lancer ou relancer)

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Merci papydall pour les améliorations, j'adopte sans réserves.
Effectivement, l'appel au s/p que tu as viré était un vestige de la version d'essai précédente, dont acte.

Mais,
J'ai la même erreur que ygeronimi, ligne 241 (dans les datas précédents ligne 238 après &amp il y a 3 guillemets successifs), mais une fois corrigé il ne se passe plus rien après l'affichage de gauche... (on ne sort pas de la sub Html2Txt)
La ligne 238 devrait être celle-ci:

Code:: DATA " ","<",">","&",""","»","F": ' caractère à remplacer

mais après il y a un autre problème...

On peut lancer et relancer le programme autant de fois que l’on veut et ça marchera à condition d’en sortir par le bouton Quitter.
Si on a choisi Lancer ou relancer, le programme continue de tourner(mais sa fenêtre est invisible) jusqu’à ce qu’ un autre message soit posté sur le Forum.
Si on lance, pendant ce temps une autre instance du programme, on obtiendra un message d’erreur.
L’idéal est de trouver une autre façon de quitter le programme autrement que par poster un message.

» Bug du forum
» anniversaire du forum
» Présence forum
» Le Forum est en vacances.
» La vie du forum