:: Visual Foxpro, Foxpro for DOS
• Войти
Страницы:  1 2 3
ОСТАТОК ОТ ДЕЛЕНИЯ
LUCIAN
Автор

Сообщений: 343
Откуда: Лида Беларусь
Дата регистрации: 25.03.2008
LUCIAN
07.06.17 16:38:12
Как с помощью vfp получить остаток от деления числа типа 1121111130141200000000132818113474
на 97,это для проверки правильности номера счёта IBAN.
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
of63

Сообщений: 25256
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
of63
07.06.17 16:51:55
Библиотеку длинных чисел надо, или столбиком.
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
pasha_usue

Сообщений: 3650
Откуда: Е-бург
Дата регистрации: 06.10.2006
pasha_usue
07.06.17 17:03:26
Вот статья. Делят на 97 (;Ж
www.liveinternet.ru
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
07.06.17 20:48:23
?ll_mod('1121111130141200000000132818113474','97')





*!* Function ll_add adds two integers, represented by strings m.s1 and m.s2

function ll_add

lparameter m.s1, m.s2



if left(m.s1,1)="-"

    return ll_sub(m.s2, substr(m.s1,2))

endif



if left(m.s2,1)="-"

    return ll_sub(m.s1, substr(m.s2,2))

endif



*!* Uncomment next rows if you want some additional data checking,

*!* but this may dramaticaly reduce performance on large strings

*!*   local m.ln1, m.ln2, m.ln3, m.s3

*!*   if len(chrtran(m.s1, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s1"

*!*       return ""

*!*   endif



*!*   if len(chrtran(m.s2, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s2"

*!*       return ""

*!*   endif



m.ln1=len(m.s1)

m.ln2=len(m.s2)

m.ln3 = max(m.ln1, m.ln2)+1

m.s1 = padl(m.s1, m.ln3, "0")

m.s2 = padl(m.s2, m.ln3, "0")



m.s3 = repl("0", m.ln3)



local m.hhnd, m.ptr, m.st2, m.rez



if !pemstatus(_screen,"ll_add",5) or _screen.ll_add=0

    Declare Integer HeapCreate in Win32Api Integer, Integer, Integer

    Declare Integer HeapAlloc in Win32Api Integer, Integer, Integer

    Declare RtlMoveMemory in Win32API Integer, String, Integer cnt



    m.st2 = ;

        chr(0x55)+chr(0x89)+chr(0xE5)+chr(0x57)+chr(0x56)+chr(0x50)+chr(0x53)+chr(0x51)+ ;

        chr(0x52)+chr(0x8B)+chr(0x75)+chr(0x08)+chr(0x8B)+chr(0x5D)+chr(0x0C)+chr(0x8B)+ ;

        chr(0x4D)+chr(0x10)+chr(0x8B)+chr(0x7D)+chr(0x14)+chr(0x8A)+chr(0x04)+chr(0x0E)+ ;

        chr(0x02)+chr(0x04)+chr(0x0B)+chr(0x02)+chr(0x04)+chr(0x0F)+chr(0x2C)+chr(0x60)+ ;

        chr(0x3C)+chr(0x39)+chr(0x7E)+chr(0x06)+chr(0x2C)+chr(0x0A)+chr(0xFE)+chr(0x44)+ ;

        chr(0x0F)+chr(0xFF)+chr(0x88)+chr(0x04)+chr(0x0F)+chr(0x49)+chr(0x75)+chr(0xE5)+ ;

        chr(0x5A)+chr(0x59)+chr(0x5B)+chr(0x58)+chr(0x5E)+chr(0x5F)+chr(0x89)+chr(0xEC)+ ;

        chr(0x5D)+chr(0xC2)+chr(0x10)+chr(0x00)



    m.hhnd=HeapCreate(0x40000,1024,1024)

    m.ptr=HeapAlloc(m.hhnd,0,len(m.st2)+16)

    RtlMoveMemory(m.ptr,m.st2,len(m.st2))

    _screen.addproperty("ll_add",m.ptr)

    

endif



Declare CallWindowProc in Win32API Integer, String, String, Integer, String @



CallWindowProc(_screen.ll_add, m.s1, m.s2, m.ln3-1, @m.s3)



return chrtran(ltrim(chrtran(m.s3, "0", " ")), " ", "0")





*!* Function ll_sub substracts integer, represented by strings m.s2 from the 

*!* integer, epresented by m.s1

function ll_sub

lparameter m.s1, m.s2



if left(m.s2,1)="-"

    return ll_add(m.s1, substr(m.s2,2))

endif

if left(m.s1,1)="-"

    return "-"+ll_add(substr(m.s1,2), m.s2)

endif





*!* Uncomment next rows if you want some additional data checking,

*!* but this may dramaticaly reduce performance on large strings

*!*   local m.ln1, m.ln2, m.ln3, m.s3

*!*   if len(chrtran(m.s1, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s1"

*!*       return ""

*!*   endif



*!*   if len(chrtran(m.s2, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s2"

*!*       return ""

*!*   endif



m.ln1=len(m.s1)

m.ln2=len(m.s2)

m.ln3 = max(m.ln1, m.ln2)+1

m.s1 = padl(m.s1, m.ln3, "0")

m.s2 = padl(m.s2, m.ln3, "0")



if m.s1 < m.s2

    return "-"+ll_sub(m.s2, m.s1)

endif



m.s3 = repl("0", m.ln3)





local m.hhnd, m.ptr, m.st2, m.rez



if !pemstatus(_screen,"ll_sub",5) or _screen.ll_sub=0

    Declare Integer HeapCreate in Win32Api Integer, Integer, Integer

    Declare Integer HeapAlloc in Win32Api Integer, Integer, Integer

    Declare RtlMoveMemory in Win32API Integer, String, Integer cnt



    m.st2 = ;

        chr(0x55)+chr(0x89)+chr(0xE5)+chr(0x57)+chr(0x56)+chr(0x50)+chr(0x53)+chr(0x51)+ ;

        chr(0x52)+chr(0x8B)+chr(0x75)+chr(0x08)+chr(0x8B)+chr(0x5D)+chr(0x0C)+chr(0x8B)+ ;

        chr(0x4D)+chr(0x10)+chr(0x8B)+chr(0x7D)+chr(0x14)+chr(0xBA)+chr(0x00)+chr(0x00)+ ;

        chr(0x00)+chr(0x00)+chr(0x8A)+chr(0x04)+chr(0x0E)+chr(0x00)+chr(0x14)+chr(0x0B)+ ;

        chr(0x2A)+chr(0x04)+chr(0x0B)+chr(0x7D)+chr(0x06)+chr(0xB2)+chr(0x01)+chr(0x04)+ ;

        chr(0x0A)+chr(0xEB)+chr(0x02)+chr(0xB2)+chr(0x00)+chr(0x04)+chr(0x30)+chr(0x88)+ ;

        chr(0x04)+chr(0x0F)+chr(0x49)+chr(0x75)+chr(0xE5)+chr(0x5A)+chr(0x59)+chr(0x5B)+ ;

        chr(0x58)+chr(0x5E)+chr(0x5F)+chr(0x89)+chr(0xEC)+chr(0x5D)+chr(0xC2)+chr(0x10)+ ;

        chr(0x00)



    m.hhnd=HeapCreate(0x40000,1024,1024)

    m.ptr=HeapAlloc(m.hhnd,0,len(m.st2)+16)

    RtlMoveMemory(m.ptr,m.st2,len(m.st2))

    _screen.addproperty("ll_sub",m.ptr)

    

endif



Declare CallWindowProc in Win32API Integer, String, String, Integer, String @



CallWindowProc(_screen.ll_sub, m.s1, m.s2, m.ln3-1, @m.s3)

return chrtran(ltrim(chrtran(m.s3, "0", " ")), " ", "0")





*!* Function ll_mult multiplies two integers, represented by strings m.s1 and m.s2

function ll_mult

lparameter m.s1, m.s2

local m.ln2, m.sm



do case

    case left(m.s1,1) = "-" and left(m.s2,1) <> "-"

        return "-" + ll_mult(substr(m.s1,2), m.s2)

    case left(m.s1,1) <> "-" and left(m.s2,1) = "-"

        return "-" + ll_mult(m.s1, substr(m.s2,2))

    case left(m.s1,1) = "-" and left(m.s2,1) = "-"

        return ll_mult(substr(m.s1,2), substr(m.s2,2))

endcase





*!* Uncomment next rows if you want some additional data checking,

*!* but this may dramaticaly reduce performance on large strings

*!*   local m.ln2, m.sm, m.i

*!*   if len(chrtran(m.s1, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s1"

*!*       return ""

*!*   endif



*!*   if len(chrtran(m.s2, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s2"

*!*       return ""

*!*   endif

m.ln2 = len(m.s2)



m.sm = "0"

for i = 1 to m.ln2

    m.sm = ll_add(m.sm, ll_mult1(m.s1, int(val(substr(m.s2, m.ln2-i+1, 1)))) + repl("0", i-1))

next



return m.sm







*!* Function ll_mult1 multiplies integers, represented by strings m.s1 and one digit integer m.n2

*!* Is used by function ll_mult

function ll_mult1

lparameter m.s1, m.n2

local m.ln1, m.sm, m.i



*!* Uncomment next rows if you want some additional data checking,

*!* but this may dramaticaly reduce performance on large strings

*!*   if len(chrtran(m.s1, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s1"

*!*       return ""

*!*   endif



m.ln1 = len(m.s1)+1

m.s1="0"+m.s1



m.s3 = repl("0", m.ln1)





local m.hhnd, m.ptr, m.st2, m.rez



if !pemstatus(_screen,"ll_mult1",5) or _screen.ll_mult1=0

    Declare Integer HeapCreate in Win32Api Integer, Integer, Integer

    Declare Integer HeapAlloc in Win32Api Integer, Integer, Integer

    Declare RtlMoveMemory in Win32API Integer, String, Integer cnt



    m.st2 = ;

        chr(0x55)+chr(0x89)+chr(0xE5)+chr(0x57)+chr(0x56)+chr(0x50)+chr(0x53)+chr(0x51)+ ;

        chr(0x52)+chr(0x8B)+chr(0x75)+chr(0x08)+chr(0x8B)+chr(0x5D)+chr(0x0C)+chr(0x8B)+ ;

        chr(0x4D)+chr(0x10)+chr(0x8B)+chr(0x7D)+chr(0x14)+chr(0xBA)+chr(0x0A)+chr(0x00)+ ;

        chr(0x00)+chr(0x00)+chr(0x8A)+chr(0x04)+chr(0x0E)+chr(0x2C)+chr(0x30)+chr(0xF6)+ ;

        chr(0xE3)+chr(0xF6)+chr(0xF2)+chr(0x00)+chr(0x24)+chr(0x0F)+chr(0x80)+chr(0x3C)+ ;

        chr(0x0F)+chr(0x39)+chr(0x7E)+chr(0x08)+chr(0xFE)+chr(0x44)+chr(0x0F)+chr(0xFF)+ ;

        chr(0x80)+chr(0x2C)+chr(0x0F)+chr(0x0A)+chr(0x00)+chr(0x44)+chr(0x0F)+chr(0xFF)+ ;

        chr(0x49)+chr(0x75)+chr(0xDF)+chr(0x5A)+chr(0x59)+chr(0x5B)+chr(0x58)+chr(0x5E)+ ;

        chr(0x5F)+chr(0x89)+chr(0xEC)+chr(0x5D)+chr(0xC2)+chr(0x10)+chr(0x00)



    m.hhnd=HeapCreate(0x40000,1024,1024)

    m.ptr=HeapAlloc(m.hhnd,0,len(m.st2)+16)

    RtlMoveMemory(m.ptr,m.st2,len(m.st2))

    _screen.addproperty("ll_mult1",m.ptr)

    

endif



Declare CallWindowProc in Win32API Integer, String, Integer, Integer, String @



CallWindowProc(_screen.ll_mult1, m.s1, m.n2, m.ln1-1, @m.s3)

return chrtran(ltrim(chrtran(m.s3, "0", " ")), " ", "0")





*!* Function ll_div divides integer, represented by strings m.s1 by the 

*!* integer, epresented by m.s1. (int(m.s1/m.s2)). If parameter m.md is

*!* passed by reference, mod(m.s1,m.s2) is returned in m.md

function ll_div

lparameter m.s1, m.s2, m.md



do case

    case left(m.s1,1) = "-" and left(m.s2,1) <> "-"

        return "-" + ll_div(substr(m.s1,2), m.s2)

    case left(m.s1,1) <> "-" and left(m.s2,1) = "-"

        return "-" + ll_div(m.s1, substr(m.s2,2))

    case left(m.s1,1) = "-" and left(m.s2,1) = "-"

        return ll_div(substr(m.s1,2), substr(m.s2,2))

endcase





*!* Uncomment next rows if you want some additional data checking,

*!* but this may dramaticaly reduce performance on large strings

*!*   local m.ln1, m.ln2, m.sm, m.i, m.ts1, m.ts1e, m.cnt

*!*   if len(chrtran(m.s1, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s1"

*!*       return ""

*!*   endif



*!*   if len(chrtran(m.s2, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s2"

*!*       return ""

*!*   endif



if ll_less(m.s1, m.s2)

    m.md = m.s1

    return "0"

endif



m.ln2 = len(m.s2)

m.sm = ""

m.ts1 = left(m.s1, m.ln2)

m.ts1e = substr(m.s1, m.ln2 + 1)

m.ln1 = len(m.ts1e)

for m.i = 1 to m.ln1 +1

    m.cnt = 0

    do while !ll_less(m.ts1, m.s2)

        m.ts1 = ll_sub(m.ts1, m.s2)

        m.cnt = m.cnt + 1

    enddo

    m.sm = m.sm + allt(str(m.cnt))

    m.ts1 = m.ts1 + left(m.ts1e, 1)

    m.ts1e = substr(m.ts1e, 2)

next



m.sm = tr0(m.sm)

m.md = m.ts1

return m.sm







*!* Function ll_mod returns mod(m.s1, m.s2) 

function ll_mod

lparameter m.s1, m.s2



do case

    case left(m.s1,1) = "-" and left(m.s2,1) <> "-"

        return ""

    case left(m.s1,1) <> "-" and left(m.s2,1) = "-"

        return ""

    case left(m.s1,1) = "-" and left(m.s2,1) = "-"

        return ""

endcase



local m.md

ll_div(m.s1, m.s2, @m.md)

return m.md





*!* Function ll_less compare two integers, represented by m.s1 and m.s2.

*!* .t. is returned if m.s1 < m.s2

function ll_less

lparameter m.s1, m.s2

do case

    case left(m.s1,1) = "-" and left(m.s2,1) <> "-"

        return .t.

    case left(m.s1,1) <> "-" and left(m.s2,1) = "-"

        return .f.

    case left(m.s1,1) = "-" and left(m.s2,1) = "-"

        return ll_less(substr(m.s2,2), substr(m.s1,2))

endcase



m.s1 = tr0(m.s1)

m.s2 = tr0(m.s2)



return len(m.s1) < len(m.s2) or (len(m.s1) = len(m.s2) and m.s1 < m.s2)



*!* Function tr0 is used by function ll_less 

function tr0

lparameter m.s1

do while left(m.s1, 1) = "0" and len(m.s1) > 1

    m.s1 = substr(m.s1, 2)

enddo

return m.s1





*!* Funnction ll_intsqrt returns mod(m.s1, m.s2) 

function ll_intsqrt

lparameter m.s1



*!* Uncomment next rows if you want some additional data checking,

*!* but this may dramaticaly reduce performance on large strings

*!*   if len(chrtran(m.s1, "0123456789", "")) > 0

*!*       wait window "Long_ar: error in s1"

*!*       return ""

*!*   endif



local m.ln, m.chet, m.tln, m.sq, m.i, m.j, m.tsq, m.tkv, m.tnkv

m.ln = len(m.s1)

if m.ln <= 16

    return allt(str(int(sqrt(val(m.s1)))))

endif

m.chet = m.ln%2

m.tln = m.ln - 16 + m.chet

m.sq = allt(str(int(sqrt(val(left(m.s1, m.ln - m.tln))))))



for m.i = 1 to m.tln/2

    m.tkv = left(m.s1, m.ln - m.tln + m.i*2)

    for m.j = 9 to 0 step -1

        m.tsq = m.sq+allt(str(m.j))

        m.tnkv = ll_mult(m.tsq, m.tsq)

        if m.tnkv <= m.tkv

            exit

        endif

    next

    m.sq = m.sq + allt(str(m.j))

next

return m.sq
Ratings: 0 negative/1 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
of63

Сообщений: 25256
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
of63
07.06.17 21:42:03
2leonid
Ведь имеется и ассемблерный текст для кодов этих загадочных байтов. Интересно, если используются небольшое количество команд процессора (не все множество команд x86, и/или только независимые что-ли от положения в адресном пространстве... Нельзя ли написать "простенькй" транслятор текста ассемблерного кода (подпрограмку, возвращающую набор байтов для этого ассемблерного текста), причем только этих любимых/уместных команд, (может даже с переобозначением одной строкой некоторых однообразных серий, типа PUSH... POP), чисто для использования в фоксе?... Ну, чтобы не наблюдать набор байтов, а наблюдать исходный ассемблерный код, править...
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
07.06.17 21:58:25
of63
2leonid Ведь имеется и ассемблерный текст для кодов этих загадочных байтов. Интересно, если используются небольшое количество команд процессора (не все множество команд x86, и/или только независимые что-ли от положения в адресном пространстве... Нельзя ли написать "простенькй" транслятор текста ассемблерного кода (подпрограмку, возвращающую набор байтов для этого ассемблерного текста), причем только этих любимых/уместных команд, (может даже с переобозначением одной строкой некоторых однообразных серий, типа PUSH... POP), чисто для использования в фоксе?... Ну, чтобы не наблюдать набор байтов, а наблюдать исходный ассемблерный код, править...

Боюсь, что "простенький" транслятор текста окажется не таким уж и простеньким. И писать его на фоксе совсем неохота, учитывая, что в интернете есть куча подобных трансляторов. О том, который я использовал, я писал вот тут:
forum.foxclub.ru
Если действительно кто-то хочет посмотреть ассемблеровские исходники, могу привести, только уж очень сомневаюсь, что кому-то захочется их править и заново компилировать.
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
of63

Сообщений: 25256
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
of63
07.06.17 22:09:12
> могу привести, только уж очень сомневаюсь, что кому-то захочется их править и заново компилировать
Если не приводить, то никто и не заинтересуется, и не узнает как устроено... Компилировать не ломанутся, но "воспроизводство" отношений, программ, ивобще всего - оно полезно. Не все же знают, что фокс - это не единственный язык, или си, или ассемблер, и что пару байтов можно сложить не только фоксом. А тут только "магическое заклинание" чарр+чарр...
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
Simple777

Сообщений: 33855
Дата регистрации: 05.11.2006
Simple777
08.06.17 06:45:42
Любопытно, а есть ли консольные утилиты, выполняющие такого рода операции? Ведь наверняка проверку 30-значного расчетного счета уже давно все выполняют, где используется международная система кодирования расчетных счетов. Консольная утилита позволила бы выполнять такого рода проверку из любой среды фактически, да хоть даже из командной строки.
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
spinz

Сообщений: 5263
Дата регистрации: 21.01.2016
spinz
08.06.17 08:04:58
Ну и зачем для этого консольная утилита?

Ты похоже все еще где-то в 90-х живешь



Исправлено 1 раз(а). Последнее : spinz, 08.06.17 08:05
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
LUCIAN
Автор

Сообщений: 343
Откуда: Лида Беларусь
Дата регистрации: 25.03.2008
LUCIAN
08.06.17 08:59:53
Всем спасибо. Проверил функцию предложенную leonid
в результате получил 1 т.е. номер счёта IBAN верный.
С 04.07.2017 в РБ переходят на международную структуру банковского номера счета(IBAN).
Так как 3 и 4 символы этого счета контрольные цифры поэтому возник вопрос как проверить
правильность счета.На польском сайте нашёл такой алгоритм:
1.Рассмотрите всю строку номера IBAN (включая код страны). Этот номер должен быть написан без пробелов.
2.Проверьте длину этой строки в контексте той или иной страны (в Польше(в РБ тоже), номер банковского счета в IBAN будет состоять из 28 символов).
3.Перенесите первые 4 символа IBAN на конец.
4.Каждую букву в этой строке заменить на 2 цифры следующим образом:«А» заменить на «10», «B» на «11» ... «Z» заменить «35». Для кода «PL»(«BY») мы должны получить число 2521(1134),так как «Р» преобразуется в 25, и «L» 21.
5.В результате мы получили строку цифр. Мы рассматриваем полученную строку как число и вычисляем остаток от деления на число 97.
6.Если остаток равен 1, то контрольная сумма верна.
Приведенное выше число 1121111130141200000000132818113474 получено от счета IBAN "BY74BLBB30141200000000132818"
Поэтому под этот алгоритм придется писать код, если никто не укажет где найти.



Исправлено 2 раз(а). Последнее : LUCIAN, 08.06.17 09:13
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
of63

Сообщений: 25256
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
of63
08.06.17 09:29:38
Интересный алгоритм вычисления остатка alexandrerodichevski.chiappani.it
"" Чтобы облегчить деление чрезмерно длинных номеров, можно расчленить численную строку на малые части, и вычислить остаток деления первой части на 97, после этого составить новую численную строку из остатка деления и второй части, и вычислить остаток деления этого номера на 97, и так далее.
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
ry

Сообщений: 2114
Дата регистрации: 24.09.2007
ry
08.06.17 09:53:51
LUCIAN
Поэтому под этот алгоритм придется писать код, если никто не укажет где найти.

Делал для 1С, алгоритм несложный, код тоже. Думаю, на фокспро это просто будет реализовать.
Вот здесь www.morfoedro.it есть хорошее описание и пример деления итоговой строки на части с их последовательным делением на 97, что позволяет не оперировать большими числами (т.е. не вылезать за ограничения integer).
Пример короткого кода оттуда же (можно взять за основу и переделать для фокса):
Часть текста скрыта

Здесь infostart.ru пример для 1С 8, для 7.7 делал немного по-другому, матрицу заменял на строку символов, код короче и наглядней, но под рукой его нет - на другой работе.

з.ы. Оказывается, у of63 ссылка на ту же информацию, но с другим адресом.



Исправлено 1 раз(а). Последнее : ry, 08.06.17 10:01
Ratings: 0 negative/0 positive
Проверка корректности IBAN
LUCIAN
Автор

Сообщений: 343
Откуда: Лида Беларусь
Дата регистрации: 25.03.2008
LUCIAN
08.06.17 10:38:47
В решениях foxclub нашёл такое 
CLEAR

*m.str=CheckIBAN('AT61 1904 3002 3457 3201')

m.str=CheckIBAN('BY74BLBB30141200000000132818')

IF !EMPTY(m.str)

    =MESSAGEBOX('ВНИМАНИЕ! IBAN содержит следующие ошибки:'+CHR(13)+m.str)

ELSE

    =MESSAGEBOX('IBAN корректен !')

ENDIF



*     _______________________________________________________

*    |  Проверка корректности IBAN                             |

*    |_______________________________________________________|

*    |  Дата изменения: 24.11.04, написана  24.11.04         |

*    |_______________________________________________________|

FUNCTION CheckIBAN 

LPARAMETERS x

&& all-in-one check on lower text box.

&& Any blank spaces are removed before the check is done 

&& nError indicates which error message or combination of messages to display

PRIVATE errmsg,x,sCheck,CountryCode

m.errMsg=""

DIMENSION st(4)

m.x=UPPER(m.x)

m.x=RemoveBlanks(m.x)

st[1] = SUBSTR(m.x,1,2)

m.countryCode=st[1]

st[2] = SUBSTR(m.x,3,2)

st[3] = SUBSTR(m.x,5,4)

st[4] = SUBSTR(m.x,9)

m.sCheck=st[3]+st[4]+st[1]+st[2]



IF !ALPHA(st[1]) 

*   m.errMsg = "The first two characters must be alphabetic"+CHR(13)

    m.errMsg = "Первые два символа должны быть буквенными A-Z."+CHR(13)

ENDIF

IF !DIGIT(st[2]) 

    m.errMsg = m.errMsg + "Символы 3, 4 должны быть цифровыми."+CHR(13)

ENDIF

IF !AlphNum(m.sCheck)

    m.errMsg =m.errMsg+"Только символы A-Z и цифры 0-9 могут присутствовать в IBAN."+CHR(13)

ENDIF

IF m.countryCode=="GB"

    IF !ISALPHA(st[3]) 

        m.errMsg =m.errMsg+"Если код страны = GB, символы с 5 по 8 должны быть буквенными A-Z."+CHR(13)

    ENDIF

    IF LEN(m.sCheck)#22 

        m.errMsg =m.errMsg+"Если код страны = GB, длина IBAN должна быть равна 22."+CHR(13)

    ENDIF

ENDIF

IF !checkDigitSum(m.sCheck)

    m.errMsg =m.errMsg+"Контрольная сумма IBAN некорректна."+CHR(13)

ENDIF

RETURN m.errMsg



FUNCTION RemoveBlanks

LPARAMETERS str

PRIVATE r,x,c

m.r=''

FOR m.x=1 TO LEN(m.str)

    m.c=SUBSTR(m.str,m.x,1)

    IF m.c#' '

        m.r=m.r+SUBSTR(m.str,m.x,1)

    ENDIF

ENDFOR

RETURN m.r



FUNCTION isEngChar

LPARAMETERS c

RETURN (ASC(m.c)>=ASC('A') AND ASC(m.c)<=ASC('Z'))



FUNCTION Alpha

LPARAMETERS str

PRIVATE x,c

FOR m.x=1 TO LEN(m.str)

    m.c=SUBSTR(m.str,m.x,1)

    IF !isEngChar(m.c)

        RETURN .f.

    ENDIF

ENDFOR

RETURN .t.



FUNCTION Digit

LPARAMETERS str

PRIVATE x,c

FOR m.x=1 TO LEN(m.str)

    m.c=SUBSTR(m.str,m.x,1)

    IF !ISDIGIT(m.c)

        RETURN .f.

    ENDIF

ENDFOR

RETURN .t.



FUNCTION AlphNum

LPARAMETERS str

PRIVATE x,c

FOR m.x=1 TO LEN(m.str)

    m.c=SUBSTR(m.str,m.x,1)

    IF !ISDIGIT(m.c) AND !isEngChar(m.c)

        RETURN .f.

    ENDIF

ENDFOR

RETURN .t.



FUNCTION checkDigitSum

LPARAMETERS s

&& replace each letter by numerical equivalent to create new string newS

PRIVATE n,news,i,a,n,newm,r

m.newS = ""

FOR i = 1 TO LEN(s)

    m.a = ASC(SUBSTR(m.s,m.i,1))

    IF (a>=65) AND (a<=90)

        m.n = m.a - 55

    ELSE 

        m.n = VAL(SUBSTR(m.s,m.i,1))

    ENDIF

    m.newS = m.newS + ALLTRIM(STR(m.n))

ENDFOR

&& check digit sum by long division, starting with first two digits

m.newM=VAL(SUBSTR(m.newS,1,2))

m.r=MOD(m.newM,97)

FOR m.i = 3 TO LEN(m.news)

    m.newM = 10*m.r + VAL(SUBSTR(m.newS,m.i,1))

    m.r=MOD(m.newM,97)

ENDFOR

RETURN m.r=1



Исправлено 2 раз(а). Последнее : LUCIAN, 08.06.17 10:50
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
Simple777

Сообщений: 33855
Дата регистрации: 05.11.2006
Simple777
08.06.17 10:52:27
Вроде как и для FPD прокатывает? [sm128]

Окромя message box, но это уже не принципиально.
Ratings: 0 negative/0 positive
Re: Проверка корректности IBAN
LUCIAN
Автор

Сообщений: 343
Откуда: Лида Беларусь
Дата регистрации: 25.03.2008
LUCIAN
08.06.17 14:42:38
LUCIAN
2.Проверьте длину этой строки в контексте той или иной страны (в Польше(в РБ тоже), номер банковского счета в IBAN будет состоять из 28 символов).
В выше представленном коде этот пункт алгоритма выполняется только для страны
с кодом GB.Поэтому для проверки длины добавил другие страны 

CLEAR  

 *m.str=CheckIBAN('AT61 1904 3002 3457 3201')  

  m.str=CheckIBAN('BY74BLBB30141200000000132818')  

  IF !EMPTY(m.str)  

      =MESSAGEBOX('ВНИМАНИЕ! IBAN содержит следующие ошибки:'+CHR(13)+m.str)  

  ELSE  

      =MESSAGEBOX('IBAN корректен !')  

  ENDIF  

    

 *     _______________________________________________________  

 *    |  Проверка корректности IBAN                             |  

 *    |_______________________________________________________|  

 *    |  Дата изменения: 24.11.04, написана  24.11.04         |  

 *    |_______________________________________________________|  

  FUNCTION CheckIBAN   

  LPARAMETERS x  

  && all-in-one check on lower text box.  

  && Any blank spaces are removed before the check is done   

  && nError indicates which error message or combination of messages to display  

  PRIVATE errmsg,x,sCheck,CountryCode  

  m.errMsg=""  

  DIMENSION st(4)  

  m.x=UPPER(m.x)  

  m.x=RemoveBlanks(m.x)  

  st[1] = SUBSTR(m.x,1,2)  

  m.countryCode=st[1]  

  st[2] = SUBSTR(m.x,3,2)  

  st[3] = SUBSTR(m.x,5,4)  

  st[4] = SUBSTR(m.x,9)  

  m.sCheck=st[3]+st[4]+st[1]+st[2]  

    

  IF !ALPHA(st[1])   

 *   m.errMsg = "The first two characters must be alphabetic"+CHR(13)  

      m.errMsg = "Первые два символа должны быть буквенными A-Z."+CHR(13)  

  ENDIF  

  IF !DIGIT(st[2])   

      m.errMsg = m.errMsg + "Символы 3, 4 должны быть цифровыми."+CHR(13)  

  ENDIF  

  IF !AlphNum(m.sCheck)  

      m.errMsg =m.errMsg+"Только символы A-Z и цифры 0-9 могут присутствовать в IBAN."+CHR(13)  

  ENDIF  

    

  

  IF m.countryCode=="GB"  

      IF !ISALPHA(st[3])   

          m.errMsg =m.errMsg+"Если код страны = GB, символы с 5 по 8 должны быть буквенными A-Z."+CHR(13)  

      ENDIF  

  ENDIF  



ALCURS=SYS(2015)

SELE 0

CREATE CURSOR (ALCURS) (STRANA C(30),DL I(4),KOD C(2))

INSERT INTO (ALCURS) VALUES ('Австрия                       ',20,'AT')

INSERT INTO (ALCURS) VALUES ('Азербайджан                   ',28,'AZ')

INSERT INTO (ALCURS) VALUES ('Албания                       ',28,'AL')

INSERT INTO (ALCURS) VALUES ('Андорра                       ',24,'AD')

INSERT INTO (ALCURS) VALUES ('Бахрейн                       ',22,'BH')

INSERT INTO (ALCURS) VALUES ('Беларусь                      ',28,'BY')

INSERT INTO (ALCURS) VALUES ('Бельгия                       ',16,'BE')

INSERT INTO (ALCURS) VALUES ('Болгария                      ',22,'BG')

INSERT INTO (ALCURS) VALUES ('Босния и Герцоговина          ',20,'BA')

INSERT INTO (ALCURS) VALUES ('Бразилия                      ',29,'BR')

INSERT INTO (ALCURS) VALUES ('Великобритания                ',22,'GB')

INSERT INTO (ALCURS) VALUES ('Венгрия                       ',28,'HU')

INSERT INTO (ALCURS) VALUES ('Виргинские острова            ',24,'VG')

INSERT INTO (ALCURS) VALUES ('Восточный Тимор               ',23,'TL')

INSERT INTO (ALCURS) VALUES ('Гватемала                     ',28,'GT')

INSERT INTO (ALCURS) VALUES ('Германия                      ',22,'DE')

INSERT INTO (ALCURS) VALUES ('Гибралтар                     ',23,'GI')

INSERT INTO (ALCURS) VALUES ('Гренландия                    ',18,'GL')

INSERT INTO (ALCURS) VALUES ('Греция                        ',27,'GR')

INSERT INTO (ALCURS) VALUES ('Грузия                        ',22,'GE')

INSERT INTO (ALCURS) VALUES ('Дания                         ',18,'DK')

INSERT INTO (ALCURS) VALUES ('Доминиканская республика      ',28,'DO')

INSERT INTO (ALCURS) VALUES ('Израиль                       ',23,'IL')

INSERT INTO (ALCURS) VALUES ('Иордания                      ',30,'JO')

INSERT INTO (ALCURS) VALUES ('Ирландия                      ',22,'IE')

INSERT INTO (ALCURS) VALUES ('Исландия                      ',26,'IS')

INSERT INTO (ALCURS) VALUES ('Испания                       ',24,'ES')

INSERT INTO (ALCURS) VALUES ('Италия                        ',27,'IT')

INSERT INTO (ALCURS) VALUES ('Казахстан                     ',20,'KZ')

INSERT INTO (ALCURS) VALUES ('Катар                         ',29,'QA')

INSERT INTO (ALCURS) VALUES ('Коста-Рика                    ',21,'CR')

INSERT INTO (ALCURS) VALUES ('Кувейт                        ',30,'KW')

INSERT INTO (ALCURS) VALUES ('Латвия                        ',21,'LV')

INSERT INTO (ALCURS) VALUES ('Ливан                         ',28,'LB')

INSERT INTO (ALCURS) VALUES ('Литва                         ',20,'LT')

INSERT INTO (ALCURS) VALUES ('Лихтенштейн                   ',21,'LI')

INSERT INTO (ALCURS) VALUES ('Люксембург                    ',20,'LU')

INSERT INTO (ALCURS) VALUES ('Маврикий                      ',30,'MU')

INSERT INTO (ALCURS) VALUES ('Мавритания                    ',27,'MR')

INSERT INTO (ALCURS) VALUES ('Мальта                        ',31,'MT')

INSERT INTO (ALCURS) VALUES ('Молдова                       ',24,'MD')

INSERT INTO (ALCURS) VALUES ('Монако                        ',27,'MC')

INSERT INTO (ALCURS) VALUES ('Нидерланды                    ',18,'NL')

INSERT INTO (ALCURS) VALUES ('Норвегия                      ',15,'NO')

INSERT INTO (ALCURS) VALUES ('ОАЭ                           ',23,'AE')

INSERT INTO (ALCURS) VALUES ('Пакистан                      ',24,'PK')

INSERT INTO (ALCURS) VALUES ('Палестина                     ',29,'PS')

INSERT INTO (ALCURS) VALUES ('Польша                        ',28,'PL')

INSERT INTO (ALCURS) VALUES ('Португалия                    ',25,'PT')

INSERT INTO (ALCURS) VALUES ('Республика Кипр               ',28,'CY')

INSERT INTO (ALCURS) VALUES ('Республика Косово             ',20,'XK')

INSERT INTO (ALCURS) VALUES ('Республика Македония          ',19,'MK')

INSERT INTO (ALCURS) VALUES ('Румыния                       ',24,'RO')

INSERT INTO (ALCURS) VALUES ('Сан-Марино                    ',27,'SM')

INSERT INTO (ALCURS) VALUES ('Саудовская Аравия             ',24,'SA')

INSERT INTO (ALCURS) VALUES ('Сербия                        ',22,'RS')

INSERT INTO (ALCURS) VALUES ('Словакия                      ',24,'SK')

INSERT INTO (ALCURS) VALUES ('Словения                      ',19,'SI')

INSERT INTO (ALCURS) VALUES ('Тунис                         ',24,'TN')

INSERT INTO (ALCURS) VALUES ('Турция                        ',26,'TR')

INSERT INTO (ALCURS) VALUES ('Украина                       ',29,'UA')

INSERT INTO (ALCURS) VALUES ('Фарерские острова             ',18,'FO')

INSERT INTO (ALCURS) VALUES ('Финляндия                     ',18,'FI')

INSERT INTO (ALCURS) VALUES ('Франция                       ',27,'FR')

INSERT INTO (ALCURS) VALUES ('Хорватия                      ',21,'HR')

INSERT INTO (ALCURS) VALUES ('Черногория                    ',22,'ME')

INSERT INTO (ALCURS) VALUES ('Чехия                         ',24,'CZ')

INSERT INTO (ALCURS) VALUES ('Швейцария                     ',21,'CH')

INSERT INTO (ALCURS) VALUES ('Швеция                        ',24,'SE')

INSERT INTO (ALCURS) VALUES ('Эстония                       ',20,'EE')



LOCATE FOR KOD == m.countryCode



IF FOUND() AND (LEN(m.sCheck) # EVALUATE(ALCURS+".DL"))

    m.errMsg =m.errMsg+"Если код страны = " +m.countryCode + ", длина IBAN должна быть равна "+LTRIM(STR(EVALUATE(ALCURS+".DL")))+CHR(13)  

ENDIF  



USE IN (ALCURS)



  IF !checkDigitSum(m.sCheck)  

      m.errMsg =m.errMsg+"Контрольная сумма IBAN некорректна."+CHR(13)  

  ENDIF  

  RETURN m.errMsg  

    

  FUNCTION RemoveBlanks  

  LPARAMETERS str  

  PRIVATE r,x,c  

  m.r=''  

  FOR m.x=1 TO LEN(m.str)  

      m.c=SUBSTR(m.str,m.x,1)  

      IF m.c#' '  

          m.r=m.r+SUBSTR(m.str,m.x,1)  

      ENDIF  

  ENDFOR  

  RETURN m.r  

    

  FUNCTION isEngChar  

  LPARAMETERS c  

  RETURN (ASC(m.c)>=ASC('A') AND ASC(m.c)<=ASC('Z'))  

    

  FUNCTION Alpha  

  LPARAMETERS str  

  PRIVATE x,c  

  FOR m.x=1 TO LEN(m.str)  

      m.c=SUBSTR(m.str,m.x,1)  

      IF !isEngChar(m.c)  

          RETURN .f.  

      ENDIF  

  ENDFOR  

  RETURN .t.  

    

  FUNCTION Digit  

  LPARAMETERS str  

  PRIVATE x,c  

  FOR m.x=1 TO LEN(m.str)  

      m.c=SUBSTR(m.str,m.x,1)  

      IF !ISDIGIT(m.c)  

          RETURN .f.  

      ENDIF  

  ENDFOR  

  RETURN .t.  

    

  FUNCTION AlphNum  

  LPARAMETERS str  

  PRIVATE x,c  

  FOR m.x=1 TO LEN(m.str)  

      m.c=SUBSTR(m.str,m.x,1)  

      IF !ISDIGIT(m.c) AND !isEngChar(m.c)  

          RETURN .f.  

      ENDIF  

  ENDFOR  

  RETURN .t.  

    

  FUNCTION checkDigitSum  

  LPARAMETERS s  

  && replace each letter by numerical equivalent to create new string newS  

  PRIVATE n,news,i,a,n,newm,r  

  m.newS = ""  

  FOR i = 1 TO LEN(s)  

      m.a = ASC(SUBSTR(m.s,m.i,1))  

      IF (a>=65) AND (a<=90)  

          m.n = m.a - 55  

      ELSE   

          m.n = VAL(SUBSTR(m.s,m.i,1))  

      ENDIF  

      m.newS = m.newS + ALLTRIM(STR(m.n))  

  ENDFOR  

  && check digit sum by long division, starting with first two digits  

  m.newM=VAL(SUBSTR(m.newS,1,2))  

  m.r=MOD(m.newM,97)  

  FOR m.i = 3 TO LEN(m.news)  

      m.newM = 10*m.r + VAL(SUBSTR(m.newS,m.i,1))  

      m.r=MOD(m.newM,97)  

  ENDFOR  

  RETURN m.r=1



Исправлено 1 раз(а). Последнее : LUCIAN, 09.06.17 12:45
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
BOBAN

Сообщений: 625
Откуда: Солигорск
Дата регистрации: 05.07.2004
BOBAN
08.06.17 16:05:09
Функция RemoveBlanks выжигает мозг. ChrTran(..,[ ],[]) не пойдет ?
Ratings: 0 negative/0 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
Igor Korolyov

Сообщений: 34580
Дата регистрации: 28.05.2002
Igor Korolyov
08.06.17 16:15:20
Несколько избыточно - скажем проверяешь первые 4 символа попарно на буквы/числа, а потом их же снова в составе общей строки на "буква или число"...
Явная ошибка в проверке GB счетов (а вообще надо читать стандарт - судя по всему функцию писали именно англичане, раз пробили только "свои" ограничения - может для других стран тоже есть обязательная буквенная часть). Там должен быть вызов ALPHA(st[3]) а не ISALPHA(st[3]) - который проверяет только ПЕРВЫЙ символ строки, а не всю её.

Чуть быстрее, короче и IMHO читабельнее будет такая реализация вспомогательных функций: 



#DEFINE C_WHITE_SPACE " "+CHR(9) && Заодно и табулятор вырезаем - можно добавить переводы строки CHR(10), CHR(13) и "неразрывный пробел" CHR(160)...



FUNCTION RemoveBlanks(str)

RETURN CHRTRAN(m.str, C_WHITE_SPACE, "")



#DEFINE C_NUMBERS "0123456789"

#DEFINE C_LATIN_LETTERS "ABCDEFGHIJKLMNOPQRSTUVWXYZ"



FUNCTION AlphNum(str)

RETURN LEN(CHRTRAN(m.str, C_NUMBERS+C_LATIN_LETTERS, "")) = 0



FUNCTION Digit(str)

RETURN LEN(CHRTRAN(m.str, C_NUMBERS, "")) = 0



FUNCTION Alpha(str)

RETURN LEN(CHRTRAN(m.str, C_LATIN_LETTERS, "")) = 0

Всё ж лучше когда циклы крутит сам фокс внутри себя, в сишной реализации, нежели когда он их "интерпретирует" из фоксовых FOR...
Само "вычисление остатка" тоже не стоит крутить в фоксовом цикле по 1 элементу - хотя бы уж по 8 за раз брать, как по ссылкам делают - с 2-мя цифрами от предыдущего шага будет 10, тут точности фокса хватит


------------------
WBR, Igor




Исправлено 1 раз(а). Последнее : Igor Korolyov, 08.06.17 16:16
Ratings: 0 negative/1 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
ssa

Сообщений: 13008
Откуда: Москва
Дата регистрации: 23.03.2005
ssa
08.06.17 16:28:26
BOBAN
Функция RemoveBlanks выжигает мозг. ChrTran(..,[ ],[]) не пойдет ?
Сойдет. Вместо самой этой совершенно ненужной RemoveBlanks. 
*ssa*       m.x=UPPER(m.x)

*ssa*       m.x=RemoveBlanks(m.x)

m.x = Upper(Chrtran(m.x, C_WHITE_SPACE, ''))
А еще Evaluate не нужны...


------------------
Лень - это неосознанная мудрость.




Исправлено 3 раз(а). Последнее : ssa, 08.06.17 16:35
Ratings: 0 negative/1 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
Igor Korolyov

Сообщений: 34580
Дата регистрации: 28.05.2002
Igor Korolyov
08.06.17 16:39:45
Вообще есть вариант "сделать от обратного" первый шаг - т.е. тупо выкинуть все "неподходящие" символы из строки (не цифры и латиницу), и уж смотреть - вписывается ли она в заданные рамки или нет Двойной Chrtran проделывает такой фокус как "оставить только заданные символы".
ssa
А еще Evaluate не нужны...
Как и курсор Впрочем, я полагаю это чисто для примера тут курсор описан - реально, поди, какая-то "таблица стран" из основной БД используется, т.е. она просто "дополняется" полем размера сего кода...


------------------
WBR, Igor




Исправлено 1 раз(а). Последнее : Igor Korolyov, 08.06.17 16:41
Ratings: 0 negative/1 positive
Re: ОСТАТОК ОТ ДЕЛЕНИЯ
ssa

Сообщений: 13008
Откуда: Москва
Дата регистрации: 23.03.2005
ssa
08.06.17 16:48:46
Igor Korolyov
Вообще есть вариант "сделать от обратного" первый шаг - т.е. тупо выкинуть все "неподходящие" символы из строки (не цифры и латиницу), и уж смотреть - вписывается ли она в заданные рамки или нет Двойной Chrtran проделывает такой фокус как "оставить только заданные символы".
Именно!
Кстати, isEngChar и ALPHA при ближайшем рассмотрении дублируют друг друга... Функции ALPHA() как-то по барабану сколько ей скормили символов.


------------------
Лень - это неосознанная мудрость.




Исправлено 1 раз(а). Последнее : ssa, 08.06.17 16:49
Ratings: 0 negative/1 positive
Страницы:  1 2 3


:: Список Форумов•Список тем•Поиск•Войти
Извините, только зарегистрированные пользователи могут оставлять сообщения в этом форуме.

On-line: 27 (Гостей: 27)
© 2000-2024 Fox Club 
Яндекс.Метрика