Page 1 of 2

UpdateCurrencies functions

Posted: Wed Oct 24, 2018 2:10 pm
by Dutchman
Watching TV for a week you might see a lot of foreign currency pass by. A Scandinavian corrupt politician who receives 25,000 Krona kickbacks, a Swiss banker who receives 3,000 Franks for an illegal trade and a camel sold for 415 Dinar in Libya.
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&amp;to=ARS'>36.446414</a></td>
<td class='rtRates'><a href='… url …/?from=ARS&amp;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
Screenshot.JPG (54.13 KiB) Viewed 6842 times
Truth table is obsolete but could not be removed from this post.

Re: Valuta's for iConvert

Posted: Wed Oct 24, 2018 8:37 pm
by rbytes
This is a nice update. Thanks, Ton. I will happily accept it, although I would prefer to change the name of the category Valuta to Currencies.

I recently discovered a similar currency website with downloadable data, but am pleased not to have to do the rest of the work! :D

My next program will be something Monty Pythonish (ie. completely different)

Re: Valuta's for iConvert

Posted: Thu Oct 25, 2018 1:24 am
by rbytes
I have to share this. My step-daughter posted this on Facebook. That is quite a coincidence, since as far as I know she was unaware of my interest in the topic. Take a look at these conversions - they are very funny!


3CCAB8C9-AA77-4BF6-8014-4C1F7FFF4F4D.jpeg
3CCAB8C9-AA77-4BF6-8014-4C1F7FFF4F4D.jpeg (124.77 KiB) Viewed 6854 times

Re: Valuta's for iConvert

Posted: Thu Oct 25, 2018 9:14 am
by Dutchman
Very funny indeed :lol:

Re: Currencies for iConvert

Posted: Thu Oct 25, 2018 1:25 pm
by Dutchman
rbytes wrote:
Wed Oct 24, 2018 8:37 pm
This is a nice update. Thanks, Ton. I will happily accept it, although I would prefer to change the name of the category Valuta to Currencies.
…snip
I have changed "Valuta" in the code to "Currency" according to your wishes, including related changes in variables etc. :D

Re: Currencies for iConvert

Posted: Thu Oct 25, 2018 1:38 pm
by rbytes
Nice! 8-)

This can be an ongoing project for both of us, to add new categories as the need arises.

If other Forum members have requests for conversion categories, please send a comment to let us know.

Re: Currencies for iConvert

Posted: Thu Oct 25, 2018 1:49 pm
by Dutchman
rbytes wrote:
Thu Oct 25, 2018 1:38 pm
Nice! 8-)

This can be an ongoing project for both of us, to add new categories as the need arises.

If other Forum members have requests for conversion categories, please send a comment to let us know.
I suggest that you then publish the latest version with the omission of markings on changes and in the format (e.g. version number) to your wishes. ;)

By the way, see http://www.onlineconversion.com

Re: Currencies for iConvert

Posted: Thu Oct 25, 2018 8:15 pm
by rbytes
OK. I will post it as version 3.1, so it isn't confused with version 3. I removed the highlighted areas and gave you a credit more suited to your contributions. :)

Re: Currencies for iConvert

Posted: Thu Oct 25, 2018 10:15 pm
by Dutchman
Thanks. I am very happy with the collection of conversions.👍

Update currencies V2

Posted: Fri Nov 02, 2018 9:50 pm
by Dutchman
Obsolete