String byte packer/unpacker (crucher ?!)

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|482\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
SoCoder -> Snippet Home -> Variables

Dan	Created : 29 February 2020 Edited : 29 February 2020 System : Windows Language : Blitz String byte packer/unpacker (crucher ?!) Pack/crunch a string, containing 2 bytes data
Hi, this is my try to write a Packer/Cruncher. I'v used it for the game Dithel's Wonderland - English Amiga Board post which i have converted from amos pro to blitzbasic. The function should pack the hexadecimal bytes into smaller ones. This means that the smallest pair is from "00" to "ff" and the string should contain these bytes, but the packer is not limited to a-f letters. Filename: Function-StringPackerUnpacker.bb ;==================================================================== ; Project: Packer+Unpacker (String,Bytepairs) ; Version: 1.0 ; Author: Dan ; Description: Packs a string of Bytes e.g. "0000000011111111" into smaler string e.G "-400-511". ; If the new string is the same size, or greater than the original, the original string will be returned. ; The Unpacker does the opposite. The unpacker function needs the string length to be passed to it (to prevent overflowing) ; This code does not work for binary files (without modifications). ; The packer is usefull only for making the strings for the unpacker. The saving routine is not included. ; The unpacker is meant to be included in a program's Sourcecode for the languages, like blitzbasic, ; which do not have embedded ressource handling (e.g. images/lvl data) - or in forums. ; Note: The unpacker returns the Lowercase letters only. ;==================================================================== ;Packer code needs 2 functions: SP$, HexByte$ Function SP$(bytedata$) ;String-Byte-Pack ;Packs a string, containing pairs of Hex-Bytes (from $00 to $ff) (lower case letters only - upper case letters are converted to lower) ;e.g "ffffffaaccccccfc" into shorter one (if possible) ;if not, the returned string will be the same ;Packing starts with a string lenght of 6 ;This function does not check if the string has valid hex numbers ! ; ; Do not use - and @ in the packstring (bytedata$) - because they are used to determine the packer bits. ; Local x=1,y,z=1,c=0,e,b_hi$,b_lo$,tmp$="" ;z counts the duplicates, c = flag for counting , e = end of string bytedata=Replace(Lower$(bytedata),"-","!") bytedata=Replace(bytedata,"@","§") y=Len(bytedata) If y And 1 Then Return bytedata While x<y b_hi$=Mid$(bytedata,x,2) .StringBytePack_again If x<y Then b_lo$=Mid$(bytedata,x+2,2) ;Get next byte If x=y Then e=1 ;End of String reached If (b_hi$=b_lo$) And e=0 Then z=z+1 : c=1 ;Compare 1st and second byte, and if same increase the count and set the flag If c=0 Then tmp$=tmp$+b_hi$ ;Comparison not started, add byte to tmp$ If b_hi$<>b_lo$ And c=1 ;Bytes do not match, but counting has started ! If z=>16 tmp$=tmp$+"@"+HexByte(z)+b_hi$ ElseIf z=>0 And z<3 tmp$=tmp$+String(b_hi,z) ElseIf z=>3 And z<16 tmp$=tmp$+"-"+HexByte(z,1)+""+b_hi$ EndIf c=0: z=1 : ;x=x-2 EndIf If z=256 Then tmp$=tmp$+"@"+HexByte(z-1)+b_hi$ : z=1 : c=0 ;Limit the chars to 255 bytes - (ff) x=x+2 If c>0 And e=0 Then Goto StringBytePack_again Wend ;If Len(tmp$)>Len(bytedata$) Then tmp$=bytedata$ Return tmp$ End Function Function HexByte$(nr,pos=2) Return Right$(Hex$(nr),pos) End Function ;Unpacker needs 2 functions: Su$, Hex2Dec Function SU$(xlen,bytedata$) ;String-Byte-Unpack ;xlen used to prevent invalid data ;bytedata$ should be the string returned previously by the StringBytePack (SP) function Local c,x=1,y,z,b_l$,b_r$,tmp$,b$ Repeat b_l$=Mid$(bytedata$,x,1) b_r$=Mid$(bytedata$,x+1,1) If b_l$="-" Then c=1 : x=x+2 : b_l$="0" ;"-4ff" If b_l$="@" Then c=1 : x=x+2 : b_l$=b_r$ : b_r$=Mid$(bytedata$,x,1) : x=x+1 ;"@44ff" If c=1 b$=b_l$+b_r$ b_l$=Mid$(bytedata$,x,1) b_r$=Mid$(bytedata$,x+1,1) If b_l$="@" Or b_l$="-" Or b_r$="@" Or b_r$="-" Then Return "-1" ;no @ or - signs are not allowed, when they were allready found y=Dec(b$) If Len(tmp$)+(y2)>xlen Then Return "-2" ;Error, if the string is longer than defined by xlen tmp$=tmp$+String(b_l$+b_r$,y) Else tmp$=tmp$+b_l+b_r$ EndIf x=x+2 c=0 Until x=>Len(bytedata$) Return tmp$ End Function Function Dec(h$) ; by Cyberseed - blitzbasic.com/forum Local d=0,t2$=Upper$(Trim$(h$)) For z=1 To Len(t2$) i=Instr("0123456789ABCDEF",Mid$(t2$,z,1)) If i>0 Then d=d16+i-1 Next Return d End Function --v

