Date:         Wed, 12 Apr 2006 10:36:10 -0700
Reply-To:     chris@OVIEW.CO.UK
Sender:       "SAS(r) Discussion" <SAS-L@LISTSERV.UGA.EDU>
From:         chris@OVIEW.CO.UK
Organization: http://groups.google.com
Subject:      Re: Anyone have SAS based FCS-16 checksum routine?
Comments: To: sas-l@uga.edu
Content-Type: text/plain; charset="iso-8859-1"

Here's a SAS implementation based on the details in RFC1331.  It runs
fine, but I haven't found an easy way to verify that it's producing the
correct results, so treat it with caution.

This code is designed to calculate the checksum for a single character
string.  Each character is converted to its ASCII code via RANK() to
form the stream of input data bytes.  This may or may not suit your
purpose...

Chris.
--------------------------------------------------------
Elvis SAS Log Analyser - http://www.oview.co.uk/elvis
Version 1.1 released 2006-04-09!
--------------------------------------------------------

---------Code begins----------------

%macro fcs16(fcsinit=0ffffx, str=, fcsresultvar=fcsres);

* An Implementation of the FCS-16 checksum algorithm.;
* See ftp://ftp.rfc-editor.org/in-notes/rfc1331.txt for more info.;

* All operations assume 16-bit unsigned integers.  The SAS functions;
* BAND, BXOR and BRSHIFT operate on 32-bit integers, but no extra;
* processing is needed to allow for that;

* Algorithm: For each character in the string, derive a new checksum
value -- ;
*   calculate index as the right-most eight bits of [oldvalue XOR
character];
*   shift the old value eight bits right;
*   XOR the shifted value with lookup[index];

%global &fcsresultvar;

data _null_;
  array lookup{256} _temporary_
    (
      00000x, 01189x, 02312x, 0329bx, 04624x, 057adx, 06536x, 074bfx,
      08c48x, 09dc1x, 0af5ax, 0bed3x, 0ca6cx, 0dbe5x, 0e97ex, 0f8f7x,
      01081x, 00108x, 03393x, 0221ax, 056a5x, 0472cx, 075b7x, 0643ex,
      09cc9x, 08d40x, 0bfdbx, 0ae52x, 0daedx, 0cb64x, 0f9ffx, 0e876x,
      02102x, 0308bx, 00210x, 01399x, 06726x, 076afx, 04434x, 055bdx,
      0ad4ax, 0bcc3x, 08e58x, 09fd1x, 0eb6ex, 0fae7x, 0c87cx, 0d9f5x,
      03183x, 0200ax, 01291x, 00318x, 077a7x, 0662ex, 054b5x, 0453cx,
      0bdcbx, 0ac42x, 09ed9x, 08f50x, 0fbefx, 0ea66x, 0d8fdx, 0c974x,
      04204x, 0538dx, 06116x, 0709fx, 00420x, 015a9x, 02732x, 036bbx,
      0ce4cx, 0dfc5x, 0ed5ex, 0fcd7x, 08868x, 099e1x, 0ab7ax, 0baf3x,
      05285x, 0430cx, 07197x, 0601ex, 014a1x, 00528x, 037b3x, 0263ax,
      0decdx, 0cf44x, 0fddfx, 0ec56x, 098e9x, 08960x, 0bbfbx, 0aa72x,
      06306x, 0728fx, 04014x, 0519dx, 02522x, 034abx, 00630x, 017b9x,
      0ef4ex, 0fec7x, 0cc5cx, 0ddd5x, 0a96ax, 0b8e3x, 08a78x, 09bf1x,
      07387x, 0620ex, 05095x, 0411cx, 035a3x, 0242ax, 016b1x, 00738x,
      0ffcfx, 0ee46x, 0dcddx, 0cd54x, 0b9ebx, 0a862x, 09af9x, 08b70x,
      08408x, 09581x, 0a71ax, 0b693x, 0c22cx, 0d3a5x, 0e13ex, 0f0b7x,
      00840x, 019c9x, 02b52x, 03adbx, 04e64x, 05fedx, 06d76x, 07cffx,
      09489x, 08500x, 0b79bx, 0a612x, 0d2adx, 0c324x, 0f1bfx, 0e036x,
      018c1x, 00948x, 03bd3x, 02a5ax, 05ee5x, 04f6cx, 07df7x, 06c7ex,
      0a50ax, 0b483x, 08618x, 09791x, 0e32ex, 0f2a7x, 0c03cx, 0d1b5x,
      02942x, 038cbx, 00a50x, 01bd9x, 06f66x, 07eefx, 04c74x, 05dfdx,
      0b58bx, 0a402x, 09699x, 08710x, 0f3afx, 0e226x, 0d0bdx, 0c134x,
      039c3x, 0284ax, 01ad1x, 00b58x, 07fe7x, 06e6ex, 05cf5x, 04d7cx,
      0c60cx, 0d785x, 0e51ex, 0f497x, 08028x, 091a1x, 0a33ax, 0b2b3x,
      04a44x, 05bcdx, 06956x, 078dfx, 00c60x, 01de9x, 02f72x, 03efbx,
      0d68dx, 0c704x, 0f59fx, 0e416x, 090a9x, 08120x, 0b3bbx, 0a232x,
      05ac5x, 04b4cx, 079d7x, 0685ex, 01ce1x, 00d68x, 03ff3x, 02e7ax,
      0e70ex, 0f687x, 0c41cx, 0d595x, 0a12ax, 0b0a3x, 08238x, 093b1x,
      06b46x, 07acfx, 04854x, 059ddx, 02d62x, 03cebx, 00e70x, 01ff9x,
      0f78fx, 0e606x, 0d49dx, 0c514x, 0b1abx, 0a022x, 092b9x, 08330x,
      07bc7x, 06a4ex, 058d5x, 0495cx, 03de3x, 02c6ax, 01ef1x, 00f78x
    )
  ;

  fcs = &fcsinit;
  str = "&str";

  do i = 1 to length(str);

    index = band(bxor(fcs, rank(substr(str, i, 1))), 0ffx);
    fcs = bxor(brshift(fcs, 8), lookup[index]);

  end;

  call symput("&fcsresultvar", put(fcs, hex4.));

run;

%mend;

* Normal usage;
%fcs16(str=This is a test string);
%put fcsres = &fcsres;

* Extra parameters available if desired;
%fcs16(fcsinit=0FFFFx, str=This is a test string,
fcsresultvar=output_varname);
%put output_varname = &output_varname;

---------Code ends----------------