purebasic.info

PureBasic forum
Текущее время: Пт фев 21, 2020 6:24 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 9 ] 
Автор Сообщение
СообщениеДобавлено: Пт дек 06, 2019 11:39 pm 
Не в сети
док
Аватар пользователя

Зарегистрирован: Ср июн 18, 2014 6:34 pm
Сообщений: 195
Благодарил (а): 3 раз.
Поблагодарили: 5 раз.
Пункты репутации: 0
Предлагается вашему вниманию много нового.

Код:
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
 
 
; ;;;;;;;;;;;;;;;;;;;;;;;;;;; ЗАПУСКАТЬ С ОТЛАДЧИКОМ ::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;  Познавательная  программа  Дегтярёва. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
Procedure.s GetLastErrorAsTextt(LastError.l)
 
  If LastError
    *ErrorBuffer = AllocateMemory(1024)
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, *ErrorBuffer, 1024, 0)
    message.s=PeekS(*ErrorBuffer)
    FreeMemory(*ErrorBuffer)
  EndIf
 
  ProcedureReturn message
EndProcedure
 
Procedure GetLastErrorr()
  ; Error 1309 or 0 = No error
  LastError=GetLastError_()
  If LastError=1309 : LastError=0 : EndIf
  ProcedureReturn LastError
EndProcedure
   
Repeat
        LastError+1
                string$ = GetLastErrorAsTextt(LastError)
                                      If string$ = ""
                                                     Delay(1)
                                               Else
                                                     Delay(1000)
                                      EndIf
                                                                         Debug string$
 
ForEver
 
 



Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 07, 2019 12:12 am 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11587
Благодарил (а): 4 раз.
Поблагодарили: 485 раз.
viewtopic.php?p=27366#p27366

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 07, 2019 8:48 am 
Не в сети
док
Аватар пользователя

Зарегистрирован: Ср июн 18, 2014 6:34 pm
Сообщений: 195
Благодарил (а): 3 раз.
Поблагодарили: 5 раз.
Пункты репутации: 0
Пётр писал(а):
http://purebasic.info/phpBB3ex/viewtopic.php?p=27366#p27366

Там познавательности всего одна секунда.
А на мой код может времени не хватить, я, например, не одолел читать дальше трёх минут.


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 07, 2019 2:07 pm 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6596
Благодарил (а): 32 раз.
Поблагодарили: 227 раз.
Пункты репутации: 59
Дегтярёв писал(а):
А на мой код может времени не хватить, я, например, не одолел читать дальше трёх минут.

Можно и за секунду все ошибки в файл записать:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Procedure.s GetLastErrorAsTextt(LastError.l) 
 
  If LastError
    *ErrorBuffer = AllocateMemory(1024)
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, *ErrorBuffer, 1024, 0)
    message.s=PeekS(*ErrorBuffer)
    FreeMemory(*ErrorBuffer)
  EndIf
 
  ProcedureReturn message
EndProcedure
 
 If CreateFile(0, "LastErrorAsText.txt")        
    Repeat
        LastError+1
        string$ + "№" + Str(LastError) + " - " +  GetLastErrorAsTextt(LastError) + #CRLF$
    Until LastError = 1309
             WriteString(0, string$)  
         CloseFile(0)                      
  Else
    ;82 - Не удается создать файл или папку.
    MessageRequester("Error",  GetLastErrorAsTextt(82))
  EndIf



Создать справочник по кодам ошибок и использовать коды в своих целях (см. код 82 выше).
Я так понимаю, что фразы выдаются на языке в зависимости локализации Винды, а это как бы способ перевода на разные языки вашей программы без особых усилий.

PS
Procedure GetLastErrorr() вроде как не участвует в работе кода?

_________________
read-only ¯\_(ツ)_/¯


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 07, 2019 3:07 pm 
Не в сети
профессор

Зарегистрирован: Пн июл 22, 2013 11:00 pm
Сообщений: 932
Благодарил (а): 2 раз.
Поблагодарили: 47 раз.
Пункты репутации: 9
Дегтярёв писал(а):
Предлагается вашему вниманию много нового.

