msgrng.pas

Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl

{Copyright:      Hagen Reddmann  mailto:[e-mail]
 Author:         Hagen Reddmann
 Remarks:        freeware, but this Copyright must be included
 known Problems: none
 Version:        3.0
                 Delphi 2-4, designed and testet under D3 and D4
 Description:    Linear Feedback Shift Register (LFSR)
                 Random Number Generator with variable Period
                 from 2^32 -1 to 2^2032 -1, Standard is 2^128 -1
                 with .Seed('', -1) absolutly random
                 The Period have theoretical no effect on the Speed.

 Speed:          ca. 40 Mb/sec of a PII MMX 266 MHz 64Mb RAM

 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
 * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


  Speed: all times for PII MMX 266Mhz 64Mb
         theoretical have the Period (Size of LFSR) no effect on the Speed,
         but a greater Period will run faster. (Cache, little Branches on Pentium, etc.)
         except the Period 2^128-1, this use a specially optimized method.

              >   14.5 Mb/sec
              >   40.5 Mb/sec with 128bit LFSR
Version 3.0

  TRandom is now a descend from TProtect, see Unit DECUtil.pas

 }
unit MsgRng;

interface

{$I Ver.inc}

uses SysUtils, Classes,
 {$IFDEF DEBUG_LOG}
     MsgDebug,
 {$ENDIF}
     MsgDecUtil;

type
  ERandom = class(Exception);

  TRandom = class(TProtection)    // Basicly RNG, equal to Borland's Random()
  private
    FRegister: Integer;
    FPassword: String;
  protected
    FCount: Integer;          // not as private Fields, easier access for descends
    FSize: Integer;
    FBasicSeed: Integer;
    procedure SetSize(Value: Integer); virtual;
    function GetState: String; virtual;
    procedure SetState(Value: String); virtual;
// override TProtect Methods
    procedure CodeInit(Action: TPAction); override;
    procedure CodeDone(Action: TPAction); override;
    procedure CodeBuf(var Buffer; const BufferSize: Integer; Action: TPAction); override;
  public
    constructor Create(const APassword: String; ASize: Integer; ARandomize: Boolean; AProtection: TProtection); virtual;
    destructor Destroy; override;
// set the Seed register
//  Size =  0 -> Seed to initial Value
//  Size <  0 -> Seed to randomness Value, equal to Randomize
//  Size >  0 -> Seed is set to Buffer
    procedure Seed(const ABuffer; ASize: Integer); virtual;
// fill out ABuffer ASize Bytes randomly
    procedure Buffer(var ABuffer; ASize: Integer); virtual;
// gives Random Integer in ARange
    function Int(ARange: Integer): Integer; virtual;
// Stream loading/saving
    procedure SaveToStream(Stream: TStream); virtual;
    procedure LoadFromStream(Stream: TStream); virtual;
// File loading/saving
    procedure SaveToFile(const FileName: String);
    procedure LoadFromFile(const FileName: String);
// Count of Bytes that Int() or Buffer() has generated
    property Count: Integer read FCount write FCount;
// the Size in Bits
    property Size: Integer read FSize write SetSize;
// basicly Seed Value for use in .Seed(), Standard is DefaultSeed
    property BasicSeed: Integer read FBasicSeed write FBasicSeed;
// the internal State as MIMIE Base64 String
    property State: String read GetState write SetState;
  end;

  TRandom_LFSR = class(TRandom)       // Linear Feedback Shift Register
  private
    FPtr: Integer;                    // Current Position in FRegister
    FLast: Integer;                   // Highest Position in FRegister
    FTable: array[0..255] of Word;    // Lookup Table for FRegister
    FRegister: array[0..255] of Byte; // Linear Feedback Shift Register
    FFunc: procedure(Self: Pointer; var Buffer; Size: Integer);
  protected
    procedure SetSize(Value: Integer); override;
    function GetState: String; override;
    procedure SetState(Value: String); override;
  public
    procedure Seed(const ABuffer; ASize: Integer); override;
    procedure Buffer(var ABuffer; ASize: Integer); override;
  end;

