msgrng.pas

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

  C := ClassName; 
  if C[1] = 'T' then Delete(C, 1, 1); 
  I  := Pos('_', C); 
  if I > 0 then Delete(C, 1, I); 
  SetLength(S, Length(C)); 
  Stream.Read(PChar(S)^, Length(C));
  if S <> C then Abort;
  SetLength(S, 6); 
  Stream.Read(PChar(S)^, 6);
  SetLength(S, 4);
  I := StrToInt('$' + S);
  SetLength(S, I); 
  Stream.Read(PChar(S)^, I); 
  State := DeleteCR(S);
end; 
 
procedure TRandom.SaveToFile(const FileName: String); 
var
  S: TStream;
begin 
  S := TFileStream.Create(FileName, fmCreate); 
  try 
    SaveToStream(S); 
  finally 
    S.Free; 
  end;
end; 
 
procedure TRandom.LoadFromFile(const FileName: String); 
var 
  S: TStream; 
begin 
  S := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); 
  try 
    LoadFromStream(S); 
  finally
    S.Free;
  end;
end;
 
procedure TRandom.CodeInit(Action: TPAction);
begin
  if Action = paWipe then Seed('', -1) 
    else Seed(PChar(FPassword)^, Length(FPassword));
  inherited CodeInit(Action);
end; 
 
procedure TRandom.CodeDone(Action: TPAction); 
begin 
  inherited CodeDone(Action); 
  if Action = paWipe then Seed('', -1) 
    else Seed(PChar(FPassword)^, Length(FPassword)); 
end;
	
procedure TRandom.CodeBuf(var Buffer; const BufferSize: Integer; Action: TPAction); 
const
  maxBufSize = 1024 * 4; 
var 
  Buf: Pointer;
  BPtr: PByte; 
  BSize,CSize: Integer;
begin 
  if Action <> paDecode then inherited CodeBuf(Buffer, BufferSize, Action); 
  if Action in Actions then
  begin
    BPtr := @Buffer;
    if BPtr = nil then Exit;
    BSize := maxBufSize;
    if BSize > BufferSize then BSize := BufferSize;
    Buf := AllocMem(BSize);
    CSize := BufferSize;
    try
      if Action = paCalc then
      begin
        while CSize > 0 do
        begin
          BSize := CSize;
          if BSize > maxBufSize then BSize := maxBufSize;
          Self.Buffer(Buf^, BSize);
          XORBuffers(Buf, BPtr, BSize, Buf);
          Inc(BPtr, BSize);
          Dec(CSize, BSize);
        end
      end else
      begin
        while CSize > 0 do
        begin
          BSize := CSize;
          if BSize > maxBufSize then BSize := maxBufSize;
          Self.Buffer(Buf^, BSize);
          XORBuffers(Buf, BPtr, BSize, BPtr);
          Inc(BPtr, BSize);
          Dec(CSize, BSize);
        end;
      end;
    finally
      ReallocMem(Buf, 0);
    end;
  end;
  if Action = paDecode then
    inherited CodeBuf(Buffer, BufferSize, Action);
end;

// internal for TRandom_LFSR
procedure LFSRBuf(Self: Pointer; var Buffer; Size: Integer); assembler;
asm
      AND     EDX,EDX    // Buffer = nil ?
      JZ      @@9
      AND     ECX,ECX    // BufferSize <= 0 ?
      JLE     @@9

      PUSH    EDI
      PUSH    ESI
      PUSH    EBX
      PUSH    EBP
      PUSH    EAX

      MOV     EDI,[EAX].TRandom_LFSR.FPtr
      MOV     EBP,[EAX].TRandom_LFSR.FLast
      LEA     ESI,[EAX].TRandom_LFSR.FRegister
      LEA     EBX,[EAX].TRandom_LFSR.FTable
      DEC     EDX

@@1:  MOVZX   EAX,Byte Ptr [ESI + EDI]
      MOV     [EDX + ECX],AL
      MOV     AX,[EBX + EAX * 2]
      MOV     [ESI + EDI],AL
      DEC     EDI
      JS      @@2
      XOR     [ESI + EDI],AH
      ADD     EDI,2
      CMP     EDI,EBP
      JLE     @@3
      XOR     EDI,EDI
      JMP     @@3
@@2:  MOV     EDI,EBP
      XOR     [ESI + EDI],AH
      MOV     EDI,1
@@3:  DEC     ECX
      JNZ     @@1

      POP     EAX
      MOV     [EAX].TRandom_LFSR.FPtr,EDI

      POP     EBP
      POP     EBX
      POP     ESI
      POP     EDI

@@9:
end;

procedure LFSRBuf128(Self: Pointer; var Buffer; Size: Integer); assembler;
asm
      AND     EDX,EDX    // Buffer = nil ?
      JZ      @@9
      AND     ECX,ECX    // BufferSize <= 0 ?
      JLE     @@9

      PUSH    EDI
      PUSH    ESI
      PUSH    EBX
      PUSH    EBP
      PUSH    EAX

      MOV     EDI,[EAX].TRandom_LFSR.FPtr
      LEA     EBP,[EAX].TRandom_LFSR.FTable
      LEA     ESI,[EAX].TRandom_LFSR.FRegister
      DEC     EDX
      XOR     EAX,EAX

