globalunit.pas

实达企业在线EOL源码

  begin
    LeftPad:= LeftPadCh(S, ' ', Len);
  end;

//返回一个字符,取掉左边的空格和控制字符
  function TAccessString.TrimLead(const S : string) : string;
    {-Return a string with leading white space removed}
{$IFDEF WIN32}
  begin
    Result:= TrimLeft(S);
  end;
{$ELSE}
  var
    I : integer;
  begin
{>>A2.01} Result:= S;

    I := 1;
    while (I <= Length(S)) and (S[I] <= ' ') do
      Inc(I);
    Dec(I);

{>>A 2.01}
    if I > 0 then
      Delete(Result, 1, I);
{<<A 2.01}
  end;
{$ENDIF WIN32}

//返回一个字符,取掉右边的空格和控制字符
  function TAccessString.TrimTrail(const S : string) : string;
    {-Return a string with trailing white space removed}
{$IFDEF WIN32}
  begin
    Result:= SysUtils.TrimRight(S);
  end;
{$ELSE}
  var
    SLen : integer;
  begin
{>>A 2.01}
    Result:= S;
{<<A 2.01}
    SLen:= length(S);

    while ( SLen > 0) and (S[SLen] <= ' ') do
      Dec(SLen);

    SetLength(Result, SLen);
  end;
{$ENDIF WIN32}

//计算一个String中的单词（word)数,单词的分隔符号由WordDelims指定
  function TAccessString.WordCount(const S : string; WordDelims : TChrSet) : longint;
    {-Given a set of word delimiters, return number of words in S}
  var
    I   : longint;
    SLen: longint;
  begin
    Result:= 0;
    I:= 1;
    SLen:= length(S);

    while I <= SLen do begin
      {skip over delimiters}
      while (I <= SLen) and (S[I] in WordDelims) do
        Inc(I);

      {if we're not beyond end of S, we're at the start of a word}
      if I <= SLen then
        Inc(Result);

      {find the end of the current word}
      while (I <= SLen) and not(S[I] in WordDelims) do
        Inc(I);
    end;
  end;

//***************************************************************
//计算一个String中的第N个单词,单词的分隔符号由WordDelims指定    *
//***************************************************************
  function TAccessString.ExtractWord(N : longint; const S : string; WordDelims : TChrSet) : string;
    {-Given a set of word delimiters, return the N'th word in S}
  var
    I, Count: longint;
    Len     : longint;
    SLen    : longint;
  begin
    Count:= 0;
    I:= 1;
    Len:= 0;
    ExtractWord:= EmptyStr;
    SLen:= length(S);

    while (I <= SLen) and (Count <> N) do begin
      {skip over delimiters}
      while (I <= SLen) and (S[I] in WordDelims) do
        Inc(I);

      {if we're not beyond end of S, we're at the start of a word}
      if I <= SLen then
        Inc(Count);

      {find the end of the current word}
      while (I <= SLen) and not(S[I] in WordDelims) do begin
        {if this is the N'th word, add the I'th character to Tmp}
        if Count = N then begin
          Inc(Len);
{$IFDEF WIN32}
          SetLength(Result, Len);
          Result[Len] := S[I];
{$ELSE}
          Result[0] := Char(Len);
          Result[Len] := S[I];
{$ENDIF}
        end;

        Inc(I);
      end;
    end;
  end;

//***************************************************************
//清除一个字符串中指定的某一字符，'abc','b'--->'ac'             *
//***************************************************************
{>>A 2.01}
  function TAccessString.RemoveCharacter( const S: string; C: char ): string;
    {- Return a string, contains no C chars }
  var
    Idx: word;
  begin
    Result:= NullString;

    for Idx:= 1 to length(S) do
      if S[Idx]<>C then Result:= Result + S[Idx];
  end;
{<<A 2.01}

//***************************************************************
//清除一个字符串中多个空格，只流一个空格，'abc    d' ->'abc d'  *
//***************************************************************
  function TAccessString.CompactSpaces( S : string ):string;
  {- return a string with all white spaces removed }
  var
    P : word;
  begin
    S:= Trim( S );

    if length(S)>0 then
    begin
      for P:=1 to length(S)-1 do
        if (S[P]=' ') and ( (S[P+1]=' ') or
            ( (P>1) and (S[P-1]=' ') ) ) then
          while( (S[P-1]=' ') or (S[P+1]=' ')) do
            delete( S, P, 1 );
    end; { if }

    Result:= S;
  end; { CompactSpaces }

//***************************************************************
//清除一个字符串中所有的空格                                    *
//***************************************************************
  function TAccessString.RemoveSpaces( S : string ): string;
    {- Return a string, contains no space chars }
  begin
    Result:= RemoveCharacter(S, ' ');
  end; { RemoveSpaces }

//***************************************************************
//把一个数字转换为右边用Ch填充为Len长字符串：123,0,3-->'123000' *
//***************************************************************
  function TAccessString.digiPadCh( D: longint; Ch : Char; Len : Byte) : string;      {*}
    {-Return a string right-padded to length len with ch}
  begin
    digiPadCh:= PadCh( long2str( D ), Ch, Len );
  end;

//***************************************************************
//把一个数字转换为右边用空格填充为Len长字符串：123,3-->'123   ' *
//***************************************************************
  function TAccessString.digiPad( D: longint; Len : Byte) : string;                   {*}
    {-Return a string right-padded to length len with blanks}
  begin
    digiPad:= PadCh( long2str( D ), ' ', Len );
  end;

//***************************************************************
//把一个数字转换为左边用Ch填充为Len长字符串：123,0,3-->'000123' *
//***************************************************************
  function TAccessString.digiLeftPadCh( D: longint; Ch : Char; Len : Byte) : string;
    {-Return a string left-padded to length len with ch}
  begin
    digiLeftPadCh:= LeftPadCh( long2str( D ), Ch, Len );
  end;

//***************************************************************
//把一个数字转换为左边用空格填充为Len长字符串：123,,3-->'   123'*
//***************************************************************
  function TAccessString.digiLeftPad( D: longint; Len : Byte) : string;               {*}
    {-Return a string left-padded to length len with blanks}
  begin
    digiLeftPad:= LeftPadCh( long2str( D ), ' ', Len );
  end;

//***************************************************************
//返回一个pathname中的盘符                                      *
//***************************************************************
  function TAccessString.JustDriveName( FName : string ):char;
  begin
    FName:= Trim( FName );
    if FName[2]=':' then Result:= FName[1] else
                         Result:= #0;
  end;

//***************************************************************
//返回一个pathname中的文件名除取扩展名部分                      *
//***************************************************************
  function TAccessString.JustMainFileName( FName : string ):string;
  {- return just a part of filename before point }
  var
    PointPos : word;
  begin
     PointPos:= pos( '.', FName );
     if PointPos=0 then
        Result:= Global.FAccessFile.JustFileName( FName )
     else
     begin
        FName:= Global.FAccessFile.JustFileName(FName);
        PointPos:= pos('.',FName);
        Result:= Copy( FName, 1, PointPos-1 );
     end; { if else }
  end; { JustMainFileName }


//***************************************************************
//清除一个pathname中的'\'                                       *
//***************************************************************
{>>A 1.11}
function TAccessString.RemoveBackSlash( P : string ): string;
begin
  while (length(P)>0) and (P[length(P)]='\') do
    delete( P, length(P), 1 );

  Result:= P;
end; { RemoveBackSlash }

//***************************************************************
//返回String中左边Len长度的字符串                               *
//***************************************************************
function TAccessString.TruncLine( S : string; Len : byte ): string;
begin
  Result:= S;
  if length(Result) > Len then
    SetLength(Result, Len);
end; { TruncLine }

//***************************************************************
//返回String中右边Len长度的字符串                               *
//***************************************************************
function TAccessString.TruncLineRt( S : string; Len : byte ): string;
begin
  if length( S ) > Len then
  begin
    delete( S, 1, length(S)-Len );
    TruncLineRt:= S;
  end
  else
    TruncLineRt:= S;
end; { TruncLine }

//***************************************************************
//比较两个String是否相等，大小写敏感                            *
//***************************************************************
function TAccessString.StringsIsEqual( S1, S2 : string ): boolean;
{$IFNDEF WIN32}assembler;{$ENDIF WIN32}
{$IFDEF WIN32}
begin
  Result:= ( CompareStr(S1, S2) = 0);
{$ELSE  WIN32}
asm
  push DS

  xor BX, BX            { assume failure in temp result }

  les DI, S2            { ES:[DI] points to S2[0] }
  lds SI, S1            { DS:[SI] points to S1[0] }

  mov AH, DS:[SI]       { length of S1 in AH }

  cmp AH, ES:[DI]       { compare lengths of S1 and S2 }

  jne @@Done            { if not equal then exit with False }

  xor CX, CX
  mov CL, AH            { number of chars to compare in CX }

  inc DI                { ES:[DI] now points to S2[1] }
  inc SI                { DS:[SI] now points to S1[1] }

  repe cmpsb            { compare until NO MATCH or CX=0 }
  ja @@Done             { if no match then exit with False }

  mov BX, 01            { match, returns True }

@@Done :
  pop DS

  mov AX, BX            { set result from temp store }
{$ENDIF WIN32}
end;

{/////////////////////////////////////////////////////////////////////////////}

//***************************************************************
//使一个String的第一个字符变成大写                              *
//***************************************************************
function TAccessString.FormAsName(S:string): string;                        {*}
  {-Make first letter in string as uppercase }
begin
  S:= ANSIlowerCase( S );
  S[1]:= ANSIupperCase( S[1] )[1];
  Result:= S;
end; { FormAsName }

//***************************************************************
//使一个String的每一个单词的第一个字符变成大写                  *
//***************************************************************
function TAccessString.FormAmericanString(S:string) : string;               {*}
  {-Make first letters in line as uppercase }
var P : byte;
begin
  S[1]:= ANSIupperCase( S[1] )[1];

  for P:=1 to length(S)-1 do
    if (S[P]=' ') and (S[P+1]<>' ') then S[P+1]:= ANSIupperCase(S[P+1])[1];

  Result:= S;
end; { FormAmericanString }


{>>A 2.01}
//***************************************************************
//转换一个String to 数字                                        *
//***************************************************************
function TAccessString. nxStrToInt(const S: string): longint;
begin
  if trim(S) = EmptyStr then Result:= 0
    else Result:= StrToInt(S);
end; { nxStrToInt }

//***************************************************************
//判断一个String是否为NULL                                      *
//***************************************************************
function TAccessString. StrIsNull(const S: string): boolean;
begin
  Result:= (length(trim(S))<=0);
end; { StrIsNull }
{<<A 2.01}

//***************************************************************
//统计一个String中某一字符的个数                                *
//***************************************************************
{>>A 2.02}
function TAccessString. CharCount(C: char; const S: string): integer;
var
  Idx: integer;
begin
  Result:= 0;

  for Idx:= 1 to length(S) do
    inc(Result, byte( S[Idx]=C ));
end; { CharCount }

//***************************************************************
//用一个字符替换String中另一字符                                *
//***************************************************************
procedure TAccessString.ReplaceChar(SrcChar, DstChar: char; var S: string);
{- replaces all occurencies of SrcChar in string S by DstChar }
var
  I: integer;
begin
  for I:= 1 to length(S) do
    if S[I] = SrcChar then
      S[I]:= DstChar;
end; { ReplaceChar }

//***************************************************************
//取一个字符串中双引号中间的字符串，
//如果没有双引号，则取全集
//如果有一个双引号，则取双引号右边的字符串                      *
//***************************************************************
function TAccessString. GetQuotedString(const S: string): string;
var
  QPos: {$IFDEF DELPHI3}longint{$ELSE}word{$ENDIF};
begin
  QPos:= pos(DoubleQuote, S);

  if QPos<=0 then
  begin
    Result:= S;
    Exit;
  end; { if }

  Result:= S;
  delete(Result, 1, QPos+1);

  QPos:= pos(DoubleQuote, Result);

  if QPos>0 then
    Result:= copy(Result, 1, QPos-1);
end; { GetQuotedString }

//***************************************************************
//转换十六进制的字符串为一个数字
//***************************************************************
function TAccessString. HexToInt(const H: string; Digits: integer; var I: longint): boolean;
{- Converts a hexadecimal string to long integer. Digits determines how
  much digits in a string must be used during conversion. Returns False if
  empty string passed or non-hex characters encountered. If error occurs,
  I variable does not changes it's value. In case of success returns True
  and decimal value in I variable. }
var
  Idx: integer;
  L: longint;
  H2B: byte;
  Pwr: byte;

  function HexPower(Signer: integer): longint;
  var
    HxIdx: integer;
  begin
    Result:= 1;
    if Signer=0 then
      Exit;

    Result:= 1;
    for HxIdx:= 1 to Signer do
      Result:= Result * 16;
  end; { HexPower }

begin
  Result:= False;
  L:= 0;

  for Idx:= 1 to length(H) do
    if pos(UpCase(H[Idx]), HEXdigits) = 0 then Exit;

  if Digits>8 then
    Exit;

  Pwr:= 0;
  for Idx:= length(H) downto 1 do
  begin
    for H2B:= 0 to $F do
      if HEXdigits[H2B] = UpCase(H[Idx]) then
      begin
        L:= L + HexPower(Pwr) * H2B;