Код:
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
 
 
; ;;;;;;;;;;;;;;;;;;;;;;;;;;; ЗАПУСКАТЬ С ОТЛАДЧИКОМ ::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;  Познавательная  программа  Дегтярёва. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
Procedure.s GetLastErrorAsTextt(LastError.l)
 
  If LastError
    *ErrorBuffer = AllocateMemory(1024)
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, *ErrorBuffer, 1024, 0)
    message.s=PeekS(*ErrorBuffer)
    FreeMemory(*ErrorBuffer)
  EndIf
 
  ProcedureReturn message
EndProcedure
 
Procedure GetLastErrorr()
  ; Error 1309 or 0 = No error
  LastError=GetLastError_()
  If LastError=1309 : LastError=0 : EndIf
  ProcedureReturn LastError
EndProcedure
   
Repeat
        LastError+1
                string$ = GetLastErrorAsTextt(LastError)
                                      If string$ = ""
                                                     Delay(1)
                                               Else
                                                     Delay(1000)
                                      EndIf
                                                                         Debug string$
 
ForEver
 
 


А так? :roll:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
; ;;;;;;;;;;;;;;;;;;;;;;;;;;; ЗАПУСКАТЬ С ОТЛАДЧИКОМ ::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;  Познавательная  программа  Дегтярёва c изменением  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
Procedure.s GetLastErrorAsTextt(LastError.l)
Static strokavyvoda$ {1024}
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, @strokavyvoda$, 1024, 0)
  ProcedureReturn strokavyvoda$
EndProcedure
Repeat
        string$ = GetLastErrorAsTextt(LastError)
         If string$ = ""
           Delay(1)
         Else
           Delay(100)
         EndIf
         Debug Str(LastError) +"  "+string$
        LastError+1  
ForEver
 


и типа за пол секунды,правда не все конечно ошибки.:D
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Global strokavyvoda$ {1024}
 If CreateFile(0, "LastErrorAsText.txt")        
   Repeat
     FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, @strokavyvoda$, 1024, 0)  
      string$ + "№" + Str(LastError) + " - " +  strokavyvoda$ + #CRLF$
     LastError+1
    Until LastError = 1309
         WriteString(0, string$)  
         CloseFile(0)                      
  Else
    ;82 - Не удается создать файл или папку.
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, 82, 0, @strokavyvoda$, 1024, 0)
    MessageRequester("Error", strokavyvoda$)
  EndIf
 



Последний раз редактировалось Сергейчик Сб дек 07, 2019 3:35 pm, всего редактировалось 4 раз(а).

Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 07, 2019 3:09 pm 
Не в сети
док
Аватар пользователя

Зарегистрирован: Ср июн 18, 2014 6:34 pm
Сообщений: 195
Благодарил (а): 3 раз.
Поблагодарили: 5 раз.
Пункты репутации: 0
Ага, точно, не участвует в коде Procedure GetLastErrorr()
Я когда ночью "изобрёл" эту программу, то, сделал к ней окно, чтобы был красивый крупный текст, без дебагера.
Потом увяз в этом окне и код получился великоват.
Потом, думаю, пурики-то, у всех разные, у кого-то обязательно кракозябры пойдут, люди будут нервничать и пришлось вырезать окно, а процедуру лишнюю вырезать-то и не усмотрел.
Очень правильное замечание, стало ещё больше познавательности, что, вот, только Квитали-то и увидел лишний код.

Теперь, немного философии, относительно замечания по данной лишней процедуре.
Вот, я, давеча, беру инсталлятор пурика 5.60 и ставлю этот пурик "искаропки".
Сразу беру инсталлятор последней Друпии и ставлю её к этому пурику.
Заметьте, всё новое, всё искаропки, и ничего не работает, пурик запускать Друпию не хочет.
Начинаю разбираться, оказывается, в исходнике Друпии ошибка, оказывается, две лишние константы заявлены ошибочно два раза.
И какой вывод?
А вывод такой, что там профессионалы, мастера высокого класса, и они лепят лишний код, ни черта не проверяют.
Заметьте, у меня лишняя процедура ни на что не влияет, а у них, у буржуйских маестро Друпий, вообще, ничего не запускается.
Им никто замечаний не делает, а мне за то же самое, вот, уже тонко намекнули на неувязки.


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вт дек 10, 2019 6:36 pm 
Не в сети
док
Аватар пользователя

Зарегистрирован: Ср июн 18, 2014 6:34 pm
Сообщений: 195
Благодарил (а): 3 раз.
Поблагодарили: 5 раз.
Пункты репутации: 0
Короче, насколько я понял, моя познавательная программа никого не впечатлила и оказалась полной чепухой.
В связи этим, я написал ещё более ненужную программу-дрянь, которая просто удивляет своей ненужностью и наредкость омерзительным кодом.
Если можно, отпишитесь, сколько на неё потратили минут её смотреть, или секунд...
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
; ;;;;;;;;;;;;;;;;;;;;;;;;;;; == ЗАПУСКАТЬ С ОТЛАДЧИКОМ == ::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ;;;;;;;;;;;;;;;;;;;;;;;;;; == Ненужная программа  Дегтярёва ==;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
Global Stringone$, toostring$:Procedure.s GetLastErrorAsTextt(LastError.l):If LastError
*ErrorBuffer = AllocateMemory(1024):FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, *ErrorBuffer, 1024, 0)
message.s=PeekS(*ErrorBuffer):FreeMemory(*ErrorBuffer):EndIf:ProcedureReturn message:EndProcedure
Procedure$ Zaput(Stringone$,toostring$):NewList MyList$():NewList ListMy$()
fild = CountString(Stringone$," "):dlif = CountString(toostring$," "):For k = 1 To fild+1
AddElement(MyList$()):MyList$() = StringField(Stringone$, k, " "):Beep_(4500,50):Delay(3):Next
For h = 1 To dlif+1:AddElement(ListMy$()):ListMy$() = StringField(toostring$, h, " "):Beep_(3500,50):Delay(3)
Next:Repeat:SelectElement(mylist$(), a):SelectElement(listmy$(), a): Vivod$ + mylist$() + " ":Vivod$ + listMy$() + " "
 a+1:Until a=k-1 Or a=h-1:ProcedureReturn Vivod$:EndProcedure
Procedure$ Getfrazy():Static LastError:Repeat:LastError+1:string$ = GetLastErrorAsTextt(LastError)
If string$ = "":Delay(1):Else:Delay(1):EndIf:If cikl = 0
Stringone$ = UCase(string$):Else:toostring$ = UCase(string$):EndIf:cikl+1:Until cikl= 2:EndProcedure
Repeat:Getfrazy():Debug Zaput(Stringone$,toostring$)
Stringone$="":toostring$ = "":cikl=0:Delay(1000):ForEver
 
 



Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вт дек 10, 2019 7:21 pm 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6596
Благодарил (а): 32 раз.
Поблагодарили: 227 раз.
Пункты репутации: 59
Слушал секунд 40, пока из другой комнаты жена ласково не поинтересовалась, "А что там у тебя так пикает противно?". Пришлось выключить.

_________________
read-only ¯\_(ツ)_/¯


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вт дек 10, 2019 7:38 pm 
Не в сети
док
Аватар пользователя

Зарегистрирован: Ср июн 18, 2014 6:34 pm
Сообщений: 195
Благодарил (а): 3 раз.
Поблагодарили: 5 раз.
Пункты репутации: 0
Вот, кстати, ты хорошую мысль подсказал, писк убрать, а сделать озвучивание текста голосом.
Ещё мысль, на каждое всплываемое слово запрашивать в яндексе картинку.
Голосом озвучивать слова, и демострировать логически связанные с ним картинки.
Программа-пытка.
GetLastErrorAsText заменить на гет ошибка как картинка, ShowErrorAsYandexImage.


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 9 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB