データー圧縮 - abwiki @ ウィキ (ActiveBasic非公式wiki)

'データー圧縮
'
Function Encode(src As *Byte, srclen As DWord, dst As *Byte) As DWord 
	Dim i As DWord, j As DWord, k As DWord
	While i < srclen
		dst[j] = src[i]
		k = 0 
		While src[i] = dst[j]
			If k = 255 Or i > srclen Then Exit While
			k=k+1
			i=i+1
		Wend
		j=j+1
		dst[j] = k
		j=j+1
	Wend
	Encode = j
End Function


Function Decode(src As *Byte, srclen As DWord, dst As *Byte) As DWord
	Dim i As DWord, j As DWord, k As DWord
	While i < srclen
		dst[j] = src[i]
		For k=0 To src[i+1]-1
			dst[j+k]=src[i]
		Next
		i=i+2
		j=j+k
	Wend
	Decode = j
End Function

Function RleStr(src As *Byte, srclen As DWord) As String
	Dim s As String
	Dim i As DWord
	For i=0 To srclen-1 Step 2
		s = s + Chr$(src[i]) + "[" + Str$(src[i+1]) + "]"
	Next
	RleStr = s
End Function


#N88BASIC
Dim isrc[100] As *Byte
Dim idst[200] As *Byte
Dim idst2[100] As *Byte

Dim isrclen As DWord
Dim idstlen As DWord
Dim idst2len As DWord

lstrcpy(isrc, "AAAAAAAADDDDDDEEEECBBBBBBBBBCCCC")
isrclen = lstrlen(isrc)


idstlen = Encode(isrc, isrclen, idst)
Print "変換前=";MakeStr(isrc)
Print "変換後=";RleStr(idst, idstlen)

Print lstrlen(isrc);"→";idstlen;"(";idstlen/isrclen*100;"%)"

ZeroMemory(isrc, 100)
idst2len = Decode(idst, idstlen, idst2)

Print "復　元=";MakeStr(idst2)
Print idstlen;"→";idst2len;"(";idst2len/idstlen*100;"%)"