Function CountOccurrences(SearchHere As String, SearchWhat As String)
Dim regEx, Match, Matches
Set regEx = New RegExp ' Create a regular expression.
regEx.pattern = SearchWhat ' Set pattern.
regEx.IgnoreCase = True
regEx.Global = True ' Set global applicability.
Set Matches = regEx.Execute(SearchHere) ' Execute search.
CountOccurrences = Matches.Count
End Functionjumpjack ha scritto:Per il problema delle regex, bisogna solo riscrivere questa procedura perchè conti manualmente le ricorrenze, no?
Codice:Function CountOccurrences(SearchHere As String, SearchWhat As String) Dim regEx, Match, Matches Set regEx = New RegExp ' Create a regular expression. regEx.pattern = SearchWhat ' Set pattern. regEx.IgnoreCase = True regEx.Global = True ' Set global applicability. Set Matches = regEx.Execute(SearchHere) ' Execute search. CountOccurrences = Matches.Count End Function
Function CountOccurrences(strText As String, _
strFind As String, _
Optional lngCompare As VbCompareMethod) As Long
' Conta le ricorrenze di un particolare carattere o caratteri.
' Se l'argomento lngCompare è omesso, la procedura esegue il confronto binario.
Dim lngPos As Long
Dim lngTemp As Long
Dim lngCount As Long
' Viene indicata una posizione di partenza. Non è necessaria per la prima
' volta attraverso il ciclo, ma sarà necessaria nei successivi passaggi.
lngPos = 1
' Esegue il ciclo almeno una volta.
Do
' Memorizza la posizione in cui ricorre il primo degli strFind.
lngPos = InStr(lngPos, strText, strFind, lngCompare)
' Memorizza la posizione in una variabile temporanea.
lngTemp = lngPos
' Controlla che strFind sia stato trovato.
If lngPos > 0 Then
' Incrementa la variabile contatore.
lngCount = lngCount + 1
' Definisce una nuova posizione di partenza.
lngPos = lngPos + Len(strFind)
End If
' Cicla fintanto che l'ultima ricorrenza sia stata trovata.
Loop Until lngPos = 0
' Ritorna il numero delle ricorrenze trovate.
CountOccurrences = lngCount
End Function' ********* Scarica il file del genere
'For G = 1 To NumeroGeneri
nomefile = Path & "Canali_" & genere(G) & ".txt"
strurl = Replace(STRINGA_GENERE, "GGGGGGGG", genere(G))
Debug.Print "Scarico " & strurl & "..."
Tentativi = 0
If (Dir$(nomefile) <> "" And frmSetup.chkUpdate.Value = True) Or _
(Dir$(nomefile) = "") Then ' Evita di RI-scaricare il file se c'è gia e se non è stato
' richiesto specificamente dalll'utente di aggiornarlo.
retry3:
Tentativi = Tentativi + 1
errcode = URLDownloadToFile(0, strurl, nomefile, 0, 0)
If errcode = 0 Then
'Debug.Print "OK"
Else
If Tentativi < MAX_Tentativi Then
GoTo retry3:
Else
Debug.Print "############ Scaricamento dati genere '" + genere(G), "': ERRORE ", Hex$(errcode)
errcode = 0
End If
End If
Else
Debug.Print "File "; nomefile; " già scaricato, elaboro..."
End If
jumpjack ha scritto:Faccio un po' di ordine in questo primo post, lasciando l'originale solo per riferimento.
Sito di riferimento:
http://win98.altervista.org/SatGrabLC/
Versioni attuali:
VERSIONE 3.3.0 - 13 gennaio 2011
' Aggiunto link a programmazione mensile
' Corretta estensione filtro automatico e colorazione intestazione.
Standalone (1.1.0 - Windows)
Promemoria sul nuovo formato JSON dell'EPG SKY:
ELENCO CANALI: http://guidatv.sky.it/app/guidatv/contenuti/data/grid/grid_cinema_channels.js
ELENCO EVENTI: http://guidatv.sky.it/app/guidatv/contenuti/data/grid/09_02_19/ch_371.js
DATI EVENTO: http://guidatv.sky.it/EpgBackend/event_description.do?eid=17489032
PROGRAMMAZIONE MENSILE: http://guidatv.sky.it/EpgBackend/getprogrammazione.do?idprogramma=186553 (id secondario)
------------------
Vi piacerebbe avere tutta la programmazione settimanale di tutti i canali SKY comodamente memorizzata su un foglio excel, sul quale poter fare filtri, ordinamenti ed elaborazioni a piacimento?
E allora cosa aspettate a scaricare il foglio excel?
Non è ancora completissimo, ma ci sto lavorando.
Edit:
ecco invece una versione che non richiede ne' Excel, ne' OpenOffice, nè altro. Sorgenti inclusi per chi vuol provare a compilarli per Linux (è scritto in RapidQ):
DOWNLOAD SatGrabLC 0.2.2
Edit:
Nuova versione 1.0.0
Novità:
-sistemato bug contatori
-aggiunta finestra di log ed eliminata quella DOS
-aggiunta possibilità di scaricare la sola lista degli eventi, senza dettagli, con conseguente enorme incremento di velocità di scaricamento (l'intero palinsesto puo' essere scaricato in pochi secondi
-aggiunta possibilità di scaricare i dati del solo evento che interessa
DOWNLOAD
<!DOCTYPE html>
<html>
<head>
<script src="jquery-1.3.1.js">
</script>
<script>
function doDataLink(data) {
Android.dataLink(data);
}
</script>
</head>
<body>
<script>
/*
STRINGA_GENERE = "http://guidatv.sky.it/app/guidatv/contenuti/data/grid/grid_GGGGGGGG_channels.js"
STRINGA_CANALE = "http://guidatv.sky.it/app/guidatv/contenuti/data/grid/AA_MM_GG/ch_CCCCCCCC.js"
STRINGA_EVENTO = "http://guidatv.sky.it/EpgBackend/event_description.do?eid=EEEEEEEE"
STRINGA_MENSILE = "http://guidatv.sky.it/EpgBackend/getprogrammazione.do?idprogramma=" ' Seguita da id interno programma
*/
$( document ).ready(function() {
var filename = "test.json";
var ChannelList = "";
var ChannelName;
var ChannelNumber;
var ChannelId;
var ChannelServiceNumber;
$.getJSON(filename, function(FileContents){
$.each(FileContents, function(i, item) {
ChannelName=FileContents[i].name;
ChannelNumber=FileContents[i].number;
ChannelId=FileContents[i].id;
ChannelServiceNumber=FileContents[i].service;
ChannelList=ChannelList + ChannelNumber + ": " + ChannelName + " (" + ChannelId + "," + ChannelServiceNumber + ")\n";
});
alert (ChannelList);
doDataLink(ChannelList); // Send data to RFOBASIC
});
});
</script>
<br>
<br>
<br>
<a href="http://www.google.it">Test link</a>
</body>
</html>!!
This program demonstrats some
of the possibilities
when using the BASIC! html commands.
!!
! html must be opened before doing
! any html command
HTML.OPEN
! Load the file, htmlDemo1.html
HTML.LOAD.URL "android-rfobasic-json.html"
!The user now sees the html
! We can now monitor the user
! actions
xnextUserAction:
! loop until data$ is not ""
DO
HTML.GET.DATALINK data$
UNTIL data$ <> ""
print "Dati ricevuti: "
print data$