Delphi控件源码

开发平台：
Delphi

MMString.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  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 = '

						