hsiung.博格 ERP軟體

*******************************************
演算法製作:行者孫(QQ:310727570)
*******************************************
VFP應用程式演算法群:12787940
*******************************************


**----------------------------------------------------------------------------------
**--函數名:ZIPFILE(OLEDFILE,NEWFILE,TYPE)
**--參 數:OLEDFILE被處理的文件,NEWFILE處理後的文件,TYPE類型:1為壓縮,2為還原
**--功 能:通用檔壓縮
**----------------------------------------------------------------------------------
FUNCTION ZIPFILE(OLDFILE AS STRING,NEWFILE AS STRING,TYPE AS INTEGER)
PRIVATE OLDFILE,NEWFILE,TYPE
IF TYPE=1
IF !FILE(OLDFILE)
MESSAGEBOX('文件不存在！'+CHR(13)+CHR(10)+OLDFILE,48,'資訊提示')
RETURN .F.
ELSE
IF FILE(NEWFILE)
MESS=MESSAGEBOX('該目錄下存在一個同名檔，是否覆蓋？'+CHR(13)+CHR(10)+NEWFILE,33,'資訊提示')
IF MESS=1
DELETE FILE NEWFILE
COMPRESSFILE(OLDFILE,NEWFILE)
ELSE
RETURN .F.
ENDIF
ELSE
COMPRESSFILE(OLDFILE,NEWFILE)
ENDIF
ENDI
ENDIF
IF TYPE=2
IF STRCONV(SUBSTR(FILETOSTR(OLDFILE),1,8),15)=='D0D0D5DFD1B9CBF5'
IF !FILE(OLDFILE)
MESSAGEBOX('文件不存在！'+CHR(13)+CHR(10)+OLDFILE,48,'資訊提示')
RETURN .F.
ELSE
IF FILE(NEWFILE)
MESS=MESSAGEBOX('該目錄下存在一個同名檔，是否覆蓋？'+CHR(13)+CHR(10)+NEWFILE,33,'資訊提示')
IF MESS=1
DELETE FILE NEWFILE
DECOMPRESSFILE(OLDFILE,NEWFILE)
ELSE
RETURN .F.
ENDIF
ELSE
DECOMPRESSFILE(OLDFILE,NEWFILE)
ENDIF
ENDI
ELSE
MESSAGEBOX('不可識別的壓縮備份檔案'+CHR(13)+CHR(10)+OLDFILE,'錯誤資訊')
RETURN .F.
ENDI
ENDI
ENDFUNC
FUNCTION SETVALUE()
PUBLIC POS_TACK
POS_TACK=1
PUBLIC OUT_TACK
OUT_TACK=0
PUBLIC OUT_BUFF
OUT_BUFF=0
PUBLIC INPUT_TACK
INPUT_TACK=0
PUBLIC INPUT_BUFF
INPUT_BUFF=0
PUBLIC BITS
BITS=12
PUBLIC HASHING_SHIFT
HASHING_SHIFT=4
PUBLIC MAX_VALUE
MAX_VALUE=4095&& BITLSHIFT(1,BITS) - 1
PUBLIC MAX_CODE
MAX_CODE=4094&& MAX_VALUE - 1
PUBLIC TABLE_SIZE
TABLE_SIZE=5021
PUBLIC ARRCODEVALUE[TABLE_SIZE]
PUBLIC ARRPREFCODE[TABLE_SIZE]
PUBLIC ARRHASHCODE[TABLE_SIZE]
PUBLIC ARRDECODESTACK[4000]
ENDFUNC
FUNCTION DECOMPRESSFILE(LSFILENAMEORI,LSFILENAMEDES)
LOCAL LHFILEIN
LOCAL LHFILEOUT
LOCAL LNCHARACTER, LSSTRING
LOCAL LNOLDCHAR, LNNEWCHAR
LOCAL LNNEXTCODE
SETVALUE()
LHFILEIN = FOPEN( LSFILENAMEORI )
FSEEK(LHFILEIN,8)&&文件頭
IF( LHFILEIN < 0 )
RETURN .F.
ENDIF
LHFILEOUT = FCREATE( LSFILENAMEDES )
IF( LHFILEOUT < 0 )
FCLOSE( LHFILEIN )
RETURN .F.
ENDIF
LNNEXTCODE = 256
LNNEWCHAR = 0
LNOLDCHAR = READCODE( LHFILEIN )
LNCHARACTER = LNOLDCHAR
FWRITE( LHFILEOUT, SHORT2TOSTRING( LNOLDCHAR ) )
DO WHILE( .T. )
LNNEWCHAR = READCODE( LHFILEIN )
IF( LNNEWCHAR == MAX_VALUE )
EXIT
ENDIF
IF( LNNEWCHAR >= LNNEXTCODE )
ARRDECODESTACK[POS_TACK] = LNCHARACTER
POS_TACK = POS_TACK + 1
LNSTRING = DECODESTRING( LNOLDCHAR )
ELSE
LNSTRING = DECODESTRING( LNNEWCHAR )
ENDIF
LNCHARACTER = LNSTRING
DO WHILE( LNSTRING >= ARRDECODESTACK[ POS_TACK ] )
FWRITE( LHFILEOUT, SHORT2TOSTRING( LNSTRING ) )
POS_TACK = POS_TACK - 1
IF( POS_TACK < 1 )
POS_TACK = 1
EXIT
ELSE
LNSTRING = ARRDECODESTACK[ POS_TACK ]
ENDIF
ENDDO
IF( LNNEXTCODE <= MAX_CODE )
ARRPREFCODE[ LNNEXTCODE + 1 ] = LNOLDCHAR
ARRHASHCODE[ LNNEXTCODE + 1 ] = LNCHARACTER
LNNEXTCODE = LNNEXTCODE + 1
ENDIF
LNOLDCHAR = LNNEWCHAR
ENDDO
FCLOSE( LHFILEIN )
FCLOSE( LHFILEOUT )
ENDFUNC
FUNCTION DECODESTRING( LNINDEX )
LOCAL LNI, BRETURN
LNI = 0
BRETURN = .T.
DO WHILE( LNINDEX > 255 )
ARRDECODESTACK[POS_TACK] = ARRHASHCODE[ LNINDEX + 1 ]
POS_TACK = POS_TACK + 1
LNINDEX =ARRPREFCODE[ LNINDEX + 1 ]
IF( LNI >= 4094 )
BRETURN = .F.
EXIT
ENDIF
LNI = LNI + 1
ENDDO
IF( BRETURN == .F. )
RETURN( "" )
ENDIF
ARRDECODESTACK[ POS_TACK ] = LNINDEX
RETURN( ARRDECODESTACK[POS_TACK ] )
ENDFUNC
FUNCTION READCODE( LHFILEIN )
LOCAL LNRETURN
DO WHILE( INPUT_TACK <= 24 )
INPUT_BUFF=BITOR( INPUT_BUFF, BITLSHIFT( ASC(FREAD( LHFILEIN, 1 )), (24-INPUT_TACK) ) )
INPUT_TACK=INPUT_TACK + 8
ENDDO
LNRETURN=BITRSHIFT( INPUT_BUFF, (32-BITS) )
INPUT_BUFF=BITLSHIFT( INPUT_BUFF,BITS )
INPUT_TACK=INPUT_TACK-BITS
RETURN( LNRETURN )
ENDFUNC
FUNCTION COMPRESSFILE( LSFILENAMEORI, LSFILENAMEDES )
LOCAL LHFILEIN
LOCAL LHFILEOUT
LOCAL LNCHARACTER, LNCHARPREF
LOCAL LNINDEX, LNNEXTCODE
SETVALUE()
LHFILEIN = FOPEN( LSFILENAMEORI )
IF( LHFILEIN < 0 )
RETURN .F.
ENDIF
LHFILEOUT = FCREATE( LSFILENAMEDES )
FWRITE(LHFILEOUT,STRCONV('D0D0D5DFD1B9CBF5',16))&&文件頭
IF( LHFILEOUT < 0 )
FCLOSE( LHFILEIN )
RETURN .F.
ENDIF
LNNEXTCODE = 256
FOR I = 1 TO TABLE_SIZE
ARRCODEVALUE[ I ] = -1
NEXT
LNCHARPREF = ASC( FREAD( LHFILEIN, 1 ) )
DO WHILE( !FEOF( LHFILEIN ) )
LNCHARACTER = ASC( FREAD( LHFILEIN, 1 ) )
LNINDEX = FINDINDEX( LNCHARPREF, LNCHARACTER )
IF ( ARRCODEVALUE[ LNINDEX + 1 ] != -1 )
LNCHARPREF = ARRCODEVALUE[ LNINDEX + 1 ]
ELSE
IF( LNNEXTCODE <= MAX_CODE )
ARRCODEVALUE[ LNINDEX + 1 ] = LNNEXTCODE
LNNEXTCODE = LNNEXTCODE + 1
ARRPREFCODE[ LNINDEX + 1 ] = LNCHARPREF
ARRHASHCODE[ LNINDEX + 1 ] = LNCHARACTER
ENDIF
WRITE( LHFILEOUT, LNCHARPREF )
LNCHARPREF = LNCHARACTER
ENDIF
ENDDO
WRITE( LHFILEOUT, LNCHARPREF )
WRITE( LHFILEOUT, MAX_VALUE )
WRITE( LHFILEOUT, 0 )
FCLOSE( LHFILEIN )
FCLOSE( LHFILEOUT )
ENDFUNC
FUNCTION FINDINDEX( LSPREFCHAR, LSHASHCHAR )
LOCAL LNINDEX
LOCAL LNOFFSET
LNINDEX = BITXOR( BITLSHIFT( LSHASHCHAR, HASHING_SHIFT ), LSPREFCHAR )
LNOFFSET = IIF( LNINDEX != 0, TABLE_SIZE - LNINDEX, 1 )
DO WHILE( .T. )
IF( ARRCODEVALUE[ LNINDEX + 1 ] == -1 )
EXIT
ENDIF
IF ( ARRPREFCODE[ LNINDEX + 1 ] == LSPREFCHAR AND ;
ARRHASHCODE[ LNINDEX + 1 ] == LSHASHCHAR )
EXIT
ENDIF
LNINDEX = LNINDEX - LNOFFSET
IF( LNINDEX < 0 )
LNINDEX = LNINDEX + TABLE_SIZE
ENDIF
ENDDO
RETURN( LNINDEX )
ENDFUNC
FUNCTION WRITE( LHFILEOUT, LSCODE )
OUT_BUFF = BITOR( OUT_BUFF, BITLSHIFT( LSCODE, (32-BITS-OUT_TACK) ) )
OUT_TACK = OUT_TACK + BITS
DO WHILE( OUT_TACK >= 8 )
FWRITE( LHFILEOUT, SHORT2TOSTRING( BITRSHIFT( OUT_BUFF, 24 ) ) )
OUT_BUFF = BITLSHIFT( OUT_BUFF, 8 )
OUT_TACK =OUT_TACK - 8
ENDDO
ENDFUNC
FUNCTION STRINGWRITE( LSCODE )
LOCAL LSRETURN
LSRETURN=""
OUT_BUFF = BITOR( OUT_BUFF, BITLSHIFT( LSCODE, (32-BITS-OUT_TACK) ) )
OUT_TACK = OUT_TACK + BITS
DO WHILE( OUT_TACK >= 8 )
LSRETURN = LSRETURN + SHORT2TOSTRING( BITRSHIFT( OUT_BUFF, 24 ) )
OUT_BUFF = BITLSHIFT( OUT_BUFF, 8 )
OUT_TACK = OUT_TACK - 8
ENDDO
RETURN LSRETURN
ENDFUNC
FUNCTION SHORT2TOSTRING( M.VALOR )
LOCAL LSNEWVAL
LSNEWVAL = CHR( BITAND( M.VALOR, 0XFF ) ) + CHR( BITRSHIFT( M.VALOR, 8 ) )
IF( ASC( SUBSTR( LSNEWVAL, 2, 1 ) ) == 0 )
LSNEWVAL = SUBSTR( LSNEWVAL, 1, 1 )
ENDIF
RETURN LSNEWVAL
ENDFUNC