msgdecutil.pas

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

    end;
  finally
    DoProgress(Self, 0, 0);
    ReallocMem(Buf, 0);
    CodeDone(Action);
  end;
end;

procedure TProtection.CodeFile(const Source, Dest: String; Action: TPAction);
var
  S,D: TFileStream;
begin
  S := nil;
  D := nil;
  try
    if (AnsiCompareText(Source, Dest) <> 0) and ((Trim(Dest) <> '') or (Action = paCalc)) then
    begin
      S := TFileStream.Create(Source, fmOpenRead or fmShareDenyNone);
      if Action = paCalc then D := S
        else D := TFileStream.Create(Dest, fmCreate);
    end else
    begin
      S := TFileStream.Create(Source, fmOpenReadWrite);
      D := S;
    end;
    CodeStream(S, D, S.Size, Action);
  finally
    S.Free;
    if S <> D then
    begin
{$IFDEF VER_D3H}
      D.Size := D.Position;
{$ENDIF}
      D.Free;
    end;
  end;
end;

function TProtection.CodeBuffer(var Buffer; BufferSize: Integer; Action: TPAction): Integer;
begin
  Result := BufferSize;
  CodeInit(Action);
  try
    CodeBuf(Buffer, BufferSize, Action);
  finally
    CodeDone(Action);
  end;
end;

function TProtection.CodeString(const Source: String; Action: TPAction; Format: Integer): String;
var
  M: TMemoryStream;
begin
  Result := '';
  if Length(Source) <= 0 then Exit;
  M := TMemoryStream.Create;
  try
    if Action <> paDecode then Result := Source
      else Result := FormatToStr(PChar(Source), Length(Source), Format);
    M.Write(PChar(Result)^, Length(Result));
    M.Position := 0;
    CodeStream(M, M, M.Size, Action);
    if Action = paDecode then
    begin
      SetLength(Result, M.Size);
      Move(M.Memory^, PChar(Result)^, M.Size);
    end else
      Result := StrToFormat(M.Memory, M.Size, Format);
  finally
    M.Free;
  end;
end;

constructor TProtection.Create(AProtection: TProtection);
begin
  inherited Create;
  Protection := AProtection;
  FActions := [paEncode..paWipe];
end;

destructor TProtection.Destroy;
begin
  Protection := nil;
  inherited Destroy;
end;

class function TProtection.Identity: Word;
var
  S: String;
begin
  S := ClassName;
  Result := not CRC16(IdentityBase, PChar(S), Length(S));
end;

class function TStringFormat.ToStr(Value: PChar; Len: Integer): String;
begin
  SetLength(Result, Len);
  Move(Value^, PChar(Result)^, Len);
end;

class function TStringFormat.StrTo(Value: PChar; Len: Integer): String;
begin
  SetLength(Result, Len);
  Move(Value^, PChar(Result)^, Len);
end;

class function TStringFormat.Name: String;
begin
  if Self = TStringFormat then Result := sFMT_COPY
    else Result := GetShortClassName(Self);
end;

class function TStringFormat.Format: Integer;
begin
  Result := fmtCOPY;
end;

class function TStringFormat.IsValid(Value: PChar; Len: Integer; ToStr: Boolean): Boolean;
begin
  Result := True;
end;

function TableFind(Value: Char; Table: PChar; Len: Integer): Integer; assembler;
asm // Utility for TStringFormat_XXXXX
      PUSH  EDI
      MOV   EDI,EDX
      REPNE SCASB
      MOV   EAX,0
      JNE   @@1
      MOV   EAX,EDI
      SUB   EAX,EDX
@@1:  DEC   EAX
      POP   EDI
end;

class function TStringFormat_HEX.ToStr(Value: PChar; Len: Integer): String;
var
  D: PByte;
  T: PChar;
  I,P: Integer;
  HasIdent: Boolean;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len div 2 +1);
  T := CharTable;
  D := PByte(Result);
  I := 0;
  HasIdent := False;
  while Len > 0 do
  begin

    // bug fix for lower hex by AidAim Software
    if (Format = fmtHEX) then
     P := TableFind(UpCase(Value^), T, 18)
    else
     P := TableFind(Value^, T, 18);
    // bug fix for lower hex by AidAim Software

    Inc(Value);
    if P >= 0 then
      if P > 16 then
      begin
        if not HasIdent then
        begin
          HasIdent := True;
          I := 0;
          D := PByte(Result);
        end;
      end else
      begin
        if Odd(I) then
        begin
          D^ := D^ or P;
          Inc(D);
        end else D^ := P shl 4;
        Inc(I);
      end;
    Dec(Len);
  end;
  SetLength(Result, PChar(D) - PChar(Result));
end;

class function TStringFormat_HEX.StrTo(Value: PChar; Len: Integer): String;
var
  D,T: PChar;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len * 2);
  T := CharTable;
  D := PChar(Result);
  while Len > 0 do
  begin
    D[0] := T[Byte(Value^) shr  4];
    D[1] := T[Byte(Value^) and $F];
    Inc(D, 2);
    Inc(Value);
    Dec(Len);
  end;
end;

class function TStringFormat_HEX.IsValid(Value: PChar; Len: Integer; ToStr: Boolean): Boolean;
var
  T: PChar;
  L: Integer;
