It would be useful if iConvert would be extended with currencies. The problem, however, is that the exchange rate of currencies varies continuously. That is why I created the "Update currencies.sb" program that downloads the exchange rates from the internet and offers them to iConvert.
The website https://www.x-rates.com/table/?from=USD&amount=1 delivers a page with two tables containing the exchange rates of the currencies with reference to US-dollar. The first table gives a list of the most important currencies and the second table gives about 50 currrencies in alphabetical order of the states.
The webpage is shown for inspection after which the program can be continued or stopped.
If the webpage is read from HTML-file, then the page is displayed without graphics due to missing graphics-info from the associated URL in the HTML-code.
After continuing, the second table is parsed and the extracted data is written in DATA-lines to the file "currencies.data".
This file is included in an adapted version of iConvert.
Parsing of the HTML-text is rather simple:
• Each table is contained between the markers '<tbody>' and '</tbody>'
• Each table-row is contained between the markers '<tr>' and '</tr>'
• The first element in a row is the currency-name between '<td>' and '</td>'
• The desired exchange-rate is found after 'to=USD' between '>' and '</a'
The first item in the generated data-file is the variable 'Curr' which defines the number of items in each of the two data-lines.
Then follows the variable 'CurrDate$' which is the date that the exchange rates have been downloaded. This string is added to the category-name "Currency " in the category selectionlist in the adapted program.
Then follows the label of the categorie: 'Currencies:'.
The currency-names and the exchange rates follow then in two DATA-lines.
20181112
* Main section in testprogram reduced
- Update(view,iField$) ' start function
- Preparation requires only set up of Interactive-field and browser
Other tasks in functions with minor changes:
- MakeCurrencyHTML (Url$,HtmlFile$,iview,iField$,Browser$)
- ExtractHtml (HtmlFile$,Data$(,),iField$)
- SortAndStore (File$,Data$(,),items)
- Input$(Field$,Prompt$)
- Quicksort$(Array$(,),MaxRow,Rowsize,SortColumn)
- PageContent$(file$)
- ISO_Date$
20181111
Program version 2.2 adapted for integration with iConvert
Call to iConvert is removed
Essential tasks are coded in functions:
- MakeCurrencyHTML(Url$,HtmlFile$,iview,iField$,Browser$)
- ExtractHtml(HtmlFile$,Data$(,))
- SortAndStore(File$,Data$(,),items)
- Input$(Field$,Prompt$)
- Quicksort$(Array$(,),MaxRow,Rowsize,SortColumn)
- PageContent$(file$)
- ISO_Date$
20181107 Adapted for iConvert 2.6
• View-state can now be overruled by iConvert via file 'ConverterState$'
20181103 Adapted with 'View' options
• Test-mode is changed to View-mode. If View is non-zero then program is interactive.
Default: View=0
• If "currencies.data" is not present, then View becomes inactive if "currenciies.html <date>" is present. The porogram will then extract data from that html-file and generate "currencies.data".
This is the test-mode for data-extraction.
• If both files, "currencies.data" and "currenciies.html <date>", are not present then View becomes active and the conversion-program will be started after finishing.
20181104 Adapted for "iConvert 3.4.sb"
• The condition when the converter is run after extracting data has been changed. Conversion is done when the html-file is not present. The truth table for the options on 'View' and 'Convert' is shown on the website.
• 'Title$' is now in the first line. This allows transfer of the program-name.
• At the beginning of the program 'Convert$' defines the preferred conversion program. The user can modify a copy of "iConvert….sb" according to his own needs and rename it to Convert$ for preferred usage. 'ConvertNameFile$' defines the file where the converter writes its filename.
• The launch of the conversion-program is coded in the subroutine 'Convert'
- If file 'Convert$' exists then it will be launched as preferred user version.
- On failure the program named in 'ConvertNameFile$' will be launched if it is available.
- On failure the user-function 'FindFile' will be used to find a converter-program containing "iConvert" in its name and "sb" as extension. The function returns the latest matching name from the sorted folder-listing. The search is ascending and case-insensitive.
- On failure the program ends with an error-message.
Code: Select all
'UpdateCurrencies.functions with testprogram
'by Dutchman, November 2018
'Generate DATA-list for currency-conversion
'https://nitisara.ru/forum/viewtopic.php?f=20&t=2272
/*
20181112
* Main section in testprogram reduced
- Update(view,iField$) ' start function
- Preparation requires only set up of Interactive-field and browser
20181111
Program version 2.2 adapted for integration with iConvert
• Call to iConvert is removed
• Tasks are coded in functions:
- MakeCurrencyHTML (Url$,HtmlFile$,iview,iField$,Browser$)
- ExtractHtml (HtmlFile$,Data$(,),iField$)
- SortAndStore (File$,Data$(,),items)
- Input$(Field$,Prompt$)
- Quicksort$(Array$(,),MaxRow,Rowsize,SortColumn)
- PageContent$(file$)
- ISO_Date$
'*/
'==== Presets ====
OPTION BASE 1
SET BROWSERS SCALED
iView=1 ' Default iView=0, non-interactive mode
'
'==== Constants ======
GET SCREEN SIZE sw,sh
'
'==== Make Interactivity field
Top=sh/30 ' top space
Top$="In" ' Field for input
FIELD Top$ AT 0,0 SIZE sw,top
FIELD Top$ BACK COLOR 0,0,1
FIELD Top$ FONT NAME "Menlo"
FIELD Top$ FONT COLOR 1,1,0
FIELD Top$ FONT SIZE top-6
FIELD Top$ HIDE
'
'==== Prepare browser
IF iView THEN BROWSER "a" AT 0,top SIZE sw,sh-top
'
'==== Main ====
IF Update(iView,Top$) THEN
FIELD Top$ BACK COLOR 0,0,1
Field Top$ TEXT "Data written to """&Update.web$&"""."
ELSE
FIELD Top$ BACK COLOR 1,0,0
Field Top$ TEXT Update.Msg$
PAUSE 1
ENDIF
PAUSE 0.5
FIELD Top$ DELETE
END
'========== Subroutines and Functions ===========
'r'
DEF Update(view,iField$)
'==== constants
Source$="https://www.x-rates.com/table/?from=USD&amount=1"
MaxCount=100 ' max number of currencies
WebPage$="currencies.html" ' undated webpage filename
'==== Output variables
DIM Data$(maxcount,2) ' array for extracted data
DataFile$="currencies.data" ' file with DATA-lines
'
'--- Select and store source
web$=LatestFile$(webpage$)
IF web$="" THEN web$=WebPage$
web$=MakeCurrencyHTML$(Source$,Web$,view,iField$,"a")
IF web$="" THEN
Msg$="Aborted."
RETURN 0
ENDIF
'---- Extract data from HTML-file
IF ExtractHtml(web$,Data$,iField$)=0 THEN
Msg$=ExtractHtml.Msg$
RETURN 0
ENDIF
'--- Sort and write to data-file
CALL SortAndStore(DataFile$,Data$,ExtractHtml.count)
RETURN 1
END DEF
''
'r'
DEF SortAndStore(File$,Data$(,),items)
Quicksort$(Data$,Extract.count,2,1)
IF FILE_EXISTS(File$) THEN FILE File$ DELETE
items+=1 'add 1 to include reference value US-dollar
FILE File$ PRINT "Curr="&items&" ' items in Currencies"
DateTime$= ExtractHtml.DataDate$
'DateTime$&="T"&RIGHT$("0"&CURRENT_HOUR(),2)&":" ' add hour
'DateTime$&=RIGHT$("0"&CURRENT_MINUTE(),2) ' add minutes
FILE File$ PRINT "CurrDate$="""&DateTime$&""" ' download date"
FILE File$ PRINT "Currencies:"
File File$ PRINT "DATA """&"US dollar"&"""";
FOR i=1 TO items-1
File File$ PRINT ", """&Data$(i,1)&"""";
NEXT i
File File$ PRINT
File File$ PRINT "DATA 1";
FOR i=1 TO items-1
File File$ PRINT ", "&Data$(i,2);
NEXT i
END DEF
''
'r'
DEF ExtractHtml(HtmlFile$,Data$(,),iField$)
/* single item in HTML-text to parse:
<tr>
<td>Argentine Peso</td>
<td class='rtRates'><a href='… url …/?from=USD&to=ARS'>36.446414</a></td>
<td class='rtRates'><a href='… url …/?from=ARS&to=USD'>0.027438</a></td>
</tr>
*/
count=0
'--- Read body into a$
GOSUB ReadTableBody ' local subroutine
IF Msg$<>"" THEN RETURN 0
'--- Store HTML table-rows
p1=INSTR(a$,"<tr",1)
WHILE p1>0 AND count<update.maxcount
p2=INSTR(a$,"/tr>",p1)
first=p2
IF first>0 THEN
count+=1
Data$(count,1)=SUBSTR$(a$,p1,p2)
ENDIF
p1=INSTR(a$,"<tr",first)
END WHILE
'--- Check table-size
IF count>=update.maxcount THEN
Msg$="Data-array is too small. Increase constant 'count'."
RETURN 0
ENDIF
'--- extract valuta and value
FOR i=1 TO count
p1=INSTR(Data$(i,1),"<td>",1)+4
p2=INSTR(Data$(i,1),"<",p1)-1
Valuta$=SUBSTR$(Data$(i,1),p1,p2)
p1=INSTR(Data$(i,1),"to=USD'>",p2)+8
p2=INSTR(Data$(i,1),"</a",p1)-1
Value$= SUBSTR$(Data$(i,1),p1,p2)
Data$(i,1)=Valuta$ ! Data$(i,2)=Value$
NEXT i
RETURN 1 ' all OK
ReadTableBody: ' ------------ local subroutine
'--- Extract date from filename
DataDate$=RIGHT$(TRIM$(HtmlFile$),8)
'--- Find second table
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Extracting second table."
FILE HtmlFile$ SETPOS 0
Msg$="Second marker """&"tbody"&""" not found."
FOR i=1 TO 2
DO
FILE HtmlFile$ READLINE Line$
IF Line$<>"" THEN p1=INSTR(Line$,"<tbody",1)
UNTIL p1>0 OR FILE_END(HtmlFile$)
IF FILE_END(HtmlFile$) THEN RETURN 'Msg$ is set
NEXT i
IF p1<1 THEN RETURN' Msg$ is preset
'--- Read table-body
a$=Line$
DO
FILE HtmlFile$ READLINE Line$
a$&=Line$
p2=INSTR(a$,"/tbody",1)
UNTIL FILE_END(HtmlFile$) OR p2>0
Msg$&=" (no end-marker)"
IF p2<1 THEN RETURN ' Msg$ is preset
Msg$=""
RETURN ' from local sub
END DEF
''
'r'
DEF MakeCurrencyHTML$(Url$,HtmlFile$,iview,iField$,Browser$)
'HtmlFile$ contains name of existing file or undated name
'returns filename if HtmlFile$ is updated
'If 'htm-file$' was not existing then name is extended with date
IF FILE_EXISTS(HtmlFile$) THEN
prompt$ ="Latest date: "
prompt$&= RIGHT$(HtmlFile$,8)
prompt$&=". Download new? (Y/N)"
DO
Answer$=TRIM$(LOWSTR$(Input$(iField$, prompt$)))
UNTIL Answer$="y" OR Answer$="n"
FIELD iField$ BACK COLOR 0,0,1
IF Answer$="n" OR NOT iView THEN
NewData=0
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Reading data"
BROWSER Browser$ TEXT PageContent$(HtmlFile$)
ELSE ! NewData =1
ENDIF
ELSE ! NewData =1
ENDIF
'---- Update webdata
IF NewData THEN
SPLITE HtmlFile$ TO a$,n with " "
HtmlFile$=a$(1)&" "&ISO_Date$
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Collecting data"
IF iView THEN BROWSER Browser$ URL Url$
TEXT CLEAR
ENDIF
Inspect:
'---- Continue or return
IF NOT iView THEN Download
DO
prompt$= "Continue? (Y/N)"
Answer$=TRIM$(LOWSTR$(Input$(iField$, prompt$)))
UNTIL Answer$="y" OR Answer$="n"
FIELD iField$ BACK COLOR 0,0,1
BROWSER Browser$ DELETE
IF Answer$="n" THEN RETURN ""
DownLoad:
FIELD iField$ BACK COLOR 0,0,1
'---- download binary contents
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Loading webpage"
IF NewData THEN
HTTP Url$ GETDIM Bin
FILE HtmlFile$ WRITEDIM Bin
ENDIF
RETURN HtmlFile$
END DEF
'r'
DEF LatestFile$(undated$) ' find latest datafile
File$=""
DIR "." LIST FILES A$,n
FOR i=1 TO n
IF INSTR(a$(i),undated$,1)=1 THEN File$=a$(i)
NEXT i
Date$=RIGHT$(File$,8)
RETURN File$
END DEF
''
'r'
DEF ISO_Date$
Date$=STR$(CURRENT_YEAR()*10000+100*CURRENT_MONTH()+CURRENT_DATE(),"########")
ISO_Date$=Date$
END DEF ' ISO_Date$
''
'r'
DEF PageContent$(file$) ' read html-content
FILE file$ SETPOS 0
content$=""
WHILE NOT FILE_END(file$)
FILE file$ READLINE line$
content$&=Line$
END WHILE
RETURN content$
END DEF
''
'r'
DEF Input$(Field$,Prompt$)
' Inline input by Dutchman
prompt=LEN(Prompt$)
FIELD Field$ BACK COLOR 1,0,0
FIELD Field$ SHOW
FIELD Field$ SELECT
DO
IF FIELD_CURSOR_POS(Field$)<prompt THEN FIELD Field$ TEXT Prompt$
SLOWDOWN
UNTIL FIELD_CHANGED(Field$)
Txt$=FIELD_TEXT$(Field$)
T$=RIGHT$(Txt$,LEN(Txt$)-prompt)
RETURN T$
END DEF
''
'r'
DEF Quicksort$(Array$(,),MaxRow,Rowsize,SortColumn)' for STRINGS
' by Dutchman
' Non-recursive version of the QuickSort algorithm
' This sortfunction operates on a 2-dimensional string-array
' Number of rows is <MaxRow> and number of columns is <RowSize>
' The variable <SortColumn> determines which column is sorted
ShowMaxStack=0 ' will display stack-usage if set to 1
MaxStackPtr=0
DIM SwapRow$(RowSize), Stack1$(30), Stack2$(30)
StackPtr=0 ! HeadPtr=1 ! TailPtr=MaxRow
Qlabel2:
IF HeadPtr>TailPtr THEN
GOTO Qlabel4
ELSE
Pivot$= CAPSTR$(Array$((HeadPtr+TailPtr)/2,SortColumn))
qa=HeadPtr ! qb=TailPtr
Qlabel1:
IF CAPSTR$(Array$(qa,SortColumn))<Pivot$ THEN ' while2
qa=qa+1
GOTO Qlabel1
END IF '1
Qlabel3:
IF CAPSTR$(Array$(qb, SortColumn))>Pivot$ THEN
qb=qb-1
GOTO Qlabel3
END IF '2
IF qa<qb THEN
' swap rows
FOR qi=1 TO RowSize
SwapRow$(qi)=Array$(qa,qi)'save row qa
Array$(qa,qi)=Array$(qb,qi)'store row qb content in row qa
Array$(qb,qi)=SwapRow$(qi)'restore content of row qa to row qb
NEXT qi
qa=qa+1
qb=qb-1
GOTO Qlabel1
END IF '3
IF qa=qb THEN
qq = qb - 1
qr = qa + 1
ELSE
qq = qb
qr = qa
END IF '4
StackPtr = StackPtr + 1
IF MaxStackPtr<StackPtr THEN
MaxStackPtr=StackPtr
END IF '5
qp=HeadPtr
qs=TailPtr
IF (qq-qp)<(qs-qr) THEN
Stack1$(StackPtr)=qr
Stack2$(StackPtr)=qs
HeadPtr=qp
TailPtr=qq
ELSE
Stack1$(StackPtr) = qp
Stack2$(StackPtr) = qq
HeadPtr = qr
TailPtr = qs
END IF '6
GOTO Qlabel2
END IF '7
Qlabel4:
IF StackPtr > 0 THEN
HeadPtr = Stack1$(StackPtr)
TailPtr = Stack2$(StackPtr)
StackPtr = StackPtr - 1
GOTO Qlabel2
END IF '8
IF ShowMaxStack THEN
PRINT "Maximum stacksize=";MaxStackPtr
END IF '9
END DEF ' QuickSort$
- Screenshot.JPG (54.13 KiB) Viewed 6837 times
