dxstring.pas

Well known and usefull component for delphi 7

begin
   for Result:=High(KnownCommands)downto Low(KnownCommands) do
      if SearchStr=KnownCommands[Result] then Exit;
   Result:=-1;
end;

procedure InverseString(var S:string;Count:Integer);
{$IFNDEF ASM8086}
var
   TmpStr:string;
   Ctr:Integer;
   Ch:Char;

begin
   TmpStr:=Copy(S,1,Count);
   Ctr:=0;
   while Count>0 do begin
      Ch:=TmpStr[Count];
      Dec(Count);
      FastMove(Ch,S[Ctr+1],1);
      Inc(Ctr);
   end;
{$ELSE}
var
  L:Integer;
  Src,D:Pointer;
  aSourceString:String;
  tmpStr:String;

begin
  aSourceString:=Copy(S,1,Count);
  L:=Length(aSourceString);
  SetLength(tmpStr,L);
  if L=0 then exit;
  Src:=@aSourceString[1];
  D:=@tmpStr[L];
  asm
    push ESI
    push EDI
    mov  ECX, L
    mov  ESI, Src
    mov  EDI, D
@Loop:
    mov  Al, [ESI]
    inc  ESI
    mov  [EDI], Al
    dec  EDI
    dec  ECX
    jnz  @Loop
    pop  EDI
    pop  ESI
  end;
  Delete(S,1,Count);
  Insert(tmpStr,S,1);
{$ENDIF}
end;

function HexDump(const S:string):string;
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:='';
   Loop:=0;
   MaxLoop:=Length(S);
   while Loop<MaxLoop do begin
      Result:=Result+IntToHex(Ord(S[Loop+1]),2)+#32;
      Inc(Loop);
   end;
end;

function ReplaceChar(const Source:string;const OldChar,NewChar:Char):string;
var
   Loop:Integer;

begin
   Result:=Source;
   if OldChar=NewChar then Exit;
   Loop:=Length(Source);
   while Loop>0 do begin
      if Result[Loop]=OldChar then Result[Loop]:=NewChar;
      Dec(loop);
   end;
end;

function ExtractLeft(const aSourceString:string;const Size:Integer):string;
begin
   if Size>Length(aSourceString) then
      Result:=aSourceString
   else begin
      Setlength(Result,Size);
      FastMove(aSourceString[1],Result[1],Size);
   end;
end;

function ExtractRight(const aSourceString:string;const Size:Integer):string;
var
   Len:Integer;

begin
   Len:=Length(aSourceString);
   if Size>Len then
      Result:=aSourceString
   else begin
      Setlength(Result,Size);
      FastMove(aSourceString[Len-Pred(Size)],Result[1],Size);
   end;
end;

function ExtractWordAt(const Text:string;Position:Integer):string;
var
   Done:Boolean;
   StartAt:Integer;
   Len:Integer;
   OrgPosition:Integer;

begin
   Len:=Length(Text);
   Result:='';
   Done:=not(UpCase(Text[Position])in ['A'..'Z','0'..'9']);
   if (Position>0)and(Position<=Len)and not Done then begin
      OrgPosition:=Position;
      while (Position>0)and not Done do begin
         Done:=not(UpCase(Text[Position])in ['A'..'Z','0'..'9']);
         if not Done then Dec(Position);
      end;
      StartAt:=Position;
      Position:=OrgPosition;
      Done:=False;
      while (Position<=Len)and not Done do begin
         Done:=not(UpCase(Text[Position])in ['A'..'Z','0'..'9']);
         if not Done then Inc(Position);
      end;
      Result:=Copy(Text,StartAt+1,Pred(Position)-StartAt);
   end;
end;

function LeftJustify(const S:string;const MaxLength:Integer):string;
begin
   Result:=LeftJustifyCh(S,#32,MaxLength);
end;

function RightJustify(const S:string;const MaxLength:Integer):string;
begin
   Result:=RightJustifyCh(S,#32,MaxLength);
end;

function CleanChar(const InChar:Char):Char;
const
   CtlChars:string[32]='oooooooooXoollo><|!Pg*|^v><-^v';
   HiChars:string[64]='CueaaaageeeiiiAAEaaooouuyOUcLYPfarounNao?--//!<>***|||||||||||||';
   HiChars2:string[64]='|--|-+||||=+|=++-=--==-||||*****abcnEduto0nd80En=+><fj/~oo.vn2* ';

begin
   case InChar of
      #0..#31:Result:=CtlChars[Ord(InChar)+1];
      #128..#191:Result:=HiChars[Ord(InChar)-127];
      #192..#255:Result:=HiChars2[Ord(InChar)-191];
   else
      Result:=InChar;
   end;
end;

function CleanStr(const InStr:string):string;
begin
   Result:='';
   while Length(Result)<Length(InStr) do
      Result:=Result+CleanChar(InStr[Length(Result)+1]);
end;

function PosLastChar(const Ch:Char;const S:string):Integer;
var
   I:Integer;

begin
   i:=Length(S);
   while ((i>0)and(s[i]<>ch)) do
      Dec(i);
   Result:=I;
end;

function AsciiToOem(const ax:string):string;
var
   i:integer;

begin
   Result:=AX;
   for i:=Length(Result)downto 1 do begin
      case Ord(Result[i]) of
         132:Result[i]:=Char(228);
         142:Result[i]:=Char(196);
         129:Result[i]:=Char(252);
         154:Result[i]:=Char(220);
         148:Result[i]:=Char(246);
         153:Result[i]:=Char(214);
         225:Result[i]:=Char(223);
      end;
   end;
end;

function OemToAscii(const ax:string):string;
var
   i:integer;

begin
   Result:=AX;
   for i:=Length(Result)downto 1 do begin
      case Ord(Result[i]) of
         228:Result[i]:=Char(132);
         196:Result[i]:=Char(142);
         252:Result[i]:=Char(129);
         220:Result[i]:=Char(154);
         246:Result[i]:=Char(148);
         214:Result[i]:=Char(153);
         223:Result[i]:=Char(225);
      end;
   end;
end;

function WordCount(const S:string):Integer;
var
   I,Len:Integer;

begin
   Len:=Length(S);
   Result:=0;
   I:=1;
   while I<=Len do begin
      while (i<=len)and((S[i]=#32)or(S[i]=#9)or(S[i]=';')) do
         inc(i);
      if I<=len then inc(Result);
      while (I<=len)and(S[i]<>#32)and(S[i]<>#9)and(S[i]<>';') do
         inc(i);
   end;
end;

function CRC32ByChar(const Ch:Char;const starting_crc:LONGINT):LONGINT;
begin
   Result:=crc_32_tab[BYTE(starting_crc xor LONGINT(Ord(Ch)))]xor((starting_crc shr 8)and $00FFFFFF);
end;

function CRC32ByString(const S:string;const starting_crc:LONGINT):LONGINT;
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:=starting_crc;
   MaxLoop:=Length(S);
   for Loop:=1 to MaxLoop do
//      Result:=CRC32ByChar(S[Loop],Result);
      Result:=crc_32_tab[BYTE(Result xor LONGINT(Ord(S[Loop])))]xor((Result shr 8)and $00FFFFFF);
end;

function CRC16ByChar(const Ch:Char;const starting_crc:word):word;
begin
   Result:=crc_16_tab[BYTE(starting_crc xor Word(Ord(Ch)))]xor((starting_crc shr 8)and $00FF)
end;

function CRC16ByString(const S:string;const starting_crc:word):word;
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:=starting_crc;
   MaxLoop:=Length(S);
   for Loop:=1 to MaxLoop do
//      Result:=CRC16ByChar(S[Loop],Result);
      Result:=crc_16_tab[BYTE(Result xor Word(Ord(S[Loop])))]xor((Result shr 8)and $00FF)
end;

function CRCARCByChar(const Ch:Char;const starting_crc:word):word;
begin
   Result:=crc_arc_tab[BYTE(starting_crc xor Word(Ord(Ch)))]xor((starting_crc shr 8)and $00FF)
end;

function CRCARCByString(const S:string;const starting_crc:word):word;
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:=starting_crc;
   MaxLoop:=Length(S);
   for Loop:=1 to MaxLoop do
//      Result:=CRCARCByChar(S[Loop],Result);
      Result:=crc_arc_tab[BYTE(Result xor Word(Ord(S[Loop])))]xor((Result shr 8)and $00FF)
end;


procedure SetLongBit(var L:LongInt;const Bit:Byte;const Setting:Boolean);
var
   Mask:LongInt;

begin
   Mask:=1;
   Mask:=Mask shl(Bit-1);
   if Setting then
      L:=L or Mask
   else
      L:=(L and(not Mask));
end;

function GetLongBit(const L:LongInt;const Bit:Byte):Boolean;
var
   Mask:LongInt;

begin
   Mask:=1;
   Mask:=Mask shl(Bit-1);
   Result:=(L and Mask)<>0;
end;

procedure SetWordBit(var L:Word;const Bit:Byte;const Setting:Boolean);
var
   Mask:Word;

begin
   Mask:=1;
   Mask:=Mask shl(Bit-1);
   if Setting then
      L:=L or Mask
   else
      L:=(L and(not Mask));
end;

function GetWordBit(const L:Word;const Bit:Byte):Boolean;
var
   Mask:Word;

begin
   Mask:=1;
   Mask:=Mask shl(Bit-1);
   Result:=(L and Mask)<>0;
end;

procedure SetByteBit(var L:Byte;const Bit:Byte;const Setting:Boolean);
var
   Mask:Byte;

begin
   Mask:=1;
   Mask:=Mask shl(Bit-1);
   if Setting then
      L:=L or Mask
   else
      L:=(L and(not Mask));
end;

function GetByteBit(const L:Byte;const Bit:Byte):Boolean;
var
   Mask:Byte;

begin
   Mask:=1;
   Mask:=Mask shl(Bit-1);
   Result:=(L and Mask)<>0;
end;

function Replicate(const Source:string;NumberOfTimes:Integer):string;
var
   SourceLength:Integer;
   Dest:Integer;

begin
   Dest:=1;
   SourceLength:=Length(Source);
   SetLength(Result,SourceLength*NumberOfTimes);
   while NumberOfTimes>0 do begin
      FastMove(Source[1],Result[Dest],SourceLength);
      Inc(Dest,SourceLength);
      Dec(NumberOfTimes);
   end;
end;

function IsWildCard(const Source:string):Boolean;
begin
   Result:=CharPos('*',Source)+CharPos('?',Source)+CharPos('%',Source)>0;
end;

///////////////////////////////////////////////////////////////////////////////
// Internet Routines
///////////////////////////////////////////////////////////////////////////////

function GetIndex(const c:char):Integer;
var
   i:Integer;
{$IFDEF ASM8086}
   S:string;
{$ENDIF}

begin
{$IFNDEF ASM8086}
   i:=CharPos(c,Alphabet);//overkill for just 1 character
{$ELSE}
   S:=Alphabet;
   asm
   PUSH EDI                 //Preserve this register
   mov  EDI, S              //Point EDI at Alphabet string
   mov  ECX, AlphaBetLength //Tell CPU how big Alphabet is
   mov  AL,  C              //and which char we want
   RepNE ScaSB              //"Rep"eat while "N"ot "E"qual
                            //this is the same as
                            //While (EDI^ <> AL) and (ECX>0) do begin
                            //  Inc(EDI);
                            //  Dec(ECX);
                            //end;
   jnz  @NotFound           //Zero flag will be set if there was a match
   sub  EDI, S              //EDI has been incremented, so EDI-OrigAdress = Char pos !
   mov  I,   EDI
@NotFound:
   POP  EDI
   end;
{$ENDIF}
   if (i>0) then Dec(i);
   result:=i;
end;

function Base64ToString(const S:string):string;
var
   i:Integer;

function DecodeUnit(const InStr:string):ShortString;
var
   a,b,c,d:Byte;


begin
   a:=GetIndex(InStr[1]);
   b:=GetIndex(InStr[2]);
   if InStr[3]='=' then begin
      SetLength(Result,1);
      result[1]:=chr((a shl 2)or(b shr 4));
   end
   else
      if InStr[4]='=' then begin
         SetLength(Result,2);
         c:=GetIndex(InStr[3]);
         result[1]:=chr((a shl 2)or(b shr 4));
         result[2]:=chr((b shl 4)or(c shr 2));
      end
      else begin
         c:=GetIndex(InStr[3]);
         d:=GetIndex(InStr[4]);
         SetLength(result,3);
         result[1]:=chr((a shl 2)or(b shr 4));
         result[2]:=chr((b shl 4)or(c shr 2));
         result[3]:=chr((c shl 6)or d);
      end;
end;