全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:8156
推到 Plurk!
推到 Facebook!

[討論] 各式檢驗碼

 
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#1 引用回覆 回覆 發表時間:2002-07-11 22:42:10 IP:61.221.xxx.xxx 未訂閱
各位大大:      在各位在實作各項程式時(由其是資料庫程式)常常會有要作到檢驗碼的計算,檢查等的工作,而最常看到的就是身份証字號的檢驗,而小弟在此想和大家一起討論各種檢驗碼的計算公式,檢驗方式。     目前常用的檢驗資料就有不少不知各位大大都是如何去實作,希望各大大可以分享您的資料。謝謝。    目前已有的資料 1.身份證號檢查程式 2.檢查民國日期格式 3.檢查日期格式 4.驗證統一編號 5.URL 的檢驗 6.判斷e-mail合法性 7.檢查信用卡 從思考取勝一切~q 發表人 - 阿子 於 2002/07/31 15:03:07 發表人 - 阿子 於 2002/07/31 15:13:40
------
從思考取勝一切~q
領航天使
站長


發表:12216
回覆:4186
積分:4084
註冊:2001-07-25

發送簡訊給我
#2 引用回覆 回覆 發表時間:2002-07-11 22:52:55 IP:192.168.xxx.xxx 未訂閱
站長的身份證號檢查程式:
function CheckBno(cSidNo:string):boolean;
var cStrA,cStrB:string;
    iRetVal,N,iLoop:integer;
    iIdNum,iSumS:integer;
begin
   if trim(cSidNo)='' then
   begin
      result:=true;
      exit;
   end;
   result:=false;
   cStrA := 'ABCDEFGHJKLMNPQRSTUVXYWZIO';
   cStrB := '10987654322109876543321098';
   if ((cSidNo[1]<'A') or (cSidNo[1]>'Z')) then
   begin
     exit;
   end;
   if (length(cSidNo)<10) then
   begin
     exit;
   end;
   if (pos(cSidNo,' ')<>0) then
   begin
     exit;
   end;
   begin
      N := 0;
      for iLoop := 0 to 25 do
      begin
         if (cStrA[iLoop 1] = cSidNo[1]) then
         begin
            N := iLoop  1 ;  // ??
            break;
         end;
      end;
      if (N>0) then 
      begin
         if (cSidNo[2] = '1') or (cSidNo[2] = '2') then
         begin
            iIdNum := ord(cStrB[N]) - ord('0');
            iSumS := iIdNum   (ord(cSidNo[2]) - ord('0')) * 8   (ord(cSidNo[3]) -ord('0')) * 7  
                             (ord(cSidNo[4]) - ord('0')) * 6   (ord(cSidNo[5]) - ord('0')) * 5  
                             (ord(cSidNo[6]) - ord('0')) * 4   (ord(cSidNo[7]) - ord('0')) * 3  
                             (ord(cSidNo) - >    ~~~
        
------
~~~Delphi K.Top討論區站長~~~
領航天使
站長


發表:12216
回覆:4186
積分:4084
註冊:2001-07-25

發送簡訊給我
#3 引用回覆 回覆 發表時間:2002-07-11 22:58:32 IP:192.168.xxx.xxx 未訂閱
站長的檢查民國日期格式的程式: 格式為:091/07/10
function IsDigit(str:string):boolean;
var i:integer;
    c:char;
begin
   IsDigit:=true;
   for i:=1 to length(str) do
   begin
      c:=str[i];
      if not ((c>='0') and (c<='9')) then IsDigit:=false;
   end;
end;
function CheckJulian(year,month,day:integer):boolean;
var  month_tot:array [1..12] of integer;
     is_leap, month_days:integer ;
begin
   month_tot[1]:=31;
   month_tot[2]:=28;
   month_tot[3]:=31;
   month_tot[4]:=30;
   month_tot[5]:=31;
   month_tot[6]:=30;
   month_tot[7]:=31;
   month_tot:=>  >  >  str='   /  /  ' str=''>'0') and (str[1]<>'-') and (str[1]<>'1') then result:=false
      else
      begin
         s1:=copy(str,1,3);
         s2:=copy(str,5,2);
         s3:=copy(str,8,2);
         if not IsDigit(copy(s1,2,2)) then result:=false
         else if not IsDigit(s2) then result:=false
         else if not IsDigit(s3) then result:=false
         else
         begin
            y:=strtointdef(s1,0) 1911;
            m:=strtointdef(s2,0);
            d:=strtointdef(s3,0);
            if y<1 then result:=false
            else if (m<1) or (m>12) then result:=false
            else if (d<1) or (d>31) then result:=false
            else Result:=CheckJulian(y,m,d);
         end;
      end;
   end;
end;    
P.S:會不會太笨了,有誰有更好的演算法? ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~
andersonhsieh
版主


發表:33
回覆:531
積分:439
註冊:2002-06-10

發送簡訊給我
#4 引用回覆 回覆 發表時間:2002-07-12 00:32:52 IP:211.23.xxx.xxx 未訂閱
引言: 站長的檢查民國日期格式的程式: 格式為:091/07/10
function IsDigit(str:string):boolean;
var i:integer;
    c:char;
begin
   IsDigit:=true;
   for i:=1 to length(str) do
   begin
      c:=str[i];
      if not ((c>='0') and (c<='9')) then IsDigit:=false;
   end;
end;
function CheckJulian(year,month,day:integer):boolean;
var  month_tot:array [1..12] of integer;
     is_leap, month_days:integer ;
begin
   month_tot[1]:=31;
   month_tot[2]:=28;
   month_tot[3]:=31;
   month_tot[4]:=30;
   month_tot[5]:=31;
   month_tot[6]:=30;
   month_tot[7]:=31;
   month_tot:=>  >  >  str='   /  /  ' str=''>'0') and (str[1]<>'-') and (str[1]<>'1') then result:=false
      else
      begin
         s1:=copy(str,1,3);
         s2:=copy(str,5,2);
         s3:=copy(str,8,2);
         if not IsDigit(copy(s1,2,2)) then result:=false
         else if not IsDigit(s2) then result:=false
         else if not IsDigit(s3) then result:=false
         else
         begin
            y:=strtointdef(s1,0) 1911;
            m:=strtointdef(s2,0);
            d:=strtointdef(s3,0);
            if y<1 then result:=false
            else if (m<1) or (m>12) then result:=false
            else if (d<1) or (d>31) then result:=false
            else Result:=CheckJulian(y,m,d);
         end;
      end;
   end;
end;    
P.S:會不會太笨了,有誰有更好的演算法? ~~~Delphi K.Top討論區站長~~~
一般來說日期格式都會用 try strtodate(日期字串); except ShowMessage(日期格式錯誤!!!!); end; @@~~飛翔在天際的精靈~~@@
------
@@~~飛翔在天際的精靈~~@@
dllee
站務副站長


發表:321
回覆:2519
積分:1711
註冊:2002-04-15

發送簡訊給我
#5 引用回覆 回覆 發表時間:2002-07-12 07:48:46 IP:61.59.xxx.xxx 未訂閱
引言: 各位大大: 在各位在實作各項程式時(由其是資料庫程式)常常會有要作到檢驗碼的計算,檢查等的工作,而最常看到的就是身份証字號的檢驗,而小弟在此想和大家一起討論各種檢驗碼的計算公式,檢驗方式。 目前常用的檢驗資料就有不少不知各位大大都是如何去實作,希望各大大可以分享您的資料。謝謝。 從思考取勝一切~q
各種程式其檢驗碼通常都是自定的,例如,有些軟體序號也是內含檢驗碼,方法有 ascii 將值全部加總後只取 LSB 的 8 位元或 16 位元,這也就是 CheckSUM,而有些則用特別的位元運算,例如,將每個 ascii 左移 n 位後再加總,或是將每個 ascii 與某一個特殊字作 XOR 後再加總,或是以上兩種都用,或是前半部使用一種方法,後半部使用另一種方法... 真的是太多了...
------
http://www.ViewMove.com
tailen
中階會員


發表:82
回覆:109
積分:63
註冊:2002-04-08

發送簡訊給我
#6 引用回覆 回覆 發表時間:2002-07-12 09:00:38 IP:61.218.xxx.xxx 未訂閱
小弟不才,也發表一下我的日期檢查公式! //********************** //檢查日期格式是否正確 //In:sDate(chinese date format)(ex.0910508) //Out:True is right,False is fail //Create by Tailen,910508 //********************** Function CheckDateFormat(sDate:string):boolean; var dDate : TDateTime; sYearT : String; begin DateSeparator := '/'; ShortDateFormat := 'mm/dd/yyyy'; result := False; if Length(sDate) <> 7 then exit; sYearT := IntToStr(StrToInt(Copy(sDate,1,3)) 1911); sDate := Copy(sDate,4,2) DateSeparator Copy(sDate,6,2) DateSeparator sYearT; try dDate:= StrToDate(sDate); except exit; end; result := True; end;
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#7 引用回覆 回覆 發表時間:2002-07-12 23:39:46 IP:61.221.xxx.xxx 未訂閱
dllee 兄,小弟說的不是那一類的檢驗碼,而是目前市面上會用到的而您說的那一類通常是各家自己的一種檢驗資料方式,我想和大家討論的是像身份証字號這一類的檢驗碼(公式),不過也歡迎各位把自己對某一特別的檢驗碼(公式)分享給大家。 小弟先作個小說明 有特定檢驗公式的: 身份証字號 ,公司統一編號,信用卡卡號 .... 有檢查碼作檢驗的: 各式條碼,EAN系列.... 有特定格式的檢驗 : 民國日期,E-Mail, URL, IP.... 這可能只是其中的一小部份,歡迎大家一起來把討論。 ^^ 從思考取勝一切~q 發表人 - 阿子 於 2002/07/12 23:40:27
------
從思考取勝一切~q
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#8 引用回覆 回覆 發表時間:2002-07-13 16:52:45 IP:61.221.xxx.xxx 未訂閱
驗證統一編號的實作 說明:  
參考資料:吳和珍及許秋雪所編著之《Visual Fox Pro SQL應用專輯》第第3-158,3-159。    (一) 長度:共八位,,全部為數字型態。    (二) 計算公式    1、各數字分別乘以 1,2,1,2,1,2,4,1。
2、公式如下:     D1 D2 D3 D4 D5 D6 D7 D8    
* 1 2 1 2 1 2 4 1 (第一列 * 第二列)
     --------------------------------------------------------------------------------
 
 A1 B1 A2 B2 A3 B3 A4 B4 (Bx:相乘後的十位數) 
   C1  C2  C3 C4  (Cx:相乘後的個位數)     --------------------------------------------------------------------------------
 
 X1 X2 X3 X4 X5 X6 X7 X8 (Xx:相加後的十位數) 
       Y7  (Yx:相加後的個位數)         Z1= X1   X2   X3   X4   X5   X6   X7   X8 或
    Z1= X1   X2   X3   X4   X5   X6   Y7   X8    3、當第 7 位數為 7 者,可取相加之倒數第二位取 0 及 1 來計算如 Z1 及 Z2 計算其和。
