{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
Please note if you are viewing this Delphi unit as a web page all you have to
do to turn it into a Delphi unit is save it with a ".pas" extension. The
html in the unit should not affect its performance.
}
unit ads_PWVault;
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_PWVault.pas This unit contains the following routines.
TEncrypt_ads.ContainsEncryptedChars TEncrypt_ads.Decrypt TEncrypt_ads.DecryptOne TEncrypt_ads.Encrypt TEncrypt_ads.EncryptedAddPositionToEachChar TEncrypt_ads.EncryptedChars TEncrypt_ads.EncryptedSubtractPositionFromEachChar TEncrypt_ads.EncryptOne TEncrypt_ads.GetPositionValue TEncrypt_ads.MakeEncryptedCharMasterList TEncrypt_ads.MakeSeed TEncrypt_ads.PosLast TEncrypt_ads.SetRetainFormatData TEncrypt_ads.ShiftFromEncryptedBasic TEncrypt_ads.ShiftToEncryptedBasic TEncrypt_ads.Synchronize TEncrypt_ads.UnencryptedChars TPW_ads.Clear TPW_ads.GetPassword TPW_ads.init TPW_ads.quiesce TPW_ads.SetKey TPW_ads.SetPWControl TPW_ads.SetTag TPWLockBox_ads.BalanceThread TPWLockBox_ads.PWEnd TPWLockBox_ads.PWInit TPWLockBox_ads.PWMessage TPWLockBox_ads.SetPWControl TPWLockBox_ads.TuneThread
*)
interface
(*
Description: ads_PWVault
This unit contains the TPW_ads class which
encapsulates routines for protecting a password
when entered into a password control and
the storing of the password in encrypted form
should it be needed later for reconnecting
to a database.
Directions:
1. In the formCreate of the password dialog add
code similar to the following;
procedure TForm1.FormCreate(Sender: TObject);
begin
PW_ads := TPW_ads.Create();
PW_ads.PWControl := Form1.Edit1;
end;
2. In the formDestroy of the password dialog add
code similar to the following;
procedure TForm1.FormDestroy(Sender: TObject);
begin
PW_ads.Free;
end;
3. In the formShow of the password dialog add
code similar to the following;
procedure TForm1.FormShow(Sender: TObject);
begin
PW_ads.init;
end;
4. In the formClose of the password dialog add
code similar to the following;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
PW_ads.quiesce;
end;
5. In the Protected section of the password dialog add
code similar to the following;
protected
PW_ads : TPW_ads;
6. In the Interface section Uses clause of the password
dialog add;
ads_PWVault
7. Now the Login Dialog is safe from capturing keystrokes
and capturing the password. However, if a connection is
dropped the encrypted password can be used to reestablish
a connection.
*)
Uses Controls;
Type
TPW_ads = class
private
FPWControl : TWinControl;
FLockBox : TObject;
FTag : Integer;
FKey: Integer;
procedure SetPWControl(const Value: TWinControl);
Function GetPassword: String;
procedure SetTag(const Value: Integer);
procedure SetKey(const Value: Integer);
Public
constructor Create;
Destructor Destroy; Override;
procedure Init;
procedure Quiesce;
procedure Clear;
property Key : Integer read FKey write SetKey;
property Tag : Integer read FTag write SetTag;
published
property Password : String read GetPassword;
property PWControl : TWinControl read FPWControl write SetPWControl;
end;
implementation
Uses Classes,SysUtils,Windows,Forms,Messages,StdCtrls,Dialogs;
type
TEncrypt_ads = class
private
FEncryptedDataTagEnd : Integer;
FEncryptedDataTagStart : Integer;
FEncryptedLength : Integer;
FEncryptedMaxAsciiValue : Integer;
FEncryptedMinAsciiValue : Integer;
FEncryptedPacketTagEnd : Integer;
FEncryptedPacketTagStart : Integer;
FMasterCharList : String;
FSeed01 : String;
FSeed02 : String;
FUnencryptedMaxAsciiValue : Integer;
FUnEncryptedMaxLength : Integer;
FUnencryptedMinAsciiValue : Integer;
inDataAfterSize : Integer;
inDataBeforeSize : Integer;
inDataMiddleSize : Integer;
FRetainFormatData: Boolean;
Function ContainsEncryptedChars(Value: String): Boolean;
Function DecryptOne(Value : String): String;
Function EncryptedAddPositionToEachChar(Seed: String;Value: String): String;
Function EncryptedChars(inLen: Integer): String;
Function EncryptedSubtractPositionFromEachChar(Seed: String;Value: String): String;
Function EncryptOne(Value : String): String;
Function GetPositionValue(Seed: String;Position: Integer): Integer;
Function PosLast(SubString,Source: String): Integer;
Function ShiftFromEncryptedBasic(Value: String): String;
Function ShiftToEncryptedBasic(Value: String): String;
Function Synchronize(Value,Max,Min: Integer): Integer;
procedure SetRetainFormatData(const Value: Boolean);
//Property EncryptedDataTagEnd : Integer read FEncryptedDataTagEnd;
//Property EncryptedDataTagStart : Integer read FEncryptedDataTagStart;
//Property EncryptedLength : Integer read FEncryptedLength;
//Property EncryptedMaxAsciiValue : Integer read FEncryptedMaxAsciiValue;
//Property EncryptedMinAsciiValue : Integer read FEncryptedMinAsciiValue;
//Property EncryptedPacketTagEnd : Integer read FEncryptedPacketTagEnd;
//Property EncryptedPacketTagStart : Integer read FEncryptedPacketTagStart;
//Property UnencryptedMaxAsciiValue : Integer read FUnencryptedMaxAsciiValue;
//Property UnEncryptedMaxLength : Integer read FUnEncryptedMaxLength;
//Property UnencryptedMinAsciiValue : Integer read FUnencryptedMinAsciiValue;
Protected
procedure MakeEncryptedCharMasterList(FileName: String;StrName: String);
procedure MakeSeed(FileName: String;StrName: String);
Function UnencryptedChars(inLen: Integer): String;
Public
constructor Create(Owner: TObject);
destructor Destroy; Override;
Function Encrypt(Value : String): String;
Function Decrypt(Value : String): String;
Property RetainFormatData : Boolean read FRetainFormatData write SetRetainFormatData;
end;
constructor TEncrypt_ads.Create(Owner: TObject);
begin
inherited Create; // Initialize inherited parts
If Self.ClassParent <> TObject Then
Raise Exception.Create('Decendants of TEncrypt_ads are invalid!');
FRetainFormatData := True;
FUnencryptedMinAsciiValue := 9;
FUnencryptedMaxAsciiValue := 126;
FEncryptedPacketTagStart := FUnencryptedMaxAsciiValue + 1;
FEncryptedPacketTagEnd := FEncryptedPacketTagStart + 1;
FEncryptedDataTagStart := FEncryptedPacketTagEnd + 1;
FEncryptedDataTagEnd := FEncryptedDataTagStart + 1;
FEncryptedMinAsciiValue := FEncryptedDataTagEnd + 1;
FEncryptedMaxAsciiValue := 254;
FEncryptedLength := 128;
FUnEncryptedMaxLength := 64;
inDataBeforeSize := (FEncryptedLength-FUnEncryptedMaxLength-4) div 2;
inDataMiddleSize := FUnEncryptedMaxLength;
inDataAfterSize := FEncryptedLength-
inDataMiddleSize-
inDataBeforeSize-
4;
FSeed01 :=
#34+ // 1
#110+ // 2
#152+ // 3
#139+ // 4
#127+ // 5
#129+ // 6
#116+ // 7
#33+ // 8
#148+ // 9
#135+ // 10
#120+ // 11
#123+ // 12
#108+ // 13
#97+ // 14
#144+ // 15
#130+ // 16
#114+ // 17
#117+ // 18
#102+ // 19
#90+ // 20
#93+ // 21
#81+ // 22
#70+ // 23
#113+ // 24
#99+ // 25
#86+ // 26
#88+ // 27
#76+ // 28
#65+ // 29
#111+ // 30
#96+ // 31
#82+ // 32
#84+ // 33
#72+ // 34
#60+ // 35
#107+ // 36
#94+ // 37
#44+ // 38
#80+ // 39
#68+ // 40
#57+ // 41
#61+ // 42
#50+ // 43
#41+ // 44
#83+ // 45
#67+ // 46
#55+ // 47
#58+ // 48
#47+ // 49
#38+ // 50
#85+ // 51
#69+ // 52
#53+ // 53
#59+ // 54
#45+ // 55
#35+ // 56
#39+ // 57
#156+ // 58
#146+ // 59
#137+ // 60
#46+ // 61
#159+ // 62
#150+ // 63
#151+ // 64
#140+ // 65
#128+ // 66
#40+ // 67
#155+ // 68
#157+ // 69
#143+ // 70
#132+ // 71
#51+ // 72
#36+ // 73
#149+ // 74
#153+ // 75
#136+ // 76
#124+ // 77
#125+ // 78
#115+ // 79
#103+ // 80
#145+ // 81
#131+ // 82
#118+ // 83
#119+ // 84
#104+ // 85
#92+ // 86
#141+ // 87
#122+ // 88
#105+ // 89
#109+ // 90
#95+ // 91
#79+ // 92
#87+ // 93
#74+ // 94
#66+ // 95
#106+ // 96
#91+ // 97
#77+ // 98
#78+ // 99
#71+ //100
#62+ //101
#112+ //102
#98+ //103
#73+ //104
#75+ //105
#56+ //106
#52+ //107
#126+ //108
#100+ //109
#64+ //110
#89+ //111
#54+ //112
#48+ //113
#42+ //114
#43+ //115
#37+ //116
#158+ //117
#101+ //118
#63+ //119
#49+ //120
#121+ //121
#32+ //122
#154+ //123
#134+ //124
#133+ //125
#138+ //126
#142+ //127
#147; //128
FSeed02 :=
#156+ // 1
#143+ // 2
#146+ // 3
#132+ // 4
#119+ // 5
#37+ // 6
#152+ // 7
#137+ // 8
#140+ // 9
#126+ // 10
#112+ // 11
#115+ // 12
#102+ // 13
#91+ // 14
#135+ // 15
#121+ // 16
#107+ // 17
#110+ // 18
#96+ // 19
#84+ // 20
#131+ // 21
#117+ // 22
#101+ // 23
#104+ // 24
#90+ // 25
#78+ // 26
#128+ // 27
#111+ // 28
#60+ // 29
#99+ // 30
#86+ // 31
#74+ // 32
#76+ // 33
#66+ // 34
#55+ // 35
#97+ // 36
#83+ // 37
#70+ // 38
#73+ // 39
#62+ // 40
#51+ // 41
#43+ // 42
#82+ // 43
#69+ // 44
#57+ // 45
#61+ // 46
#48+ // 47
#39+ // 48
#42+ // 49
#32+ // 50
#75+ // 51
#63+ // 52
#49+ // 53
#52+ // 54
#40+ // 55
#158+ // 56
#148+ // 57
#59+ // 58
#46+ // 59
#34+ // 60
#38+ // 61
#154+ // 62
#144+ // 63
#64+ // 64
#45+ // 65
#124+ // 66
#33+ // 67
#151+ // 68
#139+ // 69
#141+ // 70
#129+ // 71
#118+ // 72
#159+ // 73
#145+ // 74
#130+ // 75
#134+ // 76
#120+ // 77
#106+ // 78
#153+ // 79
#138+ // 80
#122+ // 81
#123+ // 82
#108+ // 83
#95+ // 84
#98+ // 85
#89+ // 86
#80+ // 87
#116+ // 88
#105+ // 89
#92+ // 90
#94+ // 91
#81+ // 92
#71+ // 93
#125+ // 94
#103+ // 95
#87+ // 96
#88+ // 97
#77+ // 98
#65+ // 99
#127+ //100
#100+ //101
#50+ //102
#85+ //103
#68+ //104
#56+ //105
#67+ //106
#53+ //107
#44+ //108
#109+ //109
#79+ //110
#58+ //111
#47+ //112
#54+ //113
#36+ //114
#35+ //115
#114+ //116
#113+ //117
#72+ //118
#93+ //119
#41+ //120
#157+ //121
#133+ //122
#155+ //123
#150+ //124
#136+ //125
#142+ //126
#149+ //127
#147; //128
FMasterCharList :=
#235+ //131
#222+ //132
#225+ //133
#212+ //134
#200+ //135
#244+ //136
#230+ //137
#216+ //138
#219+ //139
#205+ //140
#193+ //141
#240+ //142
#226+ //143
#210+ //144
#213+ //145
#198+ //146
#186+ //147
#189+ //148
#177+ //149
#166+ //150
#209+ //151
#195+ //152
#182+ //153
#185+ //154
#172+ //155
#161+ //156
#207+ //157
#192+ //158
#178+ //159
#181+ //160
#168+ //161
#157+ //162
#204+ //163
#149+ //164
#140+ //165
#132+ //166
#167+ //167
#155+ //168
#146+ //169
#148+ //170
#138+ //171
#253+ //172
#169+ //173
#154+ //174
#144+ //175
#147+ //176
#135+ //177
#250+ //178
#165+ //179
#156+ //180
#142+ //181
#145+ //182
#133+ //183
#247+ //184
#249+ //185
#238+ //186
#229+ //187
#141+ //188
#254+ //189
#242+ //190
#243+ //191
#232+ //192
#220+ //193
#137+ //194
#248+ //195
#234+ //196
#237+ //197
#223+ //198
#211+ //199
#215+ //200
#201+ //201
#190+ //202
#233+ //203
#218+ //204
#202+ //205
#206+ //206
#194+ //207
#180+ //208
#228+ //209
#214+ //210
#196+ //211
#197+ //212
#184+ //213
#174+ //214
#227+ //215
#208+ //216
#187+ //217
#188+ //218
#175+ //219
#164+ //220
#171+ //221
#160+ //222
#153+ //223
#199+ //224
#176+ //225
#163+ //226
#170+ //227
#158+ //228
#150+ //229
#203+ //230
#183+ //231
#162+ //232
#173+ //233
#152+ //234
#139+ //235
#224+ //236
#136+ //237
#131+ //238
#191+ //239
#159+ //240
#151+ //241
#134+ //242
#179+ //243
#252+ //244
#246+ //245
#221+ //246
#217+ //247
#143+ //248
#231+ //249
#251+ //250
#245+ //251
#236+ //252
#239+ //253
#241; //254
end;
//Unit Description UnitIndex Master Indexfunction TEncrypt_ads.DecryptOne(Value: String): String; Var sgResult : String; inPos : Integer; begin Result := Value; If Not ContainsEncryptedChars(Value) Then Exit; If Length(Value) = 0 Then Exit; sgResult := Value; inPos := Pos(Chr(FEncryptedPacketTagStart),sgResult); If inPos = 0 Then Exit; sgResult := Copy(sgResult,inPos,Length(sgResult)-inPos+1); inPos := Pos(Chr(FEncryptedPacketTagEnd),sgResult); If inPos = 0 Then Exit; sgResult := Copy(sgResult,1,inPos); sgResult := EncryptedSubtractPositionFromEachChar(FSeed02,sgResult); inPos := Pos(Chr(FEncryptedDataTagStart),sgResult); If inPos = 0 Then Exit; sgResult := Copy(sgResult,inPos+1,Length(sgResult)-inPos); inPos := PosLast(Chr(FEncryptedDataTagEnd),sgResult); If inPos = 0 Then Exit; sgResult := Copy(sgResult,1,inPos-1); sgResult := EncryptedSubtractPositionFromEachChar(FSeed01,sgResult); sgResult := ShiftFromEncryptedBasic(sgResult); Result := sgResult; end; destructor TEncrypt_ads.Destroy; begin //put code after this inherited destroy; end; //Unit Description UnitIndex Master Index
function TEncrypt_ads.EncryptOne(Value: String): String;
Var
sgEncrypted : String;
flRand : Extended;
sgJiberish : String;
sgResult : String;
begin
Result := '';
If ContainsEncryptedChars(Value) Then Exit;
If Length(Value) = 0 Then Exit;
If Length(Value) > FUnEncryptedMaxLength Then Exit;
Randomize;
sgEncrypted := ShiftToEncryptedBasic(Value);
sgEncrypted := EncryptedAddPositionToEachChar(FSeed01,sgEncrypted);
inDataMiddleSize := Length(sgEncrypted)+2;
flRand := Int(Random(FEncryptedLength-inDataMiddleSize-2)+1);
inDataBeforeSize := StrToInt(FormatFloat('#',flRand));
inDataAfterSize := FEncryptedLength-inDataMiddleSize-inDataBeforeSize-2;
sgJiberish := EncryptedChars(inDataBeforeSize+inDataAfterSize);
sgResult := Chr(FEncryptedPacketTagStart) +
Copy(sgJiberish,1,inDataBeforeSize) +
Chr(FEncryptedDataTagStart) +
sgEncrypted +
Chr(FEncryptedDataTagEnd) +
Copy(sgJiberish,inDataBeforeSize+1,inDataAfterSize)+
Chr(FEncryptedPacketTagEnd);
sgResult := EncryptedAddPositionToEachChar(FSeed02,sgResult);
Result := sgResult;
end;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.Synchronize(Value,Max,Min: Integer): Integer;
Var
inBase : Integer;
inMod : Integer;
begin
Result := Value;
If (Value >= Min) And (Value <= Max) Then Exit;
inBase := Max-Min+1;
If inBase = 0 Then Exit;
If Value < Min Then
Begin
inMod := ((Min-Value) mod inBase);
If inMod = 0 Then
Begin
Result := Min;
End
Else
Begin
Result := Max-((Min-Value) mod inBase)+1;
End;
End
Else
Begin
inMod := ((Value-Max) mod inBase);
If inMod = 0 Then
Begin
Result := Max;
End
Else
Begin
Result := Min+((Value-Max) mod inBase)-1;
End;
End;
end;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.ContainsEncryptedChars(Value: String): Boolean;
Var
inCounter : Integer;
inLen : Integer;
sgChar : String;
pcChar : PChar;
chChar : Char;
inOrd : Integer;
Begin
Result := False;
inLen := Length(Value);
If inLen = 0 Then Exit;
For inCounter := 1 To inLen Do
Begin
sgChar := Copy(Value,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inOrd := Ord(chChar);
If
(inOrd >= FEncryptedPacketTagStart)
And
(inOrd <= FEncryptedMaxAsciiValue)
Then
Begin
Result := True;
Break;
End;
End;
End;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.EncryptedAddPositionToEachChar(Seed: String;Value: String): String;
Var
inCounter : Integer;
inLen : Integer;
sgChar : String;
pcChar : PChar;
chChar : Char;
inOrd : Integer;
sgNew : String;
inCharUsed : Integer;
Begin
Result := Value;
inLen := Length(Value);
sgNew := '';
inCharUsed := 1;
If inLen = 0 Then Exit;
For inCounter := 1 To inLen Do
Begin
sgChar := Copy(Value,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inOrd := Ord(chChar);
If
(inOrd >= FEncryptedDataTagStart)
And
(inOrd <= FEncryptedMaxAsciiValue)
Then
Begin
inOrd := inOrd + GetPositionValue(Seed,inCharUsed);
inOrd := Synchronize(inOrd,FEncryptedMaxAsciiValue,FEncryptedDataTagStart);
sgNew := sgNew + Chr(inOrd);
inc(inCharUsed);
End
Else
Begin
If
(inOrd = FEncryptedPacketTagStart)
Or
(inOrd = FEncryptedPacketTagEnd)
Then
Begin
sgNew := sgNew + Chr(inOrd);
inc(inCharUsed);
End;
End;
End;
Result := sgNew;
End;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.EncryptedSubtractPositionFromEachChar(Seed: String;Value: String): String;
Var
inCounter : Integer;
inLen : Integer;
sgChar : String;
pcChar : PChar;
chChar : Char;
inOrd : Integer;
sgNew : String;
inCharUsed : Integer;
Begin
Result := Value;
inLen := Length(Value);
sgNew := '';
inCharUsed := 1;
If inLen = 0 Then Exit;
For inCounter := 1 To inLen Do
Begin
sgChar := Copy(Value,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inOrd := Ord(chChar);
If
(inOrd >= FEncryptedDataTagStart)
And
(inOrd <= FEncryptedMaxAsciiValue)
Then
Begin
inOrd := inOrd - GetPositionValue(Seed,inCharUsed);
inOrd := Synchronize(inOrd,FEncryptedMaxAsciiValue,FEncryptedDataTagStart);
sgNew := sgNew + Chr(inOrd);
inc(inCharUsed);
End
Else
Begin
If
(inOrd = FEncryptedPacketTagStart)
Or
(inOrd = FEncryptedPacketTagEnd)
Then
Begin
sgNew := sgNew + Chr(inOrd);
inc(inCharUsed);
End;
End;
End;
Result := sgNew;
End;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.ShiftToEncryptedBasic(Value: String): String;
Var
inCounter : Integer;
inLen : Integer;
sgChar : String;
pcChar : PChar;
chChar : Char;
inOrd : Integer;
sgNew : String;
inShift : Integer;
Begin
Result := Value;
inLen := Length(Value);
sgNew := '';
If inLen = 0 Then Exit;
inShift := FEncryptedMinAsciiValue - FUnencryptedMinAsciiValue;
For inCounter := 1 To inLen Do
Begin
sgChar := Copy(Value,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inOrd := Ord(chChar);
If
(inOrd >= FUnencryptedMinAsciiValue)
And
(inOrd <= FUnencryptedMaxAsciiValue)
Then
Begin
inOrd := inOrd + inShift;
sgNew := sgNew + Chr(inOrd);
End;
End;
Result := sgNew;
End;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.ShiftFromEncryptedBasic(Value: String): String;
Var
inCounter : Integer;
inLen : Integer;
sgChar : String;
pcChar : PChar;
chChar : Char;
inOrd : Integer;
sgNew : String;
inShift : Integer;
Begin
Result := Value;
inLen := Length(Value);
sgNew := '';
If inLen = 0 Then Exit;
inShift := FEncryptedMinAsciiValue - FUnencryptedMinAsciiValue;
For inCounter := 1 To inLen Do
Begin
sgChar := Copy(Value,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inOrd := Ord(chChar);
If
(inOrd >= FEncryptedDataTagStart)
And
(inOrd <= FEncryptedMaxAsciiValue)
Then
Begin
inOrd := inOrd - inShift;
sgNew := sgNew + Chr(inOrd);
End;
End;
Result := sgNew;
End;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.Encrypt(Value : String): String;
Var
sgValue : String;
sgTemp : String;
inCut : Integer;
inLen : Integer;
Begin
Result := Value;
sgValue := Value;
If ContainsEncryptedChars(sgValue) Then Exit;
Result := '';
inLen := Length(sgValue);
If inLen = 0 Then Exit;
While inLen > 0 Do
Begin
If inLen < FUnEncryptedMaxLength Then
Begin
inCut := inLen;
End
Else
Begin
inCut := FUnEncryptedMaxLength;
End;
sgTemp := Copy(sgValue,1,inCut);
sgValue := Copy(sgValue,inCut+1,inLen-inCut);
inLen := inLen - inCut;
sgTemp := EncryptOne(sgTemp);
Result := Result + sgTemp;
End;
End;
//Unit Description UnitIndex Master Index
Function TEncrypt_ads.Decrypt(Value : String): String;
Var
sgValue : String;
sgTemp : String;
inPos : Integer;
Begin
Result := Value;
sgValue := Value;
If Not ContainsEncryptedChars(sgValue) Then Exit;
Result := '';
While True Do
Begin
inPos := Pos(Chr(FEncryptedPacketTagStart),sgValue);
If inPos < 1 Then Break;
sgValue := Copy(sgValue,inPos,Length(sgValue)-inPos+1);
inPos := Pos(Chr(FEncryptedPacketTagEnd),sgValue);
If inPos < 1 Then Break;
sgTemp := Copy(sgValue,1,inPos);
sgValue := Copy(sgValue,inPos+1,Length(sgValue)-inPos);
Result := Result + DecryptOne(sgTemp);
End;
End;
//Unit Description UnitIndex Master Index
procedure TEncrypt_ads.MakeSeed(FileName: String;StrName: String);
Var
chChar : Char;
flRand : Extended;
inCounter : Integer;
inOrd : Integer;
inPos : Integer;
lst : TStringList;
pcChar : PChar;
sgChar : String;
sgMaster : String;
sgNew : String;
sgPlus : String;
sgSpace : String;
sgSpace2 : String;
sgTemp : String;
Begin
sgMaster := '';
sgNew := '';
For inCounter := 1 To FEncryptedLength Do
Begin
sgMaster := sgMaster + Chr(32+inCounter-1);
End;
For inCounter := 1 To FEncryptedLength Do
Begin
Sleep(200);
Randomize;
flRand := Int(Random(Length(sgMaster))+1);
inOrd := StrToInt(FormatFloat('#',flRand));
sgChar := Copy(sgMaster,inOrd,1);
sgNew := sgNew + sgChar;
inPos := Pos(sgChar,sgMaster);
sgMaster := Copy(sgMaster,1,inPos-1)+Copy(sgMaster,inPos+1,Length(sgMaster)-inPos);
End;
If sgMaster <> '' Then sgNew := sgNew + sgMaster;
lst := TStringList.Create();
Try
lst.Clear;
lst.Add(' '+StrName+' :=');
For inCounter := 1 To FEncryptedLength Do
Begin
sgChar := Copy(sgNew,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inOrd := Ord(chChar);
If inCounter < 10 Then
sgSpace2 := ' '
Else
If inCounter < 100 Then
sgSpace2 := ' '
Else
sgSpace2 := '';
If inOrd < 100 Then sgSpace := ' ' Else sgSpace := '';
If inCounter = FEncryptedLength Then sgPlus := ';' Else sgPlus := '+';
sgTemp :=
' '+
sgSpace+
'#'+
IntToStr(inOrd)+
sgPlus+
' //'+
sgSpace2+
IntToStr(inCounter);
lst.Add(sgTemp);
End;
lst.SaveToFile(FileName);
Finally
lst.Free;
End;
End;
//Unit Description UnitIndex Master Index
procedure TEncrypt_ads.MakeEncryptedCharMasterList(FileName: String;StrName: String);
Var
chChar : Char;
flRand : Extended;
inCounter : Integer;
inOrd : Integer;
inPos : Integer;
inLen : Integer;
lst : TStringList;
pcChar : PChar;
sgChar : String;
sgMaster : String;
sgNew : String;
sgPlus : String;
sgSpace : String;
sgSpace2 : String;
sgTemp : String;
Begin
sgMaster := '';
sgNew := '';
For inCounter := FEncryptedMinAsciiValue To FEncryptedMaxAsciiValue Do
Begin
sgMaster := sgMaster + Chr(inCounter);
End;
For inCounter := FEncryptedMinAsciiValue To FEncryptedMaxAsciiValue Do
Begin
Sleep(200);
Randomize;
flRand := Int(Random(Length(sgMaster))+1);
inOrd := StrToInt(FormatFloat('#',flRand));
sgChar := Copy(sgMaster,inOrd,1);
sgNew := sgNew + sgChar;
inPos := Pos(sgChar,sgMaster);
sgMaster := Copy(sgMaster,1,inPos-1)+Copy(sgMaster,inPos+1,Length(sgMaster)-inPos);
End;
If sgMaster <> '' Then sgNew := sgNew + sgMaster;
lst := TStringList.Create();
Try
lst.Clear;
lst.Add(' '+StrName+' :=');
sgSpace := '';
sgSpace2 := '';
inLen := Length(sgNew);
For inCounter := 1 To inLen Do
Begin
sgChar := Copy(sgNew,inCounter,1);
pcChar := PChar(sgChar);
chChar := pcChar[0];
inOrd := Ord(chChar);
If inCounter = inLen Then sgPlus := ';' Else sgPlus := '+';
sgTemp :=
' '+
sgSpace+
'#'+
IntToStr(inOrd)+
sgPlus+
' //'+
sgSpace2+
IntToStr(FEncryptedMinAsciiValue+inCounter-1);
lst.Add(sgTemp);
End;
lst.SaveToFile(FileName);
Finally
lst.Free;
End;
End;
//Unit Description UnitIndex Master IndexFunction TEncrypt_ads.GetPositionValue(Seed: String;Position: Integer): Integer; Var chChar : Char; inOrd : Integer; pcChar : PChar; sgChar : String; Begin sgChar := Copy(Seed,Position,1); pcChar := PChar(sgChar); chChar := pcChar[0]; inOrd := Ord(chChar); Result := inOrd; End; //Unit Description UnitIndex Master Index
Function TEncrypt_ads.EncryptedChars(inLen: Integer): String;
Var
flRand : Extended;
inCounter : Integer;
inOrd : Integer;
inPos : Integer;
sgChar : String;
sgMaster : String;
sgNew : String;
Begin
Result := '';
sgMaster := FMasterCharList;
For inCounter := 1 To inLen Do
Begin
Randomize;
flRand := Int(Random(Length(sgMaster))+1);
inOrd := StrToInt(FormatFloat('#',flRand));
sgChar := Copy(sgMaster,inOrd,1);
sgNew := sgNew + sgChar;
inPos := Pos(sgChar,sgMaster);
sgMaster := Copy(sgMaster,1,inPos-1)+Copy(sgMaster,inPos+1,Length(sgMaster)-inPos);
If (inCounter < inLen) And (sgMaster = '') Then sgMaster := FMasterCharList;
End;
Result := sgNew;
End;
//Unit Description UnitIndex Master Indexfunction TEncrypt_ads.PosLast(SubString,Source: String): Integer; Var sgRevSource : String; sgRevSubStr : String; inLenSource : Integer; inLenSubStr : Integer; inCounter : Integer; inPos : Integer; Begin Result := 0; sgRevSource := ''; sgRevSubStr := ''; inLenSource := Length(Source); inLenSubStr := Length(SubString); For inCounter := inLenSource DownTo 1 Do sgRevSource := sgRevSource + Copy(Source,inCounter,1); For inCounter := inLenSubStr DownTo 1 Do sgRevSubStr := sgRevSubStr + Copy(SubString,inCounter,1); inPos := Pos(sgRevSubStr,sgRevSource); If inPos = 0 Then Exit; Result := inLenSource - inPos - inLenSubStr + 2; End; //Unit Description UnitIndex Master Index
Function TEncrypt_ads.UnencryptedChars(inLen: Integer): String;
Var
inCounter : Integer;
inOrd : Integer;
inOrdWas : Integer;
sgNew : String;
flRand : Extended;
inCount : Integer;
Begin
Result := '';
sgNew := '';
If inLen = 0 Then Exit;
inOrdWas := -2;
For inCounter := 1 To inLen Do
Begin
inCount := 0;
While True Do
Begin
inc(inCount);
Randomize;
flRand := Int(Random(FUnencryptedMaxAsciiValue-FUnencryptedMinAsciiValue)+1);
inOrd := StrToInt(FormatFloat('#',flRand));
inOrd := Synchronize(inOrd,FUnencryptedMaxAsciiValue,FUnencryptedMinAsciiValue);
If (inCount < 1000000) Then
Begin
If (inOrd = (inOrdWas-1)) Then Continue;
If (inOrd = (inOrdWas-0)) Then Continue;
If (inOrd = (inOrdWas+1)) Then Continue;
End;
inOrdWas := inOrd;
sgNew := sgNew + Chr(inOrd);
Break;
End;
End;
Result := sgNew;
End;
//Unit Description UnitIndex Master Index
procedure TEncrypt_ads.SetRetainFormatData(const Value: Boolean);
begin
If FRetainFormatData <> Value Then FRetainFormatData := Value;
If Value Then
Begin
FUnencryptedMinAsciiValue := 9;
End
Else
Begin
FUnencryptedMinAsciiValue := 32;
End;
end;
Type
TPWLockBox_ads = class(TObject)
private
Encrypt_ads : TEncrypt_ads;
PWMsgHandler : TMessageEvent;
PWCharWas : Char;
ThreadBalance : String;
FPWControl : TWinControl;
procedure PWMessage(var Msg: TMsg; var Handled: Boolean);
procedure BalanceThread;
procedure SetPWControl(const Value: TWinControl);
protected
procedure PWInit;
procedure PWEnd;
procedure TuneThread;
public
constructor Create;
Destructor Destroy; Override;
published
property PWControl : TWinControl read FPWControl write SetPWControl;
end;
//Unit Description UnitIndex Master Index
procedure TPWLockBox_ads.PWMessage(var Msg: TMsg; var Handled: Boolean);
Var
Key : Integer;
inShift : Short;
begin
If Msg.hwnd = PWControl.Handle Then
Begin
If (Msg.Message = WM_KEYDOWN) Then
Begin
Key := Msg.WParam;
inShift := GetAsyncKeyState(VK_SHIFT);
If inShift < 0 Then inShift := 1 Else inShift := 0;
//32-47= !"#$%&'()*+,-./
//48-57=0-1
//58-64=:;<=>?@
//65-90=A-Z
//91-96=[\]^_`
//97-122=a-z
//123-126={|}~
If (Key >= 32) and (Key <= 126) Then
Begin
If (Key >= 65) And (Key <= 90) And (inShift <> 1) Then Key := Key + 32;
ThreadBalance := ThreadBalance + Chr(Key);
Msg.WParam := 32;
Handled := False;
End;
If Key = 8 Then
Begin
ThreadBalance := '';
If PWControl is TEdit Then TEdit(PWControl).Text := '';
End;
End;
End;
end;
//Unit Description UnitIndex Master Index
procedure TPWLockBox_ads.PWInit;
Begin
ThreadBalance := '';
If PWControl is TEdit Then
Begin
PWCharWas := TEdit(PWControl).PasswordChar;
TEdit(PWControl).PasswordChar := '*';
End;
PWMsgHandler := Application.OnMessage;
Application.OnMessage := PWMessage;
End;
//Unit Description UnitIndex Master Index
procedure TPWLockBox_ads.PWEnd;
Begin
BalanceThread;
If PWControl is TEdit Then
Begin
TEdit(PWControl).PasswordChar := PWCharWas;
End;
PWControl := nil;
Application.OnMessage := PWMsgHandler;
End;
//Unit Description UnitIndex Master Indexprocedure TPWLockBox_ads.BalanceThread; Begin ThreadBalance := Encrypt_ads.Encrypt(ThreadBalance); End; //Unit Description UnitIndex Master Index
procedure TPWLockBox_ads.TuneThread;
Begin
ThreadBalance := Encrypt_ads.Decrypt(ThreadBalance);
End;
constructor TPWLockBox_ads.Create;
begin
inherited Create;
If Self.ClassParent <> TObject Then
Raise Exception.Create('Decendants of TPWLockBox_ads are invalid!');
Encrypt_ads := TEncrypt_ads.Create(nil);
end;
//Unit Description UnitIndex Master Index
procedure TPWLockBox_ads.SetPWControl(const Value: TWinControl);
begin
If FPWControl <> Value Then
Begin
FPWControl := Value;
PWInit;
End;
end;
Destructor TPWLockBox_ads.Destroy;
begin
PWEnd;
Encrypt_ads.Free;
inherited Destroy;
end;
{ TPW_ads }
constructor TPW_ads.Create;
begin
inherited Create;
If Self.ClassParent <> TObject Then
Raise Exception.Create('Decendants of TPW_ads are invalid!');
FTag := 0;
FKey := 0;
FLockBox := TPWLockBox_ads.Create();
end;
destructor TPW_ads.Destroy;
begin
FLockBox.Free;
inherited Destroy;
end;
//Unit Description UnitIndex Master Index
procedure TPW_ads.Clear;
begin
TPWLockBox_ads(FLockBox).ThreadBalance := '';
TPWLockBox_ads(FLockBox).
Encrypt_ads.
Encrypt(
TPWLockBox_ads(FLockBox).ThreadBalance);
end;
//Unit Description UnitIndex Master Index
Function TPW_ads.GetPassword: String;
Var
inKey : Integer;
inKey2 : Integer;
begin
Try
Try
inKey := StrToInt(FormatFloat('#',Int(Now())))+79;
Except
inKey := 0;
End;
Try
inKey2 := StrToInt(FormatDateTime('ss',Now()))+19321;
Except
inKey2 := 0;
End;
If
(Tag = inKey)
And
(inKey <> 0)
And
(inKey2 <> 0)
And
(Key >= inKey2-2)
And
(Key <= inKey2+2)
Then
Begin
Result :=
TPWLockBox_ads(FLockBox).
Encrypt_ads.
Decrypt(
TPWLockBox_ads(FLockBox).ThreadBalance);
End
Else
Begin
Result :=
TPWLockBox_ads(FLockBox).
Encrypt_ads.
Encrypt(
TPWLockBox_ads(FLockBox).ThreadBalance);
End;
Finally
FTag := 0;
FKey := 0;
End;
end;
//Unit Description UnitIndex Master Indexprocedure TPW_ads.init; begin TPWLockBox_ads(FLockBox).PWInit; end; //Unit Description UnitIndex Master Index
procedure TPW_ads.quiesce; begin TPWLockBox_ads(FLockBox).PWEnd; end; //Unit Description UnitIndex Master Index
procedure TPW_ads.SetKey(const Value: Integer); begin If FKey <> Value Then FKey := Value; end; //Unit Description UnitIndex Master Index
procedure TPW_ads.SetPWControl(const Value: TWinControl);
begin
If FPWControl <> Value Then
Begin
FPWControl := Value;
TPWLockBox_ads(FLockBox).PWControl := Value;
End;
end;
//Unit Description UnitIndex Master Indexprocedure TPW_ads.SetTag(const Value: Integer); begin If FTag <> Value Then FTag := Value; end; end. //