{   Follow the used polynomial's for TRandom_LFSR
     size in bytes of register, XORCode, Polynomial, Period

   4, $F5, x^32   + x^7 + x^5 + x^3 + x^2 + x + 1,   2^32   -1
   5, $9C, x^40   + x^5 + x^4 + x^3 + 1,             2^40   -1
   6, $ED, x^48   + x^7 + x^5 + x^4 + x^2 + x + 1,   2^48   -1
   7, $A9, x^56   + x^7 + x^4 + x^2 + 1,             2^56   -1
   8, $D8, x^64   + x^4 + x^3 + x + 1,               2^64   -1
   9, $FA, x^72   + x^6 + x^4 + x^3 + x^2 + x + 1,   2^72   -1
  10, $F5, x^80   + x^7 + x^5 + x^3 + x^2 + x + 1,   2^80   -1
  12, $BB, x^96   + x^7 + x^6 + x^4 + x^3 + x^2 + 1, 2^96   -1
  15, $E7, x^120  + x^7 + x^6 + x^5 + x^2 + x + 1,   2^120  -1
  16, $E1, x^128  + x^7 + x^2 + x + 1,               2^128  -1
  18, $A9, x^144  + x^7 + x^4 + x^2 + 1,             2^144  -1
  19, $B2, x^152  + x^6 + x^3 + x^2 + 1,             2^152  -1
  20, $B4, x^160  + x^5 + x^3 + x^2 + 1,             2^160  -1
  22, $BD, x^176  + x^7 + x^5 + x^4 + x^3 + x^2 + 1, 2^176  -1
  25, $B4, x^200  + x^5 + x^3 + x^2 + 1,             2^200  -1
  27, $D1, x^216  + x^7 + x^3 + x + 1,               2^216  -1
  38, $FC, x^304  + x^5 + x^4 + x^3 + x^2 + x + 1,   2^304  -1
  40, $D8, x^320  + x^4 + x^3 + x + 1,               2^320  -1
  42, $C9, x^336  + x^7 + x^4 + x + 1,               2^336  -1
  44, $BD, x^352  + x^7 + x^5 + x^4 + x^3 + x^2 + 1, 2^352  -1
  50, $B4, x^400  + x^5 + x^3 + x^2 + 1,             2^400  -1
  51, $FA, x^408  + x^6 + x^4 + x^3 + x^2 + x + 1,   2^408  -1
  55, $D8, x^440  + x^4 + x^3 + x + 1,               2^440  -1
  60, $BB, x^480  + x^7 + x^6 + x^4 + x^3 + x^2 + 1, 2^480  -1
  61, $D8, x^488  + x^4 + x^3 + x + 1,               2^488  -1
  63, $FA, x^504  + x^6 + x^4 + x^3 + x^2 + x + 1,   2^504  -1
  67, $95, x^536  + x^7 + x^5 + x^3 + 1,             2^536  -1
  84, $F6, x^672  + x^6 + x^5 + x^3 + x^2 + x + 1,   2^672  -1
  89, $9C, x^712  + x^5 + x^4 + x^3 + 1,             2^712  -1
  91, $B8, x^728  + x^4 + x^3 + x^2 + 1,             2^728  -1
 103, $FC, x^824  + x^5 + x^4 + x^3 + x^2 + x + 1,   2^824  -1
 141, $D1, x^1128 + x^7 + x^3 + x + 1,               2^1128 -1
 154, $F3, x^1232 + x^7 + x^6 + x^3 + x^2 + x + 1,   2^1232 -1
 254, $A3, x^2032 + x^7 + x^6 + x^2 + 1,             2^2032 -1

  follow various Periods
--------------------------------------------------------------------------------
  2^32-1   = 4294967295
  2^64-1   = 18446744073709551615
  2^128-1  = 340282366920938463463374607431768211455
  2^2032-1 = it's one Number
   49311837877366649323600580884811328064642490645928167773636391338386009428204
   17921935608125537553934278674005267623599165972833122328326583112816221076703
   35702985799671951234310153163915857728680359766210694390385082889078409114931
   66867209378778336289339669574030006474132653643098550122997363890264786354861
   31947843882498538312526670313197249581325688984118966381501107686008635362008
   71492771279798342546336760614070411100118371556871830774626226863061725361438
   46476937385117828689155818331492509954024778049592066494651864619855274961300
   9880449926596639031121858756000207590413184793166384097191709192063287295
--------------------------------------------------------------------------------
}

