msgdecutil.pas

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

      begin 
        B := B shl 8; 
        if L > 0 then 
        begin 
          B := B or Byte(Value^); 
          Inc(Value);
        end;
        Dec(L); 
      end;
      for I := 4 downto 1 do
      begin
        D[I] := T[B and $3F]; 
        B := B shr 6; 
      end;
      Inc(D, 4); 
    end; 
    Inc(D); 
  end;
  SetLength(Result, D - PChar(Result));
end; 
 
class function TStringFormat_UU.Name: String; 
begin 
  Result := sFMT_UU; 
end; 
	
class function TStringFormat_UU.Format: Integer; 
begin 
  Result := fmtUU; 
end; 
 
class function TStringFormat_UU.IsValid(Value: PChar; Len: Integer; ToStr: Boolean): Boolean; 
var 
  T: PChar; 
  L,I,P: Integer; 
begin
  Result := not ToStr;
  if not Result then
  begin
    T := CharTable; 
    L := StrLen(T);
    P := 0;
    while Len > 0 do 
    begin
      I := TableFind(Value^, T, L);
      if I >= 0 then 
      begin 
        Dec(Len); 
        Inc(Value); 
        if P = 0 then 
        begin 
          if I > 45 then Exit; 
          P := (I * 4 + 2) div 3;
        end else
          if I < 64 then Dec(P); 
      end else Exit;
    end; 
    if P <> 0 then Exit; 
  end;
  Result := True; 
end;
 
class function TStringFormat_UU.CharTable: PChar; 
asm
      MOV  EAX,OFFSET @@1
      RET  // must be >= 64 Chars
@@1:  DB   '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'
      DB   ' ',9,10,13,0
end;

class function TStringFormat_XX.Name: String;
begin
  Result := sFMT_XX;
end;

class function TStringFormat_XX.Format: Integer;
begin
  Result := fmtXX;
end;

class function TStringFormat_XX.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
      DB   ' "()[]''',9,10,13,0
end;

function CPUType: Integer;
begin
  Result := FCPUType;
end;

function IsObject(AObject: Pointer; AClass: TClass): Boolean;
var
  E: Pointer;
begin
  Result := False;
  if AObject = nil then Exit;
  E := ExceptionClass;
  ExceptionClass := nil;
  try
    if TObject(AObject) is AClass then Result := True;
  except
  end;
  ExceptionClass := E;
end;

function ROL(Value: LongWord; Shift: Integer): LongWord; assembler;
asm
       MOV   ECX,EDX
       ROL   EAX,CL
end;

