Выполнение кода в зависимости от ответа

@werblive · Регистрация: 19.10.2018

Студворк — интернет-сервис помощи студентам

Здравствуйте уважаемые знатоки

С пуребейсик не особо, поэтому прошу помощи в реализации следующего
первое это то, что нужно из нескольких хостов получить результат, тоесть сайтов может быть 3-5-10 и так далее, нашел скрипт

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
InitNetwork() 
 
 Procedure ping(in_ip.s) 
   Protected *host.hostent, ret.l 
   host.s = in_ip 
   *host = gethostbyname_(host) 
   If *host 
     ret = PeekL(PeekL(*host\h_addr_list)) 
   Else 
     ret = *host 
   EndIf 
   sel_ip = ret  
   ResultSize.l = SizeOf(ICMP_ECHO_REPLY) + 255 
   *Result = AllocateMemory(ResultSize) 
   
         hFile.l = IcmpCreateFile_() 
        lngResult.l = IcmpSendEcho_(hFile, sel_ip, Space(255), 255, 0, *Result, ResultSize, 2000) 
        If lngResult 
           ProcedureReturn #True 
        Else 
           ProcedureReturn #False 
        EndIf 
   
       IcmpCloseHandle_(hFile) 
    FreeMemory(*Result) 
 
 EndProcedure 
 
 If ping ("cyberforum.ru") 
  Debug " online" 
  Else 
  Debug "site offline" 
 EndIf

что мне нужно - необходимо имея зарание известный список сайтов например site.com, site.com1, site2.com etc проверить доступность первого - если он доступен, остальные нет смысла проверять, необходимо выполнить команду

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
Global ReturnString$
  
  ProcedureDLL.s MyFunction(var.s)
Define oWScript = dhCreateObject("WScript.Shell")
 
dhToggleExceptions(#True)
 
If oWScript
  dhCallMethod(oWScript, "Run(%s)", @"C:\game\update-wot.exe")
  Delay(100)
  dhReleaseObject(oWScript)
EndIf
  EndProcedure

если еще можно как то зарание получить список сайтов из сети к примеру по ссылке http://update.reserveserver.ru/url.txt и оттуда брать этот список, было бы очень даже

@Pro_grammer · 19.10.2018, 11:01

Сообщение от werblive

имея зарание известный список сайтов например site.com, site.com1, site2.com etc проверить доступность первого - если он доступен, остальные нет смысла проверять, необходимо выполнить команду

Можно так сделать

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
InitNetwork()
 
Procedure PingSiteOk(site.s)
   If OpenNetworkConnection(site, 80) ; Проверяем соединение
   ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
 
; Список сайтов
Dim ListSites.s(5)
 
ListSites(0) = "sitegfd2.com"
ListSites(1) = "sitegfg1.com"
ListSites(2) = "google.com"
ListSites(3) = "sitefsgf3.com"
ListSites(4) = "www.yandex.ru"
ListSites(5) = "sitegvf4.com"
 
For i = 0 To 5
      If PingSiteOk(ListSites(i)) = 1
             MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
        Break
      EndIf
Next
 
  End

Сообщение от werblive

получить список сайтов из сети к примеру по ссылке http://update.reserveserver.ru/url.txt

Скачать файл по ссылке

PureBasic
1
2
3
4
5
6
7
8
9
InitNetwork()
 
  Filename$ = SaveFileRequester("Where to save index.php ?", "", "", 0)
 
  If ReceiveHTTPFile("http://www.purebasic.com/index.php", Filename$)
    Debug "Success"
  Else
    Debug "Failed"
  EndIf

Или сразу в память

PureBasic
1
2
3
4
5
6
7
8
9
10
InitNetwork()
 
  *Buffer = ReceiveHTTPMemory("http://www.purebasic.com/index.php")
  If *Buffer
    Size = MemorySize(*Buffer)
    Debug "Content: " + PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)
    FreeMemory(*Buffer)
  Else
    Debug "Failed"
  EndIf

@werblive · 19.10.2018, 11:21 **[ТС]**

Pro_grammer, спасибо, именно то что нужно, но вот не разобрался с этим

Сообщение от Pro_grammer

Или сразу в память

как в таком случае мне передать суда список сайтов для пинга

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
InitNetwork()
 
Procedure PingSiteOk(site.s)
   If OpenNetworkConnection(site, 80) ; Проверяем соединение
   ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
 
; Список сайтов
Dim ListSites.s(5)
 
ListSites(0) = "sitegfd2.com"
ListSites(1) = "sitegfg1.com"
ListSites(2) = "google.com"
ListSites(3) = "sitefsgf3.com"
ListSites(4) = "www.yandex.ru"
ListSites(5) = "sitegvf4.com"
 