// Your actual Random Class, per default TRandom_LFSR.Create(128, False)
function RND: TRandom;

// internal used for the random initialization of the Seed Initial Value
// change this to produce Application dependent Randomness
const
  DefaultSeed: Integer = 693258280;

implementation

uses MsgDECConst;

const
  FRND: TRandom = nil;

// avaible Periods for the LFSR
  LFSRPeriod: array[0..33, 0..1] of Word =
   ((   32, $F5), (   40, $9C), (   48, $ED), (   56, $A9),
    (   64, $D8), (   72, $FA), (   80, $F5), (   96, $BB),
    (  120, $E7), (  128, $E1), (  144, $A9), (  152, $B2),
    (  160, $B4), (  176, $BD), (  200, $B4), (  216, $D1),
    (  304, $FC), (  320, $D8), (  336, $C9), (  352, $BD),
    (  400, $B4), (  408, $FA), (  440, $D8), (  480, $BB),
    (  488, $D8), (  504, $FA), (  536, $95), (  672, $F6),
    (  712, $9C), (  728, $B8), (  824, $FC), ( 1128, $D1),
    ( 1232, $F3), ( 2032, $A3));

function RND: TRandom;
begin
  if FRND = nil then
  begin
    FRND := TRandom_LFSR.Create('', 0, False, nil);
    FRND.AddRef;
  end;
  Result := FRND;
end;

procedure TRandom.SetSize(Value: Integer);
begin
  FSize := 32; // allways 32
end;

function TRandom.GetState: String;
var
  CRC: Word;
  M: TMemoryStream;
begin
  M := TMemoryStream.Create;
  try
// write a Randomized Word to begin,
// any Encryption produce allways other outputs
    RndXORBuffer(RndTimeSeed, CRC, SizeOf(CRC));
    M.Write(CRC, SizeOf(CRC));
    M.Write(FSize, SizeOf(FSize));
    M.Write(FBasicSeed, SizeOf(FBasicSeed));
    M.Write(FCount, SizeOf(FCount));
    M.Write(FRegister, SizeOf(FRegister));
    CRC := not CRC16($FFFF, M.Memory, M.Size);
    M.Write(CRC, SizeOf(CRC));
    CRC := $0100; // Version 1 without Protection
    if Protection <> nil then
    begin
      CRC := CRC or 1; // with Protection
      M.Position := 0;
      Protection.CodeStream(M, M, M.Size, paEncode);
      M.Position := M.Size;
    end;
    M.Write(CRC, SizeOf(CRC));
    Result := StrToFormat(M.Memory, M.Size, fmtMIME64);
  finally
    M.Free;
  end;
end;

procedure TRandom.SetState(Value: String);
var
  CRC: Word;
  I: Integer;
  M: TMemoryStream;
