I had to write a input routine for IBAN numbers. Old numbers must be converted.
Searching in the forum i found some tip's , no complete example.
Writing first a testmodule , i am glad to deal it , hoping it is usefull.
The inputroutine ask's first the land . This determines also the picture clausule from the bank account number .
This data comes from Wikipedia , i provided data for 48 country's ( you have to create IbanLand.txt , see source)
If the first two characters are blank , the Controle number is calculated. If not , the valid clausule controles this number
FRank
- Code: Select all Expand view RUN
# include "FiveWin.ch"
#xcommand DBG <vars,...> => ;
XBrowse( ArrTranspose( \{ \{ <"vars"> \}, Eval( \{ || \{ <vars> \} \} ) \} ), ;
ProcName(0) + " : Line : " + LTrim( Str( ProcLine(0))) + " " + ProcName(1) + " : Line : " + LTrim( Str( ProcLine(1) ) ),, ;
{ |o| o:cHeaders := { "Variable", "Value" } } )
STATIC cSep := "-" // Used in FORMAT from GET (Bank number)
FUNC MAIN(TestNr)
***********************
local oDlg , oGet[2]
local hPict := Hash()
local aLand := ReadTxt("IbanLand.txt",hPict) , cLand := " " , cNr := SPACE(31)
local nH := 400 , nB := 600 , nRow := 50
local cOri
local lOk := .F.
local chars := "0123456789" , i
IF TestNr == nil
TestNr := "BE" + PAD(" 979797979797",32)
//TestNr := "NL" + PAD(" INGB0001234567" , 32)
//TestNr := "NL" + PAD(" INGB0736160221" , 32) // to test 11 trial
END
TestNr := UPPER(TestNr)
FOR i := ASC("A") TO ASC("Z")
Chars += CHR(i)
NEXT
TestNr := SUBSTR(TestNr,1,4) + CharOnly(Chars,SUBSTR(TestNr,5))
cLand := LEFT(TestNr,2)
cNr := SUBSTR(TestNr,3)
DEFINE DIALOG oDlg TITLE "Testing IBAN " ;//COLOR "W+/B"
FROM 0 , 0 TO 400 , 600 PIXEL
DEFINE FONT oDlg:oFont NAME GetSysFont() SIZE 0, -14 // BOLD
@ 50 , 10 SAY "Bank number : " OF oDlg RIGHT PIXEL SIZE 50,10
@ 50 , 60 GET oGet[1] VAR cLand OF oDlg SIZE 30,10 PIXEL ;
ACTION ComboLand(aLand,oGet[1],oGet[2],hPict);
VALID IIF(ASCAN(aLand,{|a|a[1]==cLand})==0 , ComboLand(aLand,oGet[1],oGet[2],hPict) , (ChangPict(oGet,hPict),.T.) ) ;
PICTURE "@K !!"
@ 50 , 90 GET oGet[2] VAR cNr OF oDlg PIXEL VALID ContrIbam(cLand,oGet[2],cOri,aLand);
WHEN (cOri := oGet[2]:Varget(),.T.) SIZE 200,12;
PICTURE hPict[cLand]
oGet[2]:bKeydown := {|nKey|IIF(nKey==27,(oGet[2]:Varput(cOri),oGet[2]:Refresh()),)}
@ nH/2 - 20 , 5 BUTTON "&Ok" SIZE 40, 12 PIXEL ;
ACTION (lOk := .T. , oDlg:end() )
ACTIVATE DIALOG oDlg CENTERED VALID lOk
return nil
************************************************************************************
FUNC ContrIbam(cLand,oGet,cOri,aLand)
*****************************************
LOCAL cContr , c , cTxt := "" , Nr , cNr
LOCAL x , y , i
Nr := ASCAN(aLand,{|a|a[1]==cLand})
cNr := TRIM(oGet:Varget())
IF aLand[Nr,3]<>LEN(cNr)+2
// LEN(cNr) doesn't match
RETURN .F.
END
IF cLand == "BE" // Controle last two characters on modulus 97
IF MyMod(SUBSTR(cNr,3,10),.T.) <> RIGHT(cNr,2) // Modulus 97
RETURN .F.
END
ELSEIF cLand == "NL" .AND. SUBSTR(cNr,3,7) <> "INGB000"
// 11-proef
x := 0
y := RIGHT(cNr,9)
FOR i := 1 TO 9
x += VAL(y[i])*(10-i)
NEXT
IF x%11 <> 0
RETURN .F.
END
END
IF cNr[1]$"0123456789" .AND. cNr[2]$"0123456789"
// All ready Iban number , controle on this number
cContr := LEFT(cNr,2)
cNr := SUBSTR(cNr,3)
FOR EACH c IN cNr + cLand //cnr
IF ASC(c) > 64
cTxt += STR(Asc(c)-55,2)
ELSE
cTxt += c
END
NEXT
cTxt += "00"
RETURN cContr == MyMod(cTxt)
ELSE
// Iban controle number must be calculated
FOR EACH c IN SUBSTR(cNr,3)+cLand
IF ASC(c) > 64
cTxt += STR(Asc(c)-55,2)
ELSE
cTxt += c
END
NEXT
cTxt += "00"
cNr := PAD(MyMod(cTxt)+SUBSTR(cNr,3),32)
oGet:Varput(cNr)
oGet:Refresh()
ENDIF
RETURN .T.
******************************************************************************************
FUNC MyMod(c,lMode)
*******************
LOCAL cStart , nPos , x , d
DEFAULT lMode := .F.
IF lMode // VAL(c)%97 is ok , LEN(c) < 10
x := VAL(c)%97
IF x == 0
x := 97
END
x := STRZERO(x,2)
RETURN x
END
nPos := 1
x := ""
d := 9
DO WHIL nPos <= LEN(c)
cStart := x+SUBSTR(c,nPos,d)
nPos += d
d := 7
x := STRZERO(VAL(cStart)%97,2)
END
x := STRZERO(98 - VAL(x),2)
RETURN x
*********************************************************************
STATIC FUNC ReadTxt(cFile,hPict)
// Format : Bulgaria BG 22 4a,6n,8c PICTURE : BG99 AAAA 9999 99NN NNNN NN
// 25 30 35
LOCAL h[0]
LOCAL n := fOpen(cFile)
LOCAL c , cLand , cCode , nWidth ,cBban , cC
Local x , i , j , nLen , nPos
LOCAL hCode := Hash()
hCode["a"] := "A"
hCode["n"] := "9"
hCode["c"] := "N"
DO WHILE HB_FReadLine(n,@c)==0
cLand := SUBSTR(c,25,2)
nWidth := VAL(SUBSTR(c,30,2))
cBban := TRIM(SUBSTR(c,35,10))
AADD(h,{cLand ,LEFT(c,24) , nWidth , SUBSTR(c,35,10)})
x := ""
j := 1
nPos := 0
FOR i := 1 TO NumToken(cBban,",")
cCode := Token(cBban,",",i)
cC := RIGHT(cCode,1)
nLen := VAL(cCode)
FOR j := 1 TO nLen
x += hCode[cC]
nPos++
IF nPos%4==0 .AND. nPos < nWidth - 4
x += cSep //" " // Or other character as "-"
END
NEXT
NEXT
hPict[cLand] := "@KR! ##" + cSep + x
END
fClose(n)
RETURN h
********************************************************************************
STATIC FUNC ComboLand(aLand,oGet,NextGet,hPict)
***********************************************
LOCAL oDlg , oBrw , oButOk
LOCAL coord[0]
LOCAL cReturn
LOCAL cMem := cReturn := oGet:Varget()
LOCAL Len := LEN(cReturn)
LOCAL oFont
LOCAL nCharWidth , z
LOCAL lOk := .F. , bEnd
LOCAL nAt
DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-14
nCharWidth := 10 //oFont:nWidth
Coord := bepcoordWnd(oGet,aLand,2,nCharWidth)
DEFINE DIALOG oDlg FROM Coord[1] , Coord[2] TO Coord[3] , Coord[4] TITLE "Select" ;
PIXEL
bEnd := {||lOk := .T. , cReturn := oBrw:aRow[1], oDlg:end() }
@ 0,0 XBROWSE oBrw ARRAY aLand PIXEL OF oDlg FONT oFont;
COLUMNS {1,2};
HEADERS {"Code","Land Name"};
COLSIZES {30,200};
SIZE (oDlg:nRight - oDlg:nLeft)/2 , (oDlg:nBottom -oDlg:nTop)/2-10;
AUTOSORT LINES
WITH OBJECT oBrw
:GetDisplayCols()
:nStretchCol := STRETCHCOL_WIDEST
:ColStretch()
:BrwFitSize( .T. )
:oWnd:Center()
:SetFocus()
END
oBrw:bkeyDown := { | nkey | IIF(nkey==13 , EVAL(bEnd) , ) }
oBrw:bLDblClick := {||EVAL(bEnd) }
z := oBrw:nWidth
@ INT((Coord[3]-Coord[1])/2)-8 , 2 SAY "cSeek : " OF oDlg SIZE 30,10 PIXEL
oBrw:cSeek := cReturn
@ INT((Coord[3]-Coord[1])/2)-8 , 22 SAY oBrw:oseek Prompt oBrw:cSeek OF oDlg SIZE z - 47 ,8 PIXEL UPDATE color CLR_RED,CLR_YELLOW FONT oFont
@ INT((Coord[3]-Coord[1])/2)-10 , z - 20 BUTTON oButOk Prompt "OK" OF oDlg SIZE 20 , 12 PIXEL ACTION EVAL(bEnd)
oBrw:CreateFromCode()
ACTIVATE DIALOG oDlg ON INIT (nAt := oBrw:nArrayAt := MAX(ASCAN(oBrw:aArrayData,{|a|a[1]=TRIM(cReturn)}),1) ,;
oBrw:nRowSel := SeekMidLine(oBrw,nAt) ,;
xSetfocus(oBrw))
RELEASE FONT oFont
IF lOk
cReturn := oBrw:aRow[1]
IF cMem <> cReturn
oGet:varput(cReturn)
oGet:Refresh()
Nextget:Varput(SPACE(40))
Nextget:cPicture := NextGet:oGet:Picture := hPict[cReturn]
Nextget:Refresh()
END
xSetfocus(Nextget)
END
RETURN lOk
RETURN cReturn
***********************************************************************************************
FUNC bepcoordWnd(oGet,Arr,L,nCharWidth)
**********************************************
LOCAL hWnd := oget:hWnd() , el , WinBr := 0 , i , n := 60
LOCAL Coord
coord := GetWndRect( hWnd)
FOR i :=1 TO L
WinBr += LEN(Arr[1,i])*nCharWidth
IF i == L
EXIT
END
NEXT
winBr += 30
coord[1] := coord[3]
coord[3] := coord[1] + (24 + MIN(Len(Arr) , 12)*22) + 25 //::BepHoogte()
coord[4] := coord[2] + WinBr
IF (el := Coord[3] - ( GetSysMetrics(1) - n ) ) > 0
Coord[1] -= el
Coord[3] -= el
END
RETU Coord
***************************************************
STATIC FUNC SeekMidLine(oBrw,nAt)
**********************************
LOCAL nMid , nRow
DEFAULT nAt := oBrw:nAt
WITH OBJECT oBrw
nMid := INT(:RowCount()/2)
IF nMid <= nAt .AND. nAt <= :nLen - nMid
nRow := nMid
ELSEIF nAt < nMid
nRow := nAt
ELSE
nRow := :RowCount() - (oBrw:nLen-nAt)
END
END
RETURN nRow
****************************************************************
*****************************************************************************************
function xSetFocus( oObx )
**************************
// function from local.fivewin.english 4/1/2003 Kleyber Derick
local oTempo:=""
local lGet := oObx:ClassName $ "TGET TMULTIGET"
define timer oTempo interval 10 of oObx:oWnd ;
action (oObx:SetFocus(), IIF(lGet , oObx:SetPos(0) , ), oTempo:Deactivate() )
activate timer oTempo
return nil
**************************************************************************
PROC ChangPict(aGet,hPict)
**************************
LOCAL cLand
IF aGet[1]:oGet:Changed
cLand := aGet[1]:Varget()
aGet[2]:Varput(SPACE(32))
aGet[2]:cPicture := aGet[2]:oGet:Picture := hPict[cLand]
aGet[2]:Refresh()
END
RETURN
/*
File Ibanland.txt :
*******************
Andorra AD 24 8n,12c a:A-Z , n 0..9 , c a..z A..Z 0..9
Albania AL 28 8n,16c
Austria AT 20 16n
Bosnia and Herzegovina BA 20 16n
Belgium BE 16 12n
Bulgaria BG 22 4a,6n,8c PICTURE : BG99 AAAA 9999 99NN NNNN NN
Cyprus CY 28 8n,16c
Czech Republic CZ 24 20n
Denmark DK 18 14n
Estonia EE 20 16n
Finland FI 18 14n
Faroe Islands FO 18 14n
France FR 27 10n,11c,2n
Germany DE 22 18n
Georgia GE 22 2c,16n
Gibraltar GI 23 4a,15c
Greenland GL 18 14n
Greece GR 27 7n,16c
Croatie HR 21 17n
Hungary HU 28 24n
Ireland IE 23 4c,14n
Israel IL 23 19n
Iceland IS 26 22n
Italy IT 27 1a,10n,12c
Lebanon LB 28 4n,20c
Liechtenstein LI 21 5n,12c
Lithunia LT 20 16n
Latvia LV 21 4a,13c
Luxembourg LU 16 3n,13c
Macedonia MK 15 3n,10c,2n
Malta MT 31 4a,5n,18c
Monaco MC 27 10n,11c,2n
Montenegro ME 22 18n
Netherlands NL 18 4a,10n
Norway NO 15 11n
Poland PL 28 24n
Portugal PT 25 21n
Romania RO 24 4a,16c
Saudi Arabia SA 24 2n,18c
San Marino SM 27 1a,10n,12c
Serbia RS 22 18n
Slovakia SK 24 20n
Slovenia SI 19 15n
Spain ES 24 20n
Sweden SE 24 20n
Switzerland CH 21 5n,12c
Turkey TR 26 5n,17c
United Kingdom GB 22 4a,14n
*/
