library VBSNDEX;

uses Strings;


{This is how to declare the LP2STR function in TPW}
function LP2STR (pb:PChar;cbLen:Integer):Pointer;Far;
	External 'VBPOINT' index 2;


function Soundex (Source:Pchar): Pointer;export;

const
	Work: array [0..4] of char = '0000';
   SS: array [0..17] of char = 'BFPVCGJKQSXZDTLMNR';
   RS: array [0..17] of char = '111122222222334556';

var
	Result: pchar;
   SPos, DPos, RPos: integer;
   PCode: Char;
begin
	Result := StrNew (Work);
   Result[0] := UpCase (Source[0]);
   DPos := 1;
   SPos := 1;
   PCode := #0;
   while (DPos < 4) AND (Source [SPos] <> #0) do
   	begin
      	RPos := StrScan (SS, UpCase (Source[SPos])) - SS;
         if RPos > 0 then
         	begin
            	if RS [RPos] <> PCode then
                 	begin
                    	Result[DPos] := RS [RPos];
                    	PCode := RS [RPos];
                    	Inc (DPos);
                  end;
            end
         else
            PCode := #0;
         	Inc (SPos);
      end;

   {This is the operative bit.  Result now contains a
    long pointer to a string (LPSTR).  We pass this
    address and a byte count to LP2STR which creates a
    Visual Basic language string (HLSTR) and returns the
    handle to use here.  We assign that handle as our
    function result and then destroy our copy of the
    string.  Easy, right?}

   Soundex := LP2STR (Result, 4);
   StrDispose (Result);
end;


exports
	SOUNDEX resident;

begin
end.