Простые алгоритмы шифрования текста
01.01.2007
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;
В параметрах функции передайте саму строку, которую хотите зашифровать и код шифрования. Зашифрованная строка будет результатом функции. Для декодирования примените к закодированной строке вызов функции с тем же самым кодом.
Взято из https://forum.sources.ru
{ **** UBPFD *********** by kladovka.net.ru ****
>> Шифрование строки
Предназначена для простого шифрование строк и паролей, ключ 96 бит, шифрование
симметричное.
Зависимости: UBPFD.decrypt
Автор: Anatoly Podgoretsky, anatoly@podgoretsky.com, 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, vidsnap@mail.ru, 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, robinzon2000@pochtamt.ru, Киев
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;https://delphiworld.narod.ru/
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;
DelphiWorld 6.0
Метод основан на сложении текста и пароля: "мой текст" + "пароль" = ('м'+'п')('о'+'а')... То есть каждый символ получают путем сложения соответствующих символов текста и пароля. Под "сложением символов" я подразумеваю сложение номеров этих символов. Обычно пароль длиннее текста, поэтому его размножают: "парольпар".
Чтобы расшифровать текст, нужно проделать обратную операцию, то есть из текста вычесть пароль.
При нажатии на Button1 эта программа шифрует текст из Memo1 при помощи пароля из Edit1. Результат сохраняется в строку s. Для наглядности зашифрованный текст также помещается в Memo1. При нажатии на Button2 текст из s расшифровывается. Если Вы нажмете Button1 два раза подряд, получится зашифрованный зашифрованный текст. Вернуть начальный текст можно будет двумя нажатиями на Button2. Но, поскольку в результате шифрования в строке могут появится
https://delphiworld.narod.ru/
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;
DelphiWorld 6.0
{$I-,R-}https://delphiworld.narod.ru/
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.
DelphiWorld 6.0
{
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;
Взято с сайта: https://www.swissdelphicenter.ch
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Шифрование строки
Предназначена для простого шифрование строк и паролей, ключ 96 бит, шифрование
симметричное.
Зависимости: UBPFD.decrypt
Автор: Anatoly Podgoretsky, anatoly@podgoretsky.com, 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, anatoly@podgoretsky.com, 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) + '>';
consthttps://delphiworld.narod.ru/
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;
DelphiWorld 6.0
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;https://delphiworld.narod.ru/
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.
DelphiWorld 6.0