strfuncs.pas

木马源程序,供大家研究

          //如果另一个超链接地址头出现则结束

          P := IsUrl(I);

          IF P > -1 then break;

          url := url + value[i];

        end else break;

      end;

      If Length(url)>0 then

      begin

        result := result + Head + url + Delimiter;

      end;

    end;

    Inc(i,1);

  end;

end;

function ExtractEmail(value, Delimiter : String): string;

var

  I, n : Integer;

  Eleft, Eright: String;

begin

  for I := 1 to Length(value) do

    If value[I] = '@' then

    begin

      ELeft  := '';

      Eright := '';

      for n := I-1 downto 1 do

        If not (value[n] in [',','{','}','@',';',':','[',']','(',')','"','?','*',#0..#32,#128..#255]) then

          Eleft := value[n]+Eleft

          else Break;

      for n := I+1 to Length(value) do

        If not (value[n] in [',','{','}','@',';',':','[',']','(',')','"','?','*',#0..#32,#128..#255]) Then

          Eright := Eright+value[n]

          else Break;

      If (length(Eleft)>0) and (length(Eright)>0) Then

        result := result + Eleft + '@' + Eright + Delimiter;

    end;

end;

function TabToSpace(value: string; TabWidth : Integer): string;

var

  s: string;

begin

  FillChar(s, TabWidth, ' ');

  FastAnsiReplace(value, #9, s, [rfReplaceAll, rfIgnoreCase]);

end;

function SpaceToTab(value : string; TabWidth : Integer): string;

var

  s: string;

begin

  FillChar(s, TabWidth, ' ');

  FastAnsiReplace(value, s, #9, [rfReplaceAll, rfIgnoreCase]);

end;

function GetRandomStr(Source : string; StrLen : Integer) : string;

var

  I: Byte;

begin

  Result := '';

  If Source <> '' then

  begin

    for I := 0 to StrLen do

      Result := Result + Source[Random(Length(Source)-1)+1];

  end;

end;

function Dec2Bin(value : Integer; MinBit : Integer) : string;

begin

  result := '';

  while (value > 0) do

  begin

    if (Trunc(value / 2) * 2 = value) then

      result := '0' + result

    else Result := '1' + Result;

    value := Trunc(value / 2);

  end;

  //填满MaxBit位

  while (Length(Result) < MinBit) Do Result := '0' + Result;

end;

function Bin2Dec(const value : string) : Integer;

var

  NIndex, NLength : Integer;

begin

  result := 0;

  nLength := Length(value);

  for nIndex := 0 to nLength - 1 do

    If (value[nLength - nIndex] = '1') then

      Inc(result, Trunc(Power(2, nIndex)));

end;

function Hex2Dec(const value : string): Integer;

var

  nIndex, nLength : Integer;

  C : char;

begin

  result := 0;

  nLength := Length(value);

  for nIndex := 0 To nLength - 1 do

  begin

    C := Value[nLength - nIndex];

    If ((c >= 'A') And (c <= 'F')) then

      Inc(Result, (ord(c) - 55) * Trunc(Power(16, nIndex)))

    else If ((c >= '0') And (c <= '9')) then

      Inc(Result, (ord(c) - 48) * Trunc(Power(16, nIndex)));

  end;

end;

function Hex2Str(const value : string) : string;

var

  I : integer;

  J : integer;

  T : String;

  S : String;

begin

  S := Trim(value);

  SetLength(result, Length(value) div 2 );

  SetLength(T, 3);

  I := 1;

  J := 1;

  T[1] := '$';

  while I < Length(S) do

  begin

    T[2] := S[I];

    T[3] := S[I+1];

    if (T[2] In ['0'..'9','A'..'F','a'..'f']) and

      (T[3] In ['0'..'9','A'..'F','a'..'f']) then

    begin

      result[J] := Char(StrTointDef(T, 0));

      Inc(J,1);

    end;

    Inc(I, 2);

  end;

  If J <> Length(Value) div 2 Then Setlength(Result, J);

end;

function Mem2Hex(Buffer: PChar; Size : Longint): string;

const

  CharHex : array[#0..#255] of string[2]=(

    '00','01','02','03','04','05','06','07','08','09','0A','0B','0C','0D','0E','0F',

    '10','11','12','13','14','15','16','17','18','19','1A','1B','1C','1D','1E','1F',

    '20','21','22','23','24','25','26','27','28','29','2A','2B','2C','2D','2E','2F',

    '30','31','32','33','34','35','36','37','38','39','3A','3B','3C','3D','3E','3F',

    '40','41','42','43','44','45','46','47','48','49','4A','4B','4C','4D','4E','4F',

    '50','51','52','53','54','55','56','57','58','59','5A','5B','5C','5D','5E','5F',

    '60','61','62','63','64','65','66','67','68','69','6A','6B','6C','6D','6E','6F',

    '70','71','72','73','74','75','76','77','78','79','7A','7B','7C','7D','7E','7F',

    '80','81','82','83','84','85','86','87','88','89','8A','8B','8C','8D','8E','8F',

    '90','91','92','93','94','95','96','97','98','99','99','9B','9C','9D','9E','9F',

    'A0','A1','A2','A3','A4','A5','A6','A7','A8','A9','AA','AB','AC','AD','AE','AF',

    'B0','B1','B2','B3','B4','B5','B6','B7','B8','B9','BA','BB','BC','BD','BE','BF',

    'C0','C1','C2','C3','C4','C5','C6','C7','C8','C9','CA','CB','CC','CD','CE','CF',

    'D0','D1','D2','D3','D4','D5','D6','D7','D8','D9','DA','DB','DC','DD','DE','DF',

    'E0','E1','E2','E3','E4','E5','E6','E7','E8','E9','EA','EB','EC','ED','EE','EF',

    'F0','F1','F2','F3','F4','F5','F6','F7','F8','F9','FA','FB','FC','FD','FE','FF'

  );

var

  I, Len: Longint;

begin

  SetLength(result, Size*2+1);

  for I := 0 to size -1 do

  begin

    result[I*2+1] := CHarHex[Buffer[I]][1];

    result[I*2+2] := CHarHex[Buffer[I]][2];

  end;

end;

function Str2Hex(value : string): string;

begin

  result := Mem2Hex(PChar(value), length(value));

end;

function StrAlignment(const value : string; PageWidth : Integer;

  Alignment : TAlignment): string;

var

  StrList : TStrings;

  i : Integer;

  function GetSpace(Count : integer): string;

  var i : integer;

  begin

    SetLength(Result, Count);

    for i := 1 to Count do

      Result[i] := #32;

  end;

begin

  StrList := TStringList.Create;

  result := value;

  try

    StrList.Text := value;

    for i := 0 to StrList.Count - 1 do

    begin

       StrList[i] := StrTrimLeft(StrTrimRight(StrList[i]));

       if StrList[i] <> '' then

         case Alignment of

           taRightJustify :

             if (PageWidth - Length(StrList[i])) > 0 then

                StrList[i] := GetSpace(PageWidth - Length(StrList[i])) + StrList[i];

           taCenter :

             if ((PageWidth - Length(StrList[i])) div 2) > 0 then

                StrList[i] := GetSpace(((PageWidth - Length(StrList[i])) div 2)) + StrList[i];

         end;

    end;

    result := Strlist.text;

  finally

    StrList.Free;

  end;

end;

function StrWrap(const Text, LineBreak: string;  const Reorder : boolean;

  const Hanging, FirstLine, LeftSpace, PageWidth : Integer;

  const Break : string; const BreakMode : Integer  {0 在字符前换行 1 在字符后换行}

  ): string;

var

  Col, Pos : integer;

  Line, Lines : string;

  procedure FillSpace(Count : integer);

  var i : integer;

  begin

    for i := 1 to Count do

      Line[i] := #32;

  end;

begin

  Pos := 1;

  SetLength(Line, PageWidth);

  FillSpace(LeftSpace + FirstLine);

  Col := LeftSpace + FirstLine + 1;

  while Pos < Length(Text) do

  begin

    if Copy(Text, Pos, length(LineBreak)) = LineBreak then

    begin

      Inc(Pos, length(LineBreak));

      if not Reorder then

      begin

        Lines := Lines + copy(Line, 1, Col - 1) + LineBreak;

        FillSpace(LeftSpace + FirstLine);

        Col := LeftSpace + FirstLine + 1;

      end;

      Continue;

    end;

    if (Break <> '') and (Copy(Text, Pos, length(Break)) = Break) then

    begin

      if (BreakMode = 0) then

      begin

        Lines := Lines + copy(Line, 1, Col - 1) + LineBreak;

        FillSpace(LeftSpace + FirstLine);

        Col := LeftSpace + FirstLine + 1;

        Inc(Pos);
        
      end

      else begin

        if ( (Length(Break) + Col - 1) > PageWidth) then

        begin

          Lines := Lines + copy(Line, 1, Col - 1) + LineBreak;

          if Hanging <= 0 then

          begin

            FillSpace(LeftSpace);

            Col := LeftSpace + 1;

          end

          else begin

            FillSpace(LeftSpace + FirstLine + Hanging);

            Col := LeftSpace + FirstLine + Hanging + 1;

          end;

        end;

        Lines := Lines + copy(Line, 1, Col - 1) + Break + LineBreak;

        inc(Pos, Length(Break));

        FillSpace(LeftSpace + FirstLine);

        Col := LeftSpace + FirstLine + 1;

      end;

      continue;

    end;

    Line[Col] := Text[Pos];

    Inc(Col);

    if (Col > PageWidth) then

    begin

      // 验证双字节字符

      if ByteType(Text, Pos) = mbLeadByte then

      begin

        Dec(Col, 2);

        Dec(Pos);

      end;

      Lines := Lines + copy(Line, 1, Col) + LineBreak;

      if Hanging <= 0 then

      begin

        FillSpace(LeftSpace);

        Col := LeftSpace + 1;


      end

      else begin

        FillSpace(LeftSpace + FirstLine + Hanging);

        Col := LeftSpace + FirstLine + Hanging + 1;

      end;

    end;

    Inc(Pos);

  end;

  Result := Lines + copy(Line, 1, Col-1);

end;

function GBToBIG5(value: string): string;

var

  GBTAB : TResourceStream;

  bak : string;

  C : array[0..1] of Byte;

  I : Integer;

  W : PWordArray;

  CA : array[0..2] of Char;

begin

  try

    GBTAB := TResourceStream.Create(HInstance, 'GBToBIG5', RT_RCDATA);

    bak := '';

    W := @(C[0]);

    I := 1;

    while I <= Length(value) do

    begin

      C[1] := Byte(value[I]);

      if C[1] > $A0 then

      begin

        inc(I, 1);

        C[0] := Byte(value[I]);

        inc(I, 1);

        W[0] := W[0] - GBfirst;

        GBTAB.Position := W[0] * 2;

        GBTAB.read (CA, 2);

        CA[2] := #0;

        bak := bak + StrPas(CA);

      end

      else begin

        bak := bak + value[I];

        inc(I, 1);

      end;

    end;

  finally

    Result := bak;

  end;

end;

function BIG5ToGB(value: string): string;

var

  BIGTAB : TResourceStream;

  bak : string;

  C : array[0..1] of Byte;

  I : Integer;

  W : PWordArray;

  CA : array[0..2] of Char;

begin

  BIGTAB := TResourceStream.Create(Hinstance, 'BIG5ToGB', RT_RCDATA);

  Try

    bak := '';

    I := 1;

    w:=@(C[0]);

    while I <= Length(Value) do

    begin

      C[1] := Byte(Value[I]);

      if C[1] > $A0 then

      begin

        inc(I, 1);

        C[0] := byte(Value[I]);

        inc(I, 1);

        W[0] := W[0] - BIGfirst;

        BigTAB.Position:= W[0]*2;

        BIGTAB.Read(CA,2);

        CA[2]:=#0;

        bak := bak + StrPas(CA);

      end

      else begin

        bak := bak + Value[I];

        inc(I, 1);

      end;

    end;

  finally

    BIGTAB.Free;

    Result := bak;

  end;

end;

function GetGBKOffset(value : string): integer;

begin

  result := -1;

  if length(value)>=2 then

     result := (ord(value[1])-$81)*190+(ord(value[2])-$40);

end;

procedure LoadGBKCodeRes;

var

  sSimple,

  sTradition : widestring;

  s : string;

  P, w, I : integer;

  function getWideChar(s : widestring): WideChar;

  begin

    result:=s[1];

  end;

begin

  If (Length(sChineseTradition)=0) or (Length(sChineseSimple)=0) then

  begin

    SetLength(sChineseTradition, 44780);

    SetLength(sChineseSimple, 44780);

    for I := $81 to $FE do

      for w := $40 to $FE do

        If (w <> $7F) then

        begin

          P := (I-$81)*190+(W-$3f);

          sChineseTradition[p] := getWideChar(char(I)+char(w));

          sChineseSimple[p] := sChineseTradition[p];

        end;

    SetLength(sChineseTradition, P);

    SetLength(sChineseSimple, P);

    sSimple :=  StringFromResource('GBKSimple', RT_RCDATA);

    sTradition := StringFromResource('GBKTradition', RT_RCDATA);

    for I := 1 to length(sSimple) do