Function Decode(S: String; Code: Integer): String;
Var t: Integer;
Begin
 For t:=1 to Length(S) Do S[t]:=Chr(Ord(S[t]) xor Code);
 Result:=S;
End;

{ **** UBPFD *********** by kladovka.net.ru ****
>> Шифрование строки
Предназначена для простого шифрование строк и паролей, ключ 96 бит, шифрование
симметричное.
Зависимости: UBPFD.decrypt
Автор: Anatoly Podgoretsky, <a href="mailto:anatoly@podgoretsky.com">anatoly@podgoretsky.com</a>, Johvi
Copyright: (c) Anatoly Podgoretsky, 1996
Дата: 26 апреля 2002 г.
********************************************** }
const
 StartKey = 471; // Start default key
 MultKey = 62142; // Mult default key
 AddKey = 11719; // Add default key
// обязательно смените ключи до использования
function Encrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;
var
 I : Byte;
//Если поменять тип переменной I на Integer, то будет
//возможно шифрование текста длиной более 255 символом - VID.
begin
 Result := '';
 for I := 1 to Length(InString) do
 begin
  Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));
  StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;
 end;
end;

if Encrypt(S, StartKey, MultKey, AddKey) <> OriginalPwd then ...

{ **** UBPFD *********** by kladovka.net.ru ****
>> Шифрование строки InString, с возможностью корректного
сохранения результата шифрования в TEXT-FILE
Функция представляет модификацию функции UBPFD.Encrypt.
Отличие от указанной функции заключается в том, что
функция EncryptEX возвращает результат, обработанный функцией
UBPFD.StrToAsсii, т.е. обеспечивает возможность корректного
сохранения шифр-текста в текстовый файл.
Зависимости: UBPFD.Encrypt, UBPFD.StrToAscii
Автор: VID, <a href="mailto:vidsnap@mail.ru">vidsnap@mail.ru</a>, ICQ:132234868, Махачкала
Copyright: VID
Дата: 30 апреля 2002 г.
********************************************** }
Function EncryptEX(const InString:string; StartKey,MultKey,AddKey:Integer): string;
Begin
Result := StrTOAscii(Encrypt(InString, StartKey, MultKey, AddKey));
END;

{ **** UBPFD *********** by kladovka.net.ru ****
>> Шифрование текста
Процедура шифрует текст основываясь на введенном пароле.
Зависимости: Windows, SysUtils, Classes
Автор: Danger, <a href="mailto:robinzon2000@pochtamt.ru">robinzon2000@pochtamt.ru</a>, Киев
Copyright: Danger
Дата: 04 мая 2002 г.
********************************************** }
var
 s: string;
procedure Code(var text: string; password: string;
 decode: boolean);
var
 i, PasswordLength: integer;
 sign: shortint;
begin
 PasswordLength := length(password);
 if PasswordLength = 0 then Exit;
 if decode
  then sign := -1
  else sign := 1;
 for i := 1 to Length(text) do
  text[i] := chr(ord(text[i]) + sign *
  ord(password[i mod PasswordLength + 1]));
end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 s := Memo1.Text;

 code(s, Edit1.Text, false);

 Memo1.Text := s;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 code(s, Edit1.Text, true);

 Memo1.Text := s;

end;

unit uEncrypt;
interface
function Decrypt(const S: AnsiString; Key: Word): AnsiString;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;
implementation
const
 C1 = 52845;
 C2 = 22719;
function Decode(const S: AnsiString): AnsiString;
const
 Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
  54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
  3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
  20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
  31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
  46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0);
var
 I: LongInt;
begin
 case Length(S) of
  2:
  begin
  I := Map[S[1]] + (Map[S[2]] shl 6);
  SetLength(Result, 1);
  Move(I, Result[1], Length(Result))
  end;
  3:
  begin
  I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
  SetLength(Result, 2);
  Move(I, Result[1], Length(Result))
  end;
  4:
  begin
  I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
  (Map[S[4]] shl 18);
  SetLength(Result, 3);
  Move(I, Result[1], Length(Result))
  end
 end
end;
function PreProcess(const S: AnsiString): AnsiString;
var
 SS: AnsiString;
begin
 SS := S;
 Result := '';
 while SS <> '' do
 begin
  Result := Result + Decode(Copy(SS, 1, 4));
  Delete(SS, 1, 4)
 end
end;
function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;
var
 I: Word;
 Seed: Word;
begin
 Result := S;
 Seed := Key;
 for I := 1 to Length(Result) do
 begin
  Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
  Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)
 end
end;
function Decrypt(const S: AnsiString; Key: Word): AnsiString;
begin
 Result := InternalDecrypt(PreProcess(S), Key)
end;
function Encode(const S: AnsiString): AnsiString;
const
 Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
  'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
 I: LongInt;
begin
 I := 0;
 Move(S[1], I, Length(S));
 case Length(S) of
  1:
  Result := Map[I mod 64] + Map[(I shr 6) mod 64];
  2:
  Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
  Map[(I shr 12) mod 64];
  3:
  Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
  Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
 end
end;
function PostProcess(const S: AnsiString): AnsiString;
var
 SS: AnsiString;
begin
 SS := S;
 Result := '';
 while SS <> '' do
 begin
  Result := Result + Encode(Copy(SS, 1, 3));
  Delete(SS, 1, 3)
 end
end;
function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;
var
 I: Word;
 Seed: Word;
begin
 Result := S;
 Seed := Key;
 for I := 1 to Length(Result) do
 begin
  Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
  Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)
 end
end;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;
begin
 Result := PostProcess(InternalEncrypt(S, Key))
end;
end.
{**************************************************************}
// Example:
{**************************************************************}
procedure TForm1.Button1Click(Sender: TObject);
const
 my_key = 33189;
var
 sEncrypted, sDecrypted :AnsiString;
begin
 // Encrypt a string
 sEncrypted := Encrypt('this is a sample text
  to encrypt...abcd 123 {}[]?=)=(',my_key);
 // Show encrypted string
 ShowMessage(sEncrypted);
 // Decrypt the string
 sDecrypted := Decrypt(sEncrypted,my_key);
  // Show decrypted string
 ShowMessage(sDecrypted);
end;

var

 s: string;

procedure Code(var text: string; password: string;

 decode: boolean);

var

 i, PasswordLength: integer;

 sign: shortint;

begin

 PasswordLength := length(password);

 if PasswordLength = 0 then Exit;

 if decode

  then sign := -1

  else sign := 1;

 for i := 1 to Length(text) do

  text[i] := chr(ord(text[i]) + sign *

  ord(password[i mod PasswordLength + 1]));

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 s := Memo1.Text;

 code(s, Edit1.Text, false);

 Memo1.Text := s;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 code(s, Edit1.Text, true);

 Memo1.Text := s;

end;

{$I-,R-}
Unit Crypter;
interface
Uses Objects;
procedure EnCrypt(var Pntr: Array of Char; ArrLen: Word; password: string);
{ - Закpиптовать блок }
procedure DeCrypt(var Pntr: Array of Char; ArrLen: Word; password: string);
{ - Раскиптовать блок }
procedure EnCryptStream(var st: tStream; Password: String);
{ - Закpиптовать поток }
procedure DeCryptStream(var st: tStream; Password: String);
{ - Раскиптовать поток }
implementation
procedure EnCrypt(var Pntr: Array of Char; ArrLen:Word; password: string);
var
 len,pcounter: byte;
 x:Word;
begin
 len := length(password) div 2;
 pcounter := 1;
 for x:=0 to ArrLen-1 do begin
  Pntr[x] := chr(ord(password[pcounter]) + ord(Pntr[x]) + len);
  inc(pcounter);
  if pcounter > length(password) then pcounter := 1;
 end;
end;
procedure DeCrypt(var Pntr: Array of Char; ArrLen:Word; password: string);
var
 len,pcounter: byte;
 x:Word;
begin
 len := length(password) div 2;
 pcounter := 1;
 for x:=0 to ArrLen-1 do begin
  Pntr[x] := chr(ord(Pntr[x]) - ord(password[pcounter]) - len);
  inc(pcounter);
  if pcounter > length(password) then pcounter := 1;
 end;
end;
type
 pBuffer = ^tBuffer;
 tBuffer = Array[1..$FFFF] of Char;
procedure EnCryptStream(var st: tStream; Password: String);
 var
 buf: pBuffer;
 StSize, StPos, p: Longint;
 begin
 if (@st=nil) or (Password='') then exit;
 New(buf);
 StPos:=st.GetPos;
 StSize:=st.GetSize;
 st.Reset;
 st.Seek(0);
 repeat
  p:=st.GetPos;
  if SizeOf(Buf^)> St.GetSize-St.GetPosthen st.Read(buf^,St.GetSize-St.GetPos)
else st.Read(buf^,SizeOf(Buf^));
  EnCrypt(buf^,SizeOf(buf^),password);
  st.Reset;
  st.Seek(p);
  st.Write(buf^,SizeOf(Buf^));
 until (St.GetSize=St.GetPos);
 st.Seek(StSize);
 st.Truncate;
 st.Seek(StPos);
 Dispose(buf);
 end;
procedure DeCryptStream(var st: tStream; Password: String);
 var
 buf: pBuffer;
 StSize, StPos, p: Longint;
 begin
 if (@st=nil) or (Password='') then exit;
 New(buf);
 StPos:=st.GetPos;
 StSize:=st.GetSize;
 st.Reset;
 st.Seek(0);
 repeat
  p:=st.GetPos;
  if SizeOf(Buf^)> St.GetSize-St.GetPosthen st.Read(buf^,St.GetSize-St.GetPos)
else st.Read(buf^,SizeOf(Buf^));
  DeCrypt(buf^,SizeOf(buf^),password);
  st.Reset;
  st.Seek(p);
  st.Write(buf^,SizeOf(Buf^));
 until (St.GetSize=St.GetPos);
 st.Seek(StSize);
 st.Truncate;
 st.Seek(StPos);
 Dispose(buf);
 end;
end.

{
 This two functions are used to encrypt and decrypt text.
 Here's how to use it:
 The four entries Key1, Key2, Key3 and Key4 are numbers
 that can range from 1 to 120. In order to decrypt a text,
 you must use the same numbers you used to encrypt the text.
 No one that doesn't know what values were used on Key1, Key2, Key3 and Key4
 will be able to decrypt your text!
 Note that Key1*Key4 MUST be different than Key2*Key3.
 If any Key is zero, or Key1*Key4 is equal to Key2*Key3,
 the function will return ''.
 In Brief:
  Key1, Key2, Key3, Key4 : integer from range[1..120]
  Key1*Key4 Key2*Key3
}
 function Encrypt(Text : string; Key1, Key2, Key3, Key4 : Integer) : string;
 var
 BufS, Hexa, Hexa1, Hexa2 : string;
 BufI, BufI2, Sc, Sl, Num1, Num2, Num3, Num4, Res1, Res2, Res3, Res4 : Integer;
 begin
 Sl := Length(Text);
 Sc := 0;
 BufS := '';
 if (Key1 in [1 .. 120]) and (Key2 in [1 .. 120]) and (Key3 in [1 .. 120]) and (Key4 in [1 .. 120]) then
 begin
  BufI := Key1 * Key4;
  BufI2 := Key3 * Key2;
  BufI := BufI - BufI2;
  if BufI = 0 then
  begin
  Result := '';
  Exit;
  end;
 end
 else
 begin
  Result := '';
  Exit;
 end;
 repeat
  Inc(Sc);
  if Sc > Sl then Num1 := 0 else Num1 := Ord(Text[Sc]);
  Inc(Sc);
  if Sc > Sl then Num2 := 0 else Num2 := Ord(Text[Sc]);
  Inc(Sc);
  if Sc > Sl then Num3 := 0 else Num3 := Ord(Text[Sc]);
  Inc(sc);
  if Sc > Sl then Num4 := 0 else Num4 := Ord(Text[Sc]);
  Res1 := Num1 * Key1;
  BufI := Num2 * Key3;
  Res1 := Res1 + BufI;
  Res2 := Num1 * Key2;
  BufI := Num2 * Key4;
  Res2 := Res2 + BufI;
  Res3 := Num3 * Key1;
  BufI := Num4 * Key3;
  Res3 := Res3 + BufI;
  Res4 := Num3 * Key2;
  BufI := Num4 * Key4;
  Res4 := Res4 + BufI;
  for BufI := 1 to 4 do
  begin
  case BufI of
  1 : Hexa := IntToHex(Res1, 4);
  2 : Hexa := IntToHex(Res2, 4);
  3 : Hexa := IntToHex(Res3, 4);
  4 : Hexa := IntToHex(Res4, 4);
  end;
  Hexa1 := '$' + Hexa[1] + Hexa[2];
  Hexa2 := '$' + Hexa[3] + Hexa[4];
  if (Hexa1 = '$00') and (Hexa2 = '$00') then
  begin
  Hexa1 := '$FF';
  Hexa2 := '$FF';
  end;
  if Hexa1 = '$00' then Hexa1 := '$FE';
  if Hexa2 = '$00' then
  begin
  Hexa2 := Hexa1;
  Hexa1 := '$FD';
  end;
  BufS := BufS + Chr(StrToInt(Hexa1)) + Chr(StrToInt(Hexa2));
  end;
  until Sc >= Sl;
 Result := BufS;
 end;
 function Decrypt(Text : string; Key1, Key2, Key3, Key4 : Integer) : string;
 var
 BufS, Hexa1, Hexa2 : string;
 BufI, BufI2, Divzr, Sc, Sl, Num1, Num2, Num3, Num4, Res1, Res2, Res3, Res4 : Integer;
 begin
 Sl := Length(Text);
 Sc := 0;
 BufS := '';
 if (Key1 in [1 .. 120]) and (Key2 in [1 .. 120]) and (Key3 in [1 .. 120]) and (Key4 in [1 .. 120]) then
 begin
  Divzr := Key1 * Key4;
  BufI2 := Key3 * Key2;
  Divzr := Divzr - BufI2;
  if Divzr = 0 then
  begin
  Result := '';
  Exit;
  end;
 end
 else
 begin
  Result := '';
  Exit;
 end;
 repeat
  for BufI := 1 to 4 do
  begin
  Inc(Sc);
  Hexa1 := IntToHex(Ord(Text[Sc]), 2);
  Inc(Sc);
  Hexa2 := IntToHex(Ord(Text[Sc]), 2);
  if Hexa1 = 'FF' then
  begin
  Hexa1 := '00';
  Hexa2 := '00';
  end;
  if Hexa1 = 'FE' then Hexa1 := '00';
  if Hexa1 = 'FD' then
  begin
  Hexa1 := Hexa2;
  Hexa2 := '00';
  end;
  case BufI of
  1 : Res1 := StrToInt('$' + Hexa1 + Hexa2);
  2 : Res2 := StrToInt('$' + Hexa1 + Hexa2);
  3 : Res3 := StrToInt('$' + Hexa1 + Hexa2);
  4 : Res4 := StrToInt('$' + Hexa1 + Hexa2);
  end;
  end;
  BufI := Res1 * Key4;
  BufI2 := Res2 * Key3;
  Num1 := BufI - BufI2;
  Num1 := Num1 div Divzr;
  BufI := Res2 * Key1;
  BufI2 := Res1 * Key2;
  Num2 := BufI - BufI2;
  Num2 := Num2 div Divzr;
  BufI := Res3 * Key4;
  BufI2 := Res4 * Key3;
  Num3 := BufI - BufI2;
  Num3 := Num3 div Divzr;
  BufI := Res4 * Key1;
  BufI2 := Res3 * Key2;
  Num4 := BufI - BufI2;
  Num4 := Num4 div Divzr;
  BufS := BufS + Chr(Num1) + Chr(Num2) + Chr(Num3) + Chr(Num4);
  until Sc >= Sl;
 Result := BufS;
 end;

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Шифрование строки
Предназначена для простого шифрование строк и паролей, ключ 96 бит, шифрование
симметричное.
Зависимости: UBPFD.decrypt
Автор: Anatoly Podgoretsky, <a href="mailto:anatoly@podgoretsky.com">anatoly@podgoretsky.com</a>, Johvi
Copyright: (c) Anatoly Podgoretsky, 1996
Дата: 26 апреля 2002 г.
***************************************************** }
const
 StartKey = 471; // Start default key
 MultKey = 62142; // Mult default key
 AddKey = 11719; // Add default key
 // обязательно смените ключи до использования
