Orion9

|
Posted: Fri Dec 05, 2025 00:35 Post subject: |
|
|
Ну вот и последний пример из этой серии. Главное отличие - отдельное меню для управления заданием и его параметрами.
 Hidden text
Некоторые сайты дают доступ не к одной случайной цитате, а к нескольким. Это нужно использовать. Файл скачивается, загружается в объект List и отдает по одной цитате. Можно запустить отдельное задание в потоке, чтобы цитаты самостоятельно скачивались и всплывали через отведенный период. Сейчас стоит 2 минуты, но это только для отладки, интервал можно изменить.
Функция разбита на несколько блоков, поэтому лучше сразу скинуть весь модуль.
 Tips.aucfg | Code: | Pragma IncludeOnce
# 71100-71199
RegisterCommand 71100 "Quotes"
RegisterCommand 71101 "QuotesGet"
RegisterCommand 71102 "QuotesTask"
RegisterCommand 71103 "QuotesSource"
RegisterCommand 71104 "QuotesUpdate"
RegisterCommand 71110 "OneQuote"
RegisterCommand 71120 "HowToUpdate"
RegisterCommand 71130 "CedfRandomKey"
Global gCedfDesc, gCedfHistory, gCedfData = COMMANDER_PATH & "\Ini\Backup\Russian.cedf"
Global gQuotesUrl, gQuotesSource1, gQuotesSource2
Global gQuotesFile, gQuotesFile1, gQuotesFile2, gQuotesList = List(), gQuotesUpd = 0
Global gQuotesTask, gQuotesTime, gQuotesLoaded = 0, gQuotesNext = 0, gQuotesInterval = 2
gQuotesFile1 = TEMP & "\quotes1"
gQuotesFile2 = TEMP & "\quotes2"
gQuotesSource1 = "https://zenquotes.io/api/quotes"
gQuotesSource2 = "https://thequoteshub.com/api/tags/inspirational?page=1&page_size=75&format=json"
gQuotesUrl = gQuotesSource1
gQuotesFile = gQuotesFile1
Func Quotes()
If IsPressed(0x11) Then Return QuotesGet(0)
ShowPopupMenu /D /F /I:0 "QuotesMenu"
EndFunc
Func QuotesGet(UpdateQuotes)
Local hr, txt, url
Static c = 0
If UpdateQuotes Then c = 0
c += 1
If c > 1 Then
If gQuotesList.Count > 0 Then
txt = gQuotesList[0]
gQuotesList.Remove(0)
tip(txt, 1, "Quote")
Return
Else
c = 1
EndIf
EndIf
# data update branch
gQuotesUpd = QuotesNextUpdate()
Local file = gQuotesFile, url = gQuotesUrl
If Not FileExist(file) Or gQuotesUpd = 0 Then
hr = DllCall("Urlmon.dll\URLDownloadToFileW", _
"ptr", 0, "wstr", url, "wstr", file, "dword", 0, "ptr", 0, "hresult")
If hr <> 0 Then
txt = "An error occured." & auCRLF & url & auCRLF & _
"Error code: " & hr & auCRLF & GetINetECode(hr)
tip(txt, 3, "Quote")
Sleep(1500)
EndIf
EndIf
If Not FileExist(file) Then
tip("File doesn't exist " & file, 3, "Quote")
c = 0
Return
EndIf
# local data
gQuotesLoaded = 0
gQuotesList.Count = 0
txt = FileRead(file)
If ERROR = 1 Then
tip("Error reading " & file, 3, "Quote")
c = 0
Return
EndIf
Local q, a, i, rex
If url = gQuotesSource1 Then
rex = RegExp('"q":"(.*?)","a":"(.*?)"', txt)
Else
rex = RegExp('"text":"(.*?)","author":"(.*?)"', txt)
EndIf
If rex.Exec() Then
Do
i += 1
q = rex.Match[1]
a = rex.Match[2]
If a <> "" Then a = " (" & a & ")"
gQuotesList.Add(q & a)
Until not rex.ExecNext()
Free(rex)
gQuotesLoaded = i
txt = i & " quotes are loaded."
tip(txt, 1, "Quote")
Sleep(1500)
txt = gQuotesList[0]
gQuotesList.Remove(0)
tip(txt, 1, "Quote")
Return
Else
c = 0
Free(rex)
tip("File corruped or has no required data " & file, 3, "Quote")
EndIf
EndFunc
Func QuotesNextUpdate()
gQuotesTime = ""
If FileExist(gQuotesFile) Then gQuotesTime = FileGetTime(gQuotesFile)
If gQuotesTime <> "" And IsInt(gQuotesTime) Then
Local diff = Floor((Now() - gQuotesTime) / 10000000 / 60)
diff = 12*60 - diff
If diff < 0 Then diff = 0
Return diff
Else
Return 0
EndIf
EndFunc
Func QuotesMenu()
Local txt
Static ico1, ico2, ico3
ico1 = COMMANDER_EXE & ",37"
gQuotesUpd = QuotesNextUpdate()
If FileExist(gQuotesFile) Then gQuotesTime = FileGetTime(gQuotesFile)
If gQuotesTime <> "" Then gQuotesTime = Date('', gQuotesTime) & ' ' & Time('', gQuotesTime)
txt &= 'MENUITEM "Show", 71101' & auCRLF
txt &= 'MENUITEM SEPARATOR' & auCRLF
txt &= 'MENUITEM "Copy", em_aucmd ' & (gQuotesList.Count ? "" : "/D") & ' -1 QuotesCopy' & auCRLF
txt &= 'MENUITEM "Shuffle", em_aucmd ' & (gQuotesList.Count > 5 ? "" : "/D") & ' -1 QuotesShuffle' & auCRLF
txt &= 'MENUITEM SEPARATOR' & auCRLF
txt &= 'MENUITEM "Start", em_aucmd ' & (gQuotesTask ? "/D" : "") & ' -1 QuotesTask 1' & auCRLF
txt &= 'MENUITEM "Stop", em_aucmd ' & (gQuotesTask ? "" : "/D") & ' -1 QuotesTask 0' & auCRLF
txt &= 'MENUITEM "Reload", em_aucmd ' & ' -1 QuotesGet 1' & auCRLF
txt &= 'MENUITEM "Update source", em_aucmd ' & (FileExist(gQuotesFile) ? "" : "/D") & ' -1 QuotesUpdate' & auCRLF
txt &= 'MENUITEM SEPARATOR' & auCRLF
txt &= 'MENUITEM "Source 1", em_aucmd ' & (gQuotesUrl = gQuotesSource1 ? "/C" : "") & ' -1 QuotesSource 1' & auCRLF
txt &= 'MENUITEM "Source 2", em_aucmd ' & (gQuotesUrl = gQuotesSource2 ? "/C" : "") & ' -1 QuotesSource 2' & auCRLF
txt &= 'MENUITEM SEPARATOR' & auCRLF
txt &= 'MENUITEM "Loaded: ' & gQuotesLoaded & ' items", em_aucmd /D' & auCRLF
txt &= 'MENUITEM "Left: ' & gQuotesList.Count & ' items", em_aucmd /D' & auCRLF
txt &= 'MENUITEM "Interval: ' & gQuotesInterval & ' min.", em_aucmd /D' & auCRLF
txt &= 'MENUITEM "Next quote in ' & gQuotesNext & ' sec.", em_aucmd /D' & auCRLF
txt &= 'MENUITEM SEPARATOR' & auCRLF
txt &= 'MENUITEM "Updated: ' & gQuotesTime & '", em_aucmd /D' & auCRLF
txt &= 'MENUITEM "Next update in ' & gQuotesUpd & ' min.", em_aucmd /D' & auCRLF
txt &= 'MENUITEM "' & gQuotesFile & '", em_aucmd -1 QuotesGoto ' & auCRLF
Return txt
EndFunc
Func QuotesTask(Task)
If Task Then
If Not gQuotesTask Then RunThread QuotesThread
Else
gQuotesTask = false
EndIf
EndFunc
Func QuotesThread()
gQuotesTask = true
tip("Quotes task has started.", 1, "Quotes")
Sleep(1000)
tip("")
Local wait = 2*60*gQuotesInterval
While gQuotesTask
QuotesGet(0)
For i = 1 To wait
Sleep(500)
If Not gQuotesTask Then Break
If Mod(i, 2) = 0 Then gQuotesNext = (wait - i) / 2
Next
Wend
gQuotesNext = 0
tip("Quotes task has stopped.", 2, "Quotes")
Sleep(1000)
tip("")
EndFunc
Func QuotesUpdate()
If FileExist(gQuotesFile) Then
MsgBox("Local file will be deleted" & auCRLF & auCRLF & _
gQuotesFile & auCRLF & auCRLF & "Continue?", "Autorun", 3+32+0)
If EXTENDED <> 6 Then Return
FileDelete(gQuotesFile)
If ERROR = 1 Then
MsgBox("Error deleting file " & gQuotesFile & auCRLF & auCRLF & _
"Make sure the file is not in use and has no permission issues", "Autorun", 16)
Return
EndIf
EndIf
QuotesGet(1)
EndFunc
Func QuotesShuffle()
Local idx, c = gQuotesList.Count
If c < 5 Then Return
Local lst = List()
tmp = gQuotesList.Clone()
While tmp.Count > 0
idx = Random(0, tmp.Count - 1, 1)
lst.Add(tmp[idx])
tmp.Remove(idx)
Wend
gQuotesList.Count = 0
gQuotesList = lst.Clone()
Free(lst, tmp)
MsgBox(c & " elements have been shuffled.", "Quotes", 64)
EndFunc
Func QuotesCopy()
If gQuotesList.Count > 0 Then
ClipPut(gQuotesList.Text)
MsgBox(gQuotesList.Count & " elements are copied.", "Quotes", 64)
EndIf
EndFunc
Func QuotesSource(nSource)
gQuotesUrl = nSource = 1 ? gQuotesSource1 : gQuotesSource2
gQuotesFile = nSource = 1 ? gQuotesFile1 : gQuotesFile2
MsgBox("Source has been set to: " & auCRLF & auCRLF & _
gQuotesUrl & auCRLF & auCRLF & _
"Reload?", "Autorun", 3+32+0)
If EXTENDED <> 6 Then Return
QuotesGet(1)
EndFunc
Func QuotesGoto()
If FileExist(gQuotesFile) Then
If RequestInfo(1000) = 1 Then
CommandExec /CD %'gQuotesFile'
Else
CommandExec /CD '' %'gQuotesFile'
Endif
Else
MsgBox("Файл не существует " & gQuotesFile)
EndIf
EndFunc
Func OneQuote()
Local hr, url, file, txt, mnu
Local u1 = "https://api.forismatic.com/api/1.0/?method=getQuote&format=text"
Local u2 = "https://www.quoterism.com/api/quotes/random"
Local u3 = "https://zenquotes.io/api/random"
Local u4 = "https://stoic.tekloon.net/stoic-quote"
Static c = 0
c += 1
If c > 4 Then c = 1
url = Eval("u" & c)
file = TEMP & "\quote.one"
hr = DllCall("Urlmon.dll\URLDownloadToFileW", _
"ptr", 0, "wstr", url, "wstr", file, "dword", 0, "ptr", 0, "hresult")
If hr = 0 Then
txt = FileRead(file, 1024)
If ERROR = 1 Then Return MsgBox("Ошибка чтения " & file, "Quote", 16)
Local q, a
If c = 2 Then
q = RegExpGet(txt, '"text":"(.*?)"', "$1")
a = RegExpGet(txt, '"name":"(.*?)"', "$1")
ElseIf c = 3 Then
q = RegExpGet(txt, '"q":"(.*?)"', "$1")
a = RegExpGet(txt, '"a":"(.*?)"', "$1")
ElseIf c = 4 Then
q = RegExpGet(txt, '"quote":"(.*?)"', "$1")
a = RegExpGet(txt, '"author":"(.*?)"', "$1")
EndIf
If a <> "" Then a = " (" & a & ")"
If c > 1 Then txt = q & a
If txt = '' Then
MsgBox("Файл поврежден " & file, "Quote", 16)
Return
EndIf
url = RegExpGet(url, "https://(.*?)/", "$1")
mnu = 'MENUITEM "Source #' & c & '", em_aucmd /D' & auCRLF
mnu &= 'MENUITEM "' & url & '", em_aucmd /D' & auCRLF
tip(txt, 1, "Quote", 0, mnu)
Else
txt = "An error occured." & auCRLF & url & auCRLF & _
"Error code: " & hr & auCRLF & GetINetECode(hr)
tip(txt, 3, "Quote")
EndIf
EndFunc
Func HowTo()
Local link = "https://www.majorgeeks.com"
Local file = COMMANDER_PATH & "\Ini\Backup\how-to.html"
Static rex, txt = FileRead(file)
rex = RegExpGet(txt, '(<a href="(.*?)">(.*?)</a>)</b><br />\R(.*?)<br />', _
'$4\n<a href="' & link & '/$2">Read more</a>', Random(1, 2096, 1))
#rex &= '<a href="' & link & '">www.majorgeeks.com</a>'
tip(rex, 1)
EndFunc
Func HowToUpdate()
Static c = 0, i = 0, text
Local link = "https://www.majorgeeks.com"
Local file = TEMP & "\how_to.html", res, txt
If Not FileExist(file) Then
res = WinInetDownloadFile(link & "/content/overview/how_to.html", file)
If res <> 0 Then Return
Sleep(1000)
tip(file, 1, "Processing")
Sleep(500)
txt = FileRead(file)
txt = StrReplace(txt, """, '"')
txt = StrReplace(txt, "'", "'")
txt = StrReplace(txt, "&#039;", "'")
txt = StrReplace(txt, "&", "&")
txt = StrReplace(txt, ">", ">")
txt = StrReplace(txt, "<", "<")
FileWrite(file, txt)
c = 0
EndIf
Local rex
c += 1
If c = 1 Then
i = 0
text = FileRead(file)
rex = RegExp('(<a href="(.*?)">(.*?)</a>)</b><br />\R(.*?)<br />', text)
If rex.Exec() Then
Do
i += 1
Until not rex.ExecNext()
EndIf
Free(rex)
If i = 0 Then
MsgBox("File doesn't contain data " & file, "Autorun", 48)
Return
Else
tip(i & " articles prepared.", 1, "File")
Sleep(1000)
EndIf
EndIf
If i = 0 Then Return tip("No data or corrupt file", 3)
rex = RegExpGet(text, '(<a href="(.*?)">(.*?)</a>)</b><br />\R(.*?)<br />', _
'$4\n<a href="' & link & '/$2">Read more</a>', Random(1, i, 1))
tip(rex, 1)
EndFunc
Func CedfRandomKey()
Static hIco, WM_GETICON = 0x7f, bIcon = false
Local file = gCedfData
Local obj = BinaryFile(file)
If ERROR Then
MsgBox("Error reading file " & file, "Autorun", 16)
Return
EndIf
If bIcon Then
hIco = SendMessage(AUTORUN_TCHANDLE, WM_GETICON, 2, 0)
Else
hIco = 1
EndIf
Local block = 1024*20, blocks = Ceil(obj.Size/1024), rand = Random(1, blocks - 20, 1)
obj.Pos = rand*1024
txt = obj.ReadStr(block, "ANSI")
rex = RegExpGet(txt, _
'<key name="(.*?)" file="(.*?)" section="(.*?)" default="(.*?)" version="(.*?)".*?' & _
'<description>(.*?)</description>', '[$3\]\n$1=$4\n$6')
If ERROR Then
rex = RegExpGet(txt, '<section title="(.*?)" name="(.*?)" file="(.*?)" version="(.*?)".*?' & _
'<description>(.*?)</description>', '[$2\]\n$1\nVersion=$4\n$5')
EndIf
Local lst = List(), dbg = ""
dbg &= 'MENUITEM "Block = ' & rand & '/' & blocks & '", em_aucmd /D' & auCRLF
dbg &= 'MENUITEM "Position = ' & obj.Pos & '", em_aucmd /D' & auCRLF
dbg &= 'MENUITEM "Filesize = ' & obj.Size & '", em_aucmd /D' & auCRLF
dbg &= 'MENUITEM SEPARATOR' & auCRLF
dbg &= 'MENUITEM "History", em_aucmd -1 CedfRandHistory' & auCRLF
gCedfHistory &= "Block:" & rand & '/' & blocks & ", Pos: " & obj.Pos & auCRLF
lst.Text = rex
If lst.Count < 2 Then
lst.Count = 3
lst[0] = "Error:"
lst[1] = "Block: " & rand & "/" & blocks
lst[2] = "Position: " & obj.Pos
EndIf
txt = lst[0] & auCRLF & lst[1] & auCRLF
txt = StrReplace(txt, "[[", "[")
txt = StrReplace(txt, "]]", "]")
If StrLen(lst[2]) > 640 - StrLen(txt) Then
txt &= StrLeft(lst[2], 640 - StrLen(txt)) & "..."
Else
txt &= lst[2]
EndIf
gCedfDesc = lst.Text
Free(obj, lst)
txt &= auCRLF & '<a href="CedfReadDesc()">Читать дальше</a>'
tip(txt, hIco, "Wincmd.ini", 0, dbg)
EndFunc
Func CedfReadDesc()
MsgBox(gCedfDesc, "Description", 64+65536+262144)
EndFunc
Func CedfRandHistory()
MsgBox(gCedfHistory, "History", 64+65536+262144)
EndFunc |
|
|