Page 1 of 3 1 2 3 LastLast
Results 1 to 15 of 42

Thread: BTW Nummer Controle (Meerdere EU landen)

  1. #1
    Member
    Join Date
    Aug 2003
    Location
    Stein (Limburg)
    Posts
    92

    BTW Nummer Controle (Meerdere EU landen)

    Hier een unit met daarin functies voor het checken van BTW nummers van verschillende EU landen. Niet alle landen geven hun formule voor de controle zomaar vrij en dus kan het lastig zijn om hier achter te komen. Daarom deze thread.

    Mijn voorganger heeft enkele functies geschreven (indent = 3) en ik de rest (indent = 1).

    Mocht iemand nog de formules hebben voor andere landen dan zou ik dat heel graag horen.

    [ ik weet het, excuses voor de rommelige code]


    Code:
    unit VAT_CheckFuncs;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ComCtrls,
      Menus, DBCtrls, StdCtrls, Mask, Db, DBTables, Grids, DBGrids, FileCtrl, jpeg;
    
    
    Function ATcheck(VATnr: string): Boolean;
    Function BEcheck(VATnr: string): Boolean;
    Function DEcheck(VATnr: string): Boolean;
    Function DKcheck(VATnr: string): Boolean;
    Function FIcheck(VATnr: string): Boolean;
    Function FRcheck(VATnr: string): Boolean;
    Function GBcheck(VATnr: string): Boolean;
    Function ITcheck(VATnr: string): Boolean;
    Function LUcheck(VATnr: string): Boolean;
    Function NLcheck(VATnr: string): Boolean;
    Function NOcheck(VATnr: string): Boolean;
    Function SEcheck(VATnr: string): Boolean;
    Function EScheck(VATnr: string): Boolean;
    Function GRcheck(VATnr: string): Boolean;
    Function IRcheck(VATnr: string): Boolean;
    Function PTcheck(VATnr: string): Boolean;
    
    implementation
    
    ////////////////////////////////////////////////////////////////////////////////////////////////////
    //
    //  VAT CALCULUS HELPER FUNCTIONS
    //
    ////////////////////////////////////////////////////////////////////////////////////////////////////
    
    
    //
    Function MultiplyAdd(Digit1,Digit2 : string) : integer;
    var s : string;
    begin
     s := IntToStr(StrToInt(Digit1) * StrToInt(Digit2));
     if(Length(s) > 1) then
      result := StrToInt(s[1]) + StrToInt(s[2])
     else
      result := StrToInt(s);
    end;
    
    //Trek een nummer uit een string beginnend op start pos tot eind pos.///////////////////////////////
    Function ExtractNumFromStr(Str: String;iStart,iEnd : integer) : Integer;
    var s : string;
        i : integer;
    begin
     i := iStart;
     s := '';
     while i <= iEnd do begin
      s := s + Str[i];
      i := i + 1;
     end;
     result := StrToInt(s);
    end;
    
    
    ////////////////////////////////////////////////////////////////////////////////////////////////////
    //
    //  VAT CALCULUS FUNCTIONS
    //
    ////////////////////////////////////////////////////////////////////////////////////////////////////
    
    
    //Oosterijk.////////////////////////////////////////////////////////////////////////////////////////
    Function ATcheck(VATnr: string): Boolean;
    var i : integer;
    begin
     try
      if VATnr[1] <> 'U' then begin
       result := false;
       EXIT;
      end;
      i := StrToInt(VATnr[2])
         + MultiplyAdd('2',VATnr[3])
         + StrToInt(VATnr[4])
         + MultiplyAdd('2',VATnr[5])
         + StrToInt(VATnr[6])
         + MultiplyAdd('2',VATnr[7])
         + StrToInt(VATnr[8]);
      i := 10 - ((i+4) mod 10);
      if (i = 10) then i := 0;
      result := (StrToInt(VATnr[9]) = i);
     except
      result := false;
     end;
    End;
    
    //Belgie.///////////////////////////////////////////////////////////////////////////////////////////
    Function BEcheck(VATnr: string): Boolean;
    var deelwaarde, rechts2: Integer;
    begin
         If Length(vatnr) <> 9 Then              //Controle op de lengte
            Result := false
         else
             begin
                  If (strtoint(copy(vatnr,1,1))=0) Or
                     (strtoint(copy(vatnr,1,1))=1) Or
                     (strtoint(copy(vatnr,1,1))=8) Then
                     Result := false                //Controle op eerste cijfer
                  else
                      begin
                           deelwaarde:=(97-(strtoint(copy(vatnr,1,7)) Mod 97));  //Bepaal de rest bij deling en haal dat getal van 97 af
                           rechts2:=strtoint(copy(vatnr,8,2));                    //Bepaal het controlegetal
                           If deelwaarde <> rechts2 Then
                              Result := false
                           else
                              Result := true;
                      end;
             end;
    End;
    
    //Duitsland.////////////////////////////////////////////////////////////////////////////////////////
    Function DEcheck(VATnr: string): Boolean;
    var a, s, k, b, rechts1, teller: Integer;
    begin
         If Length(vatnr) <> 9 Then
            Result := false
         else
             begin
                  a:=10;
                  s:=(strtoint(copy(vatnr, 1, 1)) + a) Mod 10;
                  If s=0 Then
                     s:=10;
                  For teller:=2 To 8 do
                  begin
                      k:=strtoint(copy(vatnr, teller, 1));
                      a:=(2 * s) Mod 11;
                      If a=0 Then
                         a:=11;
                      s:=(k + a) Mod 10;
                      If s=0 Then
                         s:=10;
                  end;
                  a:=(2 * s) Mod 11;
                  If a=0 Then
                     a:=11;
                  b:=11-a;
                  If b=10 Then
                     b:=0;
                  rechts1:=strtoint(copy(vatnr,9, 1));
                  if b=rechts1 then
                      Result := true
                  else
                      Result := false;
             end;
    
    end;
    
    //Denemarken.///////////////////////////////////////////////////////////////////////////////////////
    Function DKcheck(VATnr: string): Boolean;
    begin
         If Length(vatnr)<>8 Then               //Controleer op lengte
            Result := false
         else
             If strtoint(copy(vatnr,1,1))=0 Then
                Result := false        //Controleer op eerste nr <> 0
             else
                 If (((strtoint(copy(vatnr,1,1))) * 2 +
                    (strtoint(copy(vatnr, 2, 1))) * 7 +
                    (strtoint(copy(vatnr, 3, 1))) * 6 +
                    (strtoint(copy(vatnr, 4, 1))) * 5 +
                    (strtoint(copy(vatnr, 5, 1))) * 4 +
                    (strtoint(copy(vatnr, 6, 1))) * 3 +
                    (strtoint(copy(vatnr, 7, 1))) * 2 +
                    (strtoint(copy(vatnr,8,1)))) Mod 11)=0 Then
                    Result := true
                 else Result := false;
    End;
    
    //Finland.//////////////////////////////////////////////////////////////////////////////////////////
    Function FIcheck(VATnr: string): Boolean;
    var c: Integer;
    begin
     c := 0;
     if Length(VATnr) = 8 Then
      c := (((StrtoInt(copy(VATnr,1,1)) * 7) +
             (StrtoInt(copy(VATnr,2,1)) * 9) +
             (StrtoInt(copy(VATnr,3,1)) * 10) +
             (StrtoInt(copy(VATnr,4,1)) * 5) +
             (StrtoInt(copy(VATnr,5,1)) * 8) +
             (StrtoInt(copy(VATnr,6,1)) * 4) +
             (StrtoInt(copy(VATnr,7,1)) * 2) ) Mod 11);
     if (c = 0) and (StrToInt(copy(vatnr,8,1))=0) Then
      Result := true
     else
      If(c > 2) Then c := 11 - c;
    
     if not Result then If c = strtoint(copy(vatnr,8,1)) Then
      Result := true
     else
      Result := false;
    End;
    
    //Frankrijk.////////////////////////////////////////////////////////////////////////////////////////
    Function  FRcheck(VATnr: string): Boolean;
    const FRCharTable : Array[0..33] of char =
          ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','J','K','L','M','N',
           'P','Q','R','S','T','U','V','W','X','Y','Z');
    var i,ic,ic1,ic2,x,y : integer;
    
        Function FindCharInTable(ch : char) : Integer;
        var i_ : integer;
        begin
         i_ := 0;
         while i <= 33 do begin
          if(FRCharTable[i] = ch) then begin
           result := i;
           EXIT;
          end;
          i := i + 1;
         end;
         i := -1;
        end;
    
    begin
     try
      //Old or new system??  Use a hack method
      try
       ic := StrToInt(Copy(VATnr,1,2));
       //if we get here then its the old system..
       result := ic = (((StrToInt64(Copy(VATnr,3,9)) * 100) + 12) mod 97)
      except
       //The new system...
       ic1 := FindCharInTable(VATnr[1]);
       ic2 := FindCharInTable(VATnr[2]);
       if(ic1 < 10) then begin
        i := (ic1 * 24) + ic2 - 10;
       end else begin
        i := (ic1 * 34) + ic2 - 100;
       end;
       X := i mod 11;
       i := i div 2 + 1;
       Y := (StrToInt(Copy(VATnr,3,9)) + i) mod 11;
       result := X = Y;
      end;
     except
      result := false;
     end;
    end;
    
    //Engeland./////////////////////////////////////////////////////////////////////////////////////////
    Function GBcheck(VATnr:string): Boolean;
    var i : integer;
    begin
     try
      //What type of VAT number??
      if(copy(VATnr,1,2) = 'GD') then begin
       //Goverment department//////////////////////////////////////////////////////
       result := StrToInt(Copy(VATnr,3,3)) < 500;
      end else
      if(copy(VATnr,1,2) = 'HA') then begin
       //Health Authority//////////////////////////////////////////////////////////
       result := StrToInt(Copy(VATnr,3,3)) > 499;
      end else
      if(Length(VATnr) = 9) then begin
       //Standard//////////////////////////////////////////////////////////////////
       i := StrToInt(Copy(VATnr,1,7));
       if not(((i > 1) and (i < 19999)) or ((i > 1000000) and (i < 9999999))) then begin
        result := false;
        EXIT;
       end;
       if StrToInt(Copy(VATnr,8,2)) >= 97 then begin
        result := false;
        EXIT;
       end;
       i := 0
          + (8  * StrToInt(VATnr[1]))
          + (7  * StrToInt(VATnr[2]))
          + (6  * StrToInt(VATnr[3]))
          + (5  * StrToInt(VATnr[4]))
          + (4  * StrToInt(VATnr[5]))
          + (3  * StrToInt(VATnr[6]))
          + (2  * StrToInt(VATnr[7]))
          + (10 * StrToInt(VATnr[8]))
          +       StrToInt(VATnr[9]);
       result := (i mod 97) = 0;
      end else
      if(Length(VATnr) = 10) then begin
       //Group registred traders////////////////////////////////////////////////////
       i := StrToInt(Copy(VATnr,1,7));
       if not(((i > 1) and (i < 19999)) or ((i > 1000000) and (i < 9999999))) then begin
        result := false;
        EXIT;
       end;
       if StrToInt(Copy(VATnr,8,2)) >= 97 then begin
        result := false;
        EXIT;
       end;
       if VATnr[10] <> '3' then begin
        result := false;
        EXIT;
       end;
       i := 0
          + (8  * StrToInt(VATnr[1]))
          + (7  * StrToInt(VATnr[2]))
          + (6  * StrToInt(VATnr[3]))
          + (5  * StrToInt(VATnr[4]))
          + (4  * StrToInt(VATnr[5]))
          + (3  * StrToInt(VATnr[6]))
          + (2  * StrToInt(VATnr[7]))
          + (10 * StrToInt(VATnr[8]))
          +       StrToInt(VATnr[9]);
       result := (i mod 97) = 0;
      end else
      if(Length(VATnr) = 12) then begin
       //Isle of man////////////////////////////////////////////////////////////////
       i := StrToInt(Copy(VATnr,4,7));
       if not(((i > 1) and (i < 19999)) or ((i > 1000000) and (i < 9999999))) then begin
        result := false;
        EXIT;
       end;
       if StrToInt(Copy(VATnr,11,2)) >= 97 then begin
        result := false;
        EXIT;
       end;
       if not((Copy(VATnr,1,3) = '000') or (Copy(VATnr,1,3) = '001')) then begin
        result := false;
        EXIT;
       end;
       i := 0
          + (8  * StrToInt(VATnr[4 ]))
          + (7  * StrToInt(VATnr[5 ]))
          + (6  * StrToInt(VATnr[6 ]))
          + (5  * StrToInt(VATnr[7 ]))
          + (4  * StrToInt(VATnr[8 ]))
          + (3  * StrToInt(VATnr[9 ]))
          + (2  * StrToInt(VATnr[10]))
          + (10 * StrToInt(VATnr[11]))
          +       StrToInt(VATnr[12]);
       result := (i mod 97) = 0;
      end else
      if(Length(VATnr) = 13) then begin
       //Isle of man, group registred traders.//////////////////////////////////////
       i := StrToInt(Copy(VATnr,4,7));
       if not(((i > 1) and (i < 19999)) or ((i > 1000000) and (i < 9999999))) then begin
        result := false;
        EXIT;
       end;
       if StrToInt(Copy(VATnr,11,2)) >= 97 then begin
        result := false;
        EXIT;
       end;
       if not((Copy(VATnr,1,3) = '000') or (Copy(VATnr,1,3) = '001')) then begin
        result := false;
        EXIT;
       end;
       if VATnr[13] <> '3' then begin
        result := false;
        EXIT;
       end;
       i := 0
          + (8  * StrToInt(VATnr[4 ]))
          + (7  * StrToInt(VATnr[5 ]))
          + (6  * StrToInt(VATnr[6 ]))
          + (5  * StrToInt(VATnr[7 ]))
          + (4  * StrToInt(VATnr[8 ]))
          + (3  * StrToInt(VATnr[9 ]))
          + (2  * StrToInt(VATnr[10]))
          + (10 * StrToInt(VATnr[11]))
          +       StrToInt(VATnr[12]);
       result := (i mod 97) = 0;
      end else
       //invalid
       result := false;
     except
      Result := false;
      EXIT;
     end;
    End;
    
    //Italie.///////////////////////////////////////////////////////////////////////////////////////////
    Function ITcheck(VATnr: string): Boolean;
    var code,som,somoneven,k,temp,l,r: Integer;
    begin
         If copy(vatnr,1,7)='0000000' Then    //Eerste 7 posities ongelijk aan 0000000
            Result := false
         else
         begin
              code:=strtoint(copy(vatnr,8,3)); //De eenheidscode die in het nummer verwerkt is filteren en controleren op geldigheid
              If inttostr(code)='' Then code:=0;
              If (code>=1) And (code<=100) Or
                                (code=120) Or
                                (code=121) Then
              begin
                   k:=2;
                   som:=0;
                   while k<11 do
                   begin
                        temp:=strtoint(copy(vatnr,k,1))*2;  //Het nummer vanaf positie 2 tot 10 doornemen, even posities berekenen
                        If inttostr(temp)='' Then code:= 0;
                        If temp > 9 Then
                        begin
                             l:=strtoint(copy(inttostr(temp),1,1));        //Getal groter dan 10 => tientallen en eenheden bij elkaar optellen
                             r:=strtoint(copy(inttostr(temp),length(inttostr(temp)), 1));
                             temp:=l + r;
                        End;
                        som:=som + temp;              //Som bijwerken
                        k:=k + 2;
                   end;
                   k:=1;                       //Initialiseren variabelen
                   somoneven:=0;
                   while k<10 do    //Oneven posities tussen positie 1 en 9
                   begin
                       somoneven:=somoneven + strtoint(copy(vatnr,k,1));
                       k:=k+2;
                   end;
                   som:=som + somoneven;     //Oneven posities bij de even posities optellen
                   If ((strtoint(copy(inttostr(som),length(inttostr(som)),1))=0) And
                      (strtoint(copy(vatnr,length(vatnr),1))=0)) Then  //controle op tientallen
                           Result := true;
                   r:=strtoint(copy(inttostr(som),length(inttostr(som)),1));      //Tientallen en eenheden optellen
                   l:=strtoint(copy(vatnr,length(vatnr),1));
                   If ((10-r) = l) Then
                      Result := true
                   else Result := false;
              end;
         End;
    End;
    
    
    //Luxemburg.////////////////////////////////////////////////////////////////////////////////////////
    Function LUcheck(VATnr: string): Boolean;
    var control: Integer;
    begin
         If Length(vatnr) = 8 Then //Controleer lengte = 8
            begin
                 control:=strtoint(copy(vatnr,1,6)) Mod 89;  //rest bij deling eerste 6 cijfers door 87
                 If control = strtoint(copy(vatnr,7,2)) Then
                    Result := true
                 else Result := false;
            end
         else Result := false;
    End;
    
    //Nederland.////////////////////////////////////////////////////////////////////////////////////////
    Function NLcheck(VATnr: string): Boolean;
    var i: integer;
    begin
     try
      if(VATnr[10] <> 'B') then begin
       result := false;
       EXIT;
      end;
      i := 0
         + 9 * StrToInt(VATnr[1])
         + 8 * StrToInt(VATnr[2])
         + 7 * StrToInt(VATnr[3])
         + 6 * StrToInt(VATnr[4])
         + 5 * StrToInt(VATnr[5])
         + 4 * StrToInt(VATnr[6])
         + 3 * StrToInt(VATnr[7])
         + 2 * StrToInt(VATnr[8]);
      i := i mod 11;
      if(i = 10) then result := false
      else            result := StrToInt(VATnr[9]) = i;
     except
      result := true;
      EXIT;
     end;
    End;
    
    //Noorwegen.////////////////////////////////////////////////////////////////////////////////////////
    Function NOcheck(VATnr: string) : Boolean;
    var nummer: integer;
    begin
         if length(vatnr)=9 then
            begin
                 nummer:=(strtoint(copy(vatnr,1,1))*3)+
                         (strtoint(copy(vatnr,2,1))*2)+
                         (strtoint(copy(vatnr,3,1))*7)+
                         (strtoint(copy(vatnr,4,1))*6)+
                         (strtoint(copy(vatnr,5,1))*5)+
                         (strtoint(copy(vatnr,6,1))*4)+
                         (strtoint(copy(vatnr,7,1))*3)+
                         (strtoint(copy(vatnr,8,1))*2);
                 if (11-(nummer mod 11))=(strtoint(copy(vatnr,9,1))) then
                    Result := true
                 else Result := false;
            end
         else Result := false;
    end;
    
    
    //Sweden.///////////////////////////////////////////////////////////////////////////////////////////
    Function SEcheck(VATnr: string): Boolean;
    var k,som,temp,l,r: Integer;
    begin
         If (Length(vatnr)=12) And (strtoint(copy(vatnr,11,2))<>0) Then
            begin
                 k:=1;
                 som:=0;
                 temp:=0;
                 while k< 10 do
                 begin
                      temp:=strtoint(copy(vatnr,k,1)) * 2;
                      If temp > 9 Then
                      begin
                         l:=strtoint(copy(inttostr(temp),1,1));
                         r:=strtoint(copy(inttostr(temp),length(inttostr(temp)),1));
                         temp:=l+r;
                      end;
                      som:=som+temp;
                      k:=k+2;
                 end;
                 k:=2;
                 while k<9 do
                 begin
                     temp:=strtoint(copy(vatnr,k,1));
                     som:=som+temp;
                     k:=k+2;
                 end;
                 If ((strtoint((copy(inttostr(som),length(inttostr(som)),1)))=0) And ((strtoint(copy(vatnr,10,1)))=0)) Then
                     Result := true
                 else
                     begin
                          r:=som Mod 10;
                          l:=strtoint(copy(vatnr,10,1));
                          If ((10-r) = l) Then
                             Result := true
                          else Result := false;
                     end;
            end
         else Result := false;
    End;
    
    
    //Spanje.///////////////////////////////////////////////////////////////////////////////////////////
    Function EScheck(VATnr: string): Boolean;
    const ESCharTable : Array[1..23] of Char =
          ('T','R','W','A','G','M','Y','F','P','D','X','B','N','J','Z','S','Q','V','H','L','C','K','E');
    var ch : char;
        i  : integer;
    begin
     try
      if(Length(vatnr) <> 9) then begin
       Result := false;
       EXIT;
      end;
      ch := vatnr[1];
    
      case ch of
       //Juridical person with profit purpose:
       'A' .. 'H' : begin
                     i := 0 + MultiplyAdd(VATnr[2],'2');
                     i := i + strToInt(VATnr[3]);
                     i := i + MultiplyAdd(VATnr[4],'2');
                     i := i + StrToInt(VATnr[5]);
                     i := i + MultiplyAdd(VATnr[6],'2');
                     i := i + StrToInt(VATnr[7]);
                     i := i + MultiplyAdd(VATnr[8],'2');
                     i := 10 - (i mod 10);
                     if(i = 10) then i := 0;
                     result := StrToInt(VATnr[9]) = i;
                    end;
    
       //Juridical persons without profit purpose
       'N','P','Q','S' : begin
                          i := 0 + MultiplyAdd(VATnr[2],'2');
                          i := i + strToInt(VATnr[3]);
                          i := i + MultiplyAdd(VATnr[4],'2');
                          i := i + StrToInt(VATnr[5]);
                          i := i + MultiplyAdd(VATnr[6],'2');
                          i := i + StrToInt(VATnr[7]);
                          i := i + MultiplyAdd(VATnr[8],'2');
                          i := 10 - (i mod 10);
                          if(i = 10) then i := 0;
                          result := (i - 1 + Ord('A')) = ord(VATnr[9]);
                         end;
    
       //Foreigner physical persons smaller than 14 years old or non residents
       'K','L','M','X' : begin
                          i := 1 +(ExtractNumFromStr(VATnr,2,8) mod 23);
                          Result := ESCharTable[i] = VATnr[9];
                         end;
    
       //Spanish Physical persons
       '0' .. '9' : begin
                     i := 1 +(ExtractNumFromStr(VATnr,1,8) mod 23);
                     Result := ESCharTable[i] = VATnr[9];
                    end;
    
       else begin
        Result := false;
       end;
      end; //end case
     except
      Result := false;
     end;
    end;
    
    
    //Greece VAT calculus.//////////////////////////////////////////////////////////////////////////////
    Function GRcheck(VATnr: string): Boolean;
    var i,il,ipos,imul: integer;
    begin
     try
      il := Length(VATnr) - 1;
      if(il >= 7) and (il <= 8) then begin
       //calculus
       i    := 0;
       ipos := 1;
       if(il = 7) then
        imul := 128
       else
        iMul := 256;
       while ipos <= il do begin
        i    := i + (iMul * StrToInt(VATnr[ipos]));
        iMul := iMul shr 1;
        ipos := ipos + 1;
       end;
       i := i mod 11;
       if(i = 10) then i := 0;
       //check control
       result := i = StrToInt(VATnr[il + 1]);
      end else
       //invalid
       Result := false;
     except
      result := false;
     end;
    end;
    
    
    //Ireland.//////////////////////////////////////////////////////////////////////////////////////////
    Function IRcheck(VATnr: string): Boolean;
    const IRCharTable : Array[0..22] of char =
          ('W','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V');
    var i : integer;
    begin
     try
      //Old or new system??
      if(VATnr[2] in ['A'..'Z','+','*']) then begin
       //Old System
       if(StrToInt(VATnr[1]) <= 6) then Begin
        Result := false;
        EXIT;
       end;
       i := 0
          + 7 * StrToInt(VATnr[3])
          + 6 * StrToInt(VATnr[4])
          + 5 * StrToInt(VATnr[5])
          + 4 * StrToInt(VATnr[6])
          + 3 * StrToInt(VATnr[7])
          + 2 * StrToInt(VATnr[1]);
       i := i mod 23;
       //Check control
       result := IRCharTable[i] = VATnr[8];
      end else begin
       //New System
       i := 0
          + 8 * StrToInt(VATnr[1])
          + 7 * StrToInt(VATnr[2])
          + 6 * StrToInt(VATnr[3])
          + 5 * StrToInt(VATnr[4])
          + 4 * StrToInt(VATnr[5])
          + 3 * StrToInt(VATnr[6])
          + 2 * StrToInt(VATnr[7]);
       i := i mod 23;
       //Check control
       result := IRCharTable[i] = VATnr[8];
      end;
     except
      result := false;
     end;
    end;
    
    //Portugal./////////////////////////////////////////////////////////////////////////////////////////
    Function PTcheck(VATnr: string): Boolean;
    var i : integer;
    begin
     try
      if(StrToInt(VATnr[1]) <= 0) then begin
       result := false;
       EXIT;
      end;
      i := 0
         + 9 * StrToInt(VATnr[1])
         + 8 * StrToInt(VATnr[2])
         + 7 * StrToInt(VATnr[3])
         + 6 * StrToInt(VATnr[4])
         + 5 * StrToInt(VATnr[5])
         + 4 * StrToInt(VATnr[6])
         + 3 * StrToInt(VATnr[7])
         + 2 * StrToInt(VATnr[8]);
      i := 11 - (i mod 11);
      if(i >= 10) then i := 0;
      result := i = StrToInt(VATnr[9]);
     except
      result := false;
     end;
    end;
    
    end.

  2. #2
    notice-itter SvG's Avatar
    Join Date
    Apr 2002
    Location
    's-Hertogenbosch
    Posts
    4,865
    Enige wat ik me afvraag is waarom al die units in de usesclause staan Vooral JPEG...
    !

  3. #3
    Member
    Join Date
    Aug 2003
    Location
    Stein (Limburg)
    Posts
    92
    Eerst werd in dezelfde unit een scherm opgebouwd om zo de gebruiker via internet een btw nummer te laten controleren. Dit scherm is later verplaatst, de uses clausule is niet aangepast geworden. (ga ik nu doen)

  4. #4
    Ik was op zoek naar StrToInt64 (lijkt niet in Delphi 7 te zitten) en kwam met
    zoeken in deze thread terecht.

    In welke unit zit die functie?

    StrToIntDef werkt niet bij te grote int64

  5. #5
    uit de help
    Unit

    SysUtils

    Category

    type conversion routines

    Delphi syntax:

    function StrToInt64(const S: string): Int64;

  6. #6
    Had ik even niet gevonden - bedankt!

  7. #7
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133
    Ondanks dat dit onderwerp mij ca. anderhalf jaar geleden enorm aansprak, besloot ik laatst dan toch om bovenstaande code maar eens te gaan gebruiken. Tot mijn verbazing bleek de unit echter niet hint- en warning-loos te compileren en na een klein onderzoekje had ik vastgesteld dat de code toch niet 1-2-3 zondermeer bruikbaar was, zie bijvoorbeeld de exceptionhandler van n.b. de Nederlandse functie. De verbazing stopte niet toen ik zag dat dit onderwerp toch al 782 keer geraadpleegd is.

    Maaaaar, alle lof en respect voor Rob Lemmen's (en zijn voorganger's) werk: na op internet een tweetal andere sites met code te hebben gevonden, bleek dat er op een paar "Return value of function might be undefined"-meldingen na, de code toch eigenlijk gewoon heel aardig klopt. Overigens spreken beide sites en bovenstaande code elkaar hier en daar nog wel eens tegen, maar de checks voor Nederland, Frankrijk, Duitsland, België en Denemarken lijken te kloppen na een test met een bestand van 1400 klanten.

    Toch kon ik er niet vanaf blijven, onder andere door het gemis van een algemene routine waar je gewoon een willekeurig BTW-nummer in stopt, die zelf bepaald om welk land het gaat, en vervolgens behalve True of False geeft, misschien ook nog wat zinnigs weet te vertellen over wát er goed of verkeerd aan de check was. Bijvoorbeeld: een aantal landen hanteren meerdere categorieën BTW-nummers.

    Onderstaand het resultaat van de o zo vervelende (NL)Delphi-verslaving: NLDCheckVAT, geschikt voor inmiddels 27 landen en "geoptimaliseerd" voor snelheid:
    Code:
    //////////////////////////////////////////////////////////////////////////////
    //                                                                          //
    //  NLDCheckVAT - series routines to validate european VAT number           //
    //                                                                          //
    //  Supported country's: AT, BE, BG, CY, CZ, DE, DK, EE, EL, ES, FI, FR,    //
    //                       GB, HU, IE, IT, LT, LU, LV, MT, NL, PL, PT, RO,    //
    //                       SE, SI, SK                                         //
    //                                                                          //
    //  See also:                                                               //
    //  - http://www.nldelphi.com/forum/showthread.php?t=13911                  //
    //  - http://europa.eu.int/comm/taxation_customs/vies/nl/vieshome.htm       //
    //  - http://europa.eu.int/comm/taxation_customs/vies/nl/faqvies.htm        //
    //  - http://www.openerg.com/download/php-bin/vatguide.htm                  //
    //  - http://sima-pc.com/nif.php                                            //
    //  - http://www.braemoor.co.uk/software/vat.shtml                          //
    //  - http://www.advsofteng.com/vatid.html                                  //
    //                                                                          //
    //  By NLDelphi.com members ?«2006  -  USE AT OWN RISK !                     //
    //                                                                          //
    //////////////////////////////////////////////////////////////////////////////
    
    unit NLDCheckVAT;
    
    interface
    
    //////////////////////////////////////////////////////////////////////////////
    //                                                                          //
    //  Usage:                                                                  //
    //  ------                                                                  //
    //  - The three functions CheckVAT(VATno:String...) require VATno's with    //
    //    countrycode included.                                                 //
    //  - The three functions CheckVAT(CountryCode:String[2]; VATno:String...)  //
    //    require separate countrycode's and VATno's with countrycode excluded. //
    //  - The ReturnCode or ReturnMsg parameters in these functions tell you    //
    //    detailed information about the result of the check. For country's     //
    //    with more than one valid category, the ReturnCode or ReturnMsg        //
    //    paramterer tells which one.                                           //
    //  - The RaiseWrongVAT(..) procedure's do the same as the six above, but   //
    //    don't return a check-result. Instead they result in an exception if   //
    //    the check was false.                                                  //
    //  - The variable AutoCleanVATno has only effect with the first three      //
    //    functions (with countrycode included) and does not handle the given   //
    //    VATno's as variable. If you want to clean VATno's, use the CleanVATno //
    //    function. Initially the variable is set to False, which expects       //
    //    VATno's whithout separators. If true, VATno's will be been            //
    //    capitalized and separators will be deleted before passing to the      //
    //    appropriate individial country check-function.                        //
    //  - Maximum possibilities for the variable VATnoSeparators that have      //
    //    effect is the set [' ', '-', ',', '.'] which is initially assigned to //
    //    the variable. You can change this value to a smaller set to increase  //
    //    performance. The variable is only used if AutoCleanVATno is True.     //
    //  - To investigate if a country is supported by this unit, use the        //
    //    CheckVATCountrySupported function.                                    //
    //  - To check a whole StringList of VATno's, use the CheckVATList          //
    //    function which requires VATno's with countrycode included. If the     //
    //    Ouput parameter is nil, all output wil be returned in the Input       //
    //    parameter. You can choose between keeping or deleting the wrong       //
    //    VATno's.                                                              //
    //                                                                          //
    //////////////////////////////////////////////////////////////////////////////
    
    uses
      SysUtils, Classes;
    
    type
      TCountryCode = String[2];
      TReturnCode = (rcBadCode, rcCountryUnknown, rcInvalidLength,
        rcInvalidFormat, rcInvalidControlChar, rcValidNormal, rcValidOldSystem,
        rcValidNewSystem, rcValidLegalEntity, rcValidSpecialCase,
        rcValidIndividual, rcValidLegalPersonProfit, rcValidLegalPersonNonprofit,
        rcValidNaturalPerson, rcValidNaturalPersonForeign, rcValidLegalPerson,
        rcValidTempTaxpayerOrNaturalPerson, rcValidGovermentDept,
        rcValidHealthAuth, rcValidStandard, rcValidCommGroup, rcValidIslandOfMan,
        rcValidIslandOfManCommGroup, rcValidPersonBefore1954,
        rcValidPersonFrom1954);
      TListFilter = (lfKeepWrong, lfKeepValid);
    
      EInvalidVATNumber = class(Exception)
      private
        FCode: TReturnCode;
      public
        constructor CreateCode(const Msg: String; const ErrorCode: TReturnCode);
        property Code: TReturnCode read FCode write FCode;
      end;
    
    function CheckVAT(VATno: String): Boolean; overload;
    function CheckVAT(VATno: String; var ReturnCode: TReturnCode): Boolean;
      overload;
    function CheckVAT(VATno: String; var ReturnMsg: String): Boolean;
      overload;
    function CheckVAT(const Country: TCountryCode; const VATno: String): Boolean;
      overload;
    function CheckVAT(const Country: TCountryCode; const VATno: String;
      var ReturnCode: TReturnCode): Boolean; overload;
    function CheckVAT(const Country: TCountryCode; const VATno: String;
      var ReturnMsg: String): Boolean; overload;
    
    function CheckVATCountrySupported(const Country: TCountryCode): Boolean;
    procedure CheckVATList(Input: TStrings; Output: TStrings = nil;
      const Filter: TListFilter = lfKeepWrong);
    function CleanVATno(const VATno: String): String;
    
    procedure RaiseWrongVAT(const VATno: String); overload;
    procedure RaiseWrongVAT(const Country: TCountryCode; const VATno: String);
      overload;
    
    var
      AutoCleanVATno: Boolean = False;
      VATnoSeparators: set of Char = [' ', '-', ',', '.'];
    
    implementation
    
    ...
    Bugs, tests, commentaar en bugfixes zijn altijd welkom!
    Last edited by NGLN; 22-Apr-06 at 14:17. Reason: bijlage verwijderd, zie twee posts verder...
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  8. #8
    Member
    Join Date
    Aug 2003
    Location
    Stein (Limburg)
    Posts
    92
    Sorry voor de warnings en zeer rommelige code, de unit heeft een hele lange historie en het was vooral bedoeld om de checks zelf beschikbaar te maken voor iedereen die ze kon gebruiken, in dat opzicht is het geslaagd.
    De checks kloppen en het is een hels werk geweest om ze uit te zoeken, jouw unit NGLN zal de mijne snel vervangen in de webapp waaruit deze kwam!

  9. #9
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133
    Naar aanleiding van deze thread heb ik de eerste drie CheckVAT functies toch maar van const parameters voorzien.
    Attached Files Attached Files
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  10. #10
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133

    Update: WebService toegevoegd... (D6+)

    Requires Delphi6!

    Dit keer met behoorlijk wat hulp van NLDelphi betreffende threads en WebService's is er weer een uitbreiding toegevoegd aan NLDCheckVAT:
    Code:
    //                                                                          //
    //  - WebCheckVATList checks VAT numbers with a web-service. This is the    //
    //    most legal and secure check method. The local routines described      //
    //    above, check just for valid format. The web-service checks if the VAT //
    //    number is really published to an entity and, depending on the member  //
    //    state service, might return the corresponding name and address.       //
    //    The procedure starts a thread which is automaticaly freed on either   //
    //    the thread's or the application's termination. The parameters:        //
    //    - Input is a necessary StringList which requires VATno's with         //
    //      countrycode included.                                               //
    //    - Output is an optional StringList. If this parameter is nil, all     //
    //      output will be returned in the Input parameter, but only if Filter  //
    //      is unequal to lfKeepAll.                                            //
    //    - Filter controls keeping or deleting the wrong VATno's for Output.   //
    //    - OnProgress is an event handler which is called after a single VATno //
    //      check. In case of a SOAP error, the error is returned in the Result //
    //      parameter and the Proceed variable will be False by default. If     //
    //      Proceed is False, the thread stops.                                 //
    //    - OnDone is an event handler which is called when the thread stops,   //
    //      even when not all Input is checked.                                 //
    //                                                                          //
    //////////////////////////////////////////////////////////////////////////////
    
    type
      TWebListFilter = (lfKeepWrong, lfKeepValid, lfKeepAll);
    
      TSOAPFaultCode = (fcNone, fcInvalidInput, fcServiceUnavailable,
        fcMemberStateUnavailable, fcTimeOut, fcServerBusy);
    
      TWebCheckVATResult = record
        SOAPFaultCode: TSOAPFaultCode;
        ErrorMsg: String;
        Valid: Boolean;
        CountryCode: WideString;
        VATNumber: WideString;
        Name: WideString;
        Street: WideString;
        ZipAndCity: WideString;
      end;
    
      TWebCheckVATProgressEvent = procedure(const Step: Integer;
        const WebCheckVATResult: TWebCheckVATResult;
        var Proceed: Boolean) of object;
      TWebCheckVATDoneEvent = procedure(Checked: TStrings; const DoneCount,
        WrongCount: Integer) of object;
    
    procedure WebCheckVATList(Input: TStrings; Output: TStrings = nil;
      const Filter: TWebListFilter = lfKeepAll;
      OnProgress: TWebCheckVATProgressEvent = nil;
      OnDone: TWebCheckVATDoneEvent = nil);
    Veel plezier er mee!
    Last edited by NGLN; 13-May-06 at 17:53. Reason: bijlage verwijderd, zie volgende post...
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  11. #11
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133

    Update: Wijziging WSDL...

    Requires Delphi6!

    NLDCheckVAT is aangepast aan de gewijzigde WSDL en bijbehorende URL van de webservice van de Europese Commissie.
    Attached Files Attached Files
    Last edited by NGLN; 05-Jun-06 at 09:21. Reason: voorbeeldprogramma's bijgevoegd...
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  12. #12

    Roemenie

    Hallo,

    Er zit een fout in de Roemenie controle.
    Op regel 1695 staat
    Result := Digit[N[11]] = CC;

    en dit zou moeten zijn
    Result := Digit[N[10]] = CC;

    En voor roemenen is het gebruikelijk om dit de voorloop-nullen te gebruiken. Dus als het nummer korter is dan 10 cijfers dan moet je daar zelf nog een x-aantal nullen voor zetten om tot de lengte 10 te komen

    Succes
    Andre

  13. #13
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133
    Dat is inderdaad niet zo handig als we in een Case Length(N) of 10 zitten. Thanks!

    Andre, hoe werkt dat met die voorloopnullen precies? Roemenië heeft twee categorieën: Legal Persons (lengte 10) en Natural Persons (lengte 13). Een BTW-nummer van 13 cijfers met vier voorloopnullen, hoe moet die dan geïnterpreteerd worden?

    En schijnbaar heb je ervaring met Roemeense BTW-nummers: is een nummer van 13 cijfers misschien eigenlijk een SOFI-nummer?
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  14. #14
    Hallo, werkt best goed hoor onder windows xp maar als ik onder windows vista opstart en zodra dat ik de vat nummers inlaad geen probleem maar dan vanaf ik op die START THREAD knop druk dan geeft die een error

    Acces violation at address 75D5A513 in module msvcrt.dll read of address 00352000

    als ik nu de applicatie run onder het programma delphi 7 dan werkt het prima.

    als ik het programma delphi 7 sluit en dan de applicatie NLDCheckVAT Sample.zip opstart dan krijg ik terug die error

    Acces violation at address 75D5A513 in module msvcrt.dll read of address 00352000.

    Kan ik die dll niet mee compileren in het applicatie?

    Dank op voorbaat

  15. #15
    Hallo,

    • Bestaat er ook zoiets nuttigs voor het checken van de BBAN (Basic Bank Account number) dat een onderdeel is van de IBAN (International Bank Account number) bank code?
    • Weet iemand daar info over?

    Het probleem is hier de BBAN, die is land afhankelijk (net zoals de VAT dus). De IBAN zelf is vrij gemakkelijk te berekenen uit de BBAN.

    Alvast bedankt!
    Vriendelijke groeten,
    Dany

Page 1 of 3 1 2 3 LastLast

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •