100 PROGRAM "IBAN.bas"
110 STRING CO$(1 TO 93)*2
120 NUMERIC LG(1 TO 93)
130 FOR I=1 TO 93
140   READ CO$(I),LG(I)
150 NEXT
160 DO
170   PRINT :PRINT "IBAN code: ":INPUT PROMPT ">":IB$
180   IF IB$="" THEN EXIT DO
190   IF IBAN(IB$) THEN
200     PRINT "CRC ok."
210   ELSE
220     SET #102:INK 3:PRINT "CRC error.":SET #102:INK 1
230   END IF
240 LOOP
250 DEF TRIM$(S$)
260   LET T$=""
270   FOR I=1 TO LEN(S$)
280     IF S$(I)>CHR$(47) AND S$(I)<CHR$(91) THEN LET T$=T$&S$(I)
290   NEXT
300   LET TRIM$=T$
310 END DEF
320 DEF IBAN(IB$)
330   LET IB$=TRIM$(UCASE$(IB$)):LET T$="":LET M,IBAN=0:LET N=FIND(IB$(1:2))
340   IF N=0 THEN PRINT "Invalid country code.":EXIT DEF
350   IF LEN(IB$)<>LG(N) THEN PRINT "Number length does not match.":EXIT DEF
360   LET IB$=IB$&IB$(1:4):LET IB$=IB$(5:)
370   CALL CONVERT(IB$)
380   FOR I=1 TO LEN(IB$)
390     LET T$=STR$(M)&IB$(I)
400     LET M=MOD(VAL(T$),97)
410   NEXT
420   IF M=1 THEN LET IBAN=-1
430 END DEF
440 DEF FIND(S$)
450   LET FIND=0
460   LET BO=LBOUND(CO$):LET UP=UBOUND(CO$)
470   DO
480     LET K=INT((BO+UP)/2)
490     IF CO$(K)<S$ THEN LET BO=K+1
500     IF CO$(K)>S$ THEN LET UP=K-1
510   LOOP WHILE BO<=UP AND CO$(K)<>S$
520   IF BO<=UP THEN LET FIND=K
530 END DEF
540 DEF CONVERT(REF S$)
550   LET T$=""
560   FOR I=1 TO LEN(S$)
570     IF S$(I)>CHR$(64) AND S$(I)<CHR$(91) THEN
580       LET T$=T$&STR$(ORD(S$(I))-55)
590     ELSE
600       LET T$=T$&S$(I)
610     END IF
620   NEXT
630   LET S$=T$
640 END DEF
650 DATA AD,24,AE,23,AL,28,AO,25,AT,20,AZ,28,BA,20,BE,16,BF,28,BG,22,BH,22,BI,16,BJ,28,BR,29,BY,28,CG,27,CH,21,CI,28,CM,27,CR,22,CV,25,CY,28,CZ,24,DE,22,DK,18,DO,28,DZ,24,EE,20,EG,27,ES,24,FI,18,FO,18,FR,27,GA,27,GB,22,GE,22,GI,23,GL,18
660 DATA GR,27,GT,28,HN,28,HR,21,HU,28,IE,22,IL,23,IR,26,IS,26,IT,27,JO,30,KM,27,KW,30,KZ,20,LB,28,LI,21,LT,20,LU,20,LV,21,MA,28,MC,27,MD,24,ME,22,MG,27,MK,19,ML,28,MR,27,MT,31,MU,30,MZ,25,NE,28,NI,32,NL,18,NO,15,PK,24,PL,28,PS,29,PT,25
670 DATA QA,29,RO,24,RS,22,SA,24,SE,24,SI,19,SK,24,SM,27,SN,28,TD,27,TG,28,TL,23,TN,24,TR,26,UA,29,VG,24,XK,20