begin
  Result := not ToStr;
  if not Result then
  begin
    T := CharTable;
    L := StrLen(T);
    while Len > 0 do
      if TableFind(Value^, T, L) >= 0 then
      begin
        Dec(Len);
        Inc(Value);
      end else Exit;
  end;
  Result := True;
end;

class function TStringFormat_HEX.Name: String;
begin
  Result := sFMT_HEX;
end;

class function TStringFormat_HEX.Format: Integer;
begin
  Result := fmtHEX;
end;

class function TStringFormat_HEX.CharTable: PChar; assembler;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '0123456789ABCDEF'     // Table must be >= 18 Chars
      DB   'X$ abcdefhHx()[]{},;:-_/\*+"''',9,10,13,0
end;

class function TStringFormat_HEXL.Name: String;
begin
  Result := sFMT_HEXL;
end;

class function TStringFormat_HEXL.Format: Integer;
begin
  Result := fmtHEXL;
end;

class function TStringFormat_HEXL.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '0123456789abcdef'     // Table must be >= 18 Chars
      DB   'X$ ABCDEFhHx()[]{},;:-_/\*+"''',9,10,13,0
end;

class function TStringFormat_MIME64.ToStr(Value: PChar; Len: Integer): String;
var
  B: Cardinal;
  J,I: Integer;
  S,D,L,T: PChar;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := Length(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len);
  Move(PChar(Value)^, PChar(Result)^, Len);
  T := CharTable;
  while Len mod 4 <> 0 do
  begin
    Result := Result + T[64];
    Inc(Len);
  end;
  D := PChar(Result);
  S := D;
  L := S + Len;
  Len := Len * 3 div 4;
  while Len > 0 do
  begin
    B := 0;
    J := 4;
    while (J > 0) and (S <= L) do
    begin
      I := TableFind(S^, T, 65);
      if I >= 0 then
      begin
        B := B shl 6;
        if I >= 64 then Dec(Len) else B := B or Byte(I);
        Dec(J);
      end;
      Inc(S);
    end;
    J := 2;
    repeat
      D[J] := Char(B);
      B := B shr 8;
      Dec(J);
    until J < 0;
    if Len > 3 then Inc(D, 3) else Inc(D, Len);
    Dec(Len, 3);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TStringFormat_MIME64.StrTo(Value: PChar; Len: Integer): String;
var
  B: Cardinal;
  I: Integer;
  D,T: PChar;
begin
  Result := '';
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  SetLength(Result, Len * 4 div 3 + 4);
  D := PChar(Result);
  T := CharTable;
  while Len > 0 do
  begin
    B := 0;
    for I := 0 to 2 do
    begin
      B := B shl 8;
      if Len > 0 then
      begin
        B := B or Byte(Value^);
        Inc(Value);
      end;
      Dec(Len);
    end;
    for I := 3 downto 0 do
    begin
      if Len < 0 then
      begin
        D[I] := T[64];
        Inc(Len);
      end else D[I] := T[B and $3F];
      B := B shr 6;
    end;
    Inc(D, 4);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TStringFormat_MIME64.Name: String;
begin
  Result := sFMT_MIME64;
end;

class function TStringFormat_MIME64.Format: Integer;
begin
  Result := fmtMIME64;
end;

class function TStringFormat_MIME64.CharTable: PChar; assembler;
asm
      MOV  EAX,OFFSET @@1
      RET  // must be >= 65 Chars
@@1:  DB  'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/='
      DB  ' $()[]{},;:-_\*"''',9,10,13,0
end;

class function TStringFormat_UU.ToStr(Value: PChar; Len: Integer): String;
var
  T,D,L: PChar;
  I,E: Integer;
  B: Cardinal;
begin
  Result := ''; 
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value); 
  if Len = 0 then Exit;
  SetLength(Result, Len); 
  L := Value + Len;
  D := PChar(Result);
  T := CharTable;
  repeat
    Len := TableFind(Value^, T, 64); 
    if (Len < 0) or (Len > 45) then
      raise EStringFormat.CreateFMT(sInvalidStringFormat, [Name]);
    Inc(Value);
    while Len > 0 do 
    begin
      B := 0; 
      I := 4; 
      while (I > 0) and (Value <= L) do
      begin 
        E := TableFind(Value^, T, 64); 
        if E >= 0 then 
        begin
          B := B shl 6 or Byte(E);
          Dec(I);
        end; 
        Inc(Value);
      end; 
      I := 2; 
      repeat 
        D[I] := Char(B);
        B    := B shr 8;
        Dec(I); 
      until I < 0; 
      if Len > 3 then Inc(D, 3) else Inc(D, Len);
      Dec(Len, 3);
    end;
  until Value >= L;
  SetLength(Result, D - PChar(Result));
end; 
 
class function TStringFormat_UU.StrTo(Value: PChar; Len: Integer): String;
var
  T,D: PChar;
  L,I: Integer;
  B: Cardinal; 
begin 
  Result := ''; 
  if Value = nil then Exit; 
  if Len < 0 then Len := StrLen(Value); 
  if Len = 0 then Exit;
  SetLength(Result, Len * 4 div 3 + Len div 45 + 10);
  D := PChar(Result);
  T := CharTable; 
  while Len > 0 do
  begin
    L := Len; 
    if L > 45 then L := 45; 
    Dec(Len, L);
    D^ := T[L]; 
    while L > 0 do
    begin
      B := 0;
      for I := 0 to 2 do