{ -----------------------------------------------------------------------
Tcl Scripting Language Components (Tslc)
Copyright (C) 1996-2002 William Byrne

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

WilliamB@ByrneLitho.com
------------------------------------------------------------------------}
unit TslcFile;

interface
uses SysUtils, Classes;

type
	TTslcScriptType = (stNormal, stCompressed, stEncrypted, stCompressedEncrypted, stPrivate);

const
	TScriptTypeExt: array[Low(TTslcScriptType)..High(TTslcScriptType)] of pChar = ('.TCL', '.TCZ', '.TCE', '.TZE', '.TZP');

function StrToScriptType(ext: string): TTslcScriptType;
function CrunchScriptStream(sStrm: TStream; typ: TTslcScriptType; pword: string): TMemoryStream;
function UncrunchScriptStream(sStrm: TStream; typ: TTslcScriptType; pword: string): TMemoryStream;


implementation
uses TslcDes, TslcZLib;

function StrToScriptType(ext: string): TTslcScriptType;
var
	st: TTslcScriptType;
begin
	result := stNormal;
	for st:= Low(TTslcScriptType) to High(TTslcScriptType) do
		if CompareText(ext, TScriptTypeExt[st]) = 0 then
		   	result := st;
end;

function CrunchScriptStream(sStrm: TStream; typ: TTslcScriptType; pword: string): TMemoryStream;
var
	tStrm: TStream;
begin
	result := nil;
	if typ = stPrivate then
		typ := stCompressedEncrypted;

	if typ in [stCompressed, stCompressedEncrypted] then
	begin
		InitZLib('');
	  	result := TMemoryStream.Create;
		try
		   	DeflateStream(sStrm, result, -1);
			result.Position := 0;
		except
		   	result.Free;
			raise;
		end;
		if typ = stCompressed then
			exit;
	end;
	if typ in [stCompressedEncrypted, stEncrypted] then
	begin
		if typ = stCompressedEncrypted then
			tStrm := result
		else
			tStrm := sStrm;
		try
			result := TMemoryStream.Create;
			try
				DESStream(pword, tStrm, result, True, True);
				result.Position := 0;
		   	except
			   	result.Free;
				raise;
			end;
		finally
			if typ = stCompressedEncrypted then
				tStrm.Free;
		end;
		exit;
	end;
	// Nothing to do except guarantee a new stream
	result := TMemoryStream.Create;
	try
	   	result.CopyFrom(sStrm, sStrm.Size - sStrm.Position);
		result.Position := 0;
	except
	   	result.Free;
		raise;
	 end;
end;

function UncrunchScriptStream(sStrm: TStream; typ: TTslcScriptType; pword: string): TMemoryStream;
var
   tStrm: TStream;
begin
	if typ = stPrivate then
		typ := stCompressedEncrypted;

	if typ in [stCompressed, stCompressedEncrypted] then
		InitZLib('');

	if typ in [stCompressedEncrypted, stEncrypted] then
	begin
	  	result := TMemoryStream.Create;
		try
			DESStream(pword, sStrm, result, False, True);
			result.Position := 0;
		except
		   	result.Free;
			raise;
		end;
		if typ = stEncrypted then
			exit;
	end;
	if typ in [stCompressed, stCompressedEncrypted] then
	begin
		if typ = stCompressedEncrypted then
			tStrm := result
		else
			tStrm := sStrm;
		try
			result := TMemoryStream.Create;
			try
			   	InflateStream(tStrm, result);
				result.Position := 0;
		   	except
			   	result.Free;
				raise;
			end;
		finally
			if typ = stCompressedEncrypted then
				tStrm.Free;
		end;
		exit;
	end;
	// Nothing to do except guarantee a new stream
	result := TMemoryStream.Create;
	try
	   	result.CopyFrom(sStrm, sStrm.Size - sStrm.Position);
		result.Position := 0;
	except
	   	result.Free;
		raise;
	end;
end;
end.
