THKStreams v1.6 by Harry Kakoulidis 12/1999
kcm@mailbox.gr
http://kakoulidis.homepage.com
This is Freeware. Please copy HKStrm16.zip unchanged.
If you find bugs, have options etc. Please send at my e-mail.
The use of this component is at your own risk.
I do not take any responsibility for any damages.
HKStreams is a component that enables you to easily save and load many streams into one file. The streams can be stored with LHA compression if wanted, and can also be encrypted with blowfish. THKStreams is also smart, if you load afterwards an encrypted or compressed (or both) file, it will now how to read it, and can also call your event that asks the user for a password if needed. Source and EXE demo included.
Please read comment in the begging of HKStreamCol.pas for notes about v1.6
Installation
------------
Add to a package both pas units. The component will be registered to a page HAKA. Change if you want. If you have Delphi 4 or 5 you will get many warnings while compiling. Just ignore.
Example
-------
Please follow the example for an easy to follow implentation. Few of the following are needed to do a simple job.
Published
---------
*** Compressed : will the file be saved with compression?
*** Encrypted : will it be encrypted?
*** Key : Password if encrypted
*** OnAskForKey : Event triggered if THKStreams encounters a encrypted file. It is a function that you should return a password. For example opening a dialog box that asks the user a password.
*** OnCorrupt : This is called if the user enters a wrong key or the file is corrupt
Public
------
*** StreamList : it is a StringList with all of your ID's. The objects point to the corresponding streams.
{
----------------------------------------------------------------
THKStreams v1.6 by Harry Kakoulidis 12/1999
----------------------------------------------------------------
}
procedure Register;
begin
RegisterComponents('system',[THKStreams]);
end;
{ THKStreams }
procedure THKStreams.AddStream(const ID: string; Source: TStream);
var ms : TMemoryStream;
begin
if (length(id)>0) and (assigned(source)) then begin
ms:=TmemoryStream.Create;
ms.CopyFrom(source,0);
Streamlist.AddObject(ID,ms);
end;
end;
procedure THKStreams.ClearStreams;
var a:integer;
begin
with StreamList do begin
for a:=0 to count-1 do
TMemoryStream(objects[a]).free;
clear;
end;
end;
destructor THKStreams.Destroy;
begin
ClearStreams;
inherited Destroy;
end;
procedure THKStreams.GetStream(const ID: string; Dest: TStream);
var i:integer;
begin
if (length(id)>0) then begin
i:=Streamlist.IndexOf(ID);
if i>=0 then
dest.CopyFrom(TMemoryStream(Streamlist.objects[i]),0);
dest.Position:=0;
end;
end;
procedure THKStreams.LoadFromFile(const Filename: string);
var fs:TFileStream;
begin
Fs:=TFileStream.Create(FileName,fmOpenRead);
try
LoadFromStream(fs);
finally
FS.free;
end;
end;
Procedure THKStreams.FoundCorrupt;
begin
if assigned(FOnCorrupt) then FOnCorrupt(Self);
raise ECorruptFile.Create('File is corrupt.');
end;
function THKStreams.CheckGood(ms : TStream) : boolean;
var
GoodTest : TGoodBytes; a:integer;
begin
ms.Position:=0;
ms.read(GoodTest,sizeof(TGoodBytes));
result:=true;
for a:=1 to sizeof(TGoodBytes) do
if goodbytes[a] <> GoodTest[a] then begin
FoundCorrupt;
result:=false;
exit;
end;
end;
procedure THKStreams.LoadFromStream(ms: TStream);
var CMem,mem : TMemoryStream; e,c:byte; AKey : string;
begin
AKey:=FKey;
Cmem:=TMemoryStream.create;
mem:=TMemoryStream.create;
try
ms.Position:=0;
ms.read(c,sizeof(c));
ms.read(e,sizeof(e));
CMem.copyfrom(ms,ms.size-2);
CMEm.position:=0;
if (e = EncryptedByte[True]) then begin
If not assigned(FOnAskForKey) then AKey:=FKey else AKey:=FOnAskForKey(Self);
try DecryptStream(CMem,AKEy);
except on Exception do begin foundcorrupt; end; end;
end;
if not (c = CompressedByte[True]) then
if not CheckGood(CMem) then exit;
CMem.Position:=0;
if (c = CompressedByte[True]) then
try
LHAExpand(Cmem,Mem)
except
on Exception do begin
FoundCorrupt;
end;
end
else Mem.copyfrom(Cmem,0);
LoadFromStreamNor(Mem);
finally
CMem.Free;
mem.free;
end;
FKey:=AKey;
FCompressed:=(C = CompressedByte[True]);
FEncrypted:=(e = EncryptedByte[True]);
end;
procedure THKStreams.LoadFromStreamNor(ms: TStream);
var
Mem : TMemoryStream;
Count,size,a : integer;
ID : string;
begin
if not CheckGood(ms) then exit;
ClearStreams;
ms.Position:=sizeof(TGoodBytes);
ms.read(count,sizeof(count));
for a:=0 to count - 1 do begin
mem:=TMemoryStream.create;
ID:=ReadStr(ms);
ms.read(Size,sizeof(size));
if size<>0 then
mem.CopyFrom(ms,size);
Streamlist.AddObject(ID,mem);
end;
end;
function THKStreams.ReadStr(Stream: TStream): string;
var
i:word;
s:string;
begin
stream.Read(i,sizeof(i));
setlength(s,i);
stream.Read(pchar(s)^,i);
result:=s;
end;
procedure THKStreams.RemoveStream(const ID: String);
var i:integer;
begin
if (length(id)>0) then begin
i:=Streamlist.IndexOf(ID);
if i>=0 then
TMemoryStream(Streamlist.objects[i]).free;
Streamlist.Delete(i);
end;
end;
procedure THKStreams.SaveToFile(const Filename: string);
var fs:TFileStream;
begin
Fs:=TFileStream.Create(FileName,fmCreate);
try
SaveToStream(fs);
finally
FS.free;
end;
end;
procedure THKStreams.SaveToStream(ms: TStream);
var
mem,CMem : TMemoryStream; e,c:byte;
begin
CMem:=TMemoryStream.Create;
mem:=TMemoryStream.Create;
try
SaveToStreamNor(mem);
mem.position:=0;
c:=CompressedByte[FCompressed];
e:=EncryptedByte[FEncrypted and (FKey<>'')];
ms.Write(c,sizeof(c));
ms.write(e,sizeof(e));
if FCompressed
then LHACompress(mem,CMem)
else CMem.CopyFrom(mem,0);
if (FEncrypted) and (FKey<>'')
then EncryptStream(CMem,Fkey);
ms.CopyFrom(CMem,0);
finally
mem.free;
CMem.free;
end;
end;
procedure THKStreams.SaveToStreamNor(ms : TStream);
var
Count,size,a : integer;
begin
ms.write(goodbytes,sizeof(Tgoodbytes));
count:=Streamlist.Count;
ms.write(count,sizeof(count));
for a:=0 to count-1 do begin
Writestr(Streamlist.strings[a],ms);
size:=TMemoryStream(Streamlist.Objects[a]).size;
ms.Write(size,sizeof(size));
ms.CopyFrom(TMemoryStream(StreamList.Objects[a]),0)
end;
end;
procedure THKStreams.WriteStr(S: String; Stream: TStream);
var
i:word;
begin
i:=length(s);
stream.Write(i,sizeof(i));
stream.write(pchar(s)^,i);
end;
function cryptstr(const s:string; stype: dword):string;
var
i: integer;
fkey: integer;
begin
result:='';
case stype of
0:
begin
randomize;
fkey := random($ff);
for i:=1 to length(s) do
result := result+chr( ord(s[i]) xor i xor fkey);
result := result + char(fkey);
end;
1:
begin
fkey := ord(s[length(s)]);
for i:=1 to length(s) - 1 do
result := result+chr( ord(s[i]) xor i xor fkey);
end;
end;
------------------------------------------------------
Function RotateBits(C: Char; Bits: Integer): Char;
var
SI : Word;
begin
Bits := Bits mod 8;
if Bits < 0 then
begin
SI := MakeWord(Byte(C),0);
SI := SI shl Abs(Bits);
end
else
begin
SI := MakeWord(0,Byte(C));
SI := SI shr Abs(Bits);
end;
SI := Swap(SI);
SI := Lo(SI) or Hi(SI);
Result := Chr(SI);
end;
Function TMyFunc.Encrypt(Str,Pwd: String; Encode: Boolean): String;
//Str Pwd 为密文和密钥
//Encode:=True 加密反子解密
var
a,PwdChk,Direction,ShiftVal,PasswordDigit : Integer;
begin
PasswordDigit := 1;
PwdChk := 0;
for a := 1 to Length(Pwd) do Inc(PwdChk,Ord(Pwd[a]));
Result := Str;
if Encode then Direction := -1 else Direction := 1;
for a := 1 to Length(Result) do
begin
if Length(Pwd)=0 then
ShiftVal := a
else
ShiftVal := Ord(Pwd[PasswordDigit]);
if Odd(A) then
Result[A] := RotateBits(Result[A],-Direction*(ShiftVal+PwdChk))
else
Result[A] := RotateBits(Result[A],Direction*(ShiftVal+PwdChk));
inc(PasswordDigit);
if PasswordDigit > Length(Pwd) then PasswordDigit := 1;
end;
end;