Everhart, Glenn (FUSA)
From:	mathog@seqaxp.bio.caltech.edu
Sent:	Thursday, April 15, 1999 2:04 PM
To:	Info-VAX@Mvb.Saic.Com
Subject:	datasniffer.for, was floating point conversions
In article <01be86a6$068c1750$0100a8c0@jupiter>, "Paul Duke" <pduke@nmia.com> writes:
>I have RMS files with float and date fields on an NT server and need to
>load records into a SQL database. Does anyone know of any source code or
>tools that will help me convert these values to NT equivalents? Help
>greatly appreciated.

After my signature you will find DataSniffer.FOR.  It is a program I've
used to deduce the data structures in undocumented binary files.  Ok, it
isn't very sophisticated, but it did the trick for me.  Your best bet is to
make the smallest possible data file, containing entirely known data, and
then have a look at it.  Then you at least stand a chance of recognizing
the float type by the binary representation.   You could also use DUMP,
of course, but it won't swap bytes.

Here's a snippet of output from the program:

Examine region:
1,14,1,0
*******************************************************************************
|-Abs-Position--|-Rel-Position--|---byte-----|---word----------------|-----longword-------|char|
    int      hex     int      hex int uint hex         int        uint         int      hex
      1        1       0        0    3    3  3           3           3           3        3 **
      2        2       1        1    0    0  0           0           0           0        0 **
      3        3       2        2    0    0  0           0           0           0        0 **
      4        4       3        3    0    0  0           0           0           0        0 **
      5        5       4        4    0    0  0           0           0           0        0 **
      6        6       5        5    0    0  0           0           0  -603979776 DC000000 **
      7        7       6        6    0    0  0           0           0    47972352  2DC0000 **
      8        8       7        7    0    0  0       -9216       56320      187392    2DC00 **
      9        9       8        8  -36  220 DC         732         732         732      2DC **
     10        A       9        9    2    2  2           2           2   536870914 20000002 **
     11        B      10        A    0    0  0           0           0    18874368  1200000 **
     12        C      11        B    0    0  0        8192        8192       73728    12000 **
     13        D      12        C   32   32 20         288         288         288      120 SP
     14        E      13        D    1    1  1           1           1  1744830465 68000001 **

That is, dump data starting from positions 1 to 14, doing a dump starting at every byte position (1).
without swapping bytes (0).

Odds are that your floats are in IEEE format, so I hope that you're working on
an Alpha or you will be in for a lot of work, as there's no /float=IEEE option
on a VAX. 

Regards,

David Mathog
mathog@seqaxp.bio.caltech.edu
Manager, sequence analysis facility, biology division, Caltech 

**********************************************************************

c	DataSniffer.FOR
C	20-FEB-1997  David Mathog
C
C	This program dumps data from a binary file in arbitrary
C       formats.  It uses pointers in an awful way and is probably
C	extremely nonportable.
C	*****************************************************
c
	implicit none
	integer*4 MAXFILE
	parameter (MAXFILE=2**20)
	byte array(MAXFILE)               !A 1Mb array to hold the file
	character*120 infile,search
	integer*4 irec,brec,istat,incount,inlen,numstrings,ipoint
	integer*4 begin,length,step,swap,slen
	integer*4 inlenarray(10)
	integer*4 lastbyte
	byte sbyte(80,10)
	logical ok
c
c
c
	write(6,*)'DataSniffer'
	write(6,*)' This program examines the data in a binary file'
c
	write(6,*)' '
	write(6,*)'Input the name of the file to process'
	read(5,'(q,a)')inlen,infile(1:inlen)
c
	open(unit=10
	1 ,file=infile(1:inlen)
	1 ,form='UNFORMATTED',status='OLD'
	1 ,ORGANIZATION='SEQUENTIAL'
	1 ,RECORDTYPE='FIXED'
	1 ,READONLY,iostat=istat)
	if(istat.ne.0)stop 'Fatal error, something wrong with that file'
c
	inquire(10,RECL=irec)			!longwords, because unformmated
	if(irec.lt.0)then			!error...
	   stop 'SearchFixed fatal error, illegal record size'
	else
	   brec=irec*4				!bytes/record
	   write(6,*)' '
	   write(6,*)'Each record is ',brec,' bytes long'
	end if
c
	   write(6,*)' '
	write(6,*)'Now reading in the input file'
	ipoint=1
	incount=0
	istat = 0
	do while(istat .ge. 0 .and. ipoint .le. MAXFILE - brec + 1)
	   call getrec(array(ipoint),irec,istat)
	   if(istat.eq.0)then
	      ipoint=ipoint+brec
	      incount = incount + 1
	   end if
	end do
	lastbyte = incount*brec
	write(6,*)' '
	write(6,*)'Read in ',incount,' records'
	write(6,*)'Read in ',lastbyte,' bytes'
	write(6,*)' '
	close(10)
