Просмотров: 1362 | Дата: 19.04.2024 | Коментарии (0)

Следим за форумом






Утилита следящая за форумом: http://purebasic.info/

Продолжение темы, начатой kvitaliy

1. Программа показывает имена пользователей
2. Выводит общее число сообщений
3. Показывает число новых сообщений до обновления
4. Издает звуковой сигнал при входе/выходе на форум
5. Звуковой сигнал при новом сообщении

Двойной левый клик мыши - зайти на сайт (меняется цвет иконки в трее и обнуление)
Правый клик мыши - обнуление

Обращение к форуму идет по таймеру и в потоке, чтоб не тормозило окно...
Следить за конкретным пользователем - цели не было, сделал - пищит при каждом изменении списка.
И звук при новом сообщении... ( WAV файл не смог проиграть в потоке?)
Вот, что получилось :

Code
Enumeration  
  #Window_0
  #update
  #List
  #Text
  #SOUND
  #tamer  
EndEnumeration
Global sms=0
InitSound()

Procedure.s Between_2(string.s, L.s, R.s) ; работает с unicode (получаем текст между L и R)
  Position = FindString(string, L.s, 1)
  string2.s = Right(string, Len(string)+1-Position-Len(L.s))
  Position2 = FindString(string2, R.s, 1)
  string3.s = Left(string2, Position2-1)
  If Position <> 0
  ProcedureReturn string3.s
  EndIf  
EndProcedure

Procedure URLDownload(*x)
Static c, Mes.s
URL.s="http://purebasic.info/phpBB2/" ; адрес форума
URLDownloadToFile_(0, URL, GetTemporaryDirectory()+"Temp.htm",0,0) ; сохраняем на диск файл Temp.htm
If ReadFile(0, GetTemporaryDirectory()+"Temp.htm") ; чтение файла
ClearGadgetItems(#List) ; очищаем список
  While Eof(0) = 0 ; пока не прочли весь файл
  string.s= ReadString(0) ; строка
  ;-------------------------------------------------  
  rez=FindString(string, "Наши пользователи оставили сообщений:", 1) ; находим строку и узнаём позицию по сообщениях
  If rez <> 0  
  Message.s=Between_2(string, "<b>", "</b>") ; колличество сообщений
  SetGadgetText(#Text,"Всего сообщений: "+Message) ; меняем текст
  If Mes.s<>"" ; первый запуск
  If Mes.s<> Message.s
  sms=1
  ;Debug "Новое сообщение"  
  EndIf
  EndIf
  Mes.s= Message.s
  EndIf
  ;-------------------------------------------------  
  rez=FindString(string, "Зарегистрированные пользователи:", 1) ; находим строку и узнаём позицию
  If rez <> 0 ; если нашли
  string=Between_2(string.s, "Зарегистрированные пользователи:", "</span></td>")+"," ; отсекаем не нужное
  string = RemoveString(string,"</a>") ; из строки удаляем тег
  string = RemoveString(string,"</b>") ; из строки удаляем тег
  string = RemoveString(string,"<b>") ; из строки удаляем тег
  rez2=CountString(string, ">") ; колличество пользователей
  For a=0 To rez2 ; цикл, можно c 0, но не будет "Нет"
  delet.s=Between_2(string.s, "<", ">") ; находич что удалить
  string = RemoveString(string,"<"+delet+">") ; удаляем  
  rez=FindString(string, ",", 1) ; находим длину имени первого пользователя
  name.s= Left(string,rez-1) ; имя первого пользователя
  AddGadgetItem(#List,-1, name ) ; делаем список
  b=b+1
  string = RemoveString(string, name+",") ; удалям имя перв. пользов. из строки
  Next ; повтор
  If c<b
  Beep_ (980,1000) ; вход
  ElseIf c>b  
  Beep_ (400,1000) ; выход
  EndIf
  c = b  
  Break ; остонавливаем цикл
  EndIf
  Wend
  CloseFile(0)
EndIf
SetGadgetText(#update, "Обновлено в : " + FormatDate("%hh:%ii:%ss", Date()))
EndProcedure

Procedure User()
CreateThread(@URLDownload(), 0)
EndProcedure
   
OpenWindow (#Window_0, 0, 0, 200, 350, "следим за форумом", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)  
  StickyWindow(#Window_0, 1)
  TextGadget(#update, 5, 5, WindowWidth(#Window_0) - 10, 20, "", #PB_Text_Center)
  TextGadget(#Text,5,WindowHeight(#Window_0)-25,190,17,"Всего сообщений:")
  ListViewGadget(#List, 5, 25, WindowWidth(#Window_0) - 10, WindowHeight(#Window_0) - 60)
  AddWindowTimer(#Window_0, #tamer, 5000)
  User()

Repeat
Event = WaitWindowEvent()  
  If sms=1
  CatchSound(#SOUND, ?SoundFile)
  PlaySound(#SOUND)
  sms=0
  EndIf
  Select Event
  Case #PB_Event_Timer ; запускаем процедуру по таймеру и в потоке
  User()
  EndSelect
If Event = #PB_Event_CloseWindow
Break  
EndIf
ForEver
   
DataSection
  SoundFile:
  IncludeBinary "sms.wav"
EndDataSection


Скачать архив











Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.