@@1:  MOV     AL,[ESI + EDI]
      MOV     BX,[EBP + EAX * 2]
      MOV     [EDX + ECX],AL
      MOV     [ESI + EDI],BL
      DEC     EDI
      AND     EDI,0Fh
      XOR     [ESI + EDI],BH
      ADD     EDI,2
      AND     EDI,0Fh
      DEC     ECX
      JNZ     @@1

      POP     EAX
      MOV     [EAX].TRandom_LFSR.FPtr,EDI

      POP     EBP
      POP     EBX
      POP     ESI
      POP     EDI

@@9:
end;

procedure TRandom_LFSR.SetSize(Value: Integer);

  procedure CalcLFSRTable(XORCode: Byte);
  var
    I,J,Z: Integer;
  begin
    asm // Reverse the bitorder
      XOR   AX,AX
      MOV   AL,XORCode
      MOV   CL,8
@@1:  RCR   AL,1
      RCL   AH,1
      DEC   CL
      JNZ   @@1
      MOV   XORCode,AH
    end;
    FillChar(FTable, SizeOf(FTable), 0);
    for I := 0 to 255 do
    begin
      Z := I;
      for J := 0 to 7 do
      begin
        FTable[I] := FTable[I] shl 1;
        if Z and $80 <> 0 then FTable[I] := FTable[I] xor XORCode;
        Z := Z shl 1;
      end;
    end;
  end;

  procedure DoSet(Index: Integer);
  begin
    FSize := LFSRPeriod[Index, 0];
    FLast := LFSRPeriod[Index, 0] div 8 -1;
    if FSize = 128 then FFunc := LFSRBuf128 else FFunc := LFSRBuf;
    CalcLFSRTable(LFSRPeriod[Index, 1]);
    Seed('', 0);
  end;

var
  I: Integer;
begin
  if Value <= 0 then Value := 128;
  if Value <> FSize then
  begin
    for I := 33 downto 0 do
      if Value >= LFSRPeriod[I, 0] then
      begin
        DoSet(I);
        Exit;
      end;
    DoSet(9);  // The Standard fast 2^128-1 Period
  end;
end;

function TRandom_LFSR.GetState: String;
var
  CRC: Word;
  M: TMemoryStream;
begin
  M := TMemoryStream.Create;
  try
// write randomized Dummy Word
    RndXORBuffer(RndTimeSeed, CRC, SizeOf(CRC));
    M.Write(CRC, SizeOf(CRC));
    M.Write(FSize, SizeOf(FSize));
    M.Write(FRegister, SizeOf(FRegister));
    M.Write(FBasicSeed, SizeOf(FBasicSeed));
    M.Write(FCount, SizeOf(FCount));
    M.Write(FPtr, SizeOf(FPtr));
    M.Write(FLast, SizeOf(FLast));
    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_LFSR.SetState(Value: String);
var
  P: Integer;
  CRC: Word;
  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 word
    M.Read(P, SizeOf(FSize));
    SetSize(P);
    M.Read(FRegister, SizeOf(FRegister));
    M.Read(FBasicSeed, SizeOf(FBasicSeed));
    M.Read(FCount, SizeOf(FCount));
    M.Read(FPtr, SizeOf(FPtr));
    M.Read(FLast, SizeOf(FLast));
  finally
    M.Free;
  end;
end;

procedure TRandom_LFSR.Seed(const ABuffer; ASize: Integer);
var
  I,S: Integer;
begin
  FPtr := 0;
  if (ASize > 0) and (@ABuffer <> nil) then
  begin
    FillChar(FRegister, SizeOf(FRegister), 0);
    S := FSize div 8;
    for I := 0 to ASize -1 do
      FRegister[I mod S] := FRegister[I mod S] + TByteArray(ABuffer)[I];
  end else
    if ASize < 0 then RndXORBuffer(RndTimeSeed + (FCount +1), FRegister, SizeOf(FRegister))
      else FillChar(FRegister, SizeOf(FRegister), 0);
  RndXORBuffer(FBasicSeed, FRegister, SizeOf(FRegister));
  if Protection <> nil then
    Protection.CodeBuffer(FRegister, SizeOf(FRegister), paScramble);
end;

procedure TRandom_LFSR.Buffer(var ABuffer; ASize: Integer);
begin
  if ASize <= 0 then Exit;
  FFunc(Self, ABuffer, ASize);
  if Protection <> nil then
    Protection.CodeBuffer(ABuffer, ASize, paScramble);
  Inc(FCount, ASize);
end;

initialization

{$IFDEF DEBUG_LOG_INIT}
aaWriteToLog('MsgRng> initialized');
{$ENDIF}

finalization
  FRND.Release;
end.