delphi 开发使用的基类A

unit LibStrs;

interface

uses Classes, Windows;

function PadL(const str: String; others: array of integer): String;
function PadR(const str: String; others: array of integer): String;
function Center(xStr:string; xLen:integer):string;
function GetToken(AString, SepStr: string; TokenNum: Integer): string; // Τ丁筳才腹﹃い﹃ ...
function NumToken(AString, SepStr: string): Integer; // Τ丁筳才腹﹃羆计 ...
function ReplaceToken(AString, SepStr: string; TokenNum: Integer; xNew: string): string; //  Token ﹃ ...
function CutToken(var sString: string; const sDelim: string): string;
function FindToken(xString,SepStr,xToken:string):Integer; // т Token ┮
function ReplaceSubStr(xSource,xOld,xNew:string):string; // ﹃
function KillSubStr(xSource,xStr:string):string;
function ZeroATfirst(xValue, xLen: Integer): string;
function Replicate(xSource:string;xTimes:integer):string; // 硈尿狡籹﹃
function Space(xTimes:integer):string;  // 眔琿フ﹃
function RightStr(Const Str: String; Size: Word): String;//﹃
function IIF(Check:Boolean; aValue1,aValue2: Variant):Variant;
function SlashSep(const Path, S: string): string;
function ExtraPos(xSubStr,xSource:string;xNumber:integer):integer;  // 肚材碭﹃觃
function OnlyFileName(aFileName:String):String;// 奔 Path ㎝ Ext 郎

function TransDateIn(Value: string): TDateTime ;
function DateToString( xDate: TDateTime; xType: Integer; xDelim: string ):string ;
function StringToDate( xDate: string ; xType: Integer; xDelim: string ):TDateTime ;

function CheckCompanyNo(const Value : string ) : Boolean ; // 参絪腹
function CheckPersonNo (const Value : string ) : Boolean;  // 浪琩ōだ靡腹絏琌タ絋   Jachu
function CheckDate     (const Value : string ) : Boolean;  // 浪琩ら戳琌猭
function GetMonthName(const Value:string):string;  // 眔璣ゅる嘿
function WhatADate(const Value:TDateTime):string;  // 肚 DEC.14 1998 Α

function InGroup(xGroup,xGroupList: string): Boolean;
function RemoveXSC( xStr : string)  : string; //J р  asc ┪ desc 奔 р フ奔
procedure StringToStrList(input: string; delimiter: string; output: TStringList);
function IsVarEmptyOrNull(xVariant: Variant): Boolean;
function CountDate(xSourceDate:variant;xKind:string;xMove:integer):String; //衡ら戳ㄧ计
function SwapStr(xString, xOldSplit, xNewSplit: String): String; // 蠢传疭﹚﹃
function Store(xValue: Variant; xVariant: Variant; xFieldList: array of Integer): Variant;
Function SetNetDir(xAlias: string): Boolean; // 砞﹚netdir
function Changedate( xDate: string ; xType: integer; xDelim: string ):String ;
function AddAliasName(xSource,xField,xAlias:string):string;
function NumberToEnglish(Value:Double):string;  // 计锣璣ゅ
function ReplacePageNo(xSource,xOld:string):string;  //北 PAGE CURPAGE OF TOTPAGE
function JosRound(xValue:double;xDecimal:integer):double;   //彼き
function AddTstrings(x:TstringList;var F:TextFile):integer; //Vicky 1999.07.22

implementation

uses SysUtils, Dialogs, LibSys,DBtables;

function PadL(const str: String; others: array of integer): String;//オ恶じ
var
   nAlen: Integer;
   nLen1, nLen2, nLen: integer;
   cFiller: char;
   StrFill: String;
   kk: integer;
begin
   nAlen := High(others)+1;
   nLen1 := Length(str);
   nLen2 := others[0];
   if nLen1 >= nLen2 then
   begin
     Result := str;
     exit;
   end;
   if nAlen > 1 then cFiller := chr(others[1])
   else cFiller := ' ';
   nLen := nLen2-nLen1;
   SetLength(StrFill, nLen);
   for kk := 1 to nLen do
     strFill[kk] := cFiller;
   Result := Format('%s%s', [strFill, str]);
end;

function PadR(const str: String; others: array of integer): String;// 恶じ
var
   nAlen: Integer;
   nLen1, nLen2, nLen: integer;
   cFiller: char;
   StrFill: String;
   kk: integer;
begin
   nAlen := High(others)+1;
   nLen1 := Length(str);
   nLen2 := others[0];
   if nLen1 >= nLen2 then
   begin
     Result := str;
     exit;
   end;
   if nAlen > 1 then cFiller := chr(others[1])
   else cFiller := ' ';
   nLen := nLen2-nLen1;
   SetLength(StrFill, nLen);
   for kk := 1 to nLen do
     strFill[kk] := cFiller;
   Result := Format('%s%s', [str,strFill]);
end;

