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

@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

Новые блоги и статьи Все статьи Все блоги /
Воспроизведение звукового файла с помощью SDL3_mixer при касании экрана Android 8Observer8 26.01.2026 Содержание блога SDL3_mixer - это библиотека я для воспроизведения аудио. В отличие от инструкции по добавлению текста код по проигрыванию звука уже содержится в шаблоне примера. Нужно только. . .	Установка Android SDK, NDK, JDK, CMake и т.д. 8Observer8 25.01.2026 Содержание блога Перейдите по ссылке: https:/ / developer. android. com/ studio и в самом низу страницы кликните по архиву "commandlinetools-win-xxxxxx_latest. zip" Извлеките архив и вы увидите. . .	Вывод текста со шрифтом TTF на Android с помощью библиотеки SDL3_ttf 8Observer8 25.01.2026 Содержание блога Если у вас не установлены Android SDK, NDK, JDK, и т. д. то сделайте это по следующей инструкции: Установка Android SDK, NDK, JDK, CMake и т. д. Сборка примера Скачайте. . .	Использование SDL3-callbacks вместо функции main() на Android, Desktop и WebAssembly 8Observer8 24.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .
моя боль iceja 24.01.2026 Выложила интерполяцию кубическими сплайнами www. iceja. net REST сервисы временно не работают, только через Web. Написала за 56 рабочих часов этот сайт с нуля. При помощи perplexity. ai PRO , при. . .	Модель сукцессии микоризы anaschu 24.01.2026 Решили писать научную статью с неким РОманом	http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .