_funct.pas

这个是去年写的东东。 以前公司一直使用易飞ERP

    Result :=
    Copy(S,1,Position-1)+ReplaceWith+ReplaceText(TempStr,ReplacePiece,ReplaceWith)
  End
  else
    Result := S;
end;

////////////////////////
{替换全部子字符串的函数}
function ReplaceSub(str, sub1, sub2: String): String;
    var
    aPos: Integer;
    rslt: String;

  begin
    aPos := Pos(sub1, str);
    rslt := '';
    while (aPos <> 0) do begin
      rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
      Delete(str, 1, aPos + Length(sub1));
      aPos := Pos(sub1, str);
    end;
    Result := rslt + str;
  end;

/////////////////////////
{在字符串左右填充指定数量的指定字符}
function UT_PadString(inString :string; maxLength :integer; padChar :char;
left :boolean) :string;
begin
  result := inString;
  while (Length(result) < maxLength) do
    if (left) then
      result := padChar + result
    else
      result := result + padChar;
end;
/////////////////////////////////////
{提取字符串中指定子字符串前的字符串}
Function Before ( Src:string ; Var S:string ) : string ;
  Var
  F : Word ;
begin
  F := POS (Src,S) ;
  if F=0 then
    Before := S
   else
    Before := COPY(S,1,F-1) ;
end ;
//////////////////////////////////
{提取字符串中指定子字符串后的字符串}
Function After ( Src:string ; Var S:string ) : string ;
  Var
  F : Word ;

begin
  F := POS (Src,S) ;
  if F=0 then
    After := ''
   else
    After := COPY(S,F+length(src),length(s)) ;
end ;
////////////////////////////////////
{判断字符串是否可以转换为整数}
function IsIntStr(const S: string): boolean;
begin
  Result:=StrToIntDef(S,0)=StrToIntDef(S,1);
end;
//////////////////////////////////////
{从字符串中删除指定字符串}
function RemoveInvalid(what, where: string): string;
var
  tstr: string;
begin
  tstr:=where;
  while pos(what, tstr)>0 do
    tstr:=copy(tstr,1,pos(what,tstr)-1) +
       copy(tstr,pos(what,tstr)+length(tstr),length(tstr));
  Result:=tstr;
end;
{用法:
  NewStr:=RemoveInvalid('<invalid>','This <invalid> is my string and I wan to
       remove the word <invalid>');}
///////////////////////////////////////////
{根据某个字符分割字符串的函数}
Procedure SeparateTerms(s : string;Separator : char;Terms : TStringList);
{ This browses a string and divide it into terms whenever the given
  separator is found. The separators will be removed }
  var
  hs : string;
  p : integer;

begin
  Terms.Clear; // First remove all remaining terms
  if Length(s)=0 then   // Nothin' to separate
    Exit;
  p:=Pos(Separator,s);
  while P<>0 do
  begin
    hs:=Copy(s,1,p-1);   // Copy term
    Terms.Add(hs);       // Add to list
    Delete(s,1,p);       // Remove term and separator
    p:=Pos(Separator,s); // Search next separator
  end;
  if Length(s)>0 then
    Terms.Add(s);        // Add remaining term
end;

//加密
Function EncrypKey (Src:String; Key:String):string;
var
  //idx :integer;
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
  //TmpSrcAsc :Integer;
  Range :Integer;

begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then key:='Think Space';
    KeyPos:=0;
    //SrcPos:=0;
    //SrcAsc:=0;
    Range:=256;

    Randomize;
    offset:=Random(Range);
    dest:=format('%1.2x',[offset]);
    for SrcPos := 1 to Length(Src) do
    begin
      SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
      if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
      SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
      dest:=dest + format('%1.2x',[SrcAsc]);
      offset:=SrcAsc;
    end;
  Result:=Dest;
end;

//解密函数
Function UncrypKey (Src:String; Key:String):string;
var
  //idx :integer;
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
  TmpSrcAsc :Integer;
  //Range :Integer;

begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then key:='Think Space';
    KeyPos:=0;
    //SrcPos:=0;
    //SrcAsc:=0;
    //Range:=256;
    offset:=StrToInt('$'+ copy(src,1,2));
    SrcPos:=3;
    repeat
      SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
      if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
        TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
      if TmpSrcAsc <= offset then
        TmpSrcAsc := 255 + TmpSrcAsc - offset
      else
        TmpSrcAsc := TmpSrcAsc - offset;
      dest := dest + chr(TmpSrcAsc);
      offset:=srcAsc;
      SrcPos:=SrcPos + 2;
    until SrcPos >= Length(Src);
      Result:=Dest;
end;

{写ini}
Function WriteIniFile (inifile:string; inimain:string; inimain2:string; initext:string):Boolean;
Var IniFiles: TIniFile;    //INI组件
begin
if FileExists(inifile) then
  begin
   Inifiles := TIniFile.Create(inifile);//写InI文件
   IniFiles.WriteString(inimain,inimain2, initext ) ;
   Result:=True ;
   IniFiles.Free;
  end
else
  Result:=False ;

end;

{读INI文件}
Function ReadIniFile (inifile:string; inimain:string; inimain2:string):String;
Var IniFiles: TIniFile;    //INI组件
begin
  if FileExists(inifile) then
    begin
      Inifiles := TIniFile.Create(inifile);//读InI文件
      Result := TRIM(IniFiles.ReadString(inimain,inimain2,''));
      IniFiles.Free;
    end
  else
    Result:='' ;
end;

//生成随机
Function RanNum() : string; stdcall;
var i,j,Temp:integer;
    m:array[0..9] of integer ;
    s:string;
begin
  s:='';
  randomize;
  for i:=0 to 9 do
    M[i]:=i;
  for i:=0 to 9 do
  begin          //此算法将被选中的数放到数组头部，然后再剩下的数中进行选取
    j:=random(10-i)+i;  //每循环一次范围减1
    Temp:=M[i];         //交换M[i]和M[j]
    M[i]:=M[j];
    M[j]:=Temp;
  end;
   {此时M[]中已经是0-20的不重复随机数了 }
  //for i:=0 to 9 do
  //  s:=s+'-'+inttostr(m[i]);
  for i:=0 to 3 do
    s:=s+inttostr(m[i]);
  //showmessage(s);
  Result := s ;
end;

//如果是IP地址返回True，否则，返回False
function ISIPAddr(IPStr:string):Boolean;
var 
  i,DotNum:integer; 
  Tmpstr:string; 
begin 
  Result:=true; 
  DotNum:=0; 
  for i:=1 to Length(IPStr) do 
    Case IPStr[i] of 
    '0'..'9','.': 
      begin 
        if IPStr[i]<>'.' then 
        begin 
          Tmpstr:=Tmpstr+IPStr[i]; 
          if StrtoInt(tmpstr)>255 then 
          begin 
            Result:=False; 
            exit; 
          end; 
        end 
        else 
        begin 
          if (TmpStr='')and(DotNum>0) then //如果连续2个点的情况 
          begin 
            Result:=False; 
            Exit; 
          end; 
          Tmpstr:=''; 
          DotNum:=DotNum+1; 
        end; 
      end; 
      else 
        begin Result:=false; exit; end; 
      end; 
   if DotNum<>3 then Result:=False; 
end;//以上驗證IP地址

{添加文件,文件名n,添加的字符s}
Function Apptext(s,Src:string):Boolean;
var
  Txtfile:TextFile;
begin
  Assignfile(Txtfile,s);
  if fileExists(s) then
    Append(Txtfile)
  else
    Rewrite(Txtfile);
  try
    writeln(Txtfile,Src);
    Result:=True;
  finally
    closefile(Txtfile);
    Result:=False;
  end;
end;

Function FormatSD(s:string):string;
var year,month,date,sec:string;  //,m1,m2,m3
begin
  year:=copy(s,1,4)+'-';
  month:=copy(s,5,2)+'-';
  date:=copy(s,7,2)+'';
  //m1:=copy(s,9,2)+':';
  //m2:=copy(s,11,2)+':';
  //m3:=copy(s,13,2);
  //sec:=m1+m2+m3;
  result:=year+month+date  //+' '+sec;
end;

//检查是否为日期
function Do_chkdate(s:string):Boolean;
begin
if (copy(s,1,4)<'0000') then begin
   Result:=False;
   exit;
end else Result:=True;

if (copy(s,5,2)>'12') or (copy(s,5,2)<='00') then begin
  Result:=False;
  exit;
end else Result:=True;

if (copy(s,7,2)>inttostr(monthdays[isleapyear(strtoint(copy(s,1,4))),strtoint(copy(s,5,2))])) then
   Result:=False
else Result:=True;
end;



end.