begin
  M := TMemoryStream.Create;
  try
    Value := FormatToStr(PChar(Value), Length(Value), fmtMIME64);
    M.Write(PChar(Value)^, Length(Value));
    M.Position := M.Size - SizeOf(CRC);
    M.Read(CRC, SizeOf(CRC));
    if CRC and $FF00 <> $0100 then // it's Version $0100 ?
      raise ERandom.Create(sInvalidRandomStream);
    if CRC and 1 <> 0 then
      if Protection <> nil then
      begin
        M.Position := 0;
        Protection.CodeStream(M, M, M.Size - SizeOf(CRC), paDecode);
      end else raise ERandom.Create(sRandomDataProtected);
    M.Position := M.Size - SizeOf(CRC) * 2;
    M.Read(CRC, SizeOf(CRC));
    if CRC <> not CRC16($FFFF, M.Memory, M.Size - SizeOf(CRC) * 2) then
      raise ERandom.Create(sInvalidRandomStream);
    M.Position := SizeOf(CRC); // skip Dummy Random Word
    M.Read(I, SizeOf(FSize));
    SetSize(I);
    M.Read(FCount, SizeOf(FCount));
    M.Read(FBasicSeed, SizeOf(FBasicSeed));
    M.Read(FRegister, SizeOf(FRegister));
  finally
    M.Free;
  end;
end;

constructor TRandom.Create(const APassword: String; ASize: Integer; ARandomize: Boolean; AProtection: TProtection);
begin
  inherited Create(AProtection);
  FBasicSeed := DefaultSeed;
  FSize := -1;
  FPassword := APassword;
  SetSize(ASize);
  if ASize > 0 then
    if not ARandomize then Seed(PChar(FPassword)^, Length(FPassword))
      else Seed('', -1);
end;

destructor TRandom.Destroy;
begin
  Seed('', 0);
  if Self = FRND then FRND := nil;
  inherited Destroy;
end; 
	
procedure TRandom.Seed(const ABuffer; ASize: Integer); 
var
  I: Integer; 
  R: PByteArray;
begin
  if (ASize > 0) and (@ABuffer <> nil) then
  begin
    FRegister := FBasicSeed; 
    FillChar(FRegister, SizeOf(FRegister), 0);
    R := @FRegister;
    for I := 0 to ASize -1 do
      R[I and 3] := R[I and 3] + TByteArray(ABuffer)[I]; 
  end else
    if ASize < 0 then FRegister := RndTimeSeed + (FCount +1) 
      else FRegister := FBasicSeed; 
  if Protection <> nil then
    Protection.CodeBuffer(FRegister, SizeOf(FRegister), paScramble); 
end; 
 
function TRandom.Int(ARange: Integer): Integer;
begin
  Buffer(Result, SizeOf(Result));
  if (ARange = 0) or (Result = 0) then Exit; 
  if (ARange >= 0) and (Result < 0) then Result := -Result else
    if ARange < 0 then ARange := -ARange; 
  Result := Result mod (ARange +1); 
  Inc(FCount, SizeOf(Result)); 
end;
	
procedure TRandom.Buffer(var ABuffer; ASize: Integer); 
begin 
  if ASize <= 0 then Exit;
  FillChar(ABuffer, ASize, 0);
  FRegister := RndXORBuffer(FRegister, ABuffer, ASize);
  Inc(FCount, ASize);
  if Protection <> nil then
    Protection.CodeBuffer(ABuffer, ASize, paScramble); 
end; 
	
procedure TRandom.SaveToStream(Stream: TStream);
var
  I: Integer;
  S,C: String; 
begin 
  C := ClassName; 
  if C[1] = 'T' then Delete(C, 1, 1); 
  I := Pos('_', C); 
  if I > 0 then Delete(C, 1, I);
  S := InsertCR(State, 64);
  C := C + IntToHex(Length(S), 4) + #13#10 + S;
  Stream.Write(PChar(C)^, Length(C)); 
end;
	
procedure TRandom.LoadFromStream(Stream: TStream); 
var 
  C,S: String;
  I: Integer; 
begin
// write the Name from ClassName (i.E. TRandom_LFSR -> "LFSR"),
// the Size as a 4 Char HEX String and State.
// i.E. LFSR0FCB <CR> State