For i = 0 To 5
      If PingSiteOk(ListSites(i)) = 1
             MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
        Break
      EndIf
Next
 
  End

@Pro_grammer · 19.10.2018, 12:06

Сообщение от werblive

как в таком случае мне передать суда список сайтов

Надо посмотреть на формат файла, в котором список. Выкладывайте тут его.

@werblive · 19.10.2018, 12:27 **[ТС]**

Сообщение от Pro_grammer

Надо посмотреть на формат файла, в котором список. Выкладывайте тут его.

Code
1
2
3
4
5
cat url.dat
 
site.ru
site2.ru
google.com

@locm · 19.10.2018, 13:02

Сообщение от werblive

PureBasic
1
2
3
4
5
6
7
Procedure PingSiteOk(site.s)
  If OpenNetworkConnection(site, 80) ; Проверяем соединение
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Если сайт доступен, нужно закрыть соединение.

PureBasic
1
2
3
4
5
6
7
8
9
Procedure PingSiteOk(site.s)
   Protected Connect = OpenNetworkConnection(site, 80) ; Проверяем соединение
   If Connect
     CloseNetworkConnection(Connect)
     ProcedureReturn 1
  Else
     ProcedureReturn 0
  EndIf
EndProcedure

Сообщение от werblive

PureBasic
1
2
3
4
5
6
7
8
9
ProcedureDLL.s MyFunction(var.s)
Define oWScript = dhCreateObject("WScript.Shell")
dhToggleExceptions(#True)
If oWScript
  dhCallMethod(oWScript, "Run(%s)", @"C:\game\update-wot.exe")
  Delay(100)
  dhReleaseObject(oWScript)
EndIf
  EndProcedure

Это для запуска программы? Проще использовать RunProgram. https://www.purebasic.com/docu... ogram.html

@Pro_grammer · 19.10.2018, 13:39

Сообщение от werblive

site.ru site2.ru google.com

Это мало что проясняет. Цель была посмотреть кодировку и разделитель между названиями сайтов.
Разделитель строк может различаться в зависимости от системы.
Тогда так. При помощи StringField разделяете строку, которая будет в PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength) на отдельные названия и можете сразу их по мере разделения скармливать процедуре, а можете вначале в массив загнать, а потом в процедуру. И не забывайте про формат, UTF8 или что?

@werblive · 19.10.2018, 21:34 **[ТС]**

Сообщение от Pro_grammer

Это мало что проясняет. Цель была посмотреть кодировку и разделитель между названиями сайтов.

UTF8

Code
1
2
1 сайт </br>
2 сайт </br>

или можно даже так

Code
1
site.ru|site1.ru|site2.ru|site3.ru

@locm · 20.10.2018, 12:17

PureBasic
1
2
3
4
5
6
7
8
9
10
SiteList.s="site.ru|site1.ru|site2.ru|site3.ru"
 
Count = CountString(SiteList, "|")+1
For i = 1 To Count
  Site.s=StringField(SiteList, i, "|")
  If PingSiteOk(Site) = 1
    MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
    Break
  EndIf
Next

@werblive · 21.10.2018, 08:08 **[ТС]**

Сообщение от locm

PureBasic
1
2
3
4
5
6
7
8
9
10
SiteList.s="site.ru|site1.ru|site2.ru|site3.ru"
 
Count = CountString(SiteList, "|")+1
For i = 1 To Count
  Site.s=StringField(SiteList, i, "|")
  If PingSiteOk(Site) = 1
    MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
    Break
  EndIf
Next

С помощью кода

PureBasic
1
2
3
4
5
6
7
8
9
10
InitNetwork()
 
  *Buffer = ReceiveHTTPMemory("https://localhost/url.dat")
  If *Buffer
    Size = MemorySize(*Buffer)
    Debug "Content: " + PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)
    FreeMemory(*Buffer)
  Else
    Debug "Failed"
  EndIf

Дальше

PureBasic
1
 f$ = PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)

и пробую ваш код

PureBasic
1
2
3
4
5
6
7
8
9
10
 f$ = PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)
 SiteList.s=filter$
  Count = CountString(SiteList, "|")+1
For i = 1 To Count
  Site.s=StringField(SiteList, i, "|")
  If PingSiteOk(Site) = 1
    MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
    Break
  EndIf
Next

ругается на то, что

PureBasic
1
 If PingSiteOk(Site) = 1

