00001 /*----------------------------------------------------------------------------*/
00002 /*                                                                            */
00003 /*   Copyright (c) 2004-2009 William  Data  Systems Ltd. and Geoff Stevens.   */
00004 /*   All rights reserved.                                                     */
00005 /*                                                                            */
00006 /*   This program and the  accompanying  materials are made available under   */
00007 /*   the terms of the  Common  Public  License  v1.0 which accompanies this   */
00008 /*   distribution. A  copy  is  also  available  at  the following address:   */
00009 /*   http://www.opensource.org/licenses/cpl1.0.php                            */
00010 /*                                                                            */
00011 /*   Redistribution and use in  source  and  binary  forms, with or without   */
00012 /*   modification, are  permitted  provided  that  the following conditions   */
00013 /*   are met:                                                                 */
00014 /*                                                                            */
00015 /*   Redistributions  of  source  code  must  retain  the  above  copyright   */
00016 /*   notice, this list of conditions and the following disclaimer.            */
00017 /*                                                                            */
00018 /*   Redistributions in  binary  form  must  reproduce  the above copyright   */
00019 /*   notice, this list of  conditions  and  the following disclaimer in the   */
00020 /*   documentation and/or other materials provided with the distribution.     */
00021 /*                                                                            */
00022 /*   Neither the name or trademarks  of  William Data Systems nor the names   */
00023 /*   of its  contributors  may  be  used  to  endorse  or  promote products   */
00024 /*   derived from this software without specific prior written permission.    */
00025 /*                                                                            */
00026 /*   DISCLAIMER                                                               */
00027 /*                                                                            */
00028 /*   THIS SOFTWARE IS PROVIDED  BY  THE  COPYRIGHT HOLDERS AND CONTRIBUTORS   */
00029 /*   "AS IS" AND  ANY  EXPRESS  OR  IMPLIED  WARRANTIES, INCLUDING, BUT NOT   */
00030 /*   LIMITED TO, THE IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR   */
00031 /*   A PARTICULAR PURPOSE ARE DISCLAIMED.  IN  NO EVENT SHALL THE COPYRIGHT   */
00032 /*   OWNER OR CONTRIBUTORS BE LIABLE  FOR ANY DIRECT, INDIRECT, INCIDENTAL,   */
00033 /*   SPECIAL,  EXEMPLARY,  OR  CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT NOT   */
00034 /*   LIMITED TO, PROCUREMENT OF SUBSTITUTE  GOODS OR SERVICES; LOSS OF USE,   */
00035 /*   DATA, OR PROFITS; OR BUSINESS  INTERRUPTION) HOWEVER CAUSED AND ON ANY   */
00036 /*   THEORY OF LIABILITY, WHETHER  IN  CONTRACT,  STRICT LIABILITY, OR TORT   */
00037 /*   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN  ANY WAY OUT OF THE USE   */
00038 /*   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.     */
00039 /*                                                                            */
00040 /*----------------------------------------------------------------------------*/
00041 ::CLASS hashfunction PUBLIC
00042 /* */
00043  
00044 /* */
00045 ::METHOD mod16 CLASS
00046   use strict arg what
00047   times = length(what)
00048   hash = 0
00049   do times
00050     parse var what 1 c 2 what
00051     hash = (37 * hash) + x2d(c2x(c))
00052     hash = hash // 65536
00053   end
00054   hash = right(d2x(hash),4,'0')
00055   return hash
00056 /* */
00057  
00058 /* */
00059 ::METHOD mod64 CLASS
00060   use strict arg what, iv
00061   times = length(what)
00062  
00063   if iv~length <> 8
00064     then raise SYNTAX 93 ARRAY('IV length must be 8, is' iv~length)
00065  
00066   hash = right(iv,8,'00'x)
00067  
00068   do j = 1 to times
00069     parse var what 1 c 2 what
00070     bs = x2b(c2x(hash))
00071     c = '00000000000000'x||c
00072  
00073     if j // 2 = 0
00074       then do
00075              /* << 7  */
00076              t1 = left(right(bs, 57),64,'0')
00077              /* >> 3  */
00078              t2 = right(left(bs, 61),64,'0')
00079  
00080            end
00081       else do
00082              /* << 11  */
00083              t1 = left(right(bs, 53),64,'0')
00084              /* >>  5  */
00085              t2 = right(left(bs, 59),64,'0')
00086            end
00087  
00088     t1 = x2c(b2x(t1))
00089     t2 = x2c(b2x(t2))
00090     hash = bitxor(bitxor(t1, bitxor(t2, c)))
00091   end
00092  
00093   hash = right(c2x(hash),16,'0')
00094   return hash
00095 /* */
00096  
00097 /* */
00098 ::METHOD mod32 CLASS
00099   use strict arg what, iv
00100  
00101   if iv~length <> 4
00102     then raise SYNTAX 93 ARRAY('IV length must be 4, is' iv~length)
00103  
00104   times = length(what)
00105   hash = iv
00106   do j = 1 to times
00107     parse var what 1 c 2 what
00108     bs = x2b(c2x(hash))
00109     c = '000000'x||c
00110  
00111     if j // 2 = 0
00112       then do
00113              /* << 7  */
00114              t1 = left(right(bs, 25),32,'0')
00115              /* >> 3  */
00116              t2 = right(left(bs, 29),32,'0')
00117  
00118            end
00119       else do
00120              /* << 11  */
00121              t1 = left(right(bs, 21),32,'0')
00122              /* >>  5  */
00123              t2 = right(left(bs, 27),32,'0')
00124            end
00125  
00126     t1 = x2c(b2x(t1))
00127     t2 = x2c(b2x(t2))
00128     hash = bitxor(bitxor(t1, bitxor(t2, c)))
00129   end
00130  
00131   hash = right(c2x(hash),8,'0')
00132   return hash