function ROLADD(Value, Add: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROL   EAX,CL
       ADD   EAX,EDX
end;

function ROLSUB(Value, Sub: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROL   EAX,CL
       SUB   EAX,EDX
end;

function ROR(Value: LongWord; Shift: Integer): LongWord; assembler;
asm
       MOV   ECX,EDX
       ROR   EAX,CL
end;

function RORADD(Value, Add: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROR  EAX,CL
       ADD  EAX,EDX
end;

function RORSUB(Value, Sub: LongWord; Shift: Integer): LongWord; assembler;
asm
       ROR  EAX,CL
       SUB  EAX,EDX
end;
{swap 4 Bytes Intel, Little/Big Endian Conversion}
function SwapInt(Value: LongWord): LongWord; assembler; register;
asm
       XCHG  AH,AL
       ROL   EAX,16
       XCHG  AH,AL
end;

function BSwapInt(Value: LongWord): LongWord; assembler; register;
asm
       BSWAP  EAX
end;

procedure SwapIntBuf(Source,Dest: Pointer; Count: Integer); assembler; register;
asm
       TEST   ECX,ECX
       JLE    @Exit
       PUSH   EBX
       SUB    EAX,4
       SUB    EDX,4
@@1:   MOV    EBX,[EAX + ECX * 4]
       XCHG   BL,BH
       ROL    EBX,16
       XCHG   BL,BH
       MOV    [EDX + ECX * 4],EBX
       DEC    ECX
       JNZ    @@1
       POP    EBX
@Exit:
end;

procedure BSwapIntBuf(Source, Dest: Pointer; Count: Integer); assembler; register;
asm
       TEST   ECX,ECX
       JLE    @Exit
       PUSH   EBX
       SUB    EAX,4
       SUB    EDX,4
@@1:   MOV    EBX,[EAX + ECX * 4]
       BSWAP  EBX
       MOV    [EDX + ECX * 4],EBX
       DEC    ECX
       JNZ    @@1
       POP    EBX
@Exit:
end;
{reverse the bit order from a integer}
function SwapBits(Value: LongWord): LongWord;
asm
       CMP    FCPUType,3
       JLE    @@1
       BSWAP  EAX
       JMP    @@2
@@1:   XCHG   AH,AL
       ROL    EAX,16
       XCHG   AH,AL
@@2:   MOV    EDX,EAX
       AND    EAX,0AAAAAAAAh
       SHR    EAX,1
       AND    EDX,055555555h
       SHL    EDX,1
       OR     EAX,EDX
       MOV    EDX,EAX
       AND    EAX,0CCCCCCCCh
       SHR    EAX,2
       AND    EDX,033333333h
       SHL    EDX,2
       OR     EAX,EDX
       MOV    EDX,EAX
       AND    EAX,0F0F0F0F0h
       SHR    EAX,4
       AND    EDX,00F0F0F0Fh
       SHL    EDX,4
       OR     EAX,EDX
end;

function LSBit(Value: Integer): Integer; assembler;
asm
       BSF   EAX,EAX
end;

function MSBit(Value: Integer): Integer; assembler;
asm
       BSR   EAX,EAX
end;

function OneBit(Value: Integer): Integer; assembler;
asm
       MOV   ECX,EAX
       MOV   EDX,EAX
       BSF   EDX,EDX
       JZ    @@1
       BSR   ECX,ECX
       CMP   ECX,EDX
       JNE   @@1
       MOV   EAX,EDX
       RET
@@1:   XOR   EAX,EAX
end;

function MemCompare(P1, P2: Pointer; Size: Integer): Integer; assembler; register;
asm
       PUSH    ESI
       PUSH    EDI
       MOV     ESI,P1
       MOV     EDI,P2
       XOR     EAX,EAX
       REPE    CMPSB
       JE      @@1
       MOVZX   EAX,BYTE PTR [ESI-1]
       MOVZX   EDX,BYTE PTR [EDI-1]
       SUB     EAX,EDX
@@1:   POP     EDI
       POP     ESI
end;

procedure XORBuffers(I1, I2: Pointer; Size: Integer; Dest: Pointer); assembler;
asm
       AND   ECX,ECX
       JZ    @@5
       PUSH  ESI
       PUSH  EDI
       MOV   ESI,EAX
       MOV   EDI,Dest
@@1:   TEST  ECX,3
       JNZ   @@3
@@2:   SUB   ECX,4
       JL    @@4
       MOV   EAX,[ESI + ECX]
       XOR   EAX,[EDX + ECX]
       MOV   [EDI + ECX],EAX
       JMP   @@2
@@3:   DEC   ECX
       MOV   AL,[ESI + ECX]
       XOR   AL,[EDX + ECX]
       MOV   [EDI + ECX],AL
       JMP   @@1
@@4:   POP   EDI
       POP   ESI
@@5:
end;

procedure DoProgress(Sender: TObject; Current, Maximal: Integer);
begin
{saver access}
  if (TMethod(Progress).Code <> nil) and
     ((TMethod(Progress).Data = nil) or
       IsObject(TMethod(Progress).Data, TObject)) then
    Progress(Sender, Current, Maximal);
end;

function StringFormat(Format: Integer): TStringFormatClass;
var
  I: Integer;
begin
  if Format = fmtDefault then Format := DefaultStringFormat;
  Result := nil;
  if FStrFmts <> nil then
    for I := 0 to FStrFMTs.Count-1 do
      if TStringFormatClass(FStrFmts[I]).Format = Format then
      begin
        Result := FStrFMTS[I];
        Exit;
      end;
end;

function StrToFormat(Value: PChar; Len, Format: Integer): String;
var
  Fmt: TStringFormatClass;
begin
  Result := '';
  if (Value = nil) or (Format = fmtNONE) then Exit;
  if Len <  0 then Len := StrLen(Value);
  if Len <= 0 then Exit;
  Fmt := StringFormat(Format);
  if Fmt <> nil then
    if Fmt.IsValid(Value, Len, False) then Result := Fmt.StrTo(Value, Len)
      else raise EStringFormat.CreateFMT(sInvalidFormatString, [FMT.Name])
    else raise EStringFormat.CreateFMT(sStringFormatExists, [Format]);
end;

function FormatToStr(Value: PChar; Len, Format: Integer): String;
var
  Fmt: TStringFormatClass;
begin
  Result := '';
  if (Value = nil) or (Format = fmtNONE) then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  Fmt := StringFormat(Format);
  if Fmt <> nil then
    if Fmt.IsValid(Value, Len, True) then Result := Fmt.ToStr(Value, Len)
      else raise EStringFormat.CreateFMT(sInvalidStringFormat, [FMT.Name])
    else raise EStringFormat.CreateFMT(sStringFormatExists, [Format]);
end;

function ConvertFormat(Value: PChar; Len, FromFormat, ToFormat: Integer): String;
begin
  Result := '';
  if (FromFormat = fmtNONE) or (ToFormat = fmtNONE) then Exit;
  if FromFormat <> ToFormat then
  begin
    Result := FormatToStr(Value, Len, FromFormat);
    Result := StrToFormat(PChar(Result), Length(Result), ToFormat);
  end else
  begin
    if Value = nil then Exit;
    if Len < 0 then Len := StrLen(Value);
    if Len = 0 then Exit;
    SetLength(Result, Len);
    Move(Value^, PChar(Result)^, Len);
  end;
end;

function IsValidFormat(Value: PChar; Len, Format: Integer): Boolean;
var
  Fmt: TStringFormatClass;
begin
  Result := True;
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  Fmt := StringFormat(Format);
  if Fmt = nil then Result := False
    else Result := Fmt.IsValid(Value, Len, True);
end;

function IsValidString(Value: PChar; Len, Format: Integer): Boolean;
var
  Fmt: TStringFormatClass;
begin
  Result := True;
  if Value = nil then Exit;
  if Len < 0 then Len := StrLen(Value);
  if Len = 0 then Exit;
  Fmt := StringFormat(Format);
  if Fmt = nil then Result := False
    else Result := Fmt.IsValid(Value, Len, False);
end;

procedure RegisterStringFormats(const StringFormats: array of TStringFormatClass);
var
  I,J: Integer;
  FMT: TStringFormatClass;
begin
  if FStrFMTs = nil then FStrFMTs := TList.Create;
  for I := Low(StringFormats) to High(StringFormats) do
    if (StringFormats[I] <> nil) and
       (StringFormats[I].Format <> fmtDEFAULT) then
    begin
      FMT := StringFormat(StringFormats[I].Format);
      if FMT <> nil then
      begin
        J := FStrFMTs.IndexOf(FMT);
        FStrFMTs[J] := StringFormats[I];
      end else FStrFMTs.Add(StringFormats[I]);
    end;
end;

procedure GetStringFormats(Strings: TStrings);
var
  I: Integer;
begin
  if IsObject(Strings, TStrings) and (FStrFMTs <> nil) then
    for I := 0 to FStrFMTs.Count-1 do
      Strings.AddObject(TStringFormatClass(FStrFMTs[I]).Name, FStrFMTs[I]);
end;

function InsertCR(const Value: String; BlockSize: Integer): String;
var
  I: Integer;
  S,D: PChar;
begin
  if (BlockSize <= 0) or (Length(Value) <= BlockSize) then
  begin
    Result := Value;
    Exit;
  end;
  I := Length(Value);
  SetLength(Result, I + I * 2 div BlockSize + 2);
  S := PChar(Value);
  D := PChar(Result);
  repeat
    Move(S^, D^, BlockSize);
    Inc(S, BlockSize);
    Inc(D, BlockSize);
    D^ := #13; Inc(D);
    D^ := #10; Inc(D);
    Dec(I, BlockSize);
  until I < BlockSize;
  Move(S^, D^, I);
  Inc(D, I);
  SetLength(Result, D - PChar(Result));
end;