Comments
Saturday, 29 February 2020, 05:34
Dan	Here is a test code for the above function: Include "Function-StringPackerUnpacker.bb" Screen(800,800,1) Const teststring$="abcdefghijklmnopqrstuvwxyz0123456789" AppTitle "String of Bytes packer" Print "Enter any double digits or letters (lowercase only)" Print "e.g. nnnnnnnnffffaaffffff111111111111" Print Print "Output of the exaple:" Color 0,$ff,0 Print "1st line - Original string" Color 0,$40,$ff Print "2nd line - Packed String" Color 0,$ff,$ff Print "3rd line - Unpacked String" Color $ff,0,$ff Print "4th line Original/Upacked length + comparison result" Color $ff,$ff,$ff Print "----------------------------------------------------------" Print "" Local a$,b$,c$ Repeat Color $ff,$ff,$ff Print String("-",50) Print "Press any key to continue, e to input a string, or ESC to end" Print String("-",50) WaitKey() a$="":h$=" " If KeyDown(18) Then ; e key a$=Input("> ") If isEven(Len(a$))=0 Color $ff,0,0 : Print "String is not even, error will result." End If a$=Lower(a$) Else If Rand(1,6)=1 Then z=Rand (1,50) For x=1 To z b$=Lower(Mid$(teststring,Rand(1,Len(teststring)),1)) a$=a$+b$+b$ Next Else a$=Lower$(String("HI",Rand(0,20))+String("44",(Rand(0,20)))+String("22",(Rand(0,10)))+String("11",(Rand(0,20)))) End If End If Color 0,$ff,0 Print a$ c$=SP$(a$) Color 0,$40,$ff Print c$ b$=SU$(Len(a$),c$) Color 0,$ff,$ff Print b$ Color $ff,0,$ff Write RSet(Len(a$),3)+":"+RSet(Len(b$),3)+" = " If a$=b$ Then Color $0,$ff,0 : Write "Super" Else Color $ff,0,0 : Write "OOps ..." Color $50,$80,$ff Write " Packed length: "+Len(c$)+ " = " : Color $a0,$a0,$a0: Print ((Len(c$)100)/Len(a$))+" % " Until KeyHit(1) End Function Screen(x,y,zoom#=1) If x<64 Then x=64 If y<64 Then y=64 bits=32 Graphics xzoom,y*zoom,bits,2 Graphics x,y,bits,3 End Function Function isEven(nr) ;1 if even Return 1-(nr And 1) End Function --v

String byte packer/unpacker (crucher ?!)

Comments