Advanced Delphi Systems- Şifreleme

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Advanced Delphi Systems- Şifreleme

Mesaj gönderen Asri »

Aşağıdaki unit'i unit1'de uses olarak ekleyip bu unit içindeki procedure ve function'ları kullanbilirsiniz.

Bu unit program şifreleme işleminde kullanılır.

Kod: Tümünü seç

unit ads_Encrypt;
{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.
}

(*
Description: ads_Encrypt.pas
This unit contains the TEncrypt_ads class which
encapsulates encryption and decryption routines.

Retention of formatting is controlled by the
RetainFormatData property.  If RetainFormatData is
True then line feeds, returns, tabs etc are retained.
If RetainFormatData is False then all characters
below 32 (space) are discarded.
*)

interface
Uses SysUtils, WinProcs, Dialogs, Classes;

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;

implementation

{ TEncrypt_ads }

constructor TEncrypt_ads.Create(Owner: TObject);
begin
  inherited Create;  // Initialize inherited parts
  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;

end.
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
Cevapla