C
C
C
	length = 1
	write(6,*)'You will now be prompted for regions to examine as'
	write(6,*)'  Begin, Length, step, swap'
	write(6,*)'      Begin: position to begin (in bytes, 1 = first byte)'
	write(6,*)'      Length: to examine (in bytes), 0 exits'
	write(6,*)'      Step: between outputs, (in bytes), (>0)'
	write(6,*)'      Swap: (0 = as is, anything else= reverse byte order)'
	write(6,*)'      Values in decimal (16)or hex (10x)'
	do while(length .ne. 0)
	  write(6,*)' '
	  write(6,*)'Examine region:'
	  read(5,'(q,a)')slen,search(1:slen)
	  call sparse(search(1:slen),begin,length,step,swap,istat)
	  if(istat .eq. 0)then
	    if(begin .lt. 1.)then
	      begin = 1
	      write(6,*)'Cannot search before first byte, starting at 1'
	    end if
	    if(begin + length - 1 .gt. lastbyte)then
	      length = lastbyte - begin + 1
	      write(6,*)'Truncating search at end of file'
	    endif
	    if(length .gt. 0)call tellem(array,begin,length,step,swap)
	  else
	    istat = 0
	  endif
	end do

	stop 'SearchFixed: normal completion' 
	end

	subroutine getrec(scratch,size,stat)
	implicit none
	integer*4 size,stat,scratch(size)
	read(10,iostat=stat)scratch
	return
	end

	subroutine tellem(array,begin,length,step,swap)
	implicit none
	integer*4 begin,length,step,swap,i,j,k
	byte array(*)
	byte ba(4),btemp
	integer*2 wa(2),wtemp
	integer*4 la, longword
	integer*4   sbyte,sword
	integer*4   ubyte,uword
	character*2 outc
	equivalence (ba,wa,la)
c
	write(6,2000)'*******************************************************************************'
	write(6,2000)'|-Abs-Position--|-Rel-Position--|---byte-----|---word----------------|-----longword-------|char|'
	write(6,2000)'    int      hex     int      hex int uint hex         int        uint         int      hex'
	do i =begin,begin+length-1,step
c
c	load the 4 bytes into the equivalenced byte array
c
	  k = i
	  do j=1,4
	    ba(j)=array(k)
	    k = k + 1
	  end do
c
c	pull off the byte and unsigned byte
c
	sbyte=ba(1)
	ubyte=jiand('ff'x,la)
c
c	pull off the word and unsigned word
c
	sword=wa(1)
	uword=jiand('ffff'x,la)
c
c	pull off the longword
c
	longword=la
c
c	swap as needed
c
	if(swap .eq. 1)then
c
	   la = uword
	   btemp=ba(1)
	   ba(1)=ba(2)
	   ba(2)=btemp
	   uword=la
c
	   la = sword
	   btemp=ba(1)
	   ba(1)=ba(2)
	   ba(2)=btemp
	   sword=wa(1)
c
	   la = longword
	   do j = 0,1
	     btemp=ba(4-j)
	     ba(4-j)=ba(j+1)
	     ba(j+1)=btemp
	   end do
	   longword=la
	end if
c
c
	if(ubyte .ge. '40'o .and. ubyte .le. '177'o)then
	  outc=char(ubyte)
	  if(ubyte .eq.'40'o)outc='SP'
	else
	  outc='**'
	endif
	write(6,1000)i,i,i-begin,i-begin,sbyte,ubyte,ubyte,sword,uword,
	1      longword,longword,outc
	end do

1000	format(2(' ',i7,' ',z8),2(' ',i4),' ',z2,3(' ',i11),' ',z8,' ',a)
2000	format(' ',a)
	return
	end

	subroutine pretellem(bytestring,numbytes,offset,size,recnum)
c
c	this subroutine ensures that the output contains only
c	printable ascii characters, and that if it is within 10 of the
c	end, that the ends are padded correctly.
c
c	state = 0 is before
c	state = 1 is 1 before
c	state = 2 is in
c	state = 3 is 1 past
c	state = 4 is more than one past
c
	implicit none
	external printable
	integer*4 count,dest,source,state
	integer*4 numbytes,offset,size,recnum
	byte bytestring(numbytes)
	byte passbytes(256)
	byte printable
c
c	paste in the part that matched
c
	source=offset-10		!pointer inside text buffer
	dest=1				!pointer to xfer array
	if(source.lt.0)then		!the paste can begen left of, on, or right
	   state=0			!the first byte of the buffer
        else if(source.eq.0)then
           state=1
        else
	   state=2
	end if
	do count=1,size+20
	   if(state.eq.0)then			!>1 left of text buffer
	      passbytes(dest)=ichar('*')
	      if(source.eq.-1)state=state+1	! if 2 left, change state
	   else if(state.eq.1)then		! 1 left of text buffer
	      passbytes(dest)=ichar(']')
	      state=state+1			!only here 1 cycle
	   else if(state.eq.2)then		!inside text buffer
	      passbytes(dest)=printable(bytestring(source))
	      if(source.eq.numbytes)state=state+1
						! last byte, increment state
           else if(state.eq.3)then		! 1 right of text buffer
	      passbytes(dest)=ichar('[')
	      state=state+1			!only here one cycle
           else					!>1 right of text buffer
	      passbytes(dest)=ichar('*')		!no tests needed
	   end if
	   source=source+1
           dest=dest+1
	end do	
	call tellem(passbytes,size+20,offset,recnum)
	return
	end

	byte function printable(bchar)
	implicit none
	byte bchar
	if(bchar.lt.32)then
	   printable='52'o		!this is a *
	else if(bchar.gt.'176'o)then
	   printable='52'o
	else
	   printable=bchar
	end if
	return
	end

	subroutine deadtellem(bytestring,numbytes,offset,size,recnum)