//Τ丁筳才腹﹃い﹃
function GetToken(AString, SepStr: string; TokenNum: Integer): string;
var
  Token: string;
  StrLen: Integer;
  SepLen: Integer;
  TNum: Integer;
  TEnd: Integer;
begin
  StrLen := Length(AString);
  SepLen := Length(SepStr);
  TNum := 1;
  TEnd := StrLen;
  while ((TNum <= TokenNum) and (TEnd <> 0)) do
  begin
    TEnd := AnsiPos(SepStr, AString);
    if TEnd <> 0 then
    begin
      Token := Copy(AString, 1, TEnd - 1);
      Delete(AString, 1, TEnd + SepLen - 1);
      Inc(TNum);
    end
    else
    begin
      Token := AString;
    end;
  end;
  if TNum >= TokenNum then Result := Token
  else Result := '';
end;

//Τ丁筳才腹﹃羆计
function NumToken(AString, SepStr: string): Integer;
var
  RChar: Char;
  StrLen: Integer;
  TNum: Integer;
  TEnd: Integer;
begin
  if SepStr = '#' then RChar := '*' else RChar := '#';
  StrLen := Length(AString);
  TNum := 0;
  TEnd := StrLen;
  while TEnd <> 0 do
  begin
    Inc(TNum);
    TEnd := AnsiPos(SepStr, AString);
    if TEnd <> 0 then AString[TEnd] := RChar;
  end;
  Result := TNum;
end;

// т Token ┮
function FindToken(xString,SepStr,xToken:string):Integer;
var
  i:integer;
begin
  Result:=0;
  for i:=1 to NumToken(xString,SepStr) do
    if GetToken(xString,SepStr,i)=xToken then
    begin
      Result:=i;
      Break;
    end;
end;

//  Token ﹃ ...
function ReplaceToken(AString, SepStr: string; TokenNum: Integer; xNew: string): string;
var
  I: Integer;
  mMaxNum: Integer;
begin
  Result := '';
  mMaxNum := NumToken(AString, SepStr);
  if TokenNum > mMaxNum then
    mMaxNum := TokenNum;
  for I := 1 to mMaxNum do
  begin
    if I > NumToken(AString, SepStr) then
      AString := AString + SepStr;
    if I = TokenNum then
      Result := Result + xNew + SepStr
    else
      Result := Result + GetToken(AString, SepStr, I) + SepStr;
  end;
  if Result <> '' then
    Result := Copy(Result, 1, Length(Result) - Length(SepStr)); // 搭だ筳才腹
end;

// Kill SubStrings in String
function KillSubStr(xSource,xStr:string):string;
var
  mLeft,mRight:string;
  mPos:integer;
begin
  while Pos(xStr,xSource)>0 do
  begin
    mPos:=Pos(xStr,xSource);
    mLeft:=Copy(xSource,1,mPos-1);
    mRight:=Copy(xSource,mPos+Length(xStr),Length(xSource));
    xSource:=mLeft+mRight;
  end;
  Result:=xSource;
end;

{*********************************************
   肚㏕﹚计玡干箂﹃
*********************************************}
// 程 15 τ....
function ZeroATfirst(xValue, xLen: Integer): string;
begin
  Result := Format( '%.*d' , [xLen,xValue] ) ;
end;

(*********************************************
﹃, 眖﹃い埃赣﹃
*********************************************)
function CutToken(var sString: string; const sDelim: string): string;
var
  nPos: Integer;
begin
  nPos := AnsiPos(sDelim, sString);
  if nPos > 0 then
  begin
    CutToken := Copy(sString, 1, nPos - 1);
    sString := Copy(sString, nPos + Length(sDelim), Length(sString) - (nPos + Length(sDelim) - 1));
  end
  else
  begin
    CutToken := sString;
    sString := '';
  end;
end;

{
function TransDateIn(Value: string): string;
begin
  Result := '';
  if (Value = '') or (Length(Value) <> 8) then exit;
  Result := Copy(Value, 1, 4) + '/' + Copy(Value, 5, 2) + '/' +
    Copy(Value, 7, 2);
end;
}

function DateToString( xDate: TDateTime; xType: Integer; xDelim: string ):string ;
var
  mYear  : Word ;
  mMonth : Word ;
  mDay   : Word ;
  mDelim : string ;
begin
  mYear  := 0  ;
  mMonth := 0  ;
  mDay   := 0  ;
  mDelim := '' ;
  if Length( xDelim ) > 0 then
    mDelim := Copy( xDelim , 1 , 1 ) ;

  if xDate <> 0 then
  begin
    DeCodeDate( xDate , mYear , mMonth , mDay ) ;

    case xType of
      1 : Result := Format( '%.4d%s%.2d%s%.2d' ,[mYear,mDelim,mMonth,mDelim,mDay] ) ;
      2 : Result := Format( '%.2d%s%.2d%s%.4d' ,[mMonth,mDelim,mDay,mDelim,mYear] ) ;
      3 : Result := Format( '%.2d%s%.2d%s%.4d' ,[mDay,mDelim,mMonth,mDelim,mYear] ) ;
      4 : Result := Format( '%.2d%s%.2d%s%.2d' ,[mYear-1911,mDelim,mMonth,mDelim,mDay] ) ;
      5 : Result := Format( '%.3d%s%.2d%s%.2d' ,[mYear-1911,mDelim,mMonth,mDelim,mDay] ) ;
    end ;
  end
  else
    Result := '' ;
end ;

function StringToDate( xDate: string ; xType: Integer; xDelim: string ):TDateTime ;
var
  mValue1 : Word ;
  mValue2 : Word ;
  mValue3 : Word ;
begin
  if Trim(xDate) = '' then
    Result := 0
  else
  begin
    mValue1 := StrtoIntDef( CuttoKen( xDate , xDelim ) , -1 ) ;
    mValue2 := StrtoIntDef( CuttoKen( xDate , xDelim ) , -1 ) ;
    mValue3 := StrtoIntDef( CuttoKen( xDate , xDelim ) , -1 ) ;
    Result  := 0 ;

    if (mValue1>0) and (mValue2>0) and (mValue3>0) and (xType>0) then
    begin
      try
        case xType of
          1 : Result := EnCodeDate( mValue1, mValue2 , 1 ) ;
          2 : Result := EnCodeDate( mValue3, mValue1 , 1 ) ;
          3 : Result := EnCodeDate( mValue3, mValue2 , 1 ) ;
          4 : Result := EnCodeDate( mValue1+1911 , mValue2 , 1 ) ;
          5 : Result := EnCodeDate( mValue1+1911 , mValue2 , 1 ) ;
        end ;
        case xType of
          1 : Result := Result + mValue3 - 1 ;
          2 : Result := Result + mValue2 - 1 ;
          3 : Result := Result + mValue1 - 1 ;
          4 : Result := Result + mValue3 - 1 ;
          5 : Result := Result + mValue3 - 1 ;
        end ;
      except
        Result := 0 ;
      end ;
    end ;
  end ;
end ;

// р YYYYMMDD ら戳Α﹃锣Θ DATETIME
function TransDateIn(Value: string): TDateTime ;
var
  mYear : Word ;
  mMonth: Word ;
  mDay  : Word ;
begin
  Result := 0 ;
  if (Value = '') or (Length(Value) <> 8) then exit;
  try
    mYear := StrtoIntDef( Copy(Value, 1, 4),0) ;
    mMonth:= StrtoIntDef( Copy(Value, 5, 2),0) ;
    mDay  := StrtoIntDef( Copy(Value, 7, 2),0) ;
    if (mYear=0)or(mMonth=0)or(mDay=0) then
      Result := 0
    else
      Result := EnCodeDate( mYear, mMonth, mDay ) ;
  except
    Result := 0 ;
  end ;
end;

//check参絪腹
function CheckCompanyNo(const Value : string ) : Boolean ; // 参絪腹
var
  i        : Integer ;
  j        : Integer ;
  mTest    : Integer ;
  mCheckNo : array[ 1..3 , 1..4 ] of Integer ;
