Bu unit program password dialog işleminde kullanılır.
Kod: Tümünü seç
unit ads_PWVault;
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;
function 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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
Function 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;
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;
function 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;
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;
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;
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;
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;
procedure TPWLockBox_ads.PWEnd;
Begin
BalanceThread;
If PWControl is TEdit Then
Begin
TEdit(PWControl).PasswordChar := PWCharWas;
End;
PWControl := nil;
Application.OnMessage := PWMsgHandler;
End;
procedure TPWLockBox_ads.BalanceThread;
Begin
ThreadBalance := Encrypt_ads.Encrypt(ThreadBalance);
End;
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;
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;
procedure TPW_ads.Clear;
begin
TPWLockBox_ads(FLockBox).ThreadBalance := '';
TPWLockBox_ads(FLockBox).
Encrypt_ads.
Encrypt(
TPWLockBox_ads(FLockBox).ThreadBalance);
end;
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;
procedure TPW_ads.init;
begin
TPWLockBox_ads(FLockBox).PWInit;
end;
procedure TPW_ads.quiesce;
begin
TPWLockBox_ads(FLockBox).PWEnd;
end;
procedure TPW_ads.SetKey(const Value: Integer);
begin
If FKey <> Value Then FKey := Value;
end;
procedure TPW_ads.SetPWControl(const Value: TWinControl);
begin
If FPWControl <> Value Then
Begin
FPWControl := Value;
TPWLockBox_ads(FLockBox).PWControl := Value;
End;
end;
procedure TPW_ads.SetTag(const Value: Integer);
begin
If FTag <> Value Then FTag := Value;
end;
end.