Tema: Re: asmens kodas
Autorius: Donatas
Data: 2010-01-06 16:15:09
cia mano darytas , jei rastumet klaidu parasykit, nors veikia tvarkingai 
gana ilgai, klaidu nepasitaike.

Donatas

Function asmenskodas(kodas As String)
On Error GoTo klaida
asmenskodas = False
If Len(kodas) <> 11 Or IsNull(kodas) Then Exit Function
s1 = Mid(kodas, 1, 1) * 1 + Mid(kodas, 2, 1) * 2 + Mid(kodas, 3, 1) * 3 + 
Mid(kodas, 4, 1) * 4 + Mid(kodas, 5, 1) * 5 + Mid(kodas, 6, 1) * 6 + 
Mid(kodas, 7, 1) * 7 + Mid(kodas, 8, 1) * 8 + Mid(kodas, 9, 1) * 9 + 
Mid(kodas, 10, 1) * 1
s2 = Mid(kodas, 1, 1) * 3 + Mid(kodas, 2, 1) * 4 + Mid(kodas, 3, 1) * 5 + 
Mid(kodas, 4, 1) * 6 + Mid(kodas, 5, 1) * 7 + Mid(kodas, 6, 1) * 8 + 
Mid(kodas, 7, 1) * 9 + Mid(kodas, 8, 1) * 1 + Mid(kodas, 9, 1) * 2 + 
Mid(kodas, 10, 1) * 3

sk = Int(Mid(kodas, 11, 1))
d1 = s1 Mod 11
d2 = s2 Mod 11
    If d1 < 10 Then
         If d1 = sk Then asmenskodas = True
       ElseIf d2 < 10 Then
         If d2 = sk Then asmenskodas = True
       Else
         If sk = 0 Then asmenskodas = True
       End If


Exit Function
klaida:
'klaidos pranesimas
End Function

"Naras" <naras@e-ident.lt> wrote in message 
news:hi1t5t$cpc$1@trimpas.omnitel.net...
> pasiziurek levo braindumpa, ten exeliui ir visual basic, gal uzves ant 
> kelio.
>
> "Joint_as" <a@a.com> wrote in message 
> news:hi1sm4$btk$1@trimpas.omnitel.net...
>> buvo kazkada zmoniu su "blogais" ak, bet anie jau ismire turetu but :)
>>
>> visgi kazkur esu mates tikrinima ...
>>
>> "saimhe" <oh.no@oh.my> wrote in message 
>> news:hi1qkt$8eo$1@trimpas.omnitel.net...
>>>> Asmens kodo validation rule MS Access'e ??
>>>
>>>  Anot gandų, nedidelė dalis oficialiai išduotų kodų oficialaus algoritmo
>>> nepraeina. Todėl šita rule turi būti tik įspėjimo pavidalo, tegul 
>>> juzeris
>>> galvoja pats.
>>>
>>> -- 
>>>  saimhe
>>
>>
>
> 


3Dastronomyagricultureaudioautosautos.audiautos.audioautos.binariesautos.bmwautos.clubautos.fordautos.hondacrxautos.japanautos.mercedesautos.opelautos.sportautos.volvoautos.vwaviaavia.binariesbankcardsbinariesbooksbuildingcinemacommercecomp.hardwarecomp.softwarecomp.lietuvinimascomp.networksculturedarbas.ieskaudarbas.siulaudesigneconomicselectronicsfaunafauna.aquafauna.binariesfishingflorafotofoto.binariesgamesgames.csgames.onlinegsmgurmanaihumourhumour.binariesinternetlawmicrosoftmotomusicmusic.binariesmusic.instrumentsmusic.LT.binariesnavigacijaphppoliticsprogrammingrpgsportstudyingsveikatatalktesttranslationtransportationtraveltravel.binariestvunixvideovideo.binarieswatersportswwwwww.flashpdaautos.supermama.ltmobiledarbasretro.3Dretro.agricultureretro.astronomyretro.audioretro.autosretro.autos.audiretro.autos.audioretro.autos.binariesretro.autos.bmwretro.autos.clubretro.autos.fordretro.autos.hondacrxretro.autos.japanretro.autos.mercedesretro.autos.opelretro.autos.sportretro.autos.supermamaretro.autos.supermama.ltretro.autos.volvoretro.autos.vwretro.aviaretro.avia.binariesretro.bankcardsretro.beosretro.binariesretro.booksretro.buildingretro.cinemaretro.commerceretro.compretro.comp.hardwareretro.comp.lietuvinimasretro.comp.networksretro.comp.softwareretro.cultureretro.darbasretro.darbas.ieskauretro.darbas.siulauretro.designretro.economicsretro.electronicsretro.e-vejasretro.faunaretro.fauna.aquaretro.fauna.binariesretro.fishingretro.floraretro.fotoretro.foto.binariesretro.gamesretro.games.csretro.games.onlineretro.games.rpgretro.genealogijaretro.gsmretro.gurmanairetro.humourretro.humour.binariesretro.internetretro.YZFretro.YZF.nebukretro.YZF.nebuk.netikintisretro.YZF.nebuk.netikintis.bukretro.YZF.nebuk.netikintis.buk.tikintisretro.lawretro.microsoftretro.mobileretro.motoretro.musicretro.music.binariesretro.music.instrumentsretro.music.LTretro.music.LT.binariesretro.navigacijaretro.newsretro.news.taisyklesretro.newuserretro.pdaretro.phpretro.politicsretro.programmingretro.rpgretro.sportretro.studyingretro.sveikataretro.talkretro.translationretro.transportationretro.travelretro.travel.binariesretro.tvretro.unixretro.videoretro.video.binariesretro.watersportsretro.wwwretro.www.flashdiylt.rkm.news.announcelt.rkm.news.newuser