KennyToNormal
From 40tude Dialog Wiki
Encodes and decodes Kenny language, Rot13, Hex, Mirror Text, Base64, Morse Code, Foenigen and the LF-Language. In short: The swiss knife for 40tude Dialog ;-)
This script is an enhanced version of Guerin's Kenny-Translator. Thomas Barghahn extended it with a mirroring function, Base64 conversion, Hex text, F <-> K (in German called "Foenigen") and the LF-Language (a German children's "secret language"). He also implemented CTRL + A for selecting the whole text.
See the Swiss Knife in action:
If you want to use it independently from Dialog, you can download the standalone Kenny-Translator.
Program Kenny_Mirror_Hex_Rot13_Morse_Base64_Translater;
{ Version 4 Date: 2004/10/15 - 20:37
compile and run with Dialog version 2.0.14.1 (Beta 37)
Check the source code or save your data before use.}
uses
Forms, StdCtrls;
CONST
LetterSeparator = ' ';
WordSeparator = ' ';
VAR
CoderForm : TForm;
CoderMemo : TMemo;
CoderBtQuit : TButton;
Rot13Bt : TButton;
FromKennyBt :TButton;
FromMorseBt : TButton;
IntoKenny : TButton;
IntoMorse : TButton;
MirrorBt : TButton;
RoRrImBT : TButton;
IntoHexBt : TButton;
FromHexBt : TButton;
IntoBase64Bt : TButton;
FromBase64Bt : TButton;
ClearMemoBt : TButton;
ChangeFKBt : TButton;
IntoLFBt : TButton;
FromLFBt : TButton;
Free1Bt : TButton;
Free2Bt : TButton;
CodeMorse : TstringList;
CodeLetter: TstringList;
Index : INTEGER;
CodeLine : String;
EqualPos : INTEGER;
FUNCTION DecodeMorseWords(MorseWord : String) : String;
VAR
LetterSeparatorPos : INTEGER;
MorseChar : string;
BEGIN {DecodeMorseWords}
Result := '';
LetterSeparatorPos := Pos(LetterSeparator, MorseWord);
WHILE LetterSeparatorPos > 0 DO
BEGIN
MorseChar := Copy(MorseWord,1, LetterSeparatorPos-1);
delete(MorseWord,1, LetterSeparatorPos);
IF CodeLetter.IndexOfName(MorseChar) = -1 THEN
Result := Result + MorseChar
ELSE
BEGIN
Result := Result + CodeLetter.Values[MorseChar];
IF CodeLetter.Values[MorseChar] = 'SOS' THEN
Result := Result+' ';
END;
LetterSeparatorPos := Pos(LetterSeparator, MorseWord);
END;
IF MorseWord > '' THEN
IF CodeLetter.IndexOfName(MorseWord) = -1 THEN
Result := Result + MorseWord
ELSE
Result := Result + CodeLetter.Values[MorseWord];
Result := Result +' ';
END; {DecodeMorseWords}
FUNCTION DecodeMorseLine(Line : String) : String;
VAR
WordBuffer : string;
WordSeparatorPos : INTEGER;
Index : INTEGER;
BEGIN
Result := '';
FOR Index := Length(Line) DOWNTO 1 DO
BEGIN
IF (Line[index] < ' ') THEN
Insert(' ', line, index+1);
END;
WordSeparatorPos := POS(WordSeparator, Line);
WHILE WordSeparatorPos > 0 DO
BEGIN
WordBuffer := Copy(Line,1, WordSeparatorPos-1);
delete(Line,1, WordSeparatorPos);
Result := Result + DecodeMorseWords(WordBuffer);
WordSeparatorPos := Pos(WordSeparator, Line);
END;
IF Line > '' THEN
Result := Result + DecodeMorseWords(Line);
END; {DecodeMorseLine}
PROCEDURE NormalizeLineFeed(VAR Source : string);
VAR
LineSeparatorPos : INTEGER;
BEGIN
{normalize line feed (#10, #13#10, #10#13,#13 to #13}
LineSeparatorPos := POS(#10, Source);
WHILE LineSeparatorPos > 0 DO
BEGIN
delete(Source, LineSeparatorPos, 1);
insert(#13, Source, LineSeparatorPos);
LineSeparatorPos := POS(#10, Source);
END;
LineSeparatorPos := POS(#13#13, Source);
WHILE LineSeparatorPos > 0 DO
BEGIN
delete(Source, LineSeparatorPos, 1);
LineSeparatorPos := POS(#13#13, Source);
END;
END;
FUNCTION DecodeMorse(Source : string) :string;
VAR
Line : String;
LineSeparatorPos : INTEGER;
BEGIN
Result := '';
NormalizeLineFeed(Source);
LineSeparatorPos := POS(#13, Source);
WHILE LineSeparatorPos > 0 DO
BEGIN
Line := Copy(Source,1, LineSeparatorPos-1);
Result := Result + DecodeMorseLine(Line);
delete(Source, 1, LineSeparatorPos);
Result := Result +#13#10;
LineSeparatorPos := POS(#13, Source);
END;
IF Source > '' THEN
Result := Result + DecodeMorseLine(Source);
END;
PROCEDURE BitBtMorseToTextClick(Sender: TObject);
VAR
DecodeBuffer : string;
LengthBuffer : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
DecodeBuffer := CoderMemo.SelText;
LengthBuffer := Length(DecodeBuffer);
IF LengthBuffer > 1 THEN
BEGIN
{replace space at the beginning or / and at the end of morsestring by my morse wordseparator}
IF (DecodeBuffer[LengthBuffer] = ' ') AND (DecodeBuffer[LengthBuffer-1] <> '/') THEN
DecodeBuffer := DecodeBuffer +'/ ';
IF (DecodeBuffer[1] = ' ') AND (DecodeBuffer[2] <> '/') THEN
DecodeBuffer := ' /'+ DecodeBuffer;
END;
CoderMemo.SelText := DecodeMorse(DecodeBuffer);
CoderMemo.SetFocus;
END;
FUNCTION CodeTextWord( TextWord : String): STRING;
BEGIN
Result := '';
WHILE TextWord > '' DO
IF TextWord = 'SOS' THEN
BEGIN
Result := Result + CodeMorse.Values['SOS'];
TextWord := '';
END
ELSE
IF CodeMorse.IndexOfName(TextWord[1]) = -1 THEN
{Not a morse code}
BEGIN
IF TextWord[1] >= ' ' THEN
{printable char}
Result := Result + TextWord[1]+' '
ELSE
Result := Result + TextWord[1];
delete(TextWord, 1, 1);
END
ELSE
BEGIN
Result := Result + CodeMorse.Values[TextWord[1]]+' ';
delete(TextWord, 1, 1)
END
END;
FUNCTION CodeTextLine(TextLine : String) : String;
VAR
WordBuffer : STRING;
WordSeparatorPos : INTEGER;
BEGIN
Result := '';
WordSeparatorPos := POS(' ', TextLine) ;
WHILE WordSeparatorPos > 0 DO
BEGIN
IF Pos(' / ', TextLine) = 1 THEN
BEGIN
Result := Result + CodeMorse.Values[' / '];
delete(TextLine, 1, 3);
END
ELSE
BEGIN
WordBuffer := Copy(TextLine, 1, WordSeparatorPos-1);
Result := Result + CodeTextWord(WordBuffer)+' ';
Delete(TextLine, 1 ,WordSeparatorPos);
END;
WordSeparatorPos := POS(' ', TextLine) ;
END;
IF TextLine > '' THEN
Result := Result+ CodeTextWord(TextLine);
END;
FUNCTION CodeToMorse(Source : string) :string;
VAR
LineSeparatorPos : INTEGER;
Line : String;
BEGIN
Result := '';
Source := UpperCase(Source);
{normilize linefeed}
NormalizeLineFeed(Source);
LineSeparatorPos := pos(#13, Source);
WHILE LineSeparatorPos > 0 DO
BEGIN
Line := Copy(Source, 1, LineSeparatorPos-1);
result := result + CodeTextLine(Line)+ #13#10;
delete(Source, 1,LineSeparatorPos);
LineSeparatorPos := pos(#13, Source);
END;
IF Source > '' THEN
result := result + CodeTextLine(Source)+ #13#10;
END;
PROCEDURE BitBtTextToMorseClick(Sender: TObject);
VAR
CodeBuffer : String;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
CodeBuffer := CoderMemo.SelText;
CoderMemo.SelText := CodeToMorse(CodeBuffer);
CoderMemo.SetFocus;
END;
FUNCTION KennyToNormal (Source : string ): string;
BEGIN
CASE Source[1] OF
'm':
CASE Source[2] OF
'm':
CASE Source[3] OF
'm': result := 'a';
'p': result := 'b';
'f': result := 'c';
END; {Source[3]}
'p':
CASE Source[3] OF
'm': result := 'd';
'p': result := 'e';
'f': result := 'f';
END; {Source[3]}
'f':
CASE Source[3] OF
'm': result := 'g';
'p': result := 'h';
'f': result := 'i';
END; {Source[3]}
END;{Source[2]}
'p':
CASE Source[2] OF
'm':
CASE Source[3] OF
'm': result := 'j';
'p': result := 'k';
'f': result := 'l';
END;{Source[3]}
'p':
CASE Source[3] OF
'm': result := 'm';
'p': result := 'n';
'f': result := 'o';
END; {Source[3]}
'f':
CASE Source[3] OF
'm': result := 'p';
'p': result := 'q';
'f': result := 'r';
END; {Source[3]}
END; {Source[2]}
'f':
CASE Source[2] OF
'm':
CASE Source[3] OF
'm': result := 's';
'p': result := 't';
'f': result := 'u';
END;{Source[3]}
'p':
CASE Source[3] OF
'm': result := 'v';
'p': result := 'w';
'f': result := 'x';
END; {Source[3]}
'f':
CASE Source[3] OF
'm': result := 'y';
'p': result := 'z';
END; {Source[3]}
END; {Source[2]}
'M':
CASE Source[2] OF
'm':
CASE Source[3] OF
'm': result := 'A';
'p': result := 'B';
'f': result := 'C';
END; {Source[3]}
'p':
CASE Source[3] OF
'm': result := 'D';
'p': result := 'E';
'f': result := 'F';
END; {Source[3]}
'f':
CASE Source[3] OF
'm': result := 'G';
'p': result := 'H';
'f': result := 'I';
END; {Source[3]}
END; {Source[2]}
'P':
CASE Source[2] OF
'm':
CASE Source[3] OF
'm': result := 'J';
'p': result := 'K';
'f': result := 'L';
END; {Source[3]}
'p':
CASE Source[3] OF
'm': result := 'M';
'p': result := 'N';
'f': result := 'O';
END;{Source[3]}
'f':
CASE Source[3] OF
'm': result := 'P';
'p': result := 'Q';
'f': result := 'R';
END; {Source[3]}
END; {Source[2]}
'F':
CASE Source[2] OF
'm':
CASE Source[3] OF
'm': result := 'S';
'p': result := 'T';
'f': result := 'U';
END;{Source[3]}
'p':
CASE Source[3] OF
'm': result := 'V';
'p': result := 'W';
'f': result := 'X';
END; {Source[3]}
'f':
CASE Source[3] OF
'm': result := 'Y';
'p': result := 'Z';
END; {Source[3]}
END {Source[2]}
END {Source[1]}
END;
PROCEDURE BitBtKennyToNormalClick(Sender: TObject);
VAR
Index : INTEGER;
SelBuffer : String;
TestBuffer : STRING;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
SelBuffer := CoderMemo.SelText;
{IF Kenny was decoded from Morse, only uppercase letter
are in the code when no triplet has the last two letter
uppercase. It allows a multiple coding translation like
rot13 + Kenny+Rot13+Morse and recerse.
It is not possible to restore exactly the initial sentence
but it is readable ;-) }
{Start uppercase translation at the end of the string}
Index := Length(SelBuffer)-2;
WHILE Index > 0 DO
BEGIN
{copy triplet}
TestBuffer := Copy(Selbuffer,Index,3);
{is Triplet a kenny triplet}
IF ((TestBuffer[1] = 'F')
OR (TestBuffer[1] = 'M')
OR (TestBuffer[1] = 'P')
OR (TestBuffer[1] = 'f')
OR (TestBuffer[1] = 'm')
OR (TestBuffer[1] = 'p'))
AND
((TestBuffer[2] = 'F')
OR (TestBuffer[2] = 'M')
OR (TestBuffer[2] = 'P')
OR (TestBuffer[2] = 'f')
OR (TestBuffer[2] = 'm')
OR (TestBuffer[2] = 'p'))
AND
((TestBuffer[3] = 'F')
OR (TestBuffer[3] = 'M')
OR (TestBuffer[3] = 'P')
OR (TestBuffer[3] = 'f')
OR (TestBuffer[3] = 'm')
OR (TestBuffer[3] = 'p'))
THEN
{If last two figures translated into uppercase by morse, do it lower case}
BEGIN
IF (TestBuffer[2] = 'F')
OR (TestBuffer[2] = 'M')
OR (TestBuffer[2] = 'P') THEN
TestBuffer[2] := Chr(Byte(Ord(TestBuffer[2])+32));
IF (TestBuffer[3] = 'F')
OR (TestBuffer[3] = 'M')
OR (TestBuffer[3] = 'P') THEN
TestBuffer[3] := Chr(Byte(Ord(TestBuffer[3])+32));
TestBuffer := KennyToNormal(TestBuffer);
Delete(Selbuffer, Index, 3);
Insert(TestBuffer, Selbuffer, Index);
Index := Index-3;
END
ELSE
Index := index-1
END;
CoderMemo.Seltext := SelBuffer;
CoderMemo.SetFocus;
END;
FUNCTION To_Kennyspeak (source : string) : string;
VAR
Index : integer;
BEGIN
Result :='';
Index := 1;
WHILE Index <= Length(Source) DO
BEGIN
IF (Source[Index] < 'A')
OR ((Source[Index] >'Z') AND (Source[Index]<'a'))
OR (Source[Index] >'z') THEN
Result := Result+Source[Index]
else
CASE Source[Index] OF
'a': result := result+'mmm';
'b': result := result+'mmp';
'c': result := result+'mmf';
'd': result := result+'mpm';
'e': result := result+'mpp';
'f': result := result+'mpf';
'g': result := result+'mfm';
'h': result := result+'mfp';
'i': result := result+'mff';
'j': result := result+'pmm';
'k': result := result+'pmp';
'l': result := result+'pmf';
'm': result := result+'ppm';
'n': result := result+'ppp';
'o': result := result+'ppf';
'p': result := result+'pfm';
'q': result := result+'pfp';
'r': result := result+'pff';
's': result := result+'fmm';
't': result := result+'fmp';
'u': result := result+'fmf';
'v': result := result+'fpm';
'w': result := result+'fpp';
'x': result := result+'fpf';
'y': result := result+'ffm';
'z': result := result+'ffp';
'A': result := result+'Mmm';
'B': result := result+'Mmp';
'C': result := result+'Mmf';
'D': result := result+'Mpm';
'E': result := result+'Mpp';
'F': result := result+'Mpf';
'G': result := result+'Mfm';
'H': result := result+'Mfp';
'I': result := result+'Mff';
'J': result := result+'Pmm';
'K': result := result+'Pmp';
'L': result := result+'Pmf';
'M': result := result+'Ppm';
'N': result := result+'Ppp';
'O': result := result+'Ppf';
'P': result := result+'Pfm';
'Q': result := result+'Pfp';
'R': result := result+'Pff';
'S': result := result+'Fmm';
'T': result := result+'Fmp';
'U': result := result+'Fmf';
'V': result := result+'Fpm';
'W': result := result+'Fpp';
'X': result := result+'Fpf';
'Y': result := result+'Ffm';
'Z': result := result+'Ffp';
END;
Index := Index+1;
END;
END;
PROCEDURE BitBtTextToKennyClick(Sender: TObject);
VAR
CodeBuffer : String;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
CodeBuffer := CoderMemo.SelText;
CoderMemo.Seltext := To_Kennyspeak(CodeBuffer);
CoderMemo.SetFocus;
END;
PROCEDURE BtMirrorClick(Sender: TObject);
VAR
Buffer : String;
MirrorBuffer : String;
Letter : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText;
FOR Letter := Length(Buffer) DOWNTO 1 DO
BEGIN
IF (copy(Buffer, Letter, 1) = #10) AND (copy(Buffer, Letter + 1, 1) <> #13) THEN
BEGIN
WHILE copy(Buffer, Letter, 1) = #10 DO
BEGIN
MirrorBuffer := MirrorBuffer + #13#10;
Letter := Letter - 2;
END;
Letter := Letter + 1;
END
ELSE
MirrorBuffer := MirrorBuffer + COPY(Buffer, Letter, 1);
END;
CoderMemo.SelText := MirrorBuffer;
CoderMemo.SetFocus;
END;
PROCEDURE BtRorrimClick(Sender: TObject);
VAR
Buffer : String;
MirrorBuffer : String;
Letter : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText;
FOR Letter := Length(Buffer) DOWNTO 1 DO
BEGIN
IF (copy(Buffer, Letter, 1) = #10) AND (copy(Buffer, Letter + 1, 1) <> #13) THEN
BEGIN
WHILE copy(Buffer, Letter, 1) = #10 DO
BEGIN
MirrorBuffer := MirrorBuffer + #13#10;
Letter := Letter - 2;
END;
Letter := Letter + 1;
END
ELSE
BEGIN
IF (Letter mod 2) = 0 THEN
MirrorBuffer := MirrorBuffer + UpperCase(COPY(Buffer, Letter, 1))
ELSE
MirrorBuffer := MirrorBuffer + LowerCase(COPY(Buffer, Letter, 1));
END;
END;
CoderMemo.SelText := MirrorBuffer;
CoderMemo.SetFocus;
END;
PROCEDURE BtToHexClick(Sender: TObject);
VAR
Buffer : String;
HexBuffer : String;
Letter : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText;
FOR Letter := 1 TO Length(Buffer) DO
BEGIN
IF (((Letter / 16) - Int(Letter / 16)) <> 0) AND (Letter < Length(Buffer)) THEN
HexBuffer := HexBuffer + IntToHex(ord(Buffer[Letter]),2) + ' '
ELSE
HexBuffer := HexBuffer + IntToHex(ord(Buffer[Letter]),2) + #13#10;
END;
CoderMemo.SelText := HexBuffer;
CoderMemo.SetFocus;
END;
PROCEDURE BtFromHexClick(Sender: TObject);
VAR
Buffer : String;
HexBuffer : String;
Letter : INTEGER;
Temp : String;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
HexBuffer := CoderMemo.SelText;
FOR Letter := 1 TO Length(HexBuffer) DO
BEGIN
TRY
Temp := '$' + HexBuffer[Letter] + HexBuffer[Letter + 1];
Buffer := Buffer + chr(StrToInt(Temp));
Letter := Letter + 2;
IF HexBuffer[Letter] = chr($0D) THEN
Letter := Letter + 1;
EXCEPT
END;
END;
CoderMemo.SelText := Buffer;
CoderMemo.SetFocus;
END;
PROCEDURE BtRot13Click(Sender: TObject);
VAR
Buffer : String;
Letter : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText;
FOR Letter := 1 TO Length(Buffer) DO
BEGIN
IF ((Buffer[letter] >= 'A' )AND (Buffer[letter]<='M'))
OR ((Buffer[letter]>= 'a') AND( Buffer[letter]<= 'm')) THEN
Buffer[letter] := chr(ord(Buffer[letter])+13)
ELSE IF ((Buffer[letter] >='N') AND (Buffer[letter] <='Z'))
OR (( Buffer[letter]>='n') AND (Buffer[letter] <='z')) THEN
Buffer[letter] := chr(ord(Buffer[letter])-13);
END;
CoderMemo.SelText := Buffer;
CoderMemo.SetFocus;
END;
FUNCTION Power(Base, Exponent: Integer): Extended;
VAR
Temp_Result : Integer;
i : Integer;
BEGIN
IF Exponent = 0 THEN
Temp_Result := 1
ELSE IF (Base = 0) AND (Exponent > 0) THEN
Temp_Result := 0
ELSE IF Exponent = 1 THEN
Temp_Result := Base
ELSE IF Exponent = 2 THEN
Temp_Result := Base * Base
ELSE
BEGIN
Temp_Result := Base;
FOR i := 2 TO Exponent DO
Temp_Result := Temp_Result * Base;
END;
Result := Temp_Result;
END;
PROCEDURE Str (X : Extended; VAR S : String);
VAR DotPos : Integer;
BEGIN
S := FloatToStr (X);
DotPos := Pos ('.',S);
IF DotPos > 0 THEN
S := copy (S,1,DotPos - 1);
END;
FUNCTION CharToBin(InChar : Char; ByteGroup : Byte) : String;
VAR
IntValue : Byte;
DecChar : Extended;
TempStr : String;
Temp : String;
i : Integer;
BEGIN
TempStr := '';
IntValue := ord(InChar);
DecChar := IntValue;
FOR i := (ByteGroup - 1) DOWNTO 0 DO
BEGIN
Str(Int(DecChar / Power(2,i)),Temp);
TempStr := TempStr + Temp;
DecChar := DecChar - (Int(DecChar / Power(2,i)) * Power(2,i));
END;
Result := TempStr;
END;
FUNCTION BinToBase (BinString : String) : String;
VAR
i : Integer;
j : Integer;
BinValue : String;
TempStr : String;
BinResult : Extended;
IntResult : Integer;
BEGIN
i := 1;
WHILE i < Length (BinString) DO
BEGIN
BinResult := 0;
BinValue := copy(BinString, i, 6);
FOR j := 0 TO 5 DO
BEGIN
BinResult := BinResult + StrToInt(BinValue[6-j]) * Power(2,j);
END;
i := i + 6;
Str(Int(BinResult),TempStr);
IntResult := StrToInt(TempStr);
IF (IntResult >= 0) AND (IntResult <= 25) THEN
BEGIN
IntResult := IntResult + 65;
Result := Result + chr(IntResult);
END
ELSE IF (IntResult >= 26) AND (IntResult <= 51) THEN
BEGIN
IntResult := IntResult + 71;
Result := Result + chr(IntResult);
END
ELSE If (IntResult >= 52) AND (IntResult <= 61) THEN
BEGIN
IntResult := IntResult - 4;
Result := Result + chr(IntResult);
END
ELSE If (IntResult = 62) THEN
BEGIN
IntResult := IntResult - 19;
Result := Result + chr(IntResult);
END
ELSE If (IntResult = 63) THEN
BEGIN
IntResult := IntResult + 16;
Result := Result + chr(IntResult);
END;
END; {of while}
END;
FUNCTION DecToBin(Digit : Byte; ByteGroup : Byte) : String;
VAR
DecDigit : Extended;
TempStr : String;
Temp : String;
i : Integer;
BEGIN
TempStr := '';
DecDigit := Digit;
FOR i := (ByteGroup - 1) DOWNTO 0 DO
BEGIN
Str(Int(DecDigit / Power(2,i)),Temp);
TempStr := TempStr + Temp;
DecDigit := Int(DecDigit - (Int(DecDigit / Power(2,i)) * Power(2,i)));
END;
Result := TempStr;
END;
FUNCTION BinToAsc (BinString : String; ByteGroup : Byte) : String;
VAR i : Integer;
j : Integer;
TempStr : String;
Temp : String;
BinResult : Extended;
BEGIN
i := 1;
WHILE i < Length(BinString) DO
BEGIN
BinResult := 0;
TempStr := copy (Binstring,i,ByteGroup);
FOR j := ByteGroup DOWNTO 1 DO
BEGIN
TRY
BinResult := BinResult + StrToInt(TempStr[j]) * Power(2,(ByteGroup - j));
EXCEPT
END;
END;
i := i + ByteGroup;
Str(Int(BinResult),Temp);
Result := Result + chr(StrToInt(Temp));
END;
END;
FUNCTION BaseToBin (BaseString : String) : String;
VAR
i : Integer;
BaseResult : Integer;
BEGIN
i := 1;
WHILE i <= Length (BaseString) DO
Begin
IF (BaseString[i] >= 'A') AND (BaseString[i] <= 'Z') THEN
BEGIN
BaseResult := ord(BaseString[i]) - 65;
Result := Result + DecToBin(BaseResult, 6);
END
ELSE IF (BaseString[i] >= 'a') AND (BaseString[i] <= 'z') THEN
BEGIN
BaseResult := ord(BaseString[i]) - 71;
Result := Result + DecToBin(BaseResult, 6);
END
ELSE IF (BaseString[i] >= '0') AND (BaseString[i] <= '9') THEN
BEGIN
BaseResult := ord(BaseString[i]) + 4;
Result := Result + DecToBin(BaseResult, 6);
END
ELSE IF BaseString[i] = '+' THEN
BEGIN
BaseResult := ord(BaseString[i]) + 19;
Result := Result + DecToBin(BaseResult, 6);
END
ELSE IF BaseString[i] = '/' THEN
BEGIN
BaseResult := ord(BaseString[i]) - 16;
Result := Result + DecToBin(BaseResult, 6);
END
ELSE IF BaseString[i] = '=' THEN
BEGIN
BaseResult := 0;
Result := Result + DecToBin(BaseResult, 6);
END;
i := i + 1;
END; {of while}
END;
PROCEDURE IntoBaseBtClick(Sender: TObject);
VAR
Buffer : String;
Letter : INTEGER;
BinBuffer : String;
LenBuffer : Integer;
BaseBuffer : String;
FillValue : Byte;
i : Byte;
Seperator : Integer;
TempString : String;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText;
LenBuffer := Length(Buffer);
BinBuffer := '';
TempString := '';
Seperator := 1;
FillValue := 0;
Letter := 1;
WHILE Letter <= LenBuffer DO
BEGIN
BinBuffer := BinBuffer + CharToBin(Buffer[Letter],8);
Letter := Letter + 1;
END;
WHILE ((LenBuffer / 3) - Int(LenBuffer / 3)) <> 0 DO
BEGIN
LenBuffer := LenBuffer + 1;
FillValue := FillValue + 1;
BinBuffer := BinBuffer + '00000000';
END;
BaseBuffer := BinToBase(BinBuffer);
IF FillValue > 0 THEN
BEGIN
FOR i := 1 TO FillValue DO
BEGIN
BaseBuffer[Length(BaseBuffer) + (1 - i)] := '=';
END;
END;
WHILE Seperator < Length(BaseBuffer) DO
BEGIN
TempString := TempString + copy (BaseBuffer,Seperator,64) + #13#10;
Seperator := Seperator + 64;
END;
CoderMemo.Seltext := TempString;
CoderMemo.SetFocus;
END;
PROCEDURE FromBaseBtClick(Sender: TObject);
VAR
BinBuffer : String;
BaseBuffer : String;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
BaseBuffer := CoderMemo.SelText;
BinBuffer := BaseToBin(BaseBuffer);
CoderMemo.Seltext := BinToAsc(BinBuffer, 8);
CoderMemo.SetFocus;
END;
PROCEDURE ClearBtClick(Sender: TObject);
BEGIN
CoderMemo.Clear;
CoderMemo.SetFocus;
END;
PROCEDURE CoderMemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
BEGIN
IF (Key=65) AND (Shift=[ssCtrl]) THEN
BEGIN
// MessageDlg('Es funktioniert!', mtInformation, [mbOK],0);
CoderMemo.SelectAll;
END;
END;
PROCEDURE ChangeFKBtClick(Sender: TObject);
VAR
Buffer : String;
Letter : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText;
FOR Letter := 1 TO Length(Buffer) DO
BEGIN
CASE Buffer[Letter] OF
'c' : BEGIN
IF Buffer[Letter + 1] = 'k' THEN
Buffer[Letter] := 'f';
END;
'C' : BEGIN
IF Buffer[Letter + 1] = 'K' THEN
Buffer[Letter] := 'F';
END;
'F' : BEGIN
Buffer[Letter] := 'K';
END;
'f' : BEGIN
Buffer[Letter] := 'k';
END;
'K' : BEGIN
Buffer[Letter] := 'F';
END;
'k' : BEGIN
Buffer[Letter] := 'f';
END;
END; {of Case}
END; {FOR}
CoderMemo.SelText := Buffer;
CoderMemo.SetFocus;
END;
PROCEDURE InToLFBtClick(Sender: TObject);
VAR
Buffer : String;
Letter : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText + ' ';
Letter := 1;
WHILE Letter <= Length(Buffer) DO
BEGIN
Case (Buffer[Letter]) of
'a','A' : BEGIN
IF Buffer[Letter + 1] = 'i' THEN
BEGIN
insert ('laifai',Buffer,Letter + 2);
Letter := Letter + 7;
END
ELSE IF Buffer[Letter + 1] = 'u' THEN
BEGIN
insert ('laufau',Buffer,Letter + 2);
Letter := Letter + 7;
END
ELSE
BEGIN
insert ('lafa',Buffer,Letter + 1);
Letter := Letter + 4;
END;
END;
'e','E' : BEGIN
IF Buffer[Letter + 1] = 'i' THEN
BEGIN
insert ('leifei',Buffer,Letter + 2);
Letter := Letter + 7;
END
ELSE IF Buffer[Letter + 1] = 'u' THEN
BEGIN
insert ('leufeu',Buffer,Letter + 2);
Letter := Letter + 7;
END
ELSE IF Buffer[Letter + 1] = 'y' THEN
BEGIN
insert ('leyfey',Buffer,Letter + 2);
Letter := Letter + 7;
END
ELSE
BEGIN
insert ('lefe',Buffer,Letter + 1);
Letter := Letter + 4;
END;
END;
'i','I' : BEGIN
IF Buffer[Letter + 1] = 'e' THEN
BEGIN
insert ('liefie',Buffer,Letter + 2);
Letter := Letter + 7;
END
ELSE
BEGIN
insert ('lifi',Buffer,Letter + 1);
Letter := Letter + 4;
END;
END;
'o','O' : BEGIN
insert ('lofo',Buffer,Letter + 1);
Letter := Letter + 4;
END;
'u','U' : BEGIN
insert ('lufu',Buffer,Letter + 1);
Letter := Letter + 4;
END;
'y','Y' : BEGIN
insert ('lyfy',Buffer,Letter + 1);
Letter := Letter + 4;
END;
'ä','Ä' : BEGIN
IF Buffer[Letter + 1] = 'u' THEN
BEGIN
insert ('läufäu',Buffer,Letter + 2);
Letter := Letter + 7;
END
ELSE
BEGIN
insert ('läfä',Buffer,Letter + 1);
Letter := Letter + 4;
END;
END;
'ö','Ö' : BEGIN
insert ('löfö',Buffer,Letter + 1);
Letter := Letter + 4;
END;
'ü','Ü' : BEGIN
insert ('lüfü',Buffer,Letter + 1);
Letter := Letter + 4;
END;
END; {of Case}
Letter := Letter + 1;
END; {of while}
CoderMemo.SelText := TrimRight(Buffer);
CoderMemo.SetFocus;
END;
PROCEDURE FromLFBtClick(Sender: TObject);
VAR
Buffer : String;
Letter : INTEGER;
BEGIN
IF CoderMemo.SelLength = 0 THEN
CoderMemo.SelectAll;
Buffer := CoderMemo.SelText;
Letter := 1;
WHILE Letter <= Length(Buffer) DO
BEGIN
IF (uppercase(copy (Buffer, Letter, 8)) = 'AULAUFAU')
or (uppercase(copy (Buffer, Letter, 8)) = 'AILAIFAI')
or (uppercase(copy (Buffer, Letter, 8)) = 'EILEIFEI')
or (uppercase(copy (Buffer, Letter, 8)) = 'EULEUFEU')
or (uppercase(copy (Buffer, Letter, 8)) = 'EYLEYFEY')
or (uppercase(copy (Buffer, Letter, 8)) = 'IELIEFIE')
or (copy (Buffer, Letter, 8) = 'Äuläufäu')
or (copy (Buffer, Letter, 8) = 'äuläufäu') THEN
BEGIN
delete (Buffer, Letter + 2, 6);
END
ELSE IF (uppercase(copy (Buffer, Letter, 5)) = 'ALAFA')
or (uppercase(copy (Buffer, Letter, 5)) = 'ELEFE')
or (uppercase(copy (Buffer, Letter, 5)) = 'ILIFI')
or (uppercase(copy (Buffer, Letter, 5)) = 'OLOFO')
or (uppercase(copy (Buffer, Letter, 5)) = 'ULUFU')
or (uppercase(copy (Buffer, Letter, 5)) = 'YLYFY')
or (copy (Buffer, Letter, 5) = 'Äläfä')
or (copy (Buffer, Letter, 5) = 'äläfä')
or (copy (Buffer, Letter, 5) = 'Ölöfö')
or (copy (Buffer, Letter, 5) = 'ölöfö')
or (copy (Buffer, Letter, 5) = 'Ülüfü')
or (copy (Buffer, Letter, 5) = 'ülüfü') THEN
BEGIN
delete (Buffer, Letter + 1, 4);
END
ELSE
Letter := Letter + 1;
END; {of while}
CoderMemo.SelText := Buffer;
CoderMemo.SetFocus;
END;
PROCEDURE BuildCoderContainers;
BEGIN
CoderForm.Width := 800;
CoderForm.Height:= 380;
CoderForm.position := poScreenCenter;
CoderForm.Caption := 'Kenny-Mirror-Hex-Rot13-Morse-Base64-Fönigen-*L*F* Translator :-)';
CoderMemo := tmemo.Create(CoderForm);
CoderMemo.Parent := CoderForm;
// have a large enought width to avoid wrap around lines
// CoderMemo.Width := Application.Mainform.width;
// {freeze if Application not called from the script window : waiting for next version}
CoderMemo.Top := 10;
CoderMemo.Left := 10;
CoderMemo.Height := CoderForm.ClientHeight - 70;
CoderMemo.Width := CoderForm.ClientWidth - 20;
CoderMemo.ScrollBars := ssVertical;
CoderMemo.Font.Name := 'Courier New';
CoderMemo.OnKeyDown := @CoderMemoKeyDown;
CoderBtQuit := TButton.Create(CoderForm);
CoderBtQuit.Parent := CoderForm;
CoderBtQuit.Top := CoderMemo.Top + CoderMemo.Height + CoderBtQuit.height + 6;
CoderBtQuit.Left := (CoderForm.Width - CoderBtQuit.Width ) DIV 2;
CoderBtQuit.Caption := '&Quit';
CoderBtQuit.modalresult := mrOK;
Rot13Bt := TButton.Create(CoderForm);
Rot13Bt.Parent := CoderForm;
Rot13Bt.Top := CoderMemo.Top + CoderMemo.Height + 3;
Rot13Bt.Left := CoderBtQuit.Left;
Rot13Bt.Caption := 'R&ot 13';
Rot13Bt.OnClick := @BtRot13Click;
ClearMemoBt := TButton.Create(CoderForm);
ClearMemoBt.Parent := CoderForm;
ClearMemoBt.Top := CoderBtQuit.Top;
ClearMemoBt.Left := Rot13Bt.Left + 81;
ClearMemoBt.Caption := '&Clear';
ClearMemoBt.OnClick := @ClearBtClick;
ChangeFKBt := TButton.Create(CoderForm);
ChangeFKBt.Parent := CoderForm;
ChangeFKBt.Top := Rot13Bt.Top;
ChangeFKBt.Left := ClearMemoBt.Left;
ChangeFKBt.Caption := 'Fönigen';
ChangeFKBt.OnClick := @ChangeFKBtClick;
MirrorBt := TButton.Create(CoderForm);
MirrorBt.Parent := CoderForm;
MirrorBt.Top := CoderMemo.Top + CoderMemo.Height + 3;
MirrorBt.Left := CoderBtQuit.Left - 81;
MirrorBt.Caption := 'Mi&rror';
MirrorBt.OnClick := @BtMirrorClick;
RoRrImBt := TButton.Create(CoderForm);
RoRrImBt.Parent := CoderForm;
RoRrImBt.Top := CoderBtQuit.Top;
RoRrImBt.Left := CoderBtQuit.Left - 81;
RoRrImBt.Caption := 'RoRr&Im';
RoRrImBt.OnClick := @BtRorrimClick;
IntoMorse := TButton.Create(CoderForm);
IntoMorse.Parent := CoderForm;
IntoMorse.Top := Rot13Bt.Top;
IntoMorse.Left := CoderForm.ClientWidth * 3 DIV 4 - IntoMorse.Width + 4;
IntoMorse.Caption := '&To Morse';
IntoMorse.OnClick := @BitBtTextToMorseClick;
FromMorseBt := TButton.Create(CoderForm);
FromMorseBt.Parent := CoderForm;
FromMorseBt.Top := CoderBtQuit.Top;
FromMorseBt.Left := IntoMorse.Left;
FromMorseBt.Caption := 'From &Morse';
FromMorseBt.OnClick := @BitBtMorseToTextClick;
IntoKenny := TButton.Create(CoderForm);
IntoKenny.Parent := CoderForm;
IntoKenny.Top := Rot13Bt.Top;
IntoKenny.Left := CoderForm.ClientWidth DIV 4 - IntoKenny.Width - 2;
IntoKenny.Caption := 'To &Kenny';
IntoKenny.OnClick := @BitBtTextToKennyClick;
FromKennyBt := TButton.Create(CoderForm);
FromKennyBt.Parent := CoderForm;
FromKennyBt.Top := CoderBtQuit.Top;
FromKennyBt.Left := IntoKenny.Left;
FromKennyBt.Caption := '&From Kenny';
FromKennyBt.OnClick := @BitBtKennyToNormalClick;
IntoHexBt := TButton.Create(CoderForm);
IntoHexBt.Parent := CoderForm;
IntoHexBt.Top := Rot13Bt.Top;
IntoHexBt.Left := CoderForm.ClientWidth DIV 4 + 2;
IntoHexBt.Caption := 'To &Hex';
IntoHexBt.OnClick := @BtToHexClick;
FromHexBt := TButton.Create(CoderForm);
FromHexBt.Parent := CoderForm;
FromHexBt.Top := CoderBtQuit.Top;
FromHexBt.Left := IntoHexBt.Left;
FromHexBt.Caption := 'From He&x';
FromHexBt.OnClick := @BtFromHexClick;
IntoBase64Bt := TButton.Create(CoderForm);
IntoBase64Bt.Parent := CoderForm;
IntoBase64Bt.Top := Rot13Bt.Top;
IntoBase64Bt.Left := CoderForm.ClientWidth * 3 DIV 4 + 8;
IntoBase64Bt.Caption := 'To &Base-64';
IntoBase64Bt.OnClick := @IntoBaseBtClick;
FromBase64Bt := TButton.Create(CoderForm);
FromBase64Bt.Parent := CoderForm;
FromBase64Bt.Top := CoderBtQuit.Top;
FromBase64Bt.Left := IntoBase64Bt.Left;
FromBase64Bt.Caption := 'Fr. B&ase-64';
FromBase64Bt.OnClick := @FromBaseBtClick;
Free1Bt := TButton.Create(CoderForm);
Free1Bt.Parent := CoderForm;
Free1Bt.Top := Rot13Bt.Top;
Free1Bt.Left := CoderForm.ClientWidth * 3 DIV 4 + Free1Bt.Width + 12;
Free1Bt.Caption := 'FREE';
// Free1Bt.OnClick := @??;
Free1Bt.Enabled := False;
Free2Bt := TButton.Create(CoderForm);
Free2Bt.Parent := CoderForm;
Free2Bt.Top := CoderBtQuit.Top;
Free2Bt.Left := Free1Bt.Left;
Free2Bt.Caption := 'FREE';
// Free2Bt.OnClick := @??;
Free2Bt.Enabled := False;
InToLFBt := TButton.Create(CoderForm);
IntoLFBt.Parent := CoderForm;
IntoLFBt.Top := Rot13Bt.Top;
IntoLFBt.Left := CoderForm.ClientWidth DIV 6 - IntoLFBt.Width - 16;
IntoLFBt.Caption := 'To *L*F*';
IntoLFBt.OnClick := @InToLFBtClick;
FromLFBt := TButton.Create(CoderForm);
FromLFBt.Parent := CoderForm;
FromLFBt.Top := CoderBtQuit.Top;
FromLFBt.Left := IntoLFBt.Left;
FromLFBt.Caption := 'From *L*F*';
FromLFBt.OnClick := @FromLFBtClick;
END;
BEGIN
CodeMorse := TstringList.Create;
CodeLetter := TstringList.Create;
try
CodeMorse := TstringList.Create;
CodeLetter := TstringList.Create;
CodeMorse.Add('A=.-'); CodeMorse.Add('B=-...'); CodeMorse.Add('C=-.-.');
CodeMorse.Add('D=-..'); CodeMorse.Add('E=.'); CodeMorse.Add('F=..-.');
CodeMorse.Add('G=--.'); CodeMorse.Add('H=....'); CodeMorse.Add('I=..');
CodeMorse.Add('J=.---'); CodeMorse.Add('K=-.-'); CodeMorse.Add('L=.-..');
CodeMorse.Add('M=--'); CodeMorse.Add('N=-.'); CodeMorse.Add('O=---');
CodeMorse.Add('P=.--.'); CodeMorse.Add('Q=--.-'); CodeMorse.Add('R=.-.');
CodeMorse.Add('S=...'); CodeMorse.Add('T=-'); CodeMorse.Add('U=..-');
CodeMorse.Add('V=...-'); CodeMorse.Add('W=.--'); CodeMorse.Add('X=-..-');
CodeMorse.Add('Y=-.--'); CodeMorse.Add('Z=--..'); CodeMorse.Add('0=-----');
(*
CodeMorse.add('a=.-'); CodeMorse.add('b=-...'); CodeMorse.add('c=-.-.');
CodeMorse.add('d=-..'); CodeMorse.add('e=.'); CodeMorse.add('f=..-.');
CodeMorse.add('g=--.'); CodeMorse.add('h=....'); CodeMorse.add('i=..');
CodeMorse.add('j=.---'); CodeMorse.add('k=-.-'); CodeMorse.add('l=-.-..');
CodeMorse.add('m=--'); CodeMorse.add('n=-.'); CodeMorse.add('o=---');
CodeMorse.add('p=.--.'); CodeMorse.add('q=--.-'); CodeMorse.add('r=.-.');
CodeMorse.add('s=...'); CodeMorse.add('t=-'); CodeMorse.add('u=..-');
CodeMorse.add('v=...-'); CodeMorse.add('w=.--'); CodeMorse.add('x=-..-');
CodeMorse.add('y=-.--'); CodeMorse.add('z=--..'); CodeMorse.add('0=-----');
*)
CodeMorse.Add('1=.----'); CodeMorse.Add('2=..---'); CodeMorse.Add('3=...--');
CodeMorse.Add('4=....-'); CodeMorse.Add('5=.....'); CodeMorse.Add('6=-....');
CodeMorse.Add('7=--...'); CodeMorse.Add('8=---..'); CodeMorse.Add('9=----.');
CodeMorse.Add('.=.-.-.-'); CodeMorse.Add(',=--..--'); CodeMorse.Add('?=..--..');
CodeMorse.Add('-=-....-'); CodeMorse.Add('/=-..-.'); CodeMorse.Add(' = / ');
CodeMorse.Add('ERROR=........'); CodeMorse.Add('+=.-.-.'); CodeMorse.Add('@=...-.-');
CodeMorse.Add('SOS=...---...');
{international morse set}
{å ä à é ö ü " ! ß (S-zet) }
{$IFDEF Nordik}
CodeMorse.Add('Å=.--.-');
{$ELSE}
CodeMorse.Add('À=.--.-');
{$ENDIF}
CodeMorse.Add('Ä=.-.-');
CodeMorse.Add('É=..-..'); CodeMorse.Add('Ö=---.'); CodeMorse.Add('Ü=..--');
CodeMorse.Add('"=.-..-.'); CodeMorse.Add('!=..--.'); CodeMorse.Add('ß=----');
FOR Index := 0 TO CodeMorse.Count-1 DO
BEGIN
CodeLine := CodeMorse.Strings[Index];
EqualPos := Pos('=', CodeLine);
CodeLine := Copy(CodeLine, EqualPos+1, Length(CodeLine)-EqualPos)+'='+Copy(CodeLine,1,EqualPos-1);
CodeLetter.Add(CodeLine);
END;
CodeLetter.Add('/= ');
Ado('Copy');
CoderForm := tform.Create(nil);
try
BuildCoderContainers;
Codermemo.PasteFromCLipboard;
CoderForm.ShowModal;
finally
CoderForm.Free;
end;
finally
CodeMorse.Free;
CodeLetter.Free;
end;
END.
René Fischer