не является функцией, макросом и т.д
полный код который пробую

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
InitNetwork()
 
  *Buffer = ReceiveHTTPMemory("https://localhost.ru/url.dat")
  If *Buffer
    Size = MemorySize(*Buffer)
    Debug "Content: " + PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)
    FreeMemory(*Buffer)
  Else
    Debug "Failed"
  EndIf
  
  InitNetwork() 
 
 Procedure ping(in_ip.s) 
   Protected *host.hostent, ret.l 
   host.s = in_ip 
   *host = gethostbyname_(host) 
   If *host 
     ret = PeekL(PeekL(*host\h_addr_list)) 
   Else 
     ret = *host 
   EndIf 
   sel_ip = ret  
   ResultSize.l = SizeOf(ICMP_ECHO_REPLY) + 255 
   *Result = AllocateMemory(ResultSize) 
   
         hFile.l = IcmpCreateFile_() 
        lngResult.l = IcmpSendEcho_(hFile, sel_ip, Space(255), 255, 0, *Result, ResultSize, 2000) 
        If lngResult 
           ProcedureReturn #True 
        Else 
           ProcedureReturn #False 
        EndIf 
   
       IcmpCloseHandle_(hFile) 
    FreeMemory(*Result) 
 
 EndProcedure 
 
 f$ = PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)
 SiteList.s=f$
  Count = CountString(SiteList, "|")+1
For i = 1 To Count
  Site.s=StringField(SiteList, i, "|")
  If PingSiteOk(Site) = 1
    MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
    Break
  EndIf
Next

Содержимое url.dat

Code
1
site.ru|site1.ru|site2.ru|site3.ru

@locm · 21.10.2018, 13:40

Сообщение от werblive

f$ = PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)
SiteList.s=filter$

Откуда взялась переменная filter$?

PingSiteOk есть выше в теме.

PureBasic
1
2
3
4
5
6
7
8
9
Procedure PingSiteOk(site.s)
   Protected Connect = OpenNetworkConnection(site, 80) ; Проверяем соединение
   If Connect
     CloseNetworkConnection(Connect)
     ProcedureReturn 1
  Else
     ProcedureReturn 0
  EndIf
EndProcedure

@werblive · 22.10.2018, 08:21 **[ТС]**

Сообщение от locm

Откуда взялась переменная filter$?

это я с другого соурса видимо, скопипастил=)
locm, даже так выдает ошибку что SiteList не является функцией, массивом или макросом

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
InitNetwork()
 
Procedure PingSiteOk(site.s)
   Protected Connect = OpenNetworkConnection(site, 80) ; Проверяем соединение
   If Connect
     CloseNetworkConnection(Connect)
     ProcedureReturn 1
  Else
     ProcedureReturn 0
  EndIf
EndProcedure
 
; Список сайтов
SiteList.s="site.ru|site1.ru|site2.ru|site3.ru"
 
Count = CountString(SiteList, "|")+1
For i = 1 To Count
  Site.s=StringField(SiteList, i, "|")
  If PingSiteOk(Site) = 1
    MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
    Break
  EndIf
Next

а вот так все ок

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
InitNetwork()
 
Procedure PingSiteOk(site.s)
   Protected Connect = OpenNetworkConnection(site, 80) ; Проверяем соединение
   If Connect
     CloseNetworkConnection(Connect)
     ProcedureReturn 1
  Else
     ProcedureReturn 0
  EndIf
EndProcedure
 
; Список сайтов
Dim ListSites.s(5)
 
ListSites(0) = "sitegfd2.com"
ListSites(1) = "sitegfg1.com"
ListSites(2) = "google.com"
ListSites(3) = "sitefsgf3.com"
ListSites(4) = "www.yandex.ru"
ListSites(5) = "sitegvf4.com"
 
For i = 0 To 5
      If PingSiteOk(ListSites(i)) = 1
             MessageRequester("Ok","Сайт " + ListSites(i) + " доступен!") ; Ваше действие с сайтом
        Break
      EndIf
Next
 
  End

@Pro_grammer · 22.10.2018, 10:46

Сообщение от werblive

выдает ошибку что SiteList не является функцией, массивом или макросом

Да вы путаете!
Там написано, что ListSites не является функцией, массивом или макросом. И это правильно.
У вас ListSites(i) не определён, да и не нужен в этом коде.
Там должно быть Site

Новые блоги и статьи Все статьи Все блоги /
модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .	Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .	Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ
Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики. Hrethgir 07.04.2026 Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .	Горе от ума kumehtar 07.04.2026 Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .	Использование значений реквизитов справочника в документе, с определенными условиями и правами Maks 07.04.2026 1. Контроль срока действия договора Алгоритм из решения ниже реализован на примере нетипового документа "ЗаявкаНаРаботу", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если. . .	Доступность команды формы по условию Maks 07.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: сделать доступной кнопку (команда формы "ЗавершитьСписание") при. . .