Changes between Version 24 and Version 25 of HashSourceCodes

Timestamp:

Feb 17, 2010, 6:34:41 AM (15 years ago)

Author:

os

Comment:

--

HashSourceCodes

@@ -825 +825 @@
 }}}
 
+== FoxPro ==
+{{{
+PARAMETERS cfile
+PRIVATE ALL 
+
+*******
+* enviroment setup
+*******
+cret=''
+glTalk=(SET("TALK")="ON")
+
+IF vartype(cfile)<>'C'
+        cfile='breakdance.avi'
+ENDIF
+
+
+
+IF glTalk
+        ? cfile
+        ? cfile=''
+        ? LEN(cfile)
+endif
+
+
+nfile=FOPEN(cfile)
+nsize=FSEEK(nfile,0,2)
+
+IF gltalk
+        ? cfile 
+        ? 'size?>'
+        ?? nsize
+endif
+FSEEK(nfile,0,0)
+
+******
+* length reencode to 64 uint
+*****
+chash=hashsize(nsize)
+cempty=chr(0)
+cret=''
+IF LEN(chash)<8
+        FOR i=1 TO 8-LEN(chash)
+                cret=cret+cempty
+        ENDFOR
+ENDIF
+cret=cret+chash
+nSum=0
+
+*******
+* first 64kb
+******
+
+
+        FOR i=1 TO 8192
+                cpom=FREAD(nfile,8)
+                cpom=reverse(cpom)
+                nSum=nSum+LEN(cpom)
+                IF gltalk
+                                do buildhex WITH cret
+                                ?? '+'
+                                DO buildhex WITH cpom
+                                ? '='
+                ENDIF
+                cret=adint64(cret,cpom)
+        ENDFOR
+
+*******
+* last 64kb
+*******
+
+        FSEEK(nfile,-65536,2)
+        FOR i=1 TO 8192
+                cpom=FREAD(nfile,8)
+                cpom=reverse(cpom)
+                cret=adint64(cret,cpom)
+                nSum=nSum+LEN(cpom)
+        ENDFOR
+FCLOSE(nfile)
+
+****
+* build hexa
+****
+IF gltalk
+
+        DO buildhex WITH cret
+        ?
+        ? 'Spocital som'
+        ?? nSum
+ENDIF
+RETURN buildhex(cret)
+
+FUNCTION reverse
+PARAMETERS cstring
+PRIVATE ALL 
+cret=''
+FOR i=1 TO LEN(cstring)
+        cret=cret+SUBSTR(cstring,LEN(cstring)-i+1,1)
+ENDFOR
+RETURN cret
+
+FUNCTION buildhex
+PARAMETERS cstring,lkam
+PRIVATE ALL 
+gcTalk=SET("TALK")
+cret=''
+FOR i=1 TO LEN(cstring)
+        cpom=dec2basx(ASC(SUBSTR(cstring,i,1)),16)
+        IF LEN(cpom)<2
+                cout='0'+cpom
+                cpom=cout
+        ENDIF
+        
+        cret=cret+cpom
+        IF gcTALK="ON"
+                ?? cpom
+                ?? ':'
+        ENDIF
+ENDFOR
+RETURN cret
+
+FUNCTION adint64
+PARAMETERS cstring1,cstring2
+PRIVATE ALL 
+DIMENSION car (8,1) as Character
+
+***
+* 8 bytes both
+***
+nincrement=0
+cret=''
+FOR i=8 TO 1 STEP -1
+        nfir=ASC(SUBSTR(cstring1,i,1))
+        nsec=ASC(SUBSTR(cstring2,i,1))
+        nout=nincrement+nfir+nsec
+        IF nout>255
+                nincrement=INT(nout/256)
+                nout=nout-(nincrement*256)
+        ELSE
+                nincrement=0
+        ENDIF
+        car(i)=CHR(nout)
+ENDFOR
+FOR i=1 TO 8
+        cret=cret+car(i)
+ENDFOR
+RETURN cret
+
+
+FUNCTION hashsize
+
+PARAMETERS ncislo
+PRIVATE ALL 
+cret=''
+creverse=''
+DO WHILE .t.
+        npom=INT(ncislo/256)
+        npom2=ncislo-npom*256
+        creverse=creverse+CHR(npom2)
+        ncislo=npom
+        IF ncislo=0
+                EXIT
+        ENDIF
+ENDDO
+FOR i=1 TO LEN(creverse)
+        cret=cret+SUBSTR(creverse,LEN(creverse)-i+1,1)
+ENDFOR 
+RETURN cret
+
+
+*..............................................................................
+*   Function: DEC2BASX
+*    Purpose:  Convert whole number 0-?, to base 2-16 
+*
+* Parameters: nTempNum - number to convert (0-9007199254740992)
+*             base    - base to convert to i.e., 2 4 8 16...
+*    returns: string
+*      Usage:  cresult=Dec2BasX(nParm1, nParm2)
+*              STORE Dec2BasX(255, 16) TO cMyString  &&... cMyString contains 'ff'
+*..............................................................................
+FUNCTION dec2basx
+PARAMETERS nTempNum, nNewBase
+
+STORE 0 TO nWorkVal,;
+   remainder,;
+   dividend,;
+   nextnum,;
+   digit
+
+nWorkVal = nTempNum  
+ret_str = ''
+
+DO WHILE .T.
+   digit = MOD(nWorkVal, nNewBase)
+   dividend = nWorkVal / nNewBase
+   nWorkVal = INT(dividend)
+
+   DO CASE
+      CASE digit = 10
+         ret_str = 'a' + ret_str
+      CASE digit = 11
+         ret_str = 'b' + ret_str
+      CASE digit = 12
+         ret_str = 'c' + ret_str
+      CASE digit = 13
+         ret_str = 'd' + ret_str
+      CASE digit = 14
+         ret_str = 'e' + ret_str
+      CASE digit = 15
+         ret_str = 'f' + ret_str
+      OTHERWISE
+         ret_str = LTRIM(STR(digit)) + ret_str
+   ENDCASE
+
+   IF nWorkVal = 0
+      EXIT
+   ENDIF ( nWorkVal = 0 )
+ENDDO ( .T. )
+RETURN ret_str
+}}}
+