UWSCでLZSS圧縮

圧縮の簡単なロジックないかなー、と探してたらみつけた。
http://homepage2.nifty.com/natupaji/DxLib/lecture/Press/press.html


これだけの計算をUWSCの配列とかでやることを考えたら、うんざりしてきたので、
Asmモジュールの技術を使って、Cで実行することにした。



スクリプト

Asmモジュールの機能を内包しています。
これにより、Asmに渡すコードをLZSS圧縮することが可能となりました、、、が、有効性は不明です。


Lzss.uws

OPTION EXPLICIT


IFB GET_UWSC_NAME = "Lzss.uws" THEN
	DIM testString = INPUT("長い文字列を入力してください")
	DIM len = LENGTHB(testString), ptr = Lzss.Alloc(len)
	Lzss.SetString(ptr, testString)

	// 圧縮
	DIM pc = Lzss.Compress(ptr, len), lenc = Lzss.GetCompressSize(pc)
	Lzss.Free(ptr)	// 圧縮したので元の文字列ポインターを解放
	// 展開(第二引数TRUE:省略値の場合、展開と同時にメモリーが解放される)
	DIM leno = Lzss.GetOriginalSize(pc), po = Lzss.Decompress(pc)
	DIM ostr = Lzss.GetString(po, leno)
	Lzss.Free(po)	// 文字列化したので展開後ポインターを解放

	IFB ostr = testString THEN
		MSGBOX("成功 圧縮前サイズ:" + leno + " 圧縮後サイズ:" + lenc)
	ELSE
		MSGBOX("失敗 圧縮前サイズ:" + leno + " 圧縮後サイズ:" + lenc + "<#CR><#CR>元テキスト :" + testString + "<#CR>復元テキスト:" + ostr)
	ENDIF

	Lzss.Dispose()
ENDIF


MODULE Lzss
	PUBLIC hK32 = NULL

	DIM _proc = NULL, _para = NULL
	HASHTBL _allocs

	DEF_DLL CreateThread(DWORD, DWORD, DWORD, DWORD, DWORD, DWORD): DWORD: kernel32
	DEF_DLL WaitForSingleObject(DWORD, DWORD): DWORD: kernel32
	DEF_DLL CloseHandle(DWORD): bool: kernel32
	DEF_DLL GetExitCodeThread(DWORD, var DWORD): bool: kernel32
	DEF_DLL VirtualAlloc(DWORD, DWORD, DWORD, DWORD): DWORD: kernel32
	DEF_DLL VirtualFree(DWORD, DWORD, DWORD): bool: kernel32
	DEF_DLL GetModuleHandleW(wstring): DWORD: kernel32
	DEF_DLL GetProcAddress(DWORD, string): DWORD: kernel32

	TEXTBLOCK _lzss_code
		VYvsgexABAAAi0UIiUX8x0XgAAAAAItN/ItRCIlV0ItF/ItIEIlN7ItV/ItCBIlF
		3ItN/ItRDIlV6MZF2wCLReiJRfCLTfyDOQAPhIACAADHRcQAAAAAx0X0AAAAAOsJ
		i1X0g8IBiVX0gX30AAEAAHMQi0X0x4SFwPv//wAAAADr3sdF9AAAAADrCYtN9IPB
		AYlN9ItV9DtV0HMli0XcA0X0D7YIi5SNwPv//4PCAYtF3ANF9A+2CImUjcD7///r
		youVwPv//4lVxMdF9AEAAADrCYtF9IPAAYlF9IF99AABAABzJItN9ItVxDuUjcD7
		//9+E4tF9IuMhcD7//+JTcSKVfSIVdvrysdF1AAAAADHRfgQAAAAi0XUO0XQD4N7
		AQAAx0XM/////8dFyP/////HRfQBAAAA6wmLTfSDwQGJTfSBffT/AAAAc3WLVdQ7
		VfRzAutrx0XkAAAAAOsJi0Xkg8ABiUXki03kO030czKLVeQDVdQ7VdByAusli0XU
		A0Xki03cD7YUAYtF1CtF9ANF5ItN3A+2BAE70HQC6wLrvYN95AR8FItNzDtN5H0M
		i1XkiVXMi0X0iUXI6Xn///+Dfcj/dWODfegAdBiLTfg7TexzEItV6ANV+ItF3ANF
		1IoIiAqLVfiDwgGJVfiLRdwDRdQPtggPtlXbO8p1IIN96AB0EYtF+DtF7HMJi03o
		A034xgH/i1X4g8IBiVX4i0XUg8ABiUXU62+DfegAdBOLTfg7TexzC4tV6ANV+IpF
		24gCi034g8EBiU34g33oAHQTi1X4O1XscwuLRegDRfiKTciICItV+IPCAYlV+IN9
		6AB0E4tF+DtF7HMLi03oA034ilXMiBGLRfiDwAGJRfiLTdQDTcyJTdTpef7//4N9
		6AB0IYN97BB2G4tV8ItF0IlCBItN8ItV+IlRCItF8IpN24hIDItV+IlV4OlDAQAA
		g33cAHUXg33wAHQRg33sEHYLi0Xwi0AE6SkBAACDffAAdBaLTfCLVew7UQhyC4tF
		8ItN0DtIBHMIg8j/6QUBAADHRdQAAAAAx0X4EAAAAItV+DtV7A+D3wAAAItF6ANF
		+A+2CItV8A+2Qgw7yA+FoAAAAItN+IPBAYlN+ItV6ANV+A+2Aj3/AAAAdSKLTdwD
		TdSLVfCKQgyIAYtN1IPBAYlN1ItV+IPCAYlV+Otji0XoA0X4D7YIiU30i1X4g8IB
		iVX4i0XoA0X4D7YIiU3ki1X4g8IBiVX4x0XQAAAAAOsSi0XQg8ABiUXQi03Ug8EB
		iU3Ui1XQO1XkcxaLRdQrRfSLTdwDTdSLVdyKBAKIAevQ6yKLTdwDTdSLVegDVfiK
		AogBi03Ug8EBiU3Ui1X4g8IBiVX46RX///+LRfCLSASJTeCLReCL5V3CBADM
	ENDTEXTBLOCK

	PROCEDURE Lzss
		hK32 = GetModuleHandleW("kernel32")
		IF _proc <> NULL THEN Free(_proc)
		_proc = Set(_lzss_code)
		IF _para <> NULL THEN Free(_para)
		_para = Alloc(20)
	FEND

	PROCEDURE Dispose()
		WHILE LENGTH(_allocs)
			Free(_allocs[0, HASH_KEY])
		WEND
		_para = NULL
		_proc = NULL
	FEND


	FUNCTION Set(code)
		DEF_DLL CryptStringToBinaryW(wstring,dword,dword,dword,var dword,var dword,var dword): BOOL: crypt32
		DIM size = 0, dwFlag = 0
		RESULT = 0
		IFB CryptStringToBinaryW(code,0,7,NULL,size,NULL,dwFlag) THEN
			RESULT = Alloc(size, NULL, $40)
			IFB CryptStringToBinaryW(code,0,dwFlag,RESULT,size,NULL,NULL) THEN
				IFB size > 4 AND GetDword(RESULT) = $53535A4C THEN
					RESULT = Decompress(RESULT)
				ENDIF
			ELSE
				Free(RESULT)
				RESULT = 0
			ENDIF
		ENDIF
	FEND

	// 戻りはtypeによって異なる
	//  type=0   : スレッド終了コード
	//  type=1   : スレッド終了コード取得失敗エラーコード
	//  type=258 : スレッドハンドル
	//  type=他  : その他エラーコード
	FUNCTION Run(addr, para, var type, timeout=$7FFFFFFF)
		DIM hThread = CreateThread(0, 0, addr, para, 0, 0)
		RESULT = hThread
		type = 258
		IF timeout >= 0 THEN type = WaitForSingleObject(hThread, timeout)
		IFB type = 0 THEN
			IF !GetExitCodeThread(hThread, RESULT) THEN type = 1
			CloseHandle(hThread)
		ENDIF
	FEND

	FUNCTION Alloc(size, ptr=NULL, pro=4)
		RESULT = VirtualAlloc(0, size, $1000, pro)
		_allocs[RESULT] = size
		IFB ptr <> NULL THEN
			DEF_DLL RtlMoveMemory(DWORD, DWORD, DWORD): kernel32
			RtlMoveMemory(RESULT, ptr, size)
		ENDIF
	FEND
	FUNCTION Free(ptr)
		RESULT = _allocs[ptr, HASH_REMOVE]
		RESULT = VirtualFree(ptr, 0, $8000)
	FEND

	FUNCTION SetByte(p, data[])
		DEF_DLL RtlMoveMemory(DWORD, BYTE[], DWORD): kernel32
		RESULT = LENGTH(data)
		RtlMoveMemory(p, data, RESULT)
	FEND
	FUNCTION SetDword(p, data)
		DEF_DLL RtlMoveMemory(DWORD, var DWORD, DWORD): kernel32
		RESULT = 4
		RtlMoveMemory(p, data, RESULT)
	FEND
	FUNCTION SetString(p, data)
		DEF_DLL RtlMoveMemory(DWORD, string, DWORD): kernel32
		RESULT = LENGTHB(data)
		RtlMoveMemory(p, data, RESULT)
	FEND

	FUNCTION GetDword(p)
		DEF_DLL RtlMoveMemory(var DWORD, DWORD, DWORD): kernel32
		RESULT = 0
		RtlMoveMemory(RESULT, p, 4)
	FEND
	FUNCTION GetString(p, len=-1)
		DEF_DLL RtlMoveMemory(var string, DWORD, DWORD): kernel32
		IFB len >= 0 THEN
			RESULT = FORMAT(CHR(0), len)
			RtlMoveMemory(RESULT, p, len)
		ELSE
			len = 0
			DIM n = len
			WHILE n = len
				len = len + 1
				RESULT = FORMAT(CHR(0), len)
				RtlMoveMemory(RESULT, p, len)
				n = LENGTH(RESULT)
			WEND
		ENDIF
	FEND

	PROCEDURE Dump(addr, size, dwFlag=11)
		DEF_DLL CryptBinaryToStringW(DWORD,DWORD,DWORD,var wstring,var DWORD): BOOL: crypt32
		DIM nstr = 0, str
		IFB CryptBinaryToStringW(addr,size,dwFlag,NULL,nstr) THEN
			str = FORMAT(CHR(0), nstr)
			IFB CryptBinaryToStringW(addr,size,dwFlag,str,nstr) THEN
				PRINT str
			ENDIF
		ENDIF
	FEND


	FUNCTION Compress(ptr, size)
		RESULT = 0
		DIM i = 0
		i = i + SetDword(_para + i, 1)
		i = i + SetDword(_para + i, ptr)
		i = i + SetDword(_para + i, size)
		i = i + SetDword(_para + i, 0)
		i = i + SetDword(_para + i, 0)
		DIM cs = Run(_proc, _para, i)
		IFB i = 0 AND cs > 0 THEN
			RESULT = Alloc(cs)
			i = 12
			i = i + SetDword(_para + i, RESULT)
			i = i + SetDword(_para + i, cs)
			cs = Run(_proc, _para, i)
			IFB i <> 0 AND cs <= 0 THEN
				Free(RESULT)
				RESULT = 0
			ENDIF
		ENDIF
	FEND

	FUNCTION Decompress(ptr, free=TRUE)
		RESULT = 0
		DIM i = 0, os = GetOriginalSize(ptr)
		RESULT = Alloc(os)
		i = i + SetDword(_para + i, 0)
		i = i + SetDword(_para + i, RESULT)
		i = i + SetDword(_para + i, os)
		i = i + SetDword(_para + i, ptr)
		i = i + SetDword(_para + i, GetCompressSize(ptr))
		os = Run(_proc, _para, i)
		IFB i <> 0 AND os <= 0 THEN
			Free(RESULT)
			RESULT = 0
		ENDIF
		IF free THEN Free(ptr)
	FEND

	FUNCTION GetOriginalSize(ptr)
		RESULT = 0
		IF _allocs[ptr, HASH_EXISTS] THEN RESULT = GetDword(ptr + 4)
	FEND

	FUNCTION GetCompressSize(ptr)
		RESULT = 0
		IF _allocs[ptr, HASH_EXISTS] THEN RESULT = GetDword(ptr + 8)
	FEND

ENDMODULE


テストコードにあるように、
圧縮は、Lzss.Compress関数に圧縮したいデータのあるアドレスとサイズを渡すだけ。
圧縮後ポインターか0:失敗が返る。


展開は、

  1. 圧縮後ポインターから、圧縮後サイズを取り出すのは、Lzss.GetCompressSize
  2. 圧縮後ポインターから、圧縮前サイズを取り出すのは、Lzss.GetOriginalSize
  3. Lzss.Decompress関数に圧縮後ポインターを渡すと、圧縮データを破棄し、展開後ポインターか0:失敗が返る
    1. Lzss.Decompressの第二引数をFALSEにすると、圧縮後データを破棄しない


圧縮でも展開でも、最後にLzss.Disposeをして、確保したメモリーを解放すること。
ただし展開時は、第二引数をFALSEにしない限りメモリーは自動的に解放される。


基本的にデータはUWSCから直接は見えないメモリーの中にいる想定なので、メモリーを想像できない人にはつらい仕様となっています。
要望があるなら、ファイルを圧縮・展開するモジュールを書いても良いけど、圧縮効率はそれほど良くないので、ま、いらないでしょう。


Asmモジュールの機能を持っており、LZSS圧縮したバイナリコードを実行することも可能です。


LZSS圧縮は、それまでに出たパターンを利用して圧縮するので、同じパターンの繰り返しに強い圧縮方式です。