begin
  Result := False ;
  FillChar( mCheckNo , SizeOf(mCheckNo), #0 ) ;
  if Length( Value ) <> 8 then exit ;

  for i := 1 to 8 do
    if  ( Value[ i ] < #48 ) or ( Value[ i ] > #57 ) then exit ;

//  mTest := 0 ;
  mCheckNo[ 3 , 1 ] := StrtoIntDef( Value[ 1 ] , 0 ) ;
  mCheckNo[ 3 , 2 ] := StrtoIntDef( Value[ 3 ] , 0 ) ;
  mCheckNo[ 3 , 3 ] := StrtoIntDef( Value[ 5 ] , 0 ) ;
  mCheckNo[ 3 , 4 ] := StrtoIntDef( Value[ 8 ] , 0 ) ;

  mTest := StrtoIntDef( Value[ 2 ] , 0 ) * 2 ;
  mCheckNo[ 1 , 1 ] := mTest div 10;
  mCheckNo[ 2 , 1 ] := mTest mod 10 ;
  mTest := StrtoIntDef( Value[ 4 ] , 0 ) * 2 ;
  mCheckNo[ 1 , 2 ] := mTest div 10;
  mCheckNo[ 2 , 2 ] := mTest mod 10 ;
  mTest := StrtoIntDef( Value[ 6 ] , 0 ) * 2 ;
  mCheckNo[ 1 , 3 ] := mTest div 10;
  mCheckNo[ 2 , 3 ] := mTest mod 10 ;
  mTest := StrtoIntDef( Value[ 7 ] , 0 ) * 4 ;
  mCheckNo[ 1 , 4 ] := mTest div 10;
  mCheckNo[ 2 , 4 ] := mTest mod 10 ;

  mTest := 0 ;
  for i := 1 to 3 do
    for j := 1 to 4 do
      mTest := mTest + mCheckNo[ i , j ] ;

  Result := ( (mTest mod  10)=0 ) ;
  if not Result and ( StrtoIntDef( Value[ 7 ] , 0 ) = 7 ) then
  begin
    mTest := mTest - mCheckNo[ 1 , 4 ] - mCheckNo[ 2 , 4 ] ;
    mTest := mTest +(mCheckNo[ 1 , 4 ] + mCheckNo[ 2 , 4 ]) div 10 ;
    mTest := mTest +(mCheckNo[ 1 , 4 ] + mCheckNo[ 2 , 4 ]) mod 10 ;

    Result := ( (mTest mod  10)=0 ) ;
  end ;

end ;

function CheckPersonNo (const Value : string ) : Boolean;
const
  IDNIDX : array['A'..'Z'] of Byte =
     (1,2,3,4,5,6,7,8,25,9,10,11,12,13,26,14,15,16,17,18,19,20,23,21,22,24);

  IDNTable : array[1..26] of Byte = (10,11,12,13,14,15,16,17,18,19,20,21,22,
                                     23,24,25,26,27,28,29,30,31,32,33,34,35);
  Asc0 = Byte('0');
var V:integer;
begin
  if Value[1] in ['A'..'Z'] then
    begin
      V :=
      IDNTable[IDNIDX[Value[1]]] div 10 + (IDNTable[IDNIDX[Value[1]]] mod 10) * 9 +
      (Byte(Value[2])-Asc0) * 8 + (Byte(Value[3])-Asc0) * 7 + (Byte(Value[4])-Asc0) * 6 +
      (Byte(Value[5])-Asc0) * 5 + (Byte(Value[6])-Asc0) * 4 + (Byte(Value[7])-Asc0) * 3 +
      (Byte(Value[8])-Asc0) * 2 + Byte(Value[9])-Asc0 + Byte(Value[10])-Asc0;

      Result := (Length(Value) = 10) and ((Value[2] = '1') or (Value[2] = '2')) and (V
                    div 10 = V / 10);
    end
  else
    Result := False;
end;

function CheckDate(const Value : string) : Boolean;
begin
  Result:=True;
  if Value='' then Exit;
  try
    EncodeDate(StrToIntDef(Copy(Value,1,4),0),StrToIntDef(Copy(Value,6,2),0),StrToIntDef(Copy(Value,9,2),0));
  except
    Result:=False;
  end;
end;

procedure StringToStrList(input: string; delimiter: string; output: TStringList);
begin
  while (input<>'') do
    output.Add(Trim(CutToken(input, delimiter)));
end;

function iif(Check:Boolean;aValue1,aValue2:Variant):Variant;
begin
  if Check then
    Result:=aValue1
  else
    Result:=aValue2;
end;

function InGroup(xGroup,xGroupList: string): Boolean;
begin
  Result := False;
  if xGroupList = 'all' then
    Result := True
  else
  begin
    while xGroupList<>'' do
    begin
      if xGroup = trim(CutToken(xGroupList,',')) then
      begin
        Result := True;
        exit;
      end;
    end;
  end;
end;

function IsVarEmptyOrNull(xVariant: Variant): Boolean;
begin
  Result:= (VarType(xVariant)= VarEmpty)or(VarType(xVariant)= VarNull);
end;

// 眖InfoPower ㄓノ  ъ﹃柑﹃
Function GetWord(s: string; var APos: integer): string;
var i: integer;

   Function max(x,y: integer): integer;
   begin
     if x>y then result:= x
     else result:= y;
   end;

begin
   result:= '';
   if APos<=0 then exit;
   if APos>length(s) then exit;

   i:= APos;
   while (i<=length(s)) and ((s[i]=' ') or (s[i]=#9)) do inc(i); { skip leading whitespace}
   APos:= i; { Skip leading blanks/tabs }
   if s[i]='"' then begin
      inc(i);
      while (i<=length(s)) and (s[i]<>'"') do inc(i);
      if s[i]='"' then begin
         result:= copy(s, APos, i+1-APos);
         APos:= i+1;
      end
   end
   else if s[i]='''' then begin
      inc(i);
      while (i<=length(s)) and (s[i]<>'''') do inc(i);
      if s[i]='''' then begin
         result:= copy(s, APos, i+1-APos);
         APos:= i+1;
      end
   end
   else begin
      while (i<=length(s)) and (s[i] in ['A'..'Z','0'..'9','.','_' ]) do inc(i);
      result:= copy(s, APos, max(i-APos, 1));

      if length(result)>1 then APos:= i
      else APos:= i+1;
   end;
end;

function RemoveXSC( xStr : string)  : string; //р  asc ┪ desc 奔 р フ奔
var
  mStr  : string;
  mWord : string;
  mPos  : Integer;
begin
   if Trim(xStr) = '' then
   begin
     Result := xStr;
     Exit;
   end;
   mStr :='';
   mPos := 1;
      repeat
         mWord:= GetWord(xStr, mPos);
         if (UpperCase(mWord) <> 'ASC' ) and (UpperCase(mWord) <> 'DESC' ) then
           mStr :=mStr + mWord;
      until (mWord ='');
   for mPos := 1 to Length (mStr) do
   if mStr[mPos] <> ' ' then Result := Result +mStr[mPos];

end;

function CountDate(xSourceDate:variant;xKind:String;xMove:integer):String;//衡ら戳ㄧ计
var      // xSourceDate:ㄓら戳, xKind:璸衡癸禜(Y:,M:る,D:ら), xMove:糤搭ぶ
  MyDate: TDateTime;
  mYY, mMM, mDD :Word;
  mMonth: integer;
begin
  result:='';
  if VarType(xSourceDate)=VarString then
    MyDate := TransDateIn(xSourceDate)
  else
  if VarType(xSourceDate)=VarDate then
    MyDate := xSourceDate
  else
    exit;   // ぃ琌 Date or String Αê碞⊿猭
  try
    DecodeDate(MyDate,mYY,mMM,mDD);
  except
  end;
  if uppercase(xKind)='Y' then    // 衡
  begin
    mYY:=mYY+xMove;
    try
      Mydate:=EncodeDate(mYY,mMM,mDD);
    except
    end;
  end
  else
  if uppercase(xKind)='M' then   // 衡る
  begin
    mMonth:=mYY*12+mMM+xMove; // 场传Θる
    mMM:=mMonth mod 12 ;
    if mMM=0 then
    begin
      mMM:=12;
      mYY:=(mMonth div 12)-1;
    end
    else
      mYY:=mMonth div 12;
    try
      Mydate:=EncodeDate(mYY,mMM,mDD);
    except
    end;
  end
  else
  if uppercase(xKind)='D' then     // 衡ら
  begin
    MyDate:=MyDate+xMove;
  end
  else
    exit;   // ぃ琌 Y or M or D Αê碞⊿猭
  result:=FormatDatetime('yyyymmdd',MyDate);
end;

function SwapStr(xString, xOldSplit, xNewSplit: String): String;
var
  mPos: Integer;
  mOldLen: Integer;
begin
  if CompareText(xOldSplit, xNewSplit)<>0 then
  begin
    mPos:= AnsiPos(xOldSplit, xString);
    mOldLen:= Length(xOldSplit);
    while mPos>0 do
    begin
      Delete(xString, mPos, mOldLen);
      Insert(xNewSplit, xString, mPos);
      mPos:= ansiPos(xOldSplit, xString);
    end;
  end;
  Result:= xString;
end;

function Store(xValue: Variant; xVariant: Variant; xFieldList: array of Integer): Variant;
// xValue: Variant; 砞﹚
// xVariant: Variant; 璶砞﹚跑计
// xFieldList: 狦琌皚, 璶砞﹚ê碭, ぃ糶玥ボ场
// 肚: 材肚把计, 琘ㄇ, 礚猭钡肚材把计
// aVar:= Store(0, aVar, []);
// aVar:= Store('String', aVar, []);
// aVar:= Store(True, aVar, []);
// aVar:= Store(Date, aVar, []);
// aVariantArray:= Store(0, aVariantArray, []); // 盢aVariantArrayい┮Τ恶0
// aVariantArray:= Store(0, aVariantArray, [1, 5, 7, 4]); // 盢aVariantArrayい材1, 5, 7, 4 恶0
var
  i, mField: Integer;
  mFieldHighBound, mVariantHighBound, mMaxFieldCol: Integer;
begin
  if VarIsArray(xVariant) then
  begin
    if VarIsEmpty(xVariant) then
      MessageDlg('ㄏノStore 硂Procedure よ猭岿粇!', mtError, [mbOK], 0)
    else
    begin
      mFieldHighBound:= High(xFieldList);
      mVariantHighBound:= VarArrayHighBound(xVariant, 1);
      if mFieldHighBound<0 then
        mMaxFieldCol:= mVariantHighBound
      else mMaxFieldCol:= mFieldHighBound;
      for i:= 0 to mMaxFieldCol do
      begin
        if High(xFieldList)<0 then
          mField:= i
        else mField:= xFieldList[i];
        if VarisEmpty(xVariant[mField]) then
          xVariant[mField]:= 0;
        if mField<= mVariantHighBound then
          xVariant[mField]:= Store(xValue, xVariant[mField], []);
      end;
    end;
  end
  else
    xVariant:= xValue;
  Result:= xVariant;
end;

function SlashSep(const Path, S: string): string;
const
  Slashes: array[False..True] of PChar = ('', '/');
begin
  Result := Format('%s%s%s',[Path, Slashes[Path[Length(Path)] <> '/'], S]);
end;

function Changedate( xDate: string ; xType: integer; xDelim: string ):String ;
var
  mValue1 : string ;
  mValue2 : string ;
  mValue3 : string ;
begin
  if Trim(xDate) = '' then
    Result := '0'
  else
  begin
    if ( xDelim <> '' ) then
    begin
      mValue1 := CuttoKen( xDate , xDelim );
      mValue2 := CuttoKen( xDate , xDelim );
      mValue3 := CuttoKen( xDate , xDelim );
    end
    else
    begin
      mValue1 := System.Copy( xDate , 1 , 4  );
      mValue2 := System.Copy( xDate , 5 , 2  );
      mValue3 := System.Copy( xDate , 7 , 2  );
    end ;

    Result  := '0' ;

    if (mValue1>'0') and (mValue2>'0') and (mValue3>'0') then
    begin
      try
        case xType of
          1 : Result := ZeroATfirst(Strtointdef(mValue1,0),4)+ZeroATfirst(Strtointdef(mValue2,1),2)+ZeroATfirst(Strtointdef(mValue3,1),2);
          2 : Result := ZeroATfirst(Strtointdef(mValue3,0),4)+ZeroATfirst(Strtointdef(mValue1,1),2)+ZeroATfirst(Strtointdef(mValue2,1),2);
          3 : Result := ZeroATfirst(Strtointdef(mValue3,0),4)+ZeroATfirst(Strtointdef(mValue2,1),2)+ZeroATfirst(Strtointdef(mValue1,1),2);
          4 : Result := ZeroATfirst(Strtointdef(mValue1,0)+1911,4)+ZeroATfirst(Strtointdef(mValue2,1),2)+ZeroATfirst(Strtointdef(mValue3,1),2);
          5 : Result := ZeroATfirst(Strtointdef(mValue1,0)+1911,4)+ZeroATfirst(Strtointdef(mValue2,1),2)+ZeroATfirst(Strtointdef(mValue3,1),2);
        else
          Result := ZeroATfirst(Strtointdef(mValue1,0),4)+ZeroATfirst(Strtointdef(mValue2,1),2)+ZeroATfirst(Strtointdef(mValue3,1),2);
        end ;
      except
        Result := '0' ;
      end ;
    end ;
  end ;
end ;

//耞alias,玥砞ㄤDriverぇnet dir
Function SetNetDir(xAlias:string):Boolean;
var
  mList : TStringList;
  mPath: String;
  mAliasPath: String;
  mComputerName: String;
begin
  Result:= False;
  mComputerName:= SaveGetComputerName;
  With Session do
  begin
    if IsAlias(xAlias) then
    begin
      try
        mList:= TStringList.create;
        GetaliasParams(xAlias,mList);
        mAliasPath:= mList[0];
        Delete(mAliasPath,1,5);
        mPath:= mAliasPath;
        case GetPathType(mPath) of
         -1: NetFileDir:= mAliasPath;
          0: NetFileDir:= '//'+ mComputerName+mPath; // 0: Local Disk Path
          1: NetFileDir:= ExtractFileDrive(mPath)+'/'; // 1: 硈絬呼隔合盒诀 Path
          2: NetFileDir:= ExtractFileDrive(mPath)+'/'; // 2: UNC Path
        end;
        Result:= True;
      finally
        if Assigned(mList) then
          mList.free;
      end;
    end
    else Result:= False;
  end;
end;

// ⊿Τ﹚ Alias  SQL い干 Alias
function AddAliasName(xSource,xField,xAlias:string):string;
var
  mString:string;
  mPos:integer;
begin
  Result:='';
  mString:=UpperCase(xSource);
  while Pos(UpperCase(xField),mString)>0 do
  begin
    mPos:=Pos(UpperCase(xField),mString);
    Result:=Result+Copy(mString,1,mPos-1)+xAlias+'.'+Copy(mString,mPos,Length(xField));
    mString:=Copy(mString,mPos+Length(xField),Length(mString));
  end;
  Result:=Result+mString;
end;

// ﹃
function ReplaceSubStr(xSource,xOld,xNew:string):string;
var
  mPos:integer;
  mTempStr:string;
begin
  Result:='';
  mTempStr:=xSource;
  while Pos(xOld,mTempStr)>0 do
  begin
    mPos:=Pos(xOld,mTempStr);
    Result:=Result+Copy(mTempStr,1,mPos-1)+xNew;
    mTempStr:=Copy(mTempStr,mPos+Length(xOld),Length(mTempStr));
  end;
  Result:=Result+mTempStr;
end;

function Replicate(xSource:string;xTimes:integer):string; // 硈尿狡籹﹃
var
  i:integer;
begin
  Result:='';
  for i:=1 to xTimes do
    Result:=Result+xSource;
end;

function Space(xTimes:integer):string;  // 眔琿フ﹃
var
  i:integer;
begin
  Result:='';
  for i:=1 to xTimes do
    Result:=Result+' ';
end;

function RightStr(Const Str: String; Size: Word): String;//﹃
var
  len:Byte;
begin
  if (trim(str)<>'') and (Size>0) then
  begin
    len:=Length(Str);
    if Size > len then Size := len;
    result:=Copy(Str,len-Size+1,Size);
  end;
end;

function NumberToEnglish(Value:Double):string;
var
  mNewQty,mLowDigit:string;
  mQtyLen:integer;
  mLen:integer;
  mD6,mD9:Boolean;
  mDigit:string;
begin
  if Value=0 then
  begin
    Result:='NO COMMERCIAL VALUE, FOR CUSTOMS PURPOSE';
    Exit;
  end;
  Result:='';
  mNewQty:=Trim(FloatToStr(Value));
  mQtyLen:=Length(mNewQty);
  mLen:=mQtyLen;
  mD6:=False;
  mD9:=False;
  while (mQtyLen>0) or mD6 or mD9 do
  begin
     if (mQtyLen=0) and mD9 then
     begin
        Result:=Result+' MILLION';
        mNewQty:=mLowDigit;
        if mNewQty='000000' then
          Break;
        mQtyLen:=6;
        mLen:=6;
        mD9:=False;
     end;
     if (mQtyLen=0) and mD6 then
     begin
        Result:=Result+' THOUSAND';
        mNewQty:=mLowDigit;
        if mNewQty='000' then
           Break;
        mQtyLen:=3;
        mLen:=3;
        mD6:=False;
     end;
     if (mQtyLen>6) and (mQtyLen<=9) then    // 矪瞶6计 THOUSAND
     begin
        mD9:=True;
        // mLowDigit:=PadL(right(mNewQty,6),6,'0')          && 痙κ计絏
        mLowDigit:=PadL(RightStr(mNewQty,6),[6,49]);        // 痙κ计絏
        mNewQty:=Copy(mNewQty,1,mQtyLen-6);    // 玡碭絏暗锣传
        mQtyLen:=Length(mNewQty);
        mLen:=mQtyLen;
     end;
     if (mQtyLen>3) and (mQtyLen <=6) then   // 矪瞶6计 THOUSAND
     begin
        mD6:=True;
        mLowDigit:=PadL(RightStr(mNewQty,3),[3,49]);     // 痙κ计絏
        mNewQty:=Copy(mNewQty,1,mQtyLen-3);    // 玡碭絏暗锣传
        mQtyLen:=Length(mNewQty);
        mLen:=mQtyLen;
     end;
     mDigit:=Copy(mNewQty,mLen-mQtyLen+1,1);
     if mQtyLen=3 then
     begin
       if mDigit='9' then
         Result:=Result+ ' NINE'
       else if mDigit='8' then
         Result:=Result+ ' EIGHT'
       else if mDigit='7' then
         Result:=Result+ ' SEVEN'
       else if mDigit='6' then
         Result:=Result+ ' SIX'
       else if mDigit='5' then
         Result:=Result+ ' FIVE'
       else if mDigit='4' then
         Result:=Result+ ' FOUR'
       else if mDigit='3' then
         Result:=Result+ ' THREE'
       else if mDigit='2' then
         Result:=Result+ ' TWO'
       else if mDigit='1' then
         Result:=Result+ ' ONE';
       if mDigit<>'0' then
         Result:=Result+ ' HUNDRED';
       mQtyLen:=2;
       Continue;
     end;
     if (mQtyLen=2) and (mDigit<>'1') then
     begin
       if mDigit='9' then
         Result:=Result+ ' NINETY'
       else if mDigit='8' then
         Result:=Result+ ' EIGHTY'
       else if mDigit='7' then
         Result:=Result+ ' SEVENTY'
       else if mDigit='6' then
         Result:=Result+ ' SIXTY'
       else if mDigit='5' then
         Result:=Result+ ' FIFTY'
       else if mDigit='4' then
         Result:=Result+ ' FORTY'
       else if mDigit='3' then
         Result:=Result+ ' THIRTY'
       else if mDigit='2' then
         Result:=Result+ ' TWENTY'
       else if mDigit='1' then
         Result:=Result+ ' TEN';
       mQtyLen:=mQtyLen-1;
       Continue;
     end;
     if (mQtyLen=2) and (mDigit='1') then
     begin
       mDigit:=RightStr(mNewQty,1);
       if mDigit='9' then
         Result:=Result+ ' NINETEEN'
       else if mDigit='8' then
         Result:=Result+ ' EIGHTEEN'
       else if mDigit='7' then
         Result:=Result+ ' SEVENTEEN'
       else if mDigit='6' then
         Result:=Result+ ' SIXTEEN'
       else if mDigit='5' then
         Result:=Result+ ' FIFTEEN'
       else if mDigit='4' then
         Result:=Result+ ' FOURTEEN'
       else if mDigit='3' then
         Result:=Result+ ' THIRTEEN'
       else if mDigit='2' then
         Result:=Result+ ' TWELVE'
       else if mDigit='1' then
         Result:=Result+ ' ELEVEN'
       else if mDigit='0' then
         Result:=Result+ ' TEN';
       if mD6 or mD9 then
       begin
         mQtyLen:=0;
         Continue;
       end
       else
         Break;
     end;
     if mQtyLen<>2 then
     begin
       if mDigit='9' then
         Result:=Result+ ' NINE'
       else if mDigit='8' then
         Result:=Result+ ' EIGHT'
       else if mDigit='7' then
         Result:=Result+ ' SEVEN'
       else if mDigit='6' then
         Result:=Result+ ' SIX'
       else if mDigit='5' then
         Result:=Result+ ' FIVE'
       else if mDigit='4' then
         Result:=Result+ ' FOUR'
       else if mDigit='3' then
         Result:=Result+ ' THREE'
       else if mDigit='2' then
         Result:=Result+ ' TWO'
       else if mDigit='1' then
         Result:=Result+ ' ONE';
       mQtyLen:=mQtyLen-1;
     end;
  end;
end;

function ExtraPos(xSubStr,xSource:string;xNumber:integer):integer;  // 肚材碭﹃觃
var
  mPos:integer;
  mCount:integer;
begin
  Result:=0;
  if xNumber=0 then Exit;
  if xNumber=1 then
  begin
    Result:=Pos(xSubStr,xSource);
    Exit;
  end;
  mPos:=Pos(xSubStr,xSource);
  if mPos=0 then Exit;
  mCount:=1;
  while (mPos>0) and (mCount<xNumber) do
  begin
    Result:=Result+mPos-1;
    xSource:=Copy(xSource,mPos+Length(xSubStr),Length(xSource));
    mPos:=Pos(xSubStr,xSource);
    if mPos>0 then
      Inc(mCount);
  end;
  if mCount<xNumber then  // 计禬筁
    Result:=0
  else
    Result:=(Result+mPos)+(Length(xSubStr)*(mCount-1));
end;

function ReplacePageNo(xSource,xOld:string):string;
var
  mPos:integer;
  mTempStr:string;
  mcount:integer;
begin
  mCount:=1;
  Result:='';
  mTempStr:=xSource;
  while Pos(xOld,mTempStr)>0 do
  begin
    mPos:=Pos(xOld,mTempStr);
    Result:=Result+Copy(mTempStr,1,mPos-1)+IntToStr(mCount);
    mTempStr:=Copy(mTempStr,mPos+Length(xOld),Length(mTempStr));
    inc(mCount);
  end;
  Result:=Result+mTempStr;
end;

function GetMonthName(const Value:string):string;  // 眔璣ゅる嘿
var
  mMonth:integer;
begin
  Result:='';
  mMonth:=StrToInt(Value);
  case mMonth of
    1: Result:='JAN.';
    2: Result:='FEB.';
    3: Result:='MAR.';
    4: Result:='APR.';
    5: Result:='MAY.';
    6: Result:='JUN.';
    7: Result:='JUL.';
    8: Result:='AUG.';
    9: Result:='SEP.';
    10: Result:='OCT.';
    11: Result:='NOV.';
    12: Result:='DEC.';
  end;
end;

function WhatADate(const Value:TDateTime):string;  // 肚 DEC.14 1998 Α
begin
  Result:='';
  if Value<>0 then
    Result:=GetMonthName(FormatDateTime('MM',Value))+FormatDateTime('DD YYYY',Value);
end;

function Center(xStr:string; xLen:integer):string;
var
  mSpace:string;
begin
  xStr:=Trim(xStr);
  mSpace:=Space((xLen-Length(xStr)) div 2);
  Result:=mSpace+xStr+mSpace;
end;

function OnlyFileName(aFileName:String):String;// 奔 Path ㎝ Ext 郎
var
  Posi:byte;
begin
  Result:='';
  if Trim(aFileName)='' then Exit;
  Result:=ExtractFileName(aFileName);
  Posi:=Pos('.',Result);
  if Posi>0 then
    Result:=Copy(Result,1,Posi-1);
end;

function JosRound(xValue:double;xDecimal:integer):double;
var mPosition,mInt,mNumber:integer;
    mOriginal:String;
begin
  mOriginal:= FloatToStr(xValue*exp(xDecimal*ln(10)));
  mPosition:=Pos('.',mOriginal);
  if (mPosition<>0) then
  begin
    mInt:=StrToInt64(GetToken(mOriginal,'.',1));
    mNumber:=StrToInt(Copy(GetToken(mOriginal,'.',2),1,1));
    Case mNumber of
      0..4  : mInt:=mInt;
      5..9  : mInt:=mInt+1;
    end;
    Result:=mInt/exp(xDecimal*ln(10));
  end
  else
    Result:=xValue;
end;

function AddTstrings(x:TstringList;var F:TextFile):integer;
var
  i:integer;
begin
  for i:=0 to x.Count-1 do
    Writeln(F,X[i]);
  Result:=x.Count;
end;

end.