c
c	this subroutine ensures that the output contains only
c	printable ascii characters, and that if it is within 10 of the
c	end, that the ends are padded correctly.
c
c	state = 0 is before
c	state = 1 is 1 before
c	state = 2 is in
c	state = 3 is 1 past
c	state = 4 is more than one past
c
	implicit none
	external printable
	integer*4 i,j,k,state
	integer*4 numbytes,offset,size,recnum
	byte bytestring(numbytes)
	byte passbytes(256)
	byte printable
c
c
c	paste in the part that matched
c
	k=offset
	j=11
	do i=1,size
	   passbytes(j)=printable(bytestring(k))
	   k=k+1
           j=j+1
	end do	
c
c	paste in the part before the part that matched
c
	k=offset-1
	j=10
	do i=1,10
	   if(k.gt.0)then		!still inside the record
	      passbytes(j)=printable(bytestring(k))
	   else if(k.eq.0)then		!oops, just left the record
	      passbytes(j)='|'
	   else				!well outside of the record
	      passbytes(j)='*'
	   end if
	   k=k-1
	   j=j-1
	end do
c
c	paste in the part after the part that matched
c
	k=offset+size	!the first byte past the search
	j=10+size	!string and where it gets put
	do i=1,10
	   if(k.lt.numbytes)then		!still inside the record
	      passbytes(j)=printable(bytestring(k))
	   else if(k.eq.numbytes)then		!oops, just left the record
	      passbytes(j)='|'
	   else					!well outside of the record
	      passbytes(j)='*'
	   end if
	   k=k+1
	   j=j+1
	end do
	call tellem(passbytes,size+20,offset,recnum)
	return
	end

	subroutine converttobyte(sbyte,search,inlen)
	implicit none
	integer*4 inlen,i
	byte sbyte(inlen)
	character search*(*)
	do i=1,inlen
	   sbyte(i)=ichar(search(i:i))
	end do
	return
	end

c
c	convert a string to begin, length, step
c
c	string fields are either 1232 or 1A3x
c
	subroutine sparse(string,begin,length,step,swap,istat)
	implicit none
	integer*4 begin,length,step,swap,slen,istat
	integer*4 front,back,isix,jstat
	character*(*) string
c
	istat = -1
	slen=len(string)
	if(slen .lt. 1)return
	front=1
	back=front + index(string(front:slen),',') - 1
        isix=front + max(index(string(front:back),'x'),index(string(front:back),'X')) - 1
	if(back .eq. 0)return
	if(isix .ge. front)then
	   if(isix-1 .lt. front)return
	   read(string(front:isix-1),1000,iostat=jstat)begin
	else
	   if(back-1 .lt. front)return
	   read(string(front:back-1),*,iostat=jstat)begin
	end if
	if(jstat .ne. 0)return
c
	front = back + 1
	back=front + index(string(front:slen),',') - 1
        isix=front + max(index(string(front:back),'x'),index(string(front:back),'X')) - 1
	if(back .eq. 0)return
	if(isix .ge. front)then
	   if(isix-1 .lt. front)return
	   read(string(front:isix-1),1000,iostat=jstat)length
	else
	   if(back-1 .lt. front)return
	   read(string(front:back-1),*,iostat=jstat)length
	end if
	if(jstat .ne. 0)return
c
	front = back + 1
	back=front + index(string(front:slen),',') - 1
        isix=front + max(index(string(front:back),'x'),index(string(front:back),'X')) - 1
	if(back .eq. 0)return
	if(isix .ge. front)then
	   if(isix-1 .lt. front)return
	   read(string(front:isix-1),1000,iostat=jstat)step
	else
	   if(back-1 .lt. front)return
	   read(string(front:back-1),*,iostat=jstat)step
	end if
	if(jstat .ne. 0)return
c
	front = back + 1
	back=slen
        isix=front + max(index(string(front:back),'x'),index(string(front:back),'X')) - 1
	if(isix .ge. front)then
	   if(isix-1 .lt. front)return
	   read(string(front:isix-1),1000,iostat=jstat)swap
	else
	   if(back .lt. front)return
	   read(string(front:back),*,iostat=jstat)swap
	end if
	if(jstat .ne. 0)return
1000	format(z8)
c
	istat = 0
	if(swap .ne. 0)swap = 1
	return
	end