function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
 string;
var
 I: Byte;
 // Если поменять тип переменной I на Integer, то будет возможно
 // шифрование текста длиной более 255 символом - VID.
begin
 Result := '';
 for I := 1 to Length(InString) do
 begin
  Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));
  StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;
 end;
end;
Пример использования:
if Encrypt(S, StartKey, MultKey, AddKey) <> OriginalPwd then
 ...
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Расшифровка строки
Предназначена для расшифровки строки, ранее зашифрованной фукцией UBPFD.Encrypt
Зависимости: UBPFD.Encrypt
Автор: Anatoly Podgoretsky, <a href="mailto:anatoly@podgoretsky.com">anatoly@podgoretsky.com</a>, Johvi
Copyright: (c) Anatoly Podgoretsky, 1996
Дата: 26 апреля 2002 г.
***************************************************** }
const
 StartKey = 471; // Start default key
 MultKey = 62142; // Mult default key
 AddKey = 11719; // Add default key
 // обязательно смените ключи до использования
{$R-}
{$Q-}
function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
 string;
var
 I: Byte;
 // Если поменять тип переменной I на Integer, то будет возможно
 // шифрование текста длиной более 255 символом - VID.
begin
 Result := '';
 for I := 1 to Length(InString) do
 begin
  Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));
  StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;
 end;
end;
{$R+}
{$Q+}
//Пример использования:
S := 'Ваш старый пароль: <' + Decrypt(S, StartKey, MultKey, AddKey) + '>';

const
 csCryptFirst = 20;
 csCryptSecond = 230;
 csCryptHeader = 'Crypted';
type
 ECryptError = class(Exception);
function CryptString(Str:String):String;
var i,clen : Integer;
begin
 clen := Length(csCryptHeader);
 SetLength(Result, Length(Str)+clen);
 Move(csCryptHeader[1], Result[1], clen);
 For i := 1 to Length(Str) do
  begin
  if i mod 2 = 0 then
  Result[i+clen] := Chr(Ord(Str[i]) xor csCryptFirst)
  else
  Result[i+clen] := Chr(Ord(Str[i]) xor csCryptSecond);
  end;
end;
function UnCryptString(Str:String):String;
var i, clen : Integer;
begin
 clen := Length(csCryptHeader);
 SetLength(Result, Length(Str)-clen);
 if Copy(Str, 1, clen) < > csCryptHeader then
  raise ECryptError.Create('UnCryptString failed');
 For i := 1 to Length(Str)-clen do
  begin
  if (i) mod 2 = 0 then
  Result[i] := Chr(Ord(Str[i+clen]) xor csCryptFirst)
  else
  Result[i] := Chr(Ord(Str[i+clen]) xor csCryptSecond);
  end;
end;

unit EncodStr;
interface
uses
 Classes;
type
 TEncodedStream = class (TFileStream)
 private
  FKey: Char;
 public
  constructor Create(const FileName: string; Mode: Word);
  function Read(var Buffer; Count: Longint): Longint; override;
  function Write(const Buffer; Count: Longint): Longint; override;
  property Key: Char read FKey write FKey default 'A';
 end;
implementation
constructor TEncodedStream.Create(
 const FileName: string; Mode: Word);
begin
 inherited Create (FileName, Mode);
 FKey := 'A';
end;
function TEncodedStream.Write(const Buffer;
  Count: Longint): Longint;
var
 pBuf, pEnc: PChar;
 I, EncVal: Integer;
begin
 // allocate memory for the encoded buffer
 GetMem (pEnc, Count);
 try
  // use the buffer as an array of characters
  pBuf := PChar (@Buffer);
  // for every character of the buffer
  for I := 0 to Count - 1 do
  begin
  // encode the value and store it
  EncVal := ( Ord (pBuf[I]) + Ord(Key) ) mod 256;
  pEnc [I] := Chr (EncVal);
  end;
  // write the encoded buffer to the file
  Result := inherited Write (pEnc^, Count);
 finally
  FreeMem (pEnc, Count);
 end;
end;
function TEncodedStream.Read(var Buffer; Count: Longint): Longint;
var
 pBuf, pEnc: PChar;
 I, CountRead, EncVal: Integer;
begin
 // allocate memory for the encoded buffer
 GetMem (pEnc, Count);
 try
  // read the encoded buffer from the file
  CountRead := inherited Read (pEnc^, Count);
  // use the output buffer as a string
  pBuf := PChar (@Buffer);
  // for every character actually read
  for I := 0 to CountRead - 1 do
  begin
  // decode the value and store it
  EncVal := ( Ord (pEnc[I]) - Ord(Key) ) mod 256;
  pBuf [I] := Chr (EncVal);
  end;
 finally
  FreeMem (pEnc, Count);
 end;
 // return the number of characters read
 Result := CountRead;
end;

end.

unit EncForm;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls;
type
 TFormEncode = class(TForm)
  Memo1: TMemo;
  Memo2: TMemo;
  OpenDialog1: TOpenDialog;
  SaveDialog1: TSaveDialog;
  Panel1: TPanel;
  BtnLoadPlain: TButton;
  BtnSaveEncoded: TButton;
  BtnLoadEncoded: TButton;
  Splitter1: TSplitter;
  procedure BtnSaveEncodedClick(Sender: TObject);
  procedure BtnLoadEncodedClick(Sender: TObject);
  procedure BtnLoadPlainClick(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
 end;
var
 FormEncode: TFormEncode;
implementation
{$R *.DFM}
uses
 EncodStr;
procedure TFormEncode.BtnSaveEncodedClick(Sender: TObject);
var
 EncStr: TEncodedStream;
begin
 if SaveDialog1.Execute then
 begin
  EncStr := TEncodedStream.Create(
  SaveDialog1.Filename, fmCreate);
  try
  Memo1.Lines.SaveToStream (EncStr);
  finally
  EncStr.Free;
  end;
 end;
end;
procedure TFormEncode.BtnLoadEncodedClick(Sender: TObject);
var
 EncStr: TEncodedStream;
begin
 if OpenDialog1.Execute then
 begin
  EncStr := TEncodedStream.Create(
  OpenDialog1.FileName, fmOpenRead);
  try
  Memo2.Lines.LoadFromStream (EncStr);
  finally
  EncStr.Free;
  end;
 end;
end;
procedure TFormEncode.BtnLoadPlainClick(Sender: TObject);
begin
 if OpenDialog1.Execute then
  Memo1.Lines.LoadFromFile (
  OpenDialog1.FileName);
end;
end.