Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ** / ********************************************* ************************
- FUNCTION GenBic (pcEntity, plMsg)
- ** --------------------------------------------- **
- * Routine to calculate the BIC code from the CCC code - VALID only for SPAIN-
- * Parameters:
- * pcEntity = Code of the entity. Corresponds to positions 1 to 4 of the CCC
- * plMsg = Option to activate warning messages
- * ------------------------------------------------- ----
- plMsg = IIF (vartype (plMsg) = 'L', plMsg, .F.)
- IF empty (pcEntity)
- if plMsg
- Messagebox ('The entity code is unknown', 32, 'BIC Code')
- endif
- return ('')
- endif
- IF vartype (pcEntity) = 'N'
- pcEntity = PADL (alltrim (str (pcEntity)), 4, '0')
- endif
- IF len (PCEntity)! = 4
- if plMsg
- Messagebox ('Bad entity code', 32, 'BIC code')
- endif
- return (space (11))
- endif
- local lcBIC, llError, lcDevuelve
- lcBIC = 'BIC' + pcEntity
- BIC0003 = 'BDEPESM1XXX'
- BIC0011 = 'ALLFESMMXXX'
- BIC0019 = 'DEUTESBBXXX'
- BIC0021 = 'BCNDESM1XXX'
- BIC0030 = 'ESPCESMMXXX'
- BIC0031 = 'ETCHES2GXXX'
- BIC0036 = 'SABNESMMXXX'
- BIC0046 = 'GALEES2GXXX'
- BIC0049 = 'BSCHESMMXXX'
- BIC0057 = 'BVADESMMXXX'
- BIC0058 = 'BNPAESMMXXX'
- BIC0059 = 'MADRESMMXXX'
- BIC0061 = 'BMARES2MXXX'
- BIC0065 = 'BARCESMMXXX'
- BIC0072 = 'PSTRESMMXXX'
- BIC0073 = 'OPENESMMXXX'
- BIC0075 = 'POPUESMMXXX'
- BIC0078 = 'BAPUES22XXX'
- BIC0081 = 'BSABESBBXXX'
- BIC0083 = 'RENBESMMXXX'
- BIC0086 = 'NORTESMMXXX'
- BIC0093 = 'VALEESVVXXX'
- BIC0094 = 'BVALESMMXXX'
- BIC0099 = 'AHCRESVVXXX'
- BIC0106 = 'LOYDESMMXXX'
- BIC0107 = 'BNLIESM1XXX'
- BIC0108 = 'SOGEESMMXXX'
- BIC0113 = 'INBBESM1XXX'
- BIC0121 = 'OCBAESM1XXX'
- BIC0122 = 'CITIES2XXXX'
- BIC0125 = 'BAOFESM1XXX'
- BIC0128 = 'BKBKESMMXXX'
- BIC0129 = 'INALESM1XXX'
- BIC0130 = 'CGDIESMMXXX'
- BIC0131 = 'BESMESMMXXX'
- BIC0132 = 'PRNEESM1XXX'
- BIC0133 = 'MIKBESB1XXX'
- BIC0136 = 'AREBESMMXXX'
- BIC0138 = 'BKOAES22XXX'
- BIC0144 = 'PARBESMXXXX'
- BIC0145 = 'DEUTESM1XXX'
- BIC0149 = 'BNPAESMSXXX'
- BIC0151 = 'CHASESM3XXX'
- BIC0152 = 'BPLCESMMXXX'
- BIC0154 = 'BSUIESMMXXX'
- BIC0155 = 'BRASESMMXXX'
- BIC0156 = 'ABNAESMMXXX'
- BIC0159 = 'COBAESMXXXX'
- BIC0160 = 'BOTKESMXXXX'
- BIC0161 = 'BKTRESM1XXX'
- BIC0162 = 'MIDLESMMXXX'
- BIC0167 = 'GEBAESMMXXX'
- BIC0168 = 'BBRUESMXXXX'
- BIC0169 = 'NACNESMMXXX'
- BIC0182 = 'BBVAESMMXXX'
- BIC0184 = 'BEDFESM1XXX'
- BIC0186 = 'BFIVESBBXXX'
- BIC0188 = 'ALCLESMMXXX'
- BIC0190 = 'BBPIESMMXXX'
- BIC0196 = 'WELAESMMXXX'
- BIC0198 = 'BCOEESMMXXX'
- BIC0200 = 'PRVBESB1XXX'
- BIC0205 = 'DECRESM1XXX'
- BIC0211 = 'PROAESMMXXX'
- BIC0216 = 'POHIESMMXXX'
- BIC0217 = 'HLFXESMMXXX'
- BIC0218 = 'FCEFESM1XXX'
- BIC0219 = 'BMCEESMMXXX'
- BIC0220 = 'FIOFESM1XXX'
- BIC0223 = 'GEECESB1XXX'
- BIC0224 = 'SCFBESMMXXX'
- BIC0225 = 'FIEIESM1XXX'
- BIC0226 = 'UBSWESMMXXX'
- BIC0227 = 'UNOEESM1XXX'
- BIC0228 = 'IXIUESM1XXX'
- BIC0229 = 'POPLESMMXXX'
- BIC0231 = 'DSBLESMMXXX'
- BIC0232 = 'INVLESMMXXX'
- BIC0233 = 'POPIESMMXXX'
- BIC0234 = 'CCOCESMMXXX'
- BIC0235 = 'PIESESM1XXX'
- BIC0236 = 'LOYIESMMXXX'
- BIC0237 = 'CSURES2CXXX'
- BIC0486 = 'THREE2BXXX'
- BIC0487 = 'GBMNESMMXXX'
- BIC0488 = 'BFASESMMXXX'
- BIC1000 = 'ICROESMMXXX'
- BIC1113 = 'BSUDESM1XXX'
- BIC1116 = 'SCSIESM1XXX'
- BIC1127 = 'SCBLESM1XXX'
- BIC1156 = 'IRVTESM1XXX'
- BIC1164 = 'ESBFESM1XXX'
- BIC1168 = 'BNACESM1XXX'
- BIC1173 = 'COURESB1XXX'
- BIC1182 = 'HYVEESM1XXX'
- BIC1191 = 'HANDES21XXX'
- BIC1193 = 'PKBSES21XXX'
- BIC1196 = 'AEEVESM1XXX'
- BIC1197 = 'BILLESB1XXX'
- BIC1199 = 'CRGEESM1XXX'
- BIC1209 = 'ABCMESM1XXX'
- BIC1210 = 'REDEESM1XXX'
- BIC1221 = 'PNBMESM1XXX'
- BIC1224 = 'RHRHESM1XXX'
- BIC1227 = 'BSSAESB1XXX'
- BIC1231 = 'BOCAES21XXX'
- BIC1233 = 'BCMAESM1XXX'
- BIC1234 = 'PRBAESM1XXX'
- BIC1236 = 'HELAESM1XXX'
- BIC1238 = 'BIMEESM1XXX'
- BIC1240 = 'LOFPESB1XXX'
- BIC1241 = 'STOLESM1XXX'
- BIC1242 = 'SOLAESB1XXX'
- BIC1245 = 'BEIVESM1XXX'
- BIC1248 = 'WAFAESM1XXX'
- BIC1249 = 'NPBSES21XXX'
- BIC1251 = 'IHZUES21XXX'
- BIC1255 = 'AARBESM1XXX'
- BIC1451 = 'CRCGESB1XXX'
- BIC1454 = 'NEWGESM1XXX'
- BIC1457 = 'LLISESM1XXX'
- BIC1459 = 'PRABESMMXXX'
- BIC1460 = 'CRESESMMXXX'
- BIC1462 = 'ASSCESM1XXX'
- BIC1463 = 'PSABESM1XXX'
- BIC1464 = 'NFFSESM1XXX'
- BIC1465 = 'INGDESMMXXX'
- BIC1466 = 'FRANESM1XXX'
- BIC1467 = 'EHYPESMXXXX'
- BIC1469 = 'SHSAESM1XXX'
- BIC1470 = 'BPIPESM1XXX'
- BIC1472 = 'UCSSESM1XXX'
- BIC1473 = 'PRIBESMXXXX'
- BIC1474 = 'CITIESMXXXX'
- BIC1475 = 'CCSEESM1XXX'
- BIC1478 = 'MLIBESM1XXX'
- BIC1479 = 'NATXESMMXXX'
- BIC1480 = 'VOWAES21XXX'
- BIC1485 = 'BOFAES2XXXX'
- BIC1488 = 'PICTESMMXXX'
- BIC1490 = 'SELFESMMXXX'
- BIC1491 = 'TRIOESMMXXX'
- BIC1494 = 'BCITESMMXXX'
- BIC1497 = 'ESSIESMMXXX'
- BIC1501 = 'DPBBESM1XXX'
- BIC1502 = 'IKBDESM1XXX'
- BIC1505 = 'ARABESMMXXX'
- BIC1506 = 'MLCBESM1XXX'
- BIC1522 = 'EFGBESMMXXX'
- BIC1524 = 'UBIBESMMXXX'
- BIC1525 = 'BCDMESMMXXX'
- BIC1534 = 'KBLXESMMXXX'
- BIC1538 = 'ICBKESMMXXX'
- BIC1544 = 'BACAESMMXXX'
- BIC1545 = 'AGRIESMMXXX'
- BIC2000 = 'CECAESMMXXX'
- BIC2010 = 'CECAESMM010'
- BIC2013 = 'CESCESBBXXX'
- BIC2017 = 'CECAESMM017'
- BIC2018 = 'CECAESMM018'
- BIC2031 = 'CECAESMM031'
- BIC2038 = 'CAHMESMMXXX'
- BIC2043 = 'CECAESMM043'
- BIC2045 = 'CECAESMM045'
- BIC2048 = 'CECAESMM048'
- BIC2051 = 'CECAESMM051'
- BIC2052 = 'CECAESMM052'
- BIC2056 = 'CECAESMM056'
- BIC2066 = 'CECAESMM066'
- BIC2080 = 'CAGLESMMVIG'
- BIC2081 = 'CECAESMM081'
- BIC2085 = 'CAZRES2ZXXX'
- BIC2086 = 'CECAESMM086'
- BIC2095 = 'BASKES2BXXX'
- BIC2096 = 'CSPAES2LXXX'
- BIC2099 = 'CECAESMM099'
- BIC2100 = 'CAIXESBBXXX'
- BIC2101 = 'CGGKES22XXX'
- BIC2103 = 'UCJAES2MXXX'
- BIC2104 = 'CSSOES2SXXX'
- BIC2105 = 'CECAESMM105'
- BIC2107 = 'BBVAESMM107'
- BIC2108 = 'CSPAES2L108'
- BIC3001 = 'BCOEESMM001'
- BIC3007 = 'BCOEESMM007'
- BIC3008 = 'BCOEESMM008'
- BIC3009 = 'BCOEESMM009'
- BIC3016 = 'BCOEESMM016'
- BIC3017 = 'BCOEESMM017'
- BIC3018 = 'BCOEESMM018'
- BIC3020 = 'BCOEESMM020'
- BIC3023 = 'BCOEESMM023'
- BIC3025 = 'CDENESBBXXX'
- BIC3029 = 'CCRIES2A029'
- BIC3035 = 'CLPEES2MXXX'
- BIC3045 = 'CCRIES2A045'
- BIC3058 = 'CCRIES2AXXX'
- BIC3059 = 'BCOEESMM059'
- BIC3063 = 'BCOEESMM063'
- BIC3067 = 'BCOEESMM067'
- BIC3070 = 'BCOEESMM070'
- BIC3076 = 'BCOEESMM076'
- BIC3080 = 'BCOEESMM080'
- BIC3081 = 'BCOEESMM081'
- BIC3084 = 'CVRVES2BXXX'
- BIC3085 = 'BCOEESMM085'
- BIC3089 = 'BCOEESMM089'
- BIC3095 = 'CCRIES2A095'
- BIC3096 = 'BCOEESMM096'
- BIC3098 = 'BCOEESMM098'
- BIC3102 = 'BCOEESMM102'
- BIC3104 = 'BCOEESMM104'
- BIC3105 = 'CCRIES2A105'
- BIC3110 = 'BCOEESMM110'
- BIC3111 = 'BCOEESMM111'
- BIC3112 = 'CCRIES2A112'
- BIC3113 = 'BCOEESMM113'
- BIC3115 = 'BCOEESMM115'
- BIC3116 = 'BCOEESMM116'
- BIC3117 = 'BCOEESMM117'
- BIC3118 = 'CCRIES2A118'
- BIC3119 = 'CCRIES2A119'
- BIC3121 = 'CCRIES2A121'
- BIC3123 = 'CCRIES2A123'
- BIC3127 = 'BCOEESMM127'
- BIC3130 = 'BCOEESMM130'
- BIC3134 = 'BCOEESMM134'
- BIC3135 = 'CCRIES2A135'
- BIC3137 = 'CCRIES2A137'
- BIC3138 = 'BCOEESMM138'
- BIC3140 = 'BCOEESMM140'
- BIC3144 = 'BCOEESMM144'
- BIC3146 = 'CCCVESM1XXX'
- BIC3150 = 'BCOEESMM150'
- BIC3152 = 'CCRIES2A152'
- BIC3157 = 'CCRIES2A157'
- BIC3159 = 'BCOEESMM159'
- BIC3160 = 'CCRIES2A160'
- BIC3162 = 'BCOEESMM162'
- BIC3165 = 'CCRIES2A165'
- BIC3166 = 'BCOEESMM166'
- BIC3171 = 'CXAVESB1XXX'
- BIC3172 = 'CCOCESMMXXX'
- BIC3174 = 'BCOEESMM174'
- BIC3177 = 'BCOEESMM177'
- BIC3179 = 'CCRIES2A179'
- BIC3183 = 'CASDESBBXXX'
- BIC3186 = 'CCRIES2A186'
- BIC3187 = 'BCOEESMM187'
- BIC3188 = 'CCRIES2A188'
- BIC3190 = 'BCOEESMM190'
- BIC3191 = 'BCOEESMM191'
- BIC6814 = 'MNTYESMMXXX'
- BIC6852 = 'BMEUESM1XXX'
- BIC8233 = 'CSFAESM1XXX'
- BIC8512 = 'UCINESMMXXX'
- BIC8835 = 'SBFCESMMXXX'
- BIC9000 = 'ESPBESMMXXX'
- ** / Error handling for VFP version 6
- public llErrorBIC
- llErrorBIC = .F.
- ON ERROR DO error_BIC WITH ERROR (), MESSAGE (), MESSAGE (1), PROGRAM (), LINEN ()
- lcDevuelve = & lcBIC
- ON ERROR
- if llErrorBIC
- lcDevuelve = space (11)
- if plMsg
- MESSAGEBOX ('BIC code not found or unknown', 16, 'ERROR')
- endif
- endif
- *! * ** / Error handling for VFP version 9
- *! * TRY
- *! * lcDevuelve = & lcBIC
- *! * CATCH
- *! * lcDevuelve = space (11)
- *! * if plMsg
- *! * MESSAGEBOX ('BIC code not found or unknown', 16, 'ERROR')
- *! * endif
- *! * END
- release llErrorBIC
- return lcDevuelve
- ENDFUNC
- PROCEDURE error_BIC
- PARAMETER merror, mess, mess1, mprog, mlineno
- ** / BIC code does not exist and generates error
- llErrorBIC = .T.
- *! *? 'Error number:' + LTRIM (STR (merror))
- *! *? 'Error message:' + mess
- *! *? 'Line of code with error:' + mess1
- *! *? 'Line number of error:' + LTRIM (STR (mlinene))
- *! *? 'Program with error:' + mprog
- ENDPROC
- FUNCTION CALCULA_IBAN (lcCCC, llIban)
- ** --------------------------------------------- **
- * Routine to calculate the IBAN code from the CCC code - VALID only for SPAIN-
- * Parameters:
- * lcCCC = CCC Code
- * llIban = Option to obtain only the IBAN part (ES + 2 control digits). By default .F.
- * ------------------------------------------------- ----
- LOCAL nParte1 AS Integer, nResul1 AS Integer, cResul1 AS String,;
- nPart2 AS Integer, nResul2 AS Integer, cResul2 AS String ,;
- nPart3 AS Integer, nResul3 AS Integer, cResul3 AS String ,;
- nPart4 AS Integer, nResul4 AS Integer, cResul4 AS String ,;
- CCC AS String, nDigitosControl AS Integer, cDigitosControl AS String
- Local llSoloIBAN
- llSoloIBAN = IIF (vartype (llIban) = 'L', llIban, .F.)
- ** Value of each letter to convert the country code to numeric
- Local A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y , Z
- A = 10
- B = 11
- C = 12
- D = 13
- E = 14
- F = 15
- G = 16
- H = 17
- I = 18
- J = 19
- K = 20
- L = 21
- M = 22
- N = 23
- O = 24
- P = 25
- Q = 26
- R = 27
- S = 28
- T = 29
- U = 30
- V = 31
- W = 32
- X = 33
- Y = 34
- Z = 35
- if parameters ()> 0
- ** / Delete scripts in the CCC and blank spaces
- CCC = alltrim (STRTRAN (STRTRAN (m.lcCCC, '-', ''), '', ''))
- endif
- IF LEN (CCC) # 20
- ** / = MESSAGEBOX ('You must enter a valid CCC (20 digits).', 0 + 32 + 0, 'User information.')
- RETURN (m.CCC)
- ENDIF
- ** Convert the letters of the country (ES) into numbers by applying E = 14; S = 28
- ** In this example I add to the CCC the numbers corresponding to the "ES" and two zeros at the end
- cAux = CCC + '14 '+' 28 '+' 00 '
- ** As the resulting number is very large (26 digits) and VFP can not handle such large numeric or integer fields
- ** what is done is to go calculating by smaller chains (up to 9 digits) and concatenating the partial results
- nPart1 = VAL (SUBSTR (cAux, 1.7))
- nResul1 = MOD (nParte1,97)
- cResul1 = ALLTRIM (STR (nResul1))
- nParte2 = VAL (cResul1 + SUBSTR (cAux, 8.7))
- nResul2 = MOD (nParte2,97)
- cResul2 = ALLTRIM (STR (nResul2))
- nPart3 = VAL (cResul2 + SUBSTR (cAux, 15.7))
- nResul3 = MOD (nPart3,97)
- cResul3 = ALLTRIM (STR (nResul3))
- nParte4 = VAL (cResul3 + SUBSTR (cAux, 22.5))
- nResul4 = MOD (nParte4,97)
- cResul4 = ALLTRIM (STR (nResul4))
- nDigitosControl = 98 - VAL (cResul4)
- cDigitosControl = ALLTRIM (STR (nDigitosControl))
- ** The calculated control digits must be 2 so if the result is less than 10, add a 0 ahead
- cDigitosControl = PADL (cDigitosControl, 2, "0")
- ** / WAIT WINDOW 'CALCULATED IBAN CODE:' + 'ES' + cDigitosControl + CCC
- return ('ES' + cDigitosControl + IIF (llSoloIBAN, '', CCC))
- endfunc
- ** --------------------------------------------- **
- FUNCTION CALCULA_ACREEDOR (lcCIF, lcSufix, llDControl)
- ** --------------------------------------------- **
- * Routine to calculate the CREDITOR code from the CIF of the entity
- * Parameters:
- * lcCIF = CIF of the entity
- * lcSuffix = Code suffix of the entity. By default '000'
- * llDControl = Get only part ES + the two control digits. By default .F.
- * ------------------------------------------------- ----
- LOCAL nParte1 AS Integer, nResul1 AS Integer, cResul1 AS String,;
- nPart2 AS Integer, nResul2 AS Integer, cResul2 AS String ,;
- CIF AS String, nDigitosControl AS Integer, cDigitosControl AS String
- Local llSoloDControl, letraCIF, Sufix
- Suffix = IIF (vartype (lcSufix) = 'C', lcSuffix, '000')
- llDControl = IIF (vartype (llDControl) = 'L', llDControl, .F.)
- ** Value of each letter to convert the country code to numeric
- Local A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y , Z
- A = 10
- B = 11
- C = 12
- D = 13
- E = 14
- F = 15
- G = 16
- H = 17
- I = 18
- J = 19
- K = 20
- L = 21
- M = 22
- N = 23
- O = 24
- P = 25
- Q = 26
- R = 27
- S = 28
- T = 29
- U = 30
- V = 31
- W = 32
- X = 33
- Y = 34
- Z = 35
- if parameters ()> 0
- ** / Remove scripts and blanks in the CIF
- CIF = alltrim (STRTRAN (STRTRAN (m.lcCIF, '-', ''), '', ''))
- endif
- IF LEN (m.CIF) # 9 OR ISDIGIT (m.CIF)
- MESSAGEBOX ('CIF not valid (Letter + 8 digits).', 0 + 32 + 0, 'CIF:' + m.lcCIF)
- RETURN (m.CIF)
- ENDIF
- ** Convert the letters of the country (ES) into numbers by applying E = 14; S = 28 and the letter of the CIF for its value
- ** In this example I add to the CIF the numbers corresponding to the "ES" and two zeros at the end
- letraCIF = SUBSTR (CIF, 1,1)
- cAux = alltrim (str (& letterCIF)) + substr (CIF, 2,8) + '14' + '28' + '00'
- nPart1 = VAL (SUBSTR (cAux, 1.8))
- nResul1 = MOD (nParte1,97)
- cResul1 = ALLTRIM (STR (nResul1))
- nParte2 = VAL (cResul1 + SUBSTR (cAux, 9.8))
- nResul2 = MOD (nParte2,97)
- cResul2 = ALLTRIM (STR (nResul2))
- nDigitosControl = 98 - VAL (cResul2)
- cDigitosControl = ALLTRIM (STR (nDigitosControl))
- ** The calculated control digits must be 2 so if the result is less than 10, add a 0 ahead
- cDigitosControl = PADL (cDigitosControl, 2, "0")
- return ('ES' + cDigitosControl + IIF (llDControl, '', m.Sufix + CIF))
- endfunc
- ** --------------------------------------------- **
- FUNCTION TEXT_IBAN (lcCCC, llOculta, plMsg)
- ** --------------------------------------------- **
- * Routine to display the IBAN code on paper from the CCC code with the possibility of partially hiding the CCC
- * Parameters:
- * lcCCC = CCC Code
- * llOculta = Option to hide part of the CCC
- * plMsg = Option to activate warning messages
- * ------------------------------------------------- ----
- plMsg = IIF (vartype (plMsg) = 'L', plMsg, .F.)
- llOculta = IIF (vartype (llOculta) = 'L', llOculta, .F.)
- IF EMPTY (lcCCC)
- if plMsg
- MESSAGEBOX ('You must enter a valid CCC (20 digits) or a valid IBAN account (24 characters)', 0 + 32 + 0, 'CCC / IBAN Account not valid')
- endif
- RETURN ('IBAN?')
- ENDIF
- ** / Delete scripts in the CCC
- lcCCC = alltrim (STRTRAN (STRTRAN (m.lcCCC, '-', ''), '', ''))
- ** / Check if it is a CCC account
- IF LEN (lcCCC) = 20 && CCC
- lcIBAN = Calcula_IBAN (lcCCC, .F.)
- else
- lcIBAN = 'ES **' + lcCCC
- if plMsg
- MESSAGEBOX ('You must enter a valid CCC (20 digits).', 0 + 32 + 0, 'Error in CCC')
- endif
- Endif
- return ('IBAN' + space (1) +;
- substr (lcIBAN, 1,4) + space (1) +;
- substr (lcIBAN, 5.4) + space (1) +;
- IIF (llOculta, '****', substr (lcIBAN, 9.4)) + space (1) +;
- IIF (llOculta, '****', substr (lcIBAN, 13.4)) + space (1) +;
- IIF (llOculta, '****', substr (lcIBAN, 17,4)) + space (1) +;
- substr (lcIBAN, 21.4))
- endfunc
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement