请求帮忙翻译代码

Question

因工作需要，程序中需要对企业的税号合法性进行校验，晚上没搜到DELPHI的代码，但是搜到如下的代码，哪位大大帮忙翻译成delphi的代码啊。谢谢。在贴子看到身份证号程序,实际上企业纳税号应用比较广泛
 *********************************************************************
*
*函数过程:nshxm
*用途:校验企业纳税号是否正确
* 
*********************************************************************
 Parameter nsh
 c = ""
 nsh = Alltrim(nsh)
 If Len(nsh)<>15
  = Messagebox("纳税号应有15位!", 48, "纳税号错误")
  Return
 Endif
 For I = 1 To 6
  If Not Isdigit(Substr(nsh, I, 1))
   = Messagebox("纳税号前6位非法!", 48, "纳税号错误")
   Return
  Endif
 Endfor
 N = 0
 For I = 7 To 15
  If Isdigit(Substr(nsh, I, 1))
   N = N+1
  Endif
 Endfor
 For I = 7 To 14
  If Substr(nsh, I, 1)="O" Or Substr(nsh, I, 1)="Z" Or Substr(nsh, I, 1)="I" Or Substr(nsh, I, 1)="S"
   Return
  Endif
 Endfor
 c = xm(nsh)
 If c=Substr(nsh, 15, 1)
  = Messagebox("ok！", 64, "纳税号正确")
 Else
  = Messagebox("纳税号非法!最后一位应为:"+c, 48, "纳税号错误")
 Endif
 Return Function xm
 Parameter nsh
 Dimension z( 9)
 I = 1
 z( 1) = 3
 z( 2) = 7
 z( 3) = 9
 z( 4) = 10
 z( 5) = 5
 z( 6) = 8
 z( 7) = 4
 z( 8) = 2
 z( 9) = 0
 For I = 1 To 8
  z( 9) = z(9)+Gx(Substr(nsh, I+6, 1))*z(I)
 Endfor
 z( 9) = 11-Mod(z(9), 11)
 If z(9)=10
  Return "X"
 Endif
 If z(9)=11
  Return "0"
 Endif
 Return Alltrim(Str(z(9))) Function Gx
 Parameter xm
 If Asc(xm)>=48 And Asc(xm)<=57
  Return Asc(xm)-48
 Endif
 Return Asc(xm)-Asc("A")+10

Answer 1

随手改了一下，能编译运行，是否有错LZ验证一下
Function Gx(xmc:char):integer;
begin
  If (ord(xmc)>=48) And (ord(xmc) <=57) then
  begin
    result:= ord(xmc)-48 ;
    exit;
  end;
  result:=ord(xmc)-ord('A')+10;
end;Function xm(nsh:string):char;
var
  z:array [1..9] of integer;
  i:integer;
begin
//  I := 1; //这行多余 
z[ 1] := 3 ;
z[ 2] := 7 ;
z[ 3] := 9 ;
z[ 4] := 10 ;
z[ 5] := 5 ;
z[ 6] := 8 ;
z[ 7] := 4 ;
z[ 8] := 2 ;
z[ 9] := 0 ;
For I := 1 To 8 do
  z[9] := z[9]+Gx(nsh[I+6])*z[I];
  z[9] := 11- z[9] mod 11;
  If z[9]=10  then
  begin
     result:='x';
     exit;
  end;
  If z[9]=11 then
  begin
      result:= '0';
      exit;
  end;    
  result:=chr(z[9]+ord('0')); 
end;
procedure nshxm(nsh:string);
var
  c:char;
  i,n:integer;
begin  
//  c := '';
  nsh := trim(nsh); 
  If Length(nsh) <>15 then
  begin
    Messagebox(0,'纳税号应有15位!', '纳税号错误',0);
    exit;
  end;
  For I := 1 To 6 do 
  begin
    if (nsh[I]<'0') and (nsh[I]>'9')  then
    begin
       Messagebox(0,'纳税号前6位非法!', '纳税号错误',0);
       exit; 
    end;
  end;
  N := 0 ;
  For I := 7 To 15  do
  begin
    if (nsh[I]>='0') and (nsh[I]<='9')  then
       INC(N);
   end; 
   For I := 7 To 14 do
   begin 
      If (nsh[I]='O') Or (nsh[I]='Z') Or (nsh[I]='I') Or (nsh[I]='S') then
         exit; 
   end;
   c := xm(nsh) ;
   If c=nsh[15] then
       Messagebox(0,'ok!',  '纳税号正确',0)
       else
          Messagebox(0,pchar('纳税号非法!最后一位应为:'+c),'纳税号错误',0);
end;

Answer 2

procedure TForm26.Button1Click(Sender: TObject);
var
  s      : string;
  i, num : Integer;
begin
  s := Trim(Edit1.Text);
  if s = '' then Exit;
  if Length(s) <> 15 then
  begin
    ShowMessage('纳税号应为15位！');
    Exit;
  end;
  if not TryStrToInt(Copy(s, 0, 6), num) then
  begin
    ShowMessage('纳税号前六位应为数字！');
    Exit;
  end;
  for i := 7 to 14 do
  begin
    if (Copy(s, i, 1) = 'O') or (Copy(s, i, 1) = 'Z') or (Copy(s, i, 1) = 'I') or (Copy(s, i, 1) = 'S') then
    begin
      ShowMessage(Copy(s, i, 1));
      Exit;
    end;
  end;
  if CompareStr(Copy(s, 15, 1), GetXM(s)) = 0 then
    ShowMessage('正确！' + ' ' + Copy(s, 15, 1) + ' ' + GetXM(s))
  else
    ShowMessage('错误！' + ' ' + Copy(s, 15, 1) + ' ' + GetXM(s));
end;function TForm26.GetASCII(chr: Char): Integer;
begin
  if (Ord(chr) >= 48) and (Ord(chr) <= 57) then
    Result := Ord(chr) - 48
  else
    Result := Ord(chr) - Ord('A') + 10;
end;function TForm26.GetXM(str: string): string;
const
  Arr  : array[1..8] of Integer = (3, 7, 9, 10, 5, 8, 4, 2);
var
  i    : Integer;
  num  : Integer;
begin
  num := 0;
  for i := 1 to 8 do
  begin
    num := num + GetASCII(str[i + 6]) * Arr[i];
  end;
  num := 11 - num mod 11;
  if num = 10 then
    Result := 'X'
  else
    if num = 11 then
      Result := 'O'
    else
      Result := IntToStr(num);
end;