untfun.pas

少儿识字软件是根据网络上下载的版本进行了完善

   I : Integer;
begin
      Result := S;
      for I := 1 to Length(S) do
      begin
         Result[I] := char(byte(S[I]) xor (Key shr 8));
         Key := (byte(Result[I]) + Key) * C1 + C2;
         if Result[I] = Chr(0) then
            Result[I] := S[I];
      end;
      Result := StrToHex(Result);
end;


//字符串解密函数
function Decrypt(const S: String; Key: Word): String;
var
   I: Integer;
   S1: string;
begin
   S1 := HexToStr(S);
   Result := S1;
   for I := 1 to Length(S1) do
   begin
      if char(byte(S1[I]) xor (Key shr 8)) = Chr(0) then
         begin
            Result[I] := S1[I];
            Key := (byte(Chr(0)) + Key) * C1 + C2; //保证Key的正确性　　
         end
      else
         begin
            Result[I] := char(byte(S1[I]) xor (Key shr 8));
            Key := (byte(S1[I]) + Key) * C1 + C2;
         end;
   end;
end;
//==========================================     文件路径
function PathWithSlash(const Path: string): string;       //带\符号
begin
 Result := Path;
 if (Length(Result) > 0) and (Result[Length(Result)] <> '\') then Result := Result + '\';
end;

function PathGetSystemPath: string;   //SYSTEM32路径
var
 Buf: array[0..255] of Char;
begin
 GetSystemDirectory(@Buf, 255);
 Result := PathWithSlash(StrPas(@Buf));
end;

function PathGetWindowsPath: string;  //WINDOWS路径
var
 Buf: array[0..255] of Char;
begin
 GetWindowsDirectory(@Buf, 255);
 Result := PathWithSlash(StrPas(@Buf));
end;

function getsyspath:string; //  注:MySysPath为SYSTEM路径
var
MySysPath : PCHAR ;
  begin
  GetMem(MySysPath,255);
  GetSystemDirectory(MySysPath,255);
  result:=PathWithSlash(strpas(mysyspath));
 end;

function getAppPath : string;   //程序目录带\
var
  strTmp : string;
begin
  strTmp :=ExtractFilePath(application.Exename);
  result := PathWithSlash(strTmp);
end;

function GetTempDirectory: String;    //临时目录\
var
TempDir: array[0..255] of Char;
begin
GetTempPath(255, @TempDir);
result:=PathWithSlash(strpas(TempDir));
end; 


//▎============================================================▎//
//▎==================①扩展的字符串操作函数====================▎//
//▎============================================================▎//
 // 判断s1是否包含在s2中
function InStr(const sShort: string; const sLong: string): Boolean;
var
  s1, s2: string;
begin
  s1 := LowerCase(sShort);
  s2 := LowerCase(sLong);
  Result := Pos(s1, s2) > 0;
end;

// 扩展整数转字符串函数，参数分别为目标数、长度、填充字符（默认为０）
function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;
begin
  Result := IntToStr(Value);
  while Length(Result) < Len do
    Result := FillChar + Result;
end;

// 带分隔符的整数－字符转换
function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;
var
  s: string;
  i, j: Integer;
begin
  s := IntToStr(Value);
  Result := '';
  j := 0;
  for i := Length(s) downto 1 do
  begin
    Result := s[i] + Result;
    Inc(j);
    try
       if ((j mod SpLen) = 0) and (i <> 1) then
          Result := Sp + Result;
    except
       MessageBox(Application.Handle,' IntToStrSp函数的第二个参数值不能为数字0 ！',SCnError,16);
       exit;
    end
  end;
end;

// 返回字符串右边的字符
function StrRight(Str: string; Len: Integer): string;
begin
  if Len >= Length(Str) then
    Result := Str
  else
    Result := Copy(Str, Length(Str) - Len + 1, Len);
end;

// 返回字符串左边的字符
function StrLeft(Str: string; Len: Integer): string;
begin
  if Len >= Length(Str) then
    Result := Str
  else
    Result := Copy(Str, 1, Len);
end;

// 字节转二进制串
function ByteToBin(Value: Byte): string;
const
  V: Byte = 1;
var
  i: Integer;
begin
  for i := 7 downto 0 do
    if (V shl i) and Value <> 0 then
      Result := Result + '1'
    else
      Result := Result + '0';
end;

// 返回空格串
function Spc(Len: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Len - 1 do
    Result := Result + ' ';
end;

// 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作}
function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;
var
   i:integer;
   s,t:string;
begin
   s:='';
   t:=str;
   repeat
      if casesensitive then
         i:=pos(s1,t)
      else
         i:=pos(lowercase(s1),lowercase(t));
         if i>0 then
            begin
               s:=s+Copy(t,1,i-1)+s2;
               t:=Copy(t,i+Length(s1),MaxInt);
            end
         else
            s:=s+t;
   until i<=0;
   result:=s;
end;

function Replicate(pcChar:Char; piCount:integer):string;
begin
	Result:='';
	SetLength(Result,piCount);
	fillChar(Pointer(Result)^,piCount,pcChar)
end;

// 返回某个字符串中某个字符串中出现的次数}
function StrNum(ShortStr:string;LongString:string):Integer;     {测试通过}
var
   i:Integer;
begin
   i:=0;
   while pos(ShortStr,LongString)>0 do
      begin
         i:=i+1;
         LongString:=Copy(LongString,(pos(ShortStr,LongString))+1,Length(LongString)-pos(ShortStr,LongString))
      end;
   Result:=i;
end;


{* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
	Result:=Replicate(pcPadWith,piWidth-Length(psInput))+psInput
end;

{* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
	Result:=psInput+Replicate(pcPadWith,piWidth-Length(psInput))
end;

{* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
var
	liHalf :integer;
begin
	liHalf:=(piWidth-Length(psInput))div 2;
	Result:=Replicate(pcPadWith,liHalf)+psInput+Replicate(pcPadWith,piWidth-Length(psInput)-liHalf)
end;

{* 返回替换后字符串 Examples: ChrTran('abCdEgdlkh','d','#')； 返回'bC#Eg#lkh'}
function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;
var
	i,j:integer;
begin
	j:=Length(psInput);
	for i:=1 to j do
  begin
		if psInput[i]=pcSearch then
			psInput[i]:=pcTranWith
  end;
	Result:=psInput
end;

{* 返回替换后字符串 Examples: StrTran('aruyfbn','ruy','====='); 返回'a=====fbn'}
function StrTran(psInput:String; psSearch:String; psTranWith:String):String;
var
	liPosition,liLenOfSrch,liLenOfIn:integer;
begin
	liPosition:=Pos(psSearch,psInput);
	liLenOfSrch:=Length(psSearch);
	liLenOfIn:=Length(psInput);
	while liPosition>0 do
	begin
		psInput:=Copy(psInput,1,liPosition-1)
			+psTranWith
      +Copy(psInput,liPosition+liLenOfSrch,liLenOfIn);
		liPosition:=Pos(psSearch,psInput)
	end;
	Result:=psInput
end;

{ *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'}
function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;
begin
	Result:=Copy(psInput,1,piBeginPlace-1)+
		psStuffWith+
    Copy(psInput,piBeginPlace+piCount,Length(psInput))
end;


{功能说明：判断string是否全是数字}
function IsDigital(Value: string): boolean;
var
  i, j: integer;
  str: char;
begin
  result := true;
  Value := trim(Value);
  j := Length(Value);
  if j = 0 then
  begin
    result := false;
    exit;
  end;
  for i := 1 to j do
  begin
    str := Value[i];
    if not (str in ['0'..'9']) then
    begin
      result := false;
      exit;
    end;
  end;
end;

{随机字符串函数}
function RandomStr(aLength : Longint) : String;
var
  X : Longint;
begin
  if aLength <= 0 then exit;
  SetLength(Result, aLength);
  for X:=1 to aLength do
    Result[X] := Chr(Random(26) + 65);
end;


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

function tx(i: integer): string;
begin
 case i of
 0:RESULT:='一';
 1:RESULT:='二';
 2:result:='三';
 3:result:='四';
 4:result:='五';
 5:result:='六';
 6:result:='七';
 7:result:='八';
 8:result:='九';
 9:result:='十';
  ELSE
   result:='太多了';
 end;

end;


function deleleftdigital(str:string;partstr:string):string;
var
  i,j:integer  ;
  s:string;
begin
  
  j:=Length(partstr);

  i:=pos(partstr,str);
  s:=StrLeft(str,i-1);

  if IsDigital(s) then
  begin
    if j=1 then delete(str,1,i)
    else
    Delete(str,1,i+j-1)
  end;
  result:=trim(str);
end;


function deleleftdot(str:string):string; //删除行首点号
var
  I:integer  ;
  s:string;
begin
  str:=Trim(str);
  i:=pos('.',str);
  s:=StrLeft(str,i-1);

  if IsDigital(s) then delete(str,1,i);
  result:=trim(str);
end;

function deleleftdun(str:string):string;    //删除行首顿号
var
  I:integer  ;
  s:string;
begin
  str:=Trim(str);
  i:=pos('、',str);
  s:=StrLeft(str,i-1);

  if IsDigital(s) then delete(str,1,i+1);  // 顿号是2个字节
  result:=trim(str);
end;

 //字符串处理,分成单个字,没有乱码
procedure TxttoWords(const S: string; words: TstringList);
var
  j:Integer ;
  sCuted{ 按固定长度分割出来的部分字符串 }: string;
  iCutLength{ 按固定长度分割出来的部分字符串的长度 }: integer;
  bIsDBCS{ 是否是汉字的前半字节 }: boolean;
  sline:string;
begin
  sline:=s;
  if Length(sline)=0 then words.Add(#13#10)
  else
  repeat ;
  iCutLength :=2;
  sCuted :=Copy(sline,1,iCutLength );
  bIsDBCS:=False ;
  for j:=1 to icutlength do
    begin
      if bIsDBCS then
        bIsDBCS :=False
        else
          if Windows.IsDBCSLeadByte(Byte(sCuted[j])) then
            bIsDBCS :=True;

    end; //end of for

    if bIsDBCS then Dec(iCutLength);
    if Copy(sline,1,iCutLength)<>#13#10 then   //去除回车
    words.Add(Copy(sline,1,iCutLength));
    sline :=Copy(sline,iCutLength +1,Length(sline )-icutlength);
    until Length (sline)<=0 ;
end;

function replacing(S,source,target:string):string;    //完全去除
var
  site,StrLen:integer;
begin
  {source在S中出现的位置}
  site:=pos(source,s);
  {source的长度}
  StrLen:=length(source);
  {删除source字符串}
  delete(s,site,StrLen);
  {插入target字符串到S中}
  insert(target,s,site);
 {返回新串}

 site:=pos(source,s);
  IF site >0 then
      S:=replacing(S,source,target) ;
  Result :=S;
end;

 function balancerate(source,target:string;pdxz:Boolean):Real;
 var
   str1,str2:string;
   sourcelist,targetlist: TstringList;
   i,df:Integer;
   Temstr:string;
   maxcount:Integer ;
 begin
   source :=Trim(source);    //去除前后空格
   target :=Trim(target);

   if Trim(source)=Trim(target ) then    //   如果相等就对了
      begin
        Result :=1;
        Exit;
      end;

   source:=replacing(source,'，',''); //去除逗号
   source:=replacing(source,',','');  //去除半角，
   source:=replacing(source,'。',''); //去除句号
   source:=replacing(source,'？',''); //去除问号
   source:=replacing(source,'：',''); //去除：
   source:=replacing(source,':','');  //去除半角:
   source:=replacing(source,';','');  //去除分号
   source:=replacing(source,'；','');  //去除半角分号
   source:=replacing(source,' ','');  //去除空格
   source:=replacing(source,'《','');  //去除书引号
   source:=replacing(source,'》','');  //去除书引号

//=======================
   target:=replacing(target,'，',''); //去除逗号
   target:=replacing(target,',','');  //去除半角，
   target:=replacing(target,'。',''); //去除句号
   target:=replacing(target,'？',''); //去除问号
   target:=replacing(target,'：',''); //去除：
   target:=replacing(target,':','');  //去除半角:
   target:=replacing(target,';','');  //去除分号
   target:=replacing(target,'；','');  //去除半角分号
   target:=replacing(target,' ','');  //去除空格
   target:=replacing(target,'《','');  //去除书引号
   target:=replacing(target,'》','');  //去除书引号

 
    if Trim(source)=Trim(target ) then    //   去除符号后如果相等就对了
      begin