globalunit.pas

实达企业在线EOL源码

      {Either the root directory of default drive or invalid pathname}
      Result := PathName[1]
    else if (PathName[I] = '\') then begin
      if PathName[Pred(I)] = ':' then
        {Root directory of a drive, leave trailing backslash}
        Result := Copy(PathName, 1, I)
      else
        {Subdirectory, remove the trailing backslash}
        Result := Copy(PathName, 1, Pred(I));
    end else
      {Either the default directory of a drive or invalid pathname}
      Result := Copy(PathName, 1, I);
  end;

//***************************************************************
//给一个PathName，在末尾增加一个'\'                             *
//***************************************************************
  function TAccessFile.AddBackSlash(const DirName : string) : string;
    {-Add a default backslash to a directory name}
  begin
    if (DirName<>EmptyStr) and (DirName[Length(DirName)] in DosDelimSet) then
      Result:= DirName
    else
      Result:= DirName+'\';
  end;

//=====================================================================

{ TAccessOthers }

constructor TAccessOthers.Create;
begin
 
end;

destructor TAccessOthers.Destroy;
begin
  inherited;

end;

//大小写金额转换
function TAccessOthers.SmallTOBig(small:real):string;
var
    SmallMonth,BigMonth:string;
    wei1,qianwei1:string[2];
    qianwei,dianweizhi,qian:integer;
begin
  qianwei:=-2;
  Smallmonth:=formatfloat('0.00',small);
  dianweizhi :=pos('.',Smallmonth);
  for qian:=length(Smallmonth) downto 1 do
  begin
    if qian<>dianweizhi then
    begin
        case strtoint(copy(Smallmonth,qian,1)) of
        1:wei1:='壹'; 2:wei1:='贰';
        3:wei1:='叁'; 4:wei1:='肆';
        5:wei1:='伍'; 6:wei1:='陆';
        7:wei1:='柒'; 8:wei1:='捌';
        9:wei1:='玖'; 0:wei1:='零';
        end;
        case qianwei of
        -3:qianwei1:='厘';
        -2:qianwei1:='分';
        -1:qianwei1:='角';
        0 :qianwei1:='元';
        1 :qianwei1:='拾';
        2 :qianwei1:='佰';
        3 :qianwei1:='千';
        4 :qianwei1:='万';
        5 :qianwei1:='拾';
        6 :qianwei1:='佰';
        7 :qianwei1:='千';
        8 :qianwei1:='亿';
        9 :qianwei1:='十';
        10:qianwei1:='佰';
        11:qianwei1:='千';
        end;
        inc(qianwei);
        BigMonth :=wei1+qianwei1+BigMonth;
     end;
   end;
   SmallTOBig:=BigMonth;
end;


//格式化整数
function TAccessOthers.getstring(AInt:integer;Len:integer):string;
var
  k:integer;
  str:string;
begin
   str:=inttostr(AInt);
   for k:=Len downto length(str)+1 do
     str:='0'+str;
   Result := str;
end;

//=====================================================================

{ TAccessString }

constructor TAccessString.Create;
begin

end;

destructor TAccessString.Destroy;
begin
  inherited;

end;

//返回字符在指定字符串中出现第n次的位置
function TAccessString.Pos2(SubStr,AStr:string;Inx:Integer):Integer;
var
  Po:array[0..10] of Integer;
  i,j:integer;
begin
 j:=0;
 for i:=0 to length(AStr)-1 do
  if Copy(AStr,i,length(SubStr))=SubStr then begin
    Po[j]:=i;
    Inc(j);
  end;
  result:=Po[inx-1];
end;

//返回指定字符的重复串
function TAccessString.str(Astr:string;Num:integer):string;
var
  p:integer;
  gg:string;
begin
  for p:=0 to Num-1 do
    gg:=gg+Astr;
  result:=gg;
end;

//返回字符串中指定字符左边的部分
function TAccessString.StrLeft(SubStr,AStr:string):string;
begin
  Result:=copy(AStr,0,pos(substr,AStr)-1);
end;

//返回字符串中指定字符右边的部分
function TAccessString.StrRight(SubStr,AStr:string):string;
begin
  Result:=copy(Astr,pos(substr,Astr)+length(substr),length(Astr)-pos(substr,Astr));
end;

//判断指定串是否是数字串
function TAccessString.IsInt(AString: String): Boolean;
begin
  result:=false;
  try
    StrToInt(AString);
  except
    on EConvertError do
      result := False;
  else
    result := True;
  end;
end;

{确保字符串最后一个字符中有'\'（例如目录字符串）}
function TAccessString.slash(value:string):string;
begin
  if (value[length(value)]<>'\') then result:=value+'\' else result:=value;
end;

{单词的第一个字符大写，其它小写}
function TAccessString.capfirst(value:string):string;
var
  i:integer;
  s:string;
begin
  s:=uppercase(value[1]);
  for i:=2 to length(value) do
    if (ord(value[i-1])<33) then s:=s+uppercase(value[i]) else s:=s+lowercase(value[i]);
  result:=s;
end;

{去掉HTML标识符}
function TAccessString.striptags(value:string):string;
var
  i:integer;
  s:string;
begin
  i:=1;
  s:='';
  while i<=length(value) do
  begin
    if value[i]='<' then repeat inc(i) until (value[i]='>') else s:=s+value[i];
    inc(i);
  end;
  result:=s;
end;

{截取从s字符串中第一个以c字符开始的l个字符}
function TAccessString.CopyFromChar(s:string;c:char;l:integer):string;
var
  i:integer;
begin
  i:=pos(c,s);
  result:=copy(s,i,l);
end;

//以下为转换byte,word,longint，pointer,为一个十六进制的字符串*
  function TAccessString.HexB(B : Byte) : string;
    {-Return hex string for byte}
  begin
    SetLength(Result, 2);
    Result[1] := HEXdigits[B shr 4];
    Result[2] := HEXdigits[B and $F];
  end;

  function TAccessString.HexW(W : Word) : string;
    {-Return hex string for word}
  begin
    SetLength(Result, 4);
    Result[1] := HEXdigits[hi(W) shr 4];
    Result[2] := HEXdigits[hi(W) and $F];
    Result[3] := HEXdigits[lo(W) shr 4];
    Result[4] := HEXdigits[lo(W) and $F];
  end;

  function TAccessString.HexL(L : LongInt) : string;
    {-Return hex string for LongInt}
  begin
    with TLong(L) do
      HexL := HexW(HighWord)+HexW(LowWord);
  end;

  function TAccessString.HexPtr(P : Pointer) : string;
    {-Return hex string for pointer}
  begin
{$IFDEF WIN32}
    Result:= HexW(TLong(P).HighWord)+':'+HexW(TLong(P).LowWord);
{$ELSE}
    Result := HexW(Seg(P^))+':'+HexW(Ofs(P^));
{$ENDIF}
  end;

//以下为转换byte,word,longint,为一个二进制的字符串*
  function TAccessString.BinaryB(B : Byte) : string;
    {-Return binary string for byte}
  var
    I, N : Word;
  begin
    N := 1;
    SetLength(Result, 8);

    for I := 7 downto 0 do begin
      Result[N] := HEXdigits[Ord(B and (1 shl I) <> 0)]; {0 or 1}
      Inc(N);
    end;
  end;

  function TAccessString.BinaryW(W : Word) : string;
    {-Return binary string for word}
  var
    I, N : Word;
  begin
    N := 1;
    SetLength(Result, 16);

    for I := 15 downto 0 do begin
      Result[N] := HEXdigits[Ord(W and (1 shl I) <> 0)]; {0 or 1}
      Inc(N);
    end;
  end;

  function TAccessString.BinaryL(L : LongInt) : string;
    {-Return binary string for LongInt}
  var
    I : LongInt;
    N : Byte;
  begin
    N := 1;
    SetLength(Result, 32);

    for I := 31 downto 0 do begin
      Result[N] := HEXdigits[Ord(L and LongInt(1 shl I) <> 0)]; {0 or 1}
      Inc(N);
    end;
  end;

//以下为转换byte,word,longint,为一个八进制的字符串*
function TAccessString.OctalB(B : Byte) : string;
    {-Return octal string for byte}
  var
    I : Word;
  begin
    SetLength(Result, 3);

    for I := 0 to 2 do begin
      Result[3-I] := HEXdigits[B and 7];
      B := B shr 3;
    end;
  end;

  function TAccessString.OctalW(W : Word) : string;
    {-Return octal string for word}
  var
    I : Word;
  begin
    SetLength(Result, 6);

    for I := 0 to 5 do begin
      Result[6-I] := HEXdigits[W and 7];
      W := W shr 3;
    end;
  end;

  function TAccessString.OctalL(L : LongInt) : string;
    {-Return octal string for word}
  var
    I : Word;
  begin
    SetLength(Result, 12);

    for I := 0 to 11 do begin
      Result[12-I] := HEXdigits[L and 7];
      L := L shr 3;
    end;
  end;


//以下为转换string to integer
function TAccessString.Str2Int(const S : string; var I : Integer) : Boolean;
    {-Convert a string to an integer, returning true if successful}
  begin
    Result:= True;

    try
      I:= StrToInt(S);
    except
      Result:= False;
    end; { try }
  end;

//以下为转换string to word
  function TAccessString.Str2Word(const S : string; var I : Word) : Boolean;
    {-Convert a string to a word, returning true if successful}
  begin
    Result:= True;

    try
      I:= StrToInt(S);
    except
      Result:= False;
    end; { try }
  end;

//以下为转换string to Longint
  function TAccessString.Str2Long(const S : string; var I : LongInt) : Boolean;
    {-Convert a string to a longint, returning true if successful}
  begin
    Result:= True;

    try
      I:= StrToInt(S);
    except
      Result:= False;
    end; { try }
  end;

//以下为转换string to Double
  function TAccessString.Str2Real(const S : string; var R : Double) : Boolean;
    {-Convert a string to a double, returning true if successful.
      NOTE: for backward compatibility only. Use StrToFloat Delphi's native
      function TAccessString.}
  begin
    Result:= True;

    try
      R:= StrToFloat(S);
    except
      Result:= False;
    end; { try }
  end;

//以下为转换long/word/integer/byte/shortint to a string*
  function TAccessString.Long2Str(L : LongInt) : string;
    {-Convert a long/word/integer/byte/shortint to a string}
  begin
    Result:= IntToStr(L);
  end;

//返回一个用某一字符添满的string
  function TAccessString.CharStr(Ch : Char; Len : Byte) : string;
    {-Return a string of length len filled with ch}
  begin
    if Len = 0 then
        SetLength(Result, 0)
      else begin
        SetLength(Result, Len);
        FillChar(Result[1], Len, Ch);
      end;
  end;

//返回一个字符,其右边用长度为Len的Ch字符填充
  function TAccessString.PadCh(const S : string; Ch : Char; Len : Byte) : string;
    {-Return a string right-padded to length len with ch}
  var
    SLen : Byte absolute S;
  begin
    if Length(S) >= Len then
      Result := S
    else begin
      SetLength(Result, Len);
      Move(S[1], Result[1], SLen);

      if SLen < 255 then
        FillChar(Result[Succ(SLen)], Len-SLen, Ch);
    end;
  end;

//返回一个字符,其右边用长度为Len的空格字符填充
  function TAccessString.Pad(const S : string; Len : Byte) : string;
    {-Return a string right-padded to length len with blanks}
  begin
    Pad := PadCh(S, ' ', Len);
  end;

//返回一个字符,其左边用长度为Len的Ch字符填充
  function TAccessString.LeftPadCh(const S : string; Ch : Char; Len : Byte) : string;
    {-Return a string left-padded to length len with ch}
  var
{$IFNDEF WIN32}
    o : string;
    SLen : Byte absolute S;
{$ELSE}
    SLen: integer;
{$ENDIF}
  begin
{$IFDEF WIN32}
    SLen:= length(S);
    if SLen >= Len then
      Result := S
    else if SLen < 255 then begin
      SetLength(Result, Len);
      Move(S[1], Result[Succ(Word(Len))-SLen], SLen);
      FillChar(Result[1], Len-SLen, Ch);
    end;
{$ELSE}
    if Length(S) >= Len then
      LeftPadCh := S
    else if SLen < 255 then begin
      o[0] := Chr(Len);
      Move(S[1], o[Succ(Word(Len))-SLen], SLen);
      FillChar(o[1], Len-SLen, Ch);
      LeftPadCh := o;
    end;
{$ENDIF}
  end;

//返回一个字符,其左边用长度为Len的空格字符填充
  function TAccessString.LeftPad(const S : string; Len : Byte) : string;
    {-Return a string left-padded to length len with blanks}