4、假如 Z1 或 Z2 能被 10 整除,則表示營利事業統一編號正確。    (三) 範例  ( 以 0 0 2 3 8 7 7 8 為例 )     0 0 2 3 8 7 7 8    
* 1 2 1 2 1 2 4 1 (第一列 * 第二列)
     --------------------------------------------------------------------------------
 
 0 0 2 6 8 1 2 8 (Bx:相乘後的十位數) 
       4 8  (Cx:相乘後的個位數)     --------------------------------------------------------------------------------
 
 0 0 2 6 8 5 1 8 (Xx:相加後的十位數) 
       0  (Yx:相加後的個位數)        Z1= 0  0  2  6  8  5  1  8 = 30 或
   Z2= 0  0  2  6  8  5  0  8 = 29
 因 30 能被 10 整除,故營利事利統一編號正確。     
{* ******************************** zCheckBANO ****************************** *}
{* =================================Blue Fox================================= *}
{* 目    的:  驗證統一編號
{* 關 鍵 字:
{* 輸 入 值:  const BANO: string
{* 傳 回 值:  zCheckBANO:Boolean
{* 呼 叫 式:
{* 說    明:
{* 日    期      由      注解
{* ----------    ----    -------
{* 2001/1/24     
{* =================================Blue Fox==============================2.0 *}    function zCheckBANO(const BANO: string): Boolean;
var
  c1, c2, c3, c4, a1, a2, a3, a4, b1, b2, b3, b4, a5: Integer;
begin
  Result := False;
  if Length(BANO) <> 8 then Exit;
  c1 := StrToIntDef(BANO[1], -1);
  c2 := StrToIntDef(BANO[3], -1);
  c3 := StrToIntDef(BANO[5], -1);
  c4 := StrToIntDef(BANO, ->    從思考取勝一切~
        
------
從思考取勝一切~q
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#9 引用回覆 回覆 發表時間:2002-07-16 16:48:12 IP:61.221.xxx.xxx 未訂閱
URL 的檢驗實作
{* ******************************** zIsURL ****************************** *}
{* =================================Blue Fox================================= *}
{* 目    的:  檢測URL是否正確
{* 關 鍵 字:
{* 輸 入 值:  s: string
{* 傳 回 值:  zIsURL:Boolean
{* 呼 叫 式:
{* 說    明:
{* 日    期      由      注解
{* ----------    ----    -------
{* 2002/1/3        
{* =================================Blue Fox==============================2.0 *}    function zIsURL(s: string): Boolean;
var
  i: integer;
begin  
  Result := False;
  if Length(s) < 5 then exit;
  if (s[Length(s)] = '.') or (Pos('..', s) > 0) then exit;
  for i := 1 to Length(s) do
    if (Ord(s[i]) < 33) or (Ord(s[i]) > 126) then exit;   
  if (Pos('www.', LowerCase(s)) = 1) or (Pos('news:', LowerCase(s)) = 1) and
    (Length(s) > 6) then
  begin
    Result := True;
    Exit;
  end;
  if (Length(s) > 12) or (Pos('mailto:', LowerCase(s)) = 1) and
    (Pos('@', s) > 1) and (Pos('.', s) > 4) and (Pos('.', s) > (Pos('@', s)   1)) then
  begin
    Result := True;
    Exit;
  end;
  if (Pos('http:://', LowerCase(s)) > 0) or (Pos('ftp://', LowerCase(s)) > 0) and
    (Length(s) > 10) and (Pos('.', s) > 7) then
  begin
    Result := True;
    Exit;
  end;
end;
從思考取勝一切~q
------
從思考取勝一切~q
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#10 引用回覆 回覆 發表時間:2002-07-18 15:37:55 IP:61.221.xxx.xxx 未訂閱
各位好像對這個題目沒什麼興趣,開這個討論主要也是希望大家可以將自己有寫過或是收集來的檢驗碼實作資料,提供出來給其他人使用,小弟想到時在把這個討論的內容收集整理成冊在放回這里來,所以希望大家可以提出自想要或是已有的檢驗碼資訊可以分享給大家謝謝,就算已有相同的檢驗碼實作(程式碼)也可以在貼上來分享。 謝謝大家的幫忙。 從思考取勝一切~q
------
從思考取勝一切~q
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#11 引用回覆 回覆 發表時間:2002-07-18 15:43:16 IP:61.221.xxx.xxx 未訂閱
判斷e-mail合法性
{* ******************************** zIsEMail ****************************** *}
{* =================================Blue Fox================================= *}
{* 目    的:  判斷e-mail合法性(第一版)
{* 關 鍵 字:
{* 輸 入 值:  AEMail: string
{* 傳 回 值:  zIsEMail:Boolean
{* 呼 叫 式:
{* 說    明:
{* 日    期      由      注解
{* ----------    ----    -------
{* 2002/1/23        levi
{* =================================Blue Fox==============================2.0 *}    function zIsEMail(AEMail: string): Boolean;
var s: string;
  ETpos: Integer;
begin
  ETpos := pos('@', AEMail); //判斷是否有@在其中出現多少次
  if ETpos = 1 then
  begin
    s := copy(AEMail, ETpos   1, Length(AEMail));
    if (pos('.', s) > 1) and (pos('.', s) <> length(s)) then
      Result := true
    else
      Result := false;
  end
  else
    Result := false;
end;
從思考取勝一切~q
------
從思考取勝一切~q
pprayer
高階會員


發表:35
回覆:185
積分:174
註冊:2002-03-13

發送簡訊給我
#12 引用回覆 回覆 發表時間:2002-07-19 22:59:18 IP:61.229.xxx.xxx 未訂閱
檢查中文日期格式,是否可以使用到FormatDateTime這個函式?
nana
一般會員


發表:0
回覆:1
積分:0
註冊:2002-05-28

發送簡訊給我
#13 引用回覆 回覆 發表時間:2002-07-23 09:17:14 IP:140.92.xxx.xxx 未訂閱
引言: 站長的身份證號檢查程式:
function CheckBno(cSidNo:string):boolean;
var cStrA,cStrB:string;
    iRetVal,N,iLoop:integer;
    iIdNum,iSumS:integer;
begin
   if trim(cSidNo)='' then
   begin
      result:=true;
      exit;
   end;
   result:=false;
   cStrA := 'ABCDEFGHJKLMNPQRSTUVXYWZIO';
   cStrB := '10987654322109876543321098';
   if ((cSidNo[1]<'A') or (cSidNo[1]>'Z')) then
   begin
     exit;
   end;
   if (length(cSidNo)<10) then
   begin
     exit;
   end;
   if (pos(cSidNo,' ')<>0) then
   begin
     exit;
   end;
   begin
      N := 0;
      for iLoop := 0 to 25 do
      begin
         if (cStrA[iLoop 1] = cSidNo[1]) then
         begin
            N := iLoop  1 ;  // ??
            break;
         end;
      end;
      if (N>0) then 
      begin
         if (cSidNo[2] = '1') or (cSidNo[2] = '2') then
         begin
            iIdNum := ord(cStrB[N]) - ord('0');
            iSumS := iIdNum   (ord(cSidNo[2]) - ord('0')) * 8   (ord(cSidNo[3]) -ord('0')) * 7  
                             (ord(cSidNo[4]) - ord('0')) * 6   (ord(cSidNo[5]) - ord('0')) * 5  
                             (ord(cSidNo[6]) - ord('0')) * 4   (ord(cSidNo[7]) - ord('0')) * 3  
                             (ord(cSidNo[8]) - ord('0')) * 2   (ord(cSidNo[9]) - ord('0'))   
                             ord(cSidNo[10]) - ord('0');
            if ((iSumS mod 10) = 0) then Result:=true;
         end;
      end;
   end;
end;
~~~Delphi K.Top討論區站長~~~
身份證最後一碼為 4 時,也必須要剔除哦~
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#14 引用回覆 回覆 發表時間:2002-07-28 13:26:18 IP:61.221.xxx.xxx 未訂閱
to nana   
引言: 身份證最後一碼為 4 時,也必須要剔除哦~ 請問一下為什麼最一碼是4時為什麼要剔除
身份証驗証說明如下但沒有您說的部份,不知可否說明一下,謝謝!
(一)長度:共十位,第一位為英文字母,其後九位為數字型態,分別用以下的編碼來代表:    第 ? 位 1 2 3 4 5 6 7 8 9 10 
編碼 A1 D1 D2 D3 D4 D5 D6 D7 D8 D9     身份證編號中第 1 位 ( A1 ) 英文字母,是代表地區,例如:臺中縣為 L,轉換成數字編號為 20!    各地區的完整字母對照表如下:    字母 A B C D E F G H J 
編號 10 11 12 13 14 15 16 17 18 
縣市 臺北市 臺中市 基隆市 臺南市 高雄市 臺北縣 宜蘭縣 桃園縣 新竹縣 
字母 K L M N P Q R S T 
編號 19 20 21 22 23 24 25 26 27 
縣市 苗栗縣 臺中縣 南投縣 彰化縣 雲林縣 嘉義縣 臺南縣 高雄縣 屏東縣 
字母 U V X Y W Z I O  
編號 28 29 30 31 32 33 34 35   
縣市 花蓮縣 臺東縣 澎湖縣  陽明山 金門縣 連江縣 嘉義市 新竹市       (二)計算公式    1. 第一位英文字母 ( A1 ) 由字母對照表中得知其編號均為 2 碼的數字,令其十位數為 L1,個位數為 L2 。     A1 轉換成 2 碼的數字編號後,身份証號就變成 11 碼了,前二碼即為 L1,L2    2. 將轉換後的 11 碼數字分別乘以:1, 9, 8, 7, 6, 5, 4, 3, 2, 1, 1     3. 公式如下:        X = L1 * 1   L2 * 9   D1 * 8   D2 * 7   D3 * 6   D4 * 5    D5 * 4   D6 * 3   D7 * 2   D8 * 1   D9 * 1    4. 假如 X 能被 10 整除,則表示身分證統一編號正確。    
To pprayer 可否說明一下您的想法,大家可以一起討論一下,你只提FormatDateTime但我不是很了解你的用法,謝謝了 從思考取勝一切~q
------
從思考取勝一切~q
鈴鐺
初階會員


發表:33
回覆:81
積分:35
註冊:2002-03-13

發送簡訊給我
#15 引用回覆 回覆 發表時間:2002-07-29 10:43:55 IP:61.220.xxx.xxx 未訂閱
常看到身分證號檢查碼公式, 各位不知道有沒有發現, 這公式的缺點?(或者說是這種編碼的缺點),不知道這公式當初是怎麼編出來的. 1. 性別就浪費掉一碼, 若變性人不知他(她)身分證號要怎麼編? 2. A-Z 公式乘以 10-35, 其實十進位處根本是不需要的, 因為最後會 mod 10, 所以只要和 0,1,2,.. 相成即可 3. 但想想 A,L,X 這些字怎麼乘都還是 0, 所以不小心打錯了調換順序檢查碼根本就查不出問題.(需知道, 檢查碼最大功用就是避免打錯字, 如順序顛倒,打到前後號碼, 打到類似音)
阿子
站務副站長


發表:120
回覆:230
積分:201
註冊:2002-03-18

發送簡訊給我
#16 引用回覆 回覆 發表時間:2002-07-31 15:07:52 IP:61.221.xxx.xxx 未訂閱
檢查信用卡
{* ******************************** CardCheck ******************************* *}
{* =================================Blue Fox================================= *}
{* 目    的:  檢查信用卡
{* 關 鍵 字:  檢查,信用卡
{* 輸 入 值:  value: string
{* 傳 回 值:  CardCheck:Boolean
{* 呼 叫 式:
{* 說    明:
{* 日    期      由      注解
{* ----------    ----    -------
{* 2001/4/5      Levi    整理
{* =================================Blue Fox==============================2.0 *}    function CardCheck(value: string): Boolean;
var
  idx, Sum, leng, Weight: integer;
  Digital: array of integer;
  DigitalNumberIsOdd: Boolean;
begin
  Result := False;
  leng := length(value);
  if leng = 0 then exit;
  SetLength(Digital, leng);
  Sum := 0;      if Odd(leng) then
    DigitalNumberIsOdd := True
  else
    DigitalNumberIsOdd := False;      for idx := 1 to leng do
  begin
    Digital[idx - 1] := Ord(Value[idx]) - Ord('0');
    if (Digital[idx - 1] > 9) or (Digital[idx - 1] < 0) then Exit;
    if (DigitalNumberIsOdd) then
      if odd(idx) then
        Weight := 1
      else
        Weight := 2
    else
      if odd(idx) then
        Weight := 2
      else
        Weight := 1;
    Digital[idx - 1] := Digital[idx - 1] * Weight;
    if (Digital[idx - 1] > 9) then Digital[idx - 1] := Digital[idx - 1] - 9;
    Sum := Sum   Digital[idx - 1];
  end;      if (Sum mod 10 = 0) then
    Result := True
  else
    Result := False;
end;
從思考取勝一切~q
------
從思考取勝一切~q
christie
資深會員


發表:30
回覆:299
積分:475
註冊:2005-03-25

發送簡訊給我
#17 引用回覆 回覆 發表時間:2008-08-29 08:42:23 IP:61.59.xxx.xxx 未訂閱

EAN13 檢查碼
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *}
{* **************************** Ean8/Ean13 CheckSum ************************* *}
{* 目    的: 計算Ean8 Ean13的檢查碼
{* 關 鍵 字: 條碼,EAN8,EAN13
{* 輸 入 值: value: string
{* 傳 回 值: 檢查碼(CheckSum):Byte
{* 呼 叫 式: CalcEAN13Checksum('471049823228');
{*          CalcEAN13Checksum('1234567')
{* 日    期: 97.8.29
{* ----------    ----    -------}
function CalcEAN13Checksum(EAN13: string): byte;
var
  i: integer;
  Odd: boolean;
  CalcChecksum: integer;
begin
  CalcChecksum := 0;
  i := Length(EAN13);
  Odd := true;
  while i > 0 do
  begin
    if Odd then
      CalcChecksum := CalcChecksum   StrToInt(EAN13[i]) * 3
    else
      CalcChecksum := CalcChecksum   StrToInt(EAN13[i]);
    Odd := not Odd;
    dec(i);
  end;
  result := 0;
  while ((CalcChecksum   result) mod 10) <> 0 do
    inc(result);
end;    procedure TForm1.Button1Click(Sender: TObject);
var
  Checksum: byte;
begin
  Checksum := CalcEAN13Checksum('471049823228');
  caption:=inttostr(checksum)
end;

------
What do we live for if not to make life less difficult for each other?
編輯記錄
christie 重新編輯於 2008-08-29 16:33:46, 註解 無‧
pceyes
尊榮會員


發表:70
回覆:657
積分:1140
註冊:2003-03-13

發送簡訊給我
#18 引用回覆 回覆 發表時間:2008-08-29 13:52:31 IP:220.141.xxx.xxx 訂閱
有這個版實在太好了,補一個先

郵局帳號檢查規則

http://delphi.ktop.com.tw/board.php?cid=30&fid=69&tid=52406

郵局局號帳號檢查規則

局號及帳號皆為7碼數字末碼為檢查碼

前六碼數字加權分別為2,3,4,5,6,7



如前六碼數字為 n1,n2,n3,n4,n5,n6 , c1為檢查碼

c1=(n1*2 n2*3 n3*4 n4*5 n5*6 n6*7) mod 11

如果 c1=10 則 c1=0

c1 應與第七碼同





function CheckPostID(c:String):Boolean;

var weight : array[1..6] of integer;
iID :array[1..7] of integer;
numCheck:integer; index:integer;
i:integer;

begin
result:=True;
if Length(c)<>7 then
begin
result:= false;
exit;
end;


for i:=1 to strlen(pChar(c)) do
begin
if (c[i]>'9') or (c[i]<'0') then
begin
result:=false;
exit;
end
else iID[i]:=strtoint(c[i]);
end;


for i:=1 to 6 do
weight[i]:=i 1;


numCheck := 0;



for i:= 1 to 6 do
begin
numCheck := numCheck iID[i] * weight[i];
end;


numCheck := numCheck mod 11;
numCheck := 11 - numCheck;


if numCheck > 9 then numCheck := numCheck - 10;


if numCheck<>iID[7] then result:= False;

end;
------
努力會更接近成功
編輯記錄
pceyes 重新編輯於 2008-08-29 13:53:32, 註解 無‧
pceyes 重新編輯於 2008-08-29 13:55:47, 註解 無‧
christie
資深會員


發表:30
回覆:299
積分:475
註冊:2005-03-25

發送簡訊給我
#19 引用回覆 回覆 發表時間:2008-08-29 20:45:12 IP:61.59.xxx.xxx 未訂閱

UPC_A 檢查碼
{* * * * * * * * * * * * * * * * * *  * * * * * * * * * * * * * * * * *  *}
{* **************************** UPC_A CheckSum ************************* *}
{* 目    的: 計算UPC_A的檢查碼
{* 關 鍵 字: 條碼,UPC
{* 輸 入 值: value: string
{* 傳 回 值: 檢查碼(CheckSum):Byte
{* 呼 叫 式: CalcUPCChecksum('12345678901');
{*          
{* 日    期: 97.8.29
{* ----------    ----    -------}
function CalcUPCChecksum(UPC: string):BYTE;
var i: integer;
    Odd: boolean;
    CalcChecksum: integer;
begin
  CalcChecksum := 0;
  i := Length(UPC);
  Odd := true;
  while i > 0 do
  begin
    if Odd then
      CalcChecksum := CalcChecksum   StrToInt(UPC[i]) * 3
    else
      CalcChecksum := CalcChecksum   StrToInt(UPC[i]);
    Odd := not Odd;
    dec(i);
  end;
  result := CALCCHECKSUM MOD 10;
  if Result <> 0 then
    Result := 10 - Result
END;
------
What do we live for if not to make life less difficult for each other?
albert1225
一般會員


發表:1
回覆:1
積分:0
註冊:2008-09-01

發送簡訊給我
#20 引用回覆 回覆 發表時間:2008-09-08 14:37:48 IP:220.140.xxx.xxx 訂閱
最近看到身分證驗證規則無聊弄的,如果有不好的地方請多包含!


[code delphi]
function IDCheck(IDNum: String):Bool;
var i, j, sum: integer;
begin
Result := true;
if (Length(IDNum)<>10) or ((IDNum[2]<>'1') and (IDNum[2]<>'2'))then
begin
Result := false;
exit;
end;
case Ord(IDNum[1]) of
73,105: i := 34;
79,111: i := 35;
65..72: i := Ord(IDNum[1]) - 55;
74..78: i := Ord(IDNum[1]) - 56;
80..90: i := Ord(IDNum[1]) - 57;
97..104: i := Ord(IDNum[1]) - 87;
106..110: i := Ord(IDNum[1]) - 88;
112..122: i := Ord(IDNum[1]) - 89;
else
begin
Result := false;
exit;
end;
end;
Delete(IDNum,1,1);
IDNum := IntToStr(i) IDNum;
sum := 0;
for i := 1 to 10 do
begin
if 11 - i = 10 then
j := 1
else
j := 11 - i;
sum := sum StrToInt(IDNum[i]) * j;
end;
if (10 - (sum mod 10) <> StrToInt(IDNum[11])) and (sum mod 10 <> 10) then
Result := false;
end;

[/code]
------
新手出招,歡迎指教!
編輯記錄
albert1225 重新編輯於 2008-09-08 22:36:57, 註解 無‧
albert1225 重新編輯於 2008-09-08 22:38:41, 註解 無‧
albert1225 重新編輯於 2008-09-08 22:40:13, 註解 無‧
albert1225 重新編輯於 2008-09-08 22:41:28, 註解 無‧
ufjjc
一般會員


發表:18
回覆:47
積分:23
註冊:2002-05-21

發送簡訊給我
#21 引用回覆 回覆 發表時間:2009-08-03 17:29:34 IP:114.33.xxx.xxx 訂閱
ISBN碼驗證

資料來源
網站
http://www.swissdelphicenter.ch/en/index.php



[code delphi]
function ValidateISBN(const ISBN: string): Boolean;
//
// References:
// ===========
// [1] http://isbn-international.org/userman/chapter4.html
//
type
TISBNPart = (ipGroupID, ipPublisherID, ipTitleID, ipCheckDigit);
TISBNPartSizes = array [TISBNPart] of Integer;
const
ISBNSize = 13;
ISBNDigits = ['0'..'9'];
ISBNSpecialDigits = ['x', 'X'];
ISBNSeparators = [#32, '-'];
ISBNCharacters = ISBNDigits ISBNSpecialDigits ISBNSeparators;
var
CurPtr, EndPtr: PAnsiChar;
Accumulator, Counter: Integer;
Part: TISBNPart;
PartSizes: TISBNPartSizes;

// begin local function

function IsPartSizeValid(APart: TISBNPart): Boolean;
const
MaxPartSizes: TISBNPartSizes = (5, 7, 6, 1);
begin
Result := PartSizes[APart] <= MaxPartSizes[APart];
end;

// end local function

begin
Result := False;
// At first, check the overall string length.
if Length(ISBN) <> ISBNSize then
Exit;

CurPtr := @ISBN[1];
EndPtr := CurPtr Pred(ISBNSize);
Accumulator := 0;
Counter := 10;
Part := ipGroupID;
ZeroMemory(@PartSizes[Low(PartSizes)], SizeOf(PartSizes));

while Cardinal(CurPtr) <= Cardinal(EndPtr) do
begin
if CurPtr^ in ISBNCharacters then
begin
if CurPtr^ in ISBNSeparators then
begin
// Switch to the next ISBN part, but take care of two conditions:
// 1. Do not let Part go beyond its upper bound (ipCheckDigit).
// 2. Verify if the current ISBN part does not exceed its size limit.
if (Part < High(Part)) and IsPartSizeValid(Part) then
Inc(Part)
else
Exit;
end
else // CurPtr^ in [ISBNDigits, ISBNSpecialDigits]
begin
// Is it the last character of the string?
if (CurPtr = EndPtr) then
begin
// Check the following conditions:
// 1. Make sure current ISBN Part equals to ipCheckDigit.
// 2. Verify if the check digit does not exceed its size limit.
if (Part <> High(Part)) and not IsPartSizeValid(Part) then
Exit;
end
else
// Special check digit is allowed to occur only at the end of ISBN.
if CurPtr^ in ISBNSpecialDigits then
Exit;

// Increment the size of the current ISBN part.
Inc(PartSizes[Part]);

// Increment the accumulator by current ISBN digit multiplied by a weight.
// To get more detailed information, please refer to the web site [1].
if (CurPtr = EndPtr) and (CurPtr^ in ISBNSpecialDigits) then
Inc(Accumulator, 10 * Counter)
else
Inc(Accumulator, (Ord(CurPtr^) - Ord('0')) * Counter);
Dec(Counter);
end;
Inc(CurPtr);
end
else
Exit;
end;
// Accumulator content must be divisible by 11 without a remainder.
Result := (Accumulator mod 11) = 0;
end;


[/code]
編輯記錄
ufjjc 重新編輯於 2009-08-03 17:31:57, 註解 無‧
ufjjc
一般會員


發表:18
回覆:47
積分:23
註冊:2002-05-21

發送簡訊給我
#22 引用回覆 回覆 發表時間:2009-08-03 17:41:05 IP:114.33.xxx.xxx 訂閱
再加一個 ip驗證

資料來源同上
[code delphi]
//check if a String is a valid IP Address
function IsWrongIP(ip: string): Boolean;
var
z, i: byte;
st: array[1..3] of byte;
const
ziff = ['0'..'9'];
begin
st[1] := 0;
st[2] := 0;
st[3] := 0;
z := 0;
Result := False;
for i := 1 to Length(ip) do if ip[i] in ziff then
else
begin
if ip[i] = '.' then
begin
Inc(z);
if z < 4 then st[z] := i
else
begin
IsWrongIP := True;
Exit;
end;
end
else
begin
IsWrongIP := True;
Exit;
end;
end;
if (z <> 3) or (st[1] < 2) or (st[3] = Length(ip)) or (st[1] 2 > st[2]) or
(st[2] 2 > st[3]) or (st[1] > 4) or (st[2] > st[1] 4) or (st[3] > st[2] 4) then
begin
IsWrongIP := True;
Exit;
end;
z := StrToInt(Copy(ip, 1, st[1] - 1));
if (z > 255) or (ip[1] = '0') then
begin
IsWrongIP := True;
Exit;
end;
z := StrToInt(Copy(ip, st[1] 1, st[2] - st[1] - 1));
if (z > 255) or ((z <> 0) and (ip[st[1] 1] = '0')) then
begin
IsWrongIP := True;
Exit;
end;
z := StrToInt(Copy(ip, st[2] 1, st[3] - st[2] - 1));
if (z > 255) or ((z <> 0) and (ip[st[2] 1] = '0')) then
begin
IsWrongIP := True;
Exit;
end;
z := StrToInt(Copy(ip, st[3] 1, Length(ip) - st[3]));
if (z > 255) or ((z <> 0) and (ip[st[3] 1] = '0')) then
begin
IsWrongIP := True;
Exit;
end;
end;

[/code]

謝謝KTOP與大家的分享,小弟隨喜之。
編輯記錄
ufjjc 重新編輯於 2009-08-03 17:53:32, 註解 無‧
系統時間:2024-11-21 18:37:35
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!