mmstring.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]              =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 01.04.98 - 21:05:04 $                                        =}
{========================================================================}
unit  MMString;

{$I COMPILER.INC}

interface

uses
    {$IFDEF WIN32}
    Windows,
    Messages,
    {$ELSE}
    WinProcs,
    WinTypes,
    {$ENDIF}
    SysUtils;

{$IFNDEF WIN32}
procedure SetLength(var StrX: string; Len: integer);
procedure SetString(var StrX: string; Buffer: PChar; Len: integer);
function  Trim(const StrX: string): string;
function  TrimLeft(const StrX: string): string;
function  TrimRight(const StrX: string): string;
{$ENDIF}
function  Replicate(const StrX: string; NoTimes: Byte): string;
procedure DeleteLeft(var strX: string; Border: Char);
procedure DeleteRight(var strX: string; Border: Char);
function  PadEnds(const StrX: string; ch: Char; Len: integer): string;
function  PadLeft(const StrX: string; ch: Char; Len: integer): string;
function  PadRight(const StrX: string; ch: Char; Len: integer): string;
function  LeftEnd(const StrX: string; Border: Char): string;
function  RightEnd(const StrX: string; Border: Char): string;
function  LeftStr(const StrX: string; Len: integer): string;
function  RightStr(const StrX: string; Len: integer): string;
function  Equal(const StrX1, StrX2: string): Boolean;
function  Encrypt(const StrX: string; Key: Word): string;
function  Decrypt(const StrX: string; Key: Word): string;

function  DUpCase(const C: Char): Char;
function  DUpperCase(const S: string): string;

function  PosEx(Start: integer; SubStr, S: string): integer;
function  PosRight(Substr: string; S: string): integer;

function  Replace(const S: string; OldChar, NewChar: Char): string;

{$IFDEF WIN32}
function  StrPosEx(const SubStr: AnsiString; const S: AnsiString; nPos: integer): Integer;
{$ENDIF}

function HexToInt(S: string): Longint;
function IntToBin(Value, Bits: integer): string;

implementation

{$IFNDEF WIN32}
{-------------------------------------------------------------------------}
procedure SetLength(var StrX: string; Len: integer);
begin
     StrX[0] := Char(Len);
end;

{-------------------------------------------------------------------------}
procedure SetString(var StrX: string; Buffer: PChar; Len: integer);
begin
     StrX := StrPas(Buffer);
     StrX[0] := Char(Len);
end;

{-------------------------------------------------------------------------}
function Trim(const StrX: string): string;
var
  i, l: integer;

begin
   l := Length(StrX);
   i := 1;
   while (i <= l) and (StrX[i] <= ' ') do inc(i);
   if i > l then Result := ''
   else
   begin
      while StrX[l] <= ' ' do dec(l);
      Result := Copy(StrX, i, l - i + 1);
   end;
end;

{-------------------------------------------------------------------------}
function TrimLeft(const StrX: string): string;
var
  i, l: integer;

begin
   l := Length(StrX);
   i := 1;
   while (i <= l) and (StrX[i] <= ' ') do inc(i);
   Result := Copy(StrX, i, MaxInt);
end;

{-------------------------------------------------------------------------}
function TrimRight(const StrX: string): string;
var
  i: integer;

begin
   i := Length(StrX);
   while (i > 0) and (StrX[i] <= ' ') do dec(i);
   Result := Copy(StrX, 1, i);
end;
{$ELSE}

type
    StrRec = record
       allocSiz:       Longint;
       refCnt: Longint;
       length: Longint;
    end;

const
     skew = sizeof(StrRec);
     rOff = sizeof(StrRec) - sizeof(Longint);
     overHead = sizeof(StrRec) + 1;


{-------------------------------------------------------------------------}
function StrPosEx(const SubStr: AnsiString; const S: AnsiString; nPos: integer): Integer;
asm
{ returns the index of nPos position in S       }
{     ->EAX     Pointer to substr               }
{       EDX     Pointer to string               }
{       ECX     nPos                            }
{     <-EAX     Position of substr in s or 0    }

        TEST    EAX,EAX
        JE      @@noWork

        TEST    ECX,ECX
        JE      @@invalidCount

        TEST    EDX,EDX
        JE      @@stringEmpty

        PUSH    EBP
        PUSH    EBX
        PUSH    ESI
        PUSH    EDI

        MOV     ESI,EAX                         { Point ESI to substr           }
        MOV     EDI,EDX                         { Point EDI to s                }
        MOV     EBP,ECX                         { EBP = nPos                    }

        MOV     ECX,[EDI-skew].StrRec.length    { ECX = Length(s)               }

        PUSH    EDI                             { remember s position to calculate index        }

        MOV     EDX,[ESI-skew].StrRec.length    { EDX = Length(substr)          }

        DEC     EDX                             { EDX = Length(substr) - 1              }
        JS      @@fail                          { < 0 ? return 0                        }
        MOV     AL,[ESI]                        { AL = first char of substr             }
        INC     ESI                             { Point ESI to 2'nd char of substr      }

        SUB     ECX,EDX                         { #positions in s to look at    }
                                                { = Length(s) - Length(substr) + 1      }
        JLE     @@fail
@@loop:
        REPNE   SCASB
        JNE     @@fail
        MOV     EBX,ECX                         { save outer loop counter               }
        PUSH    ESI                             { save outer loop substr pointer        }
        PUSH    EDI                             { save outer loop s pointer             }

        MOV     ECX,EDX
        REPE    CMPSB
        POP     EDI                             { restore outer loop s pointer  }
        POP     ESI                             { restore outer loop substr pointer     }
        JE      @@found

        MOV     ECX,EBX                         { restore outer loop counter    }
        JMP     @@loop

@@found:
        DEC     EBP
        JZ      @@finalfound

        MOV     ECX,EBX
        JZ      @@fail


        jmp     @@loop
@@fail:
        POP     EDX                             { get rid of saved s pointer    }
        XOR     EAX,EAX
        JMP     @@exit

@@invalidCount:
@@stringEmpty:
        XOR     EAX,EAX
        JMP     @@noWork

@@finalfound:
        POP     EDX                             { restore pointer to first char of s    }
        MOV     EAX,EDI                         { EDI points of char after match        }
        SUB     EAX,EDX                         { the difference is the correct index   }
@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
        POP     EBP
        RET
@@noWork:
end;
{$ENDIF}

{-------------------------------------------------------------------------}
procedure DeleteLeft(Var StrX: string; Border: Char);
begin
     Delete(StrX, 1, Pos(Border, StrX)-1);
end;

{-------------------------------------------------------------------------}
procedure DeleteRight(Var StrX: string; Border: Char);
Var
   Position: integer;
begin
     Position := PosRight(Border, StrX);
     Delete(StrX, Position+1, Length(StrX)-Position+1);
end;

{-------------------------------------------------------------------------}
function PadEnds(const StrX: string; ch: Char; Len: integer): string;
begin
     if Len > Length(StrX) then
     begin
          SetLength(Result, Len);
          FillChar(Result[1], Len, ch);
          Move(StrX[1], Result[((Len - Length(StrX)) DIV 2) + 1],Length(StrX));
     end
     else Result := StrX;
end;

{-------------------------------------------------------------------------}
function PadLeft(const StrX: string; ch: Char; Len: integer): string;
begin
     if Len > Length(StrX) then
     begin
          SetLength(Result, Len);
          FillChar(Result[1], Len, ch);
          Move(StrX[1], Result[Succ(Len - Length(StrX))], Length(StrX));
     end
     else Result :=StrX;
end;

{-------------------------------------------------------------------------}
function PadRight(const StrX: string; ch: Char; Len: integer): string;
begin
     if Len > Length(StrX) then
     begin
          SetLength(Result, Len);
          FillChar(Result[1], Len, ch);
          Move(StrX[1], Result[1], Length(StrX));
     end
     else Result := StrX;
end;

{-------------------------------------------------------------------------}
function Replicate(const StrX: string; NoTimes: Byte): String;
Var
   i   : Byte;

begin
     Result := '';
     for i:= 1 to NoTimes do
         Result := Result + StrX;
End;

{-------------------------------------------------------------------------}
function  LeftEnd(const StrX: string; Border: Char): string;
begin
     Result := Copy(StrX, 1, Pos(Border, StrX)-1);
end;

{-------------------------------------------------------------------------}
function  RightEnd(const StrX: string; Border: char): string;
Var
   Position: Byte;
begin
     Position := PosRight(Border, StrX);
     if Position > 0 then
        Result := Copy(StrX, Position+1, Length(StrX)-Position+1)
     else Result := '';
end;

{-------------------------------------------------------------------------}
function LeftStr(const StrX: string; Len: integer): string;
begin
     Result:= Copy(StrX, 1, Len);
end;

{-------------------------------------------------------------------------}
function RightStr(const StrX: string; Len: integer): string;
begin
     Result := Copy(StrX, Length(StrX) - Len + 1, Len);
end;

{-------------------------------------------------------------------------}
function Equal(const StrX1,StrX2: string): Boolean;
begin
   Result := AnsiCompareText(StrX1,StrX2) = 0;
end;

const
  C1 = 52845;
  C2 = 22719;

{-------------------------------------------------------------------------}
function Encrypt(const StrX: string; Key: Word): string;
var
  i: Integer;

begin
  SetLength(Result,Length(StrX));
  for i := 1 to Length(StrX) do
  begin
     Result[i] := Char(Ord(StrX[i]) xor (Key shr 8));
     Key := (Ord(Result[i]) + Key) * C1 + C2;
  end;
end;

{-------------------------------------------------------------------------}
function Decrypt(const StrX: string; Key: Word): string;
var
   i: Integer;

begin
   SetLength(Result,Length(StrX));
   for i := 1 to Length(StrX) do
   begin
      Result[i] := Char(Ord(StrX[i]) xor (Key shr 8));
      Key := (Ord(StrX[i]) + Key) * C1 + C2;
   end;
end;

{-------------------------------------------------------------------------}
function DUpCase(const C: Char): Char;
begin
   if (C = '