Children's mathematical arithmetic software in Delphi source code Show Untfun.pas Source code

Return Download Children's mathematical arithmetic software in Delphi source code： download Untfun.pas Source code - Download Children's mathematical arithmetic software in Delphi source code Source code - Type:.pas
unit Untfun;
 
interface
 
 uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ExtCtrls, ComCtrls, ToolWin,WinSock,StdCtrls, jpeg,
  REGISTRY,ComObj, WordXP,inifiles,Math,ActiveX,ShlObj;
 
 
  const
 
  // 公共信息
{$IFDEF GB2312}
  SCnInformation = '提示';
  SCnWarning = '警告';
  SCnError = '错误';
{$ELSE}
  SCnInformation = 'Information';
  SCnWarning = 'Warning';
  SCnError = 'Error';
{$ENDIF}
 
  C1=52845; //字符串加密算法的公匙
  C2=22719; //字符串加密算法的公匙
 
 
 
//▎================1、扩展的MDI有关操作函数  ===================▎//
 
  procedure OpenChildForm(FormClass: TFormClass; var Fm; AOwner:TComponent);
  procedure OpenForm(FormClass: TFormClass; var fm; AOwner: TComponent);
 
  function IsForm(formClass:TFormClass) : boolean; //判断指定窗口存在没有
  function isapprun(str:string):boolean;//判断指定程序运行没有
  function CloseApp(ClassName: String): Boolean;   //关闭外部应用程序
 
//▎================2、扩展的网络有关操作函数  ===================▎//
 
 
 
  function GetHostIP:string;   {* 获取计算机的IP地址}
  function GetComputerName:string;  {* 获取网络计算机名称}
  function GetCurrentUserName : string;  //*获取当前Windows登录名的用户
 
 
//▎================3、 扩展的注册有关操作函数  ===================▎//
 
  function getzcm:string;
  function readzcm_ini(s:string):Integer ;
  function writezcm_ini(i:Integer;s:string):Boolean ;
  function readzcm_reg(s:string):integer;
  function writezcm_reg(s:string):Boolean;
 
  function GetHDNumber(Drv : String): DWORD; //得到硬盘序列号
  function Serial(Num:DWORD):string; //这个号码是用户给你生成注册码的，它通过对硬盘序列号编码而来。
  
  function StrToHex(AStr: string): string; {* 字符转化成十六进制}
  function HexToStr(AStr: string): string; {* 十六进制转化成字符}
  function TransChar(AChar: Char): Integer;
 
  function Encrypt(const S: String; Key: Word): String;//字符串加密函数
  function Decrypt(const S: String; Key: Word): String; //字符串解密函数
 
 //▎================4、 扩展的文件路径函数  ===================▎//
 
 function PathWithSlash(const Path: string): string;
 {功能，将路径变为带\符号的路径}
 
 function PathGetWindowsPath: string;  //WINDOWS路径\
 function PathGetSystemPath: string;   //SYSTEM32路径\
 function getsyspath:string;          //SYSTEM路径\
 function getAppPath : string;        //程序路径   带"\"
 function GetTempDirectory: String;    //临时目录\
 
 function shFileCopy(srcFile,destFile:String;bDelDest:boolean=true):boolean;// 功能：安全的复制文件
  { 功能：安全的复制文件 ,srcFile，destFile：源文件和目标文件 ,
 bDelDest：如果目标文件已经存在，是否覆盖 ,返回值：true成功，false失败}
 
 procedure DelTree(DirName:String);
 {如C:\123  或C:\123\都行,内部会补齐 }
 
 function EmptyDirectory(TheDirectory :String ; Recursive : Boolean):Boolean;
 {删除目录内的文件和子目录;如:"C:\123\" }
 
 procedure creatdesktoplink(Linkname:string);
 {建立桌面快捷方式，Linkname为在桌面上要显示的字符}
 
 
//▎================5 扩展的字符串操作函数  ===================▎//
 
function InStr(const sShort: string; const sLong: string): Boolean;     {测试通过}
{* 判断s1是否包含在s2中}
 
function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;  {测试通过}
{* 扩展整数转字符串函数  Example:   IntToStrEx(1,5,'0');   返回："00001"}
 
function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;  {测试通过}
{* 带分隔符的整数－字符转换}
 
function ByteToBin(Value: Byte): string; {测试通过}
{* 字节转二进制串}
 
function StrRight(Str: string; Len: Integer): string;  {测试通过}
{* 返回字符串右边的字符   Examples: StrRight('ABCEDFG',3);   返回:'DFG' }
 
function StrLeft(Str: string; Len: Integer): string; {测试通过}
{* 返回字符串左边的字符}
 
function Spc(Len: Integer): string;  {测试通过}
{* 返回空格串}
 
function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;  {测试通过}
{* 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作}
{example: replace('We know what we want','we','I',false) = 'I Know what I want'}
 
function Replicate(pcChar:Char; piCount:integer):string;
{在一个字符串中查找某个字符串的位置}
 
function StrNum(ShortStr:string;LongString:string):Integer;     {测试通过}
{* 返回某个字符串中某个字符串中出现的次数}
 
 
function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;        {测试通过}
{* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串}
 
function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;       {测试通过}
{* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串}
 
function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;        {测试通过}
{* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串}
 
function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;        {测试通过}
{* 返回替换后字符串[替换单个字符] Examples: ChrTran('abCdEgdlkh','d','#')； 返回'abC#Eg#lkh'}
 
function StrTran(psInput:String; psSearch:String; psTranWith:String):String;        {测试通过}
{* 返回替换后字符串[替换字符串] Examples: StrTran('aruyfbn','ruy','=====');； 返回'a=====fbn'}
 
function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;
{ *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'}
 
function IsDigital(Value: string): boolean;
{功能说明：判断string是否全是数字}
 
function RandomStr(aLength : Longint) : String;
{随机字符串函数}
 
procedure TxttoWords(const S: string; words: TstringList);  
{功能说明：分解成单个汉字，没有乱码，测试通过}
 
function tx(i: integer): string;      
{功能说明：将数字变成汉字，如1变一}
 
 //==================================== 自定义的字符串
  function deleleftdot(str:string):string;   //删除行首点号
  function deleleftdun(str:string):string; //删除行首顿号
  function deleleftdigital(str:string;partstr:string):string;
 
  function replacing(S,source,target:string):string;   
  {功能:在S中用target来替换source,能够完全去除}
 
  function balancerate(source,target:string;pdxz:Boolean):Real;
  {功能:计算两个字体符相同的经率,pdxz为是不是判断选择,处理时有差别,自定义}
 
 //以下为    处理时间
 function TimeToSecond(const H, M, S: Integer): Integer;
 function TimeSecondToTime(const secs: Integer):string;
 //▎================6 扩展的WORD操作函数  ===================▎//
 
 function CONNECTWORD: Boolean;
 {功能：建立、连接}
 
 procedure addstrtoword(text:string;align:Boolean;fontname:WideString;fontsize:integer);
 {向WORD中追加字符，顺序为追加内容、对齐方式、字体、字体大小}
 
 procedure Addbmptoword(STR:string);
 {功能：向WORD加入图片，STR为文件路径}
 
 procedure addstrtorich(s, fontname: string; fontsize,alimen: Integer; Richedit: TRichEdit);
 {功能：向RICHEDIT控件中追加内容，顺序为内容、字体、字体大小、对齐方式（O为左，1为中，2为中）、控件NAME}
 
 procedure  loadpicture(str:string;var image:TImage);
 {功能：打开图像文件，STR为路役，IMAGE为显示的控件}
 
 //▎================7 扩展的读取皮肤文件的函数  ===================▎//
  function  readskinfile(Keyname:string):string;
  {功能，读出皮肤路役，Keyname一般可设为程序名称，以利识别}
 
  procedure writeskinfile(keyname,filename:string);
  {功能，写入皮肤路役，Keyname一般可设为程序名称，以利识别}
 
//===================8.ado===========
  function setadoaccess(mdbpath:string;passwd:string):string;
  // 加入字体
 
 
 
 var
   msword: Variant;
 
 
  implementation
 
procedure OpenChildForm(FormClass: TFormClass; var Fm; AOwner:TComponent);
var
  I: Integer;
  Child: TForm;
begin
  for I := 0 to Screen.FormCount - 1 do
   if Screen.Forms[I].ClassType = FormClass then
     begin
       Child := Screen.Forms[I];
       if Child.WindowState = wsMinimized then
       ShowWindow(Child.Handle, SW_SHOWNORMAL)
       else
       ShowWindow(Child.handle,SW_SHOWNA);
       if (not Child.Visible) then Child.Visible := True;
        Child.BringToFront;
        Child.Setfocus;
        TForm(Fm) := Child;
        Exit;
     end;
    Child := TForm(FormClass.NewInstance);
    TForm(Fm) := Child;
    Child.Create(AOwner);
end;
 
 
procedure OpenForm(FormClass: TFormClass; var fm; AOwner: TComponent);
var
  i: integer;
  Child: TForm;
begin
  for i := 0 to Screen.FormCount - 1 do
    if screen.Forms[i].Owner = Aowner then
     begin
        //如有一窗口打开,将不打开新的窗口
        if Screen.Forms[i].ClassType = FormClass then
          begin
            Child := Screen.Forms[i];
            if Child.WindowState = wsMinimized then    //如已存在但最少化的窗口,将还原显示
            ShowWindow(Child.handle, SW_SHOWNORMAL)
            else
            ShowWindow(Child.handle, SW_SHOWNA);
            if (not Child.Visible) then Child.Visible := True;
            Child.BringToFront;
            Child.Setfocus;
            TForm(fm) := Child;
            exit;
          end;
 
      exit;
   end;
 
 
  Child := TForm(FormClass.NewInstance);
  TForm(fm) := Child;
  Child.Create(AOwner);
end;
 
function readzcm_reg(s:string):integer;
var
  re_id:integer;
  registerTemp : TRegistry;
  re_code:string;
  ini_num:Integer;
  Temres:Integer;
begin
  Temres:=0;
  registerTemp := TRegistry.Create;
    with registerTemp do
    begin
      RootKey:=HKEY_LOCAL_MACHINE;
       try
       if OpenKey('Software\Microsoft\Windows\'+s,True) then// 建一目录
          begin                               //wwwwwwwwwwwwwwwww 
            if ValueExists('reg_code') then  //如存在则
            begin
              re_code:=ReadString('reg_code');
              if re_code=getzcm then Temres:=0;// 己注册
            end
            else
            begin  //如果注册码键值不存在      //eeeeeeeeeeeee
 
              ini_num:=readzcm_ini('xlxt');   //读出INI记录的运行次数
 
              //往下语句肯定是非注册用户
              if valueexists('gc_id')=False then   //如NOT存在则
              begin //判断其存在否？     //ggggggggggggggg
                if ini_num =0 then
                begin
                  Writeinteger('gc_id',1);//如不存在则建立
                  writezcm_ini(1,'xlxt');
                  Temres:=1;
                end
                else
                Writeinteger('gc_id',ini_num);
              END                     //gggggggggggggg
              else
              begin //判断其存在否？   rrrrrrrrrrrrrrrrrr
                re_id:=readinteger('gc_id');//读出标志值
                re_id:=max(re_id,ini_num);
                if (re_id>500) or (re_id<1) then  Temres :=1000//假如1000，则应注册。
                else
                begin
                  re_id:=re_id+1; //最大值为500 ,试用期
                  Writeinteger('gc_id',re_id);
                  writezcm_ini(re_id,'xlxt');
                  Temres :=re_id;
                end;
              end;  //IF  EXSIT      rrrrrrrrrrrrrrrrrrrr
         end;//如果键值不存在        eeeeeeeeeeeeeeeeeeee
       end;    //      wwwwwwwwwww
       
     finally
     CloseKey;
     Free;
   end;
 Result :=Temres;
end; //with registerTemp do
 
end;
 
 
function writezcm_reg(s:string):Boolean;
VAR
  REG:TREGISTRY;
  str:string;
begin
   Result :=False;
   str:=getzcm;
   REG:=TREGISTRY.Create ;
      WITH REG DO
        BEGIN
          ROOTKEY:=HKEY_LOCAL_MACHINE;
          TRY
          if OpenKey('Software\Microsoft\Windows\'+s,True) then
            begin
              WriteString('reg_code',str);
              Writeinteger('gc_id',0);//若输入的注册码正确，则将标志值置为0 即已注册。
              Result :=True;
            end;
          FINALLY
          CloseKey;
          Free;
          END;
       end;
end;
 
function getzcm:string;
var
  str,temstr:string;
  i:Integer;
begin
  str:=Trim(Serial(GetHDNumber('C:')));
  temstr:=Copy(str,1,10);
  i:=Length(temstr);
  if i<10 then temstr:=temstr+copy('luzhenfeng',1,10-i);
  Result :=temstr ;
end;
 
function readzcm_ini(s:string):Integer ;
var
  inifile:TIniFile ;
  IniFileName:string;
  num:Integer ;
begin
  IniFileName:= PathGetWindowsPath+'myset.ini' ;
  inifile:=TInifile.Create(IniFileName);
  try
  num:=inifile.ReadInteger(s,'recorder',0);
  finally
  inifile.Free;
  end;
 
  Result :=num;  
end;
 
function writezcm_ini(i:integer;s:string):Boolean ;
var
  inifile:TIniFile ;
  IniFileName:string;
  BB:Boolean ;
begin
 
  IniFileName:= PathGetWindowsPath+'myset.ini' ;
  inifile:=TInifile.Create(IniFileName);
  try
    inifile.WriteInteger(s,'recorder',i);
    BB :=True;
  finally
    inifile.Free ;
  end;
  result:=BB;
end;
 
 //-------------------------------------  生成注册码
function GetHDNumber(Drv : String): DWORD; //得到硬盘序列号
var
 VolumeSerialNumber : DWORD;
 MaximumComponentLength : DWORD;
 FileSystemFlags : DWORD;
begin
 if Drv[Length(Drv)] =':' then Drv := Drv + '\';
 GetVolumeInformation(pChar(Drv),
            nil,
            0,
            @VolumeSerialNumber,
            MaximumComponentLength,
            FileSystemFlags,
            nil,
            0);
 Result:= (VolumeSerialNumber);
 //GetVolumeInformation("C:\\",NULL,NULL,&dwIDESerial,NULL,NULL,NULL,NULL);
end;
 
function Serial(Num:DWORD):string; //这个号码是用户给你生成注册码的，它通过对硬盘序列号编码而来。
var sNum:string; inChar:array[1..4]of char;
begin 
 
 Num:=Num xor 8009211011;
 sNum:=inttostr(Num);
 inChar[1]:=char(((integer(sNum[1])+integer(sNum[2]))mod 5)+integer('a'));
 inChar[2]:=char(((integer(sNum[3])+integer(sNum[4]))mod 5)+integer('a'));
 inChar[3]:=char(((integer(sNum[5])+integer(sNum[6]))mod 5)+integer('a'));
 inChar[4]:=char(((integer(sNum[7])+integer(sNum[8])+integer(sNum[9]))mod 5)+integer('a'));
 insert(inChar[1],sNum,1);
 insert(inChar[4],sNum,3);
 insert(inChar[2],sNum,5);
 insert(inChar[3],sNum,9);
 Result:=sNum;
end;
 
//▎======================⑾进制函数及过程======================▎//
 
function TransChar(AChar: Char): Integer;
begin
   if AChar in ['0'..'9'] then
      Result := Ord(AChar) - Ord('0')
   else
      Result := 10 + Ord(AChar) - Ord('A');
   end;
 
 
//字符转化成十六进制
function StrToHex(AStr: string): string;
var
   I : Integer;
//   Tmp: string;
   begin
      Result := '';
      For I := 1 to Length(AStr) do
      begin
         Result := Result + Format('%2x', [Byte(AStr[I])]);
      end;
      I := Pos(' ', Result);
      While I <> 0 do
      begin
         Result[I] := '0';
         I := Pos(' ', Result);
      end;
end;
 
//十六进制转化成字符
function HexToStr(AStr: string): string;
var
   I : Integer;
   CharValue: Word;
   begin
   Result := '';
   for I := 1 to Trunc(Length(Astr)/2) do
   begin
      Result := Result + ' ';
      CharValue := TransChar(AStr[2*I-1])*16 + TransChar(AStr[2*I]);
      Result[I] := Char(CharValue);
   end;
end;
 
//▎======================字符串加密和解密======================▎//
 
//字符串加密函数
function Encrypt(const S: String; Key: Word): String;
var
   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
        Result :=1;
        Exit;
      end;
 
     df :=0;
     
  if pdxz then  //if is 判断\选择题则
    begin
      target:=replacing(target,'.','');  //去除.
      source:=replacing(source,'.','');  //去除.
 
        // source代表答案,targe代表答的答题
       if Length(target)>Length(source) then
        begin
          Result :=0 ; //多选不得分;
          Exit;
        end;
 
      str2:=target;
        for i:=1 to Length(source) do
          begin
            str1:=Copy(source,i,1) ;
            if InStr(str1,str2) then
            df:=df+1;  //计算对的个数
          end;
 
      Result :=df/length(source);
   
     end//如果不是判断/选择题
     else
     begin
       sourcelist :=TStringList.Create ;
       targetlist :=TStringList.Create ;
       TxttoWords(source,sourcelist);
       TxttoWords(target,targetlist);
 
        if sourcelist.Count >targetlist.Count then
        maxcount :=sourcelist.Count
        else
        maxcount :=targetlist.Count ;//最大值
 
 
       str2 :=target ;
       for i:=0 to sourcelist.Count -2 do
         begin
           Temstr:=sourcelist.Strings[i+1];
           str1:=sourcelist.Strings[i]+temstr;
           if InStr(str1,str2) then
              df:=df+1;
         end;
 
       if df>0 then df:=df+1;
       Result :=df/maxcount;        //输出结果
       // Result :=df/sourcelist.count;
      sourcelist.Free ;  //清除内存
      targetlist.Free ;
     end;
 
end;
 
 
 
//=========================
function IsForm(FormClass: TFormClass) : boolean; //判断指定窗口存在没有
var
i : integer;
begin
result := False;
for i := 0 to screen.FormCount -1 do
begin
if (screen.Forms[i].ClassType = formClass) then
begin
result := True;
Break;
end;
end;
end;
 
function isapprun(str:string):boolean; //判断指定程序运行没有
var
HWndCalculator : HWnd;
begin
result:=false;
 
HWndCalculator := FindWindow(nil, pchar(str));
if HWndCalculator <> 0 then
    result:=true;
 
end;
 
function CloseApp(ClassName: String): Boolean;
//关闭外部应用程序
var Exehandle: THandle;
begin
  //ExeHandle := FindWindow(nil, Pchar(Caption));
  ExeHandle := FindWindow(Pchar(ClassName),nil);
  if ExeHandle <> 0
  then
   begin
     PostMessage(ExeHandle, WM_Quit, 0, 0);
     Result:=True;
   end
  else
   begin
     Result:=False;
   end;
end;
 
 
{* 获取计算机的IP地址}
function GetHostIP:string;
var
   wVersionRequested : WORD;
   wsaData : TWSAData;
   p : PHostEnt; s : array[0..128] of char; p2 : pchar;
begin
   try
      wVersionRequested := MAKEWORD(1, 1); //创建 WinSock
      WSAStartup(wVersionRequested, wsaData); //创建 WinSock
      GetHostName(@s,128);
      p:=GetHostByName(@s);
      p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
      Result:= P2;
   finally
      WSACleanup; //释放 WinSock
   end;
end;
 
 {* 获取网络计算机名称}
function GetComputerName:string;
var
   wVersionRequested : WORD;
   wsaData : TWSAData;
   p : PHostEnt; s : array[0..128] of char;
begin
   try
      wVersionRequested := MAKEWORD(1, 1); //创建 WinSock
      WSAStartup(wVersionRequested, wsaData); //创建 WinSock
      GetHostName(@s,128);
      p:=GetHostByName(@s);
      Result:=p^.h_Name;
   finally
      WSACleanup; //释放 WinSock
   end;
end;
 
//*获取当前Windows登录名的用户
function GetCurrentUserName : string;
const
   cnMaxUserNameLen = 254;
var
   sUserName : string;
   dwUserNameLen : Dword;
begin
   dwUserNameLen := cnMaxUserNameLen-1;
   SetLength( sUserName, cnMaxUserNameLen );
   GetUserName(Pchar( sUserName ), dwUserNameLen );
   SetLength( sUserName, dwUserNameLen );
   Result := sUserName;
end;
 
//===================================时间处理
function TimeToSecond(const H, M, S: Integer): Integer;
begin
Result := H * 3600 + M * 60 + S;
end;
 
function TimeSecondToTime(const secs: Integer):string;
var
  H, M, S: Word;
begin
H := secs div 3600;
M := (secs mod 3600) div 60;
S := secs mod 60;
 
Result :=format('%-.2d', [h])+'：'+format('%-.2d', [m])+ '：'+format('%-.2d', [s]);
 
end; 
 
 
function CONNECTWORD: Boolean;
var
  template:OleVariant ;
  newtemplate:OleVariant ;
  docutype:OleVariant ;
  visible:OleVariant ;
 
begin
  template:=EmptyParam ;
 // newtemplate :=TRUE;  //模板式
  //docutype:=0;   //模板式
   newtemplate :=False;
   docutype :=wdNewBlankDocument ;    //文档式
   visible :=True;
  try
   begin
    MSWord := CreateOLEObject('Word.Application');//连接Word
    msword.visible:=True;
    msword.Documents.Add(template,newtemplate,docutype ,visible );
    Result:=True;
    END;
  except
    begin
     application.MessageBox('Word文档连接失败','提示',MB_OK+  MB_ICONEXCLAMATION);
     Result :=False ;
     END;
  END;
end;
 
 
procedure addstrtoword(text:string;align:Boolean;fontname:WideString;fontsize:integer);
begin
  MSWord.Selection.Font.Size:=fontsize ;
  MSWord.Selection.Font.Name := fontname ;
  if  align then
  MSWord.Selection.ParagraphFormat.Alignment:= wdAlignParagraphCenter
  else
   BEGIN
   MSWord.Selection.ParagraphFormat.Alignment:= wdAlignParagraphLEFT;
   MSWord.Selection.ParagraphFormat.FirstLineIndent:=30;
   end;
 
  MSWord.Selection.TypeText(text);
  MSWord.Selection.TypeParagraph;
end;
 
procedure Addbmptoword(str:string );
begin  //str:图片绝对路径;
    msword.Selection.InlineShapes.AddPicture(str,False, True);
end;
{s:加入的字符;FONTNAME:字体名称,FONTSIZE:字体大小;ALIGENM:对齐方式0为左2为中1为右,RICHEDIT为加入对象的载体}
 
procedure addstrtorich(s, fontname: string; fontsize,alimen: Integer; Richedit: TRichEdit);
begin
  try
    Richedit.Lines.Add(s) ;
    Richedit.SelLength :=-length(s)-2;
    Richedit.SelAttributes.Size :=fontsize ;
    Richedit.SelAttributes.Name :=fontname ;
    Richedit.Paragraph.Alignment :=talignment(alimen) ;
  //  Richedit.SelStart:=Length(Richedit.Lines.Text);
  except
    Exit ;
  END;  
end;
 
//读取皮肤文件========================================================
function readskinfile(keyname:string):string;
var
 IniFileName:string;
 inifile:TInifile;
 str:string;
 ML:string;
 
begin
  ml:= getapppath+'ini';
  if Not DirectoryExists(ml) then CreateDir(ml);
 
  IniFileName:=getapppath+'ini\skin.ini';
  inifile:=TInifile.Create(IniFileName);
  str:=inifile.ReadString(Keyname,'skinfiles','');
  inifile.Free;
 
  Result :=str;
 
end;
 
procedure writeskinfile(keyname,filename:string);
var
  inifile:TInifile;
  IniFileName:string;
  ML:string;
 
begin
  ml:= getapppath+'ini';
  if Not DirectoryExists(ml) then CreateDir(ml);
 
  IniFileName:=GETAPPPath+'ini\Skin.ini';
  inifile:=TInifile.Create(IniFileName);
    try
       inifile.WriteString(keyname,'skinfiles',filename);
    finally
      inifile.Free;
    end;
end;
 
{ 
功能：安全的复制文件 
srcFile，destFile：源文件和目标文件 
bDelDest：如果目标文件已经存在，是否覆盖 
返回值：true成功，false失败 
} 
function shFileCopy(srcFile,destFile:String;bDelDest:boolean=true):boolean; 
begin
  result:=false;
  if not FileExists(srcFile) then
  begin
    Application.MessageBox ('源文件不存在，不能复制','提示',MB_OK+MB_ICONEXCLAMATION);
    exit;
  end;
 
  if srcFile=destFile then
  begin
    Application.MessageBox ('源文件和目标文件相同，不能复制','提示',MB_OK+MB_ICONEXCLAMATION);
    exit;
  end;
  
  if FileExists(destFile) then
  begin
  if not bDelDest then
      begin
       Application.MessageBox ('目标文件已经存在，不能复制','提示',MB_OK+MB_ICONEXCLAMATION);
       exit;
       end
  else
  begin
    if Application.MessageBox('目标文件己存在,要覆盖吗?','提示',MB_OK+MB_ICONQUESTION)=IDOK then
    begin
      FileSetAttr(destFile,FileGetAttr(destFile) and not $00000001);
      
      if not DeleteFile(PChar(destFile)) then
      begin
        Application.MessageBox ('目标文件已经存在，并且不能被删除，复制失败','提示',MB_OK+MB_ICONEXCLAMATION);
        exit;
      end;
    END;
  END;
  end; //END IF FILEEXISTS
     if not CopyFile(PChar(srcFile),PChar(destFile),False ) then     //COPY
     begin
       Application.MessageBox ('发生未知的错误，复制文件失败','提示',MB_OK+MB_ICONEXCLAMATION);
       exit;
     end;
//目标文件去掉只读属性 
    FileSetAttr(destFile,FileGetAttr(destFile) and not $00000001);
    result:=true;
end;
 
procedure loadpicture(str:string;var image:TImage);
var
 ms: tmemorystream;
 mJPeg: TJPegImage;
 sType:String ;
begin
   sType:=ExtractFileExt(str) ;
   ms:=TMemoryStream.Create ;
   mJpeg:=TJpegImage.Create ;
    Try
     ms.LoadFromFile(str ) ;
     ms.Position:=0 ;
    If (UpperCase(sType)='.JPEG') or (UpperCase(sType)='.JPG') Then
      Begin
        mJpeg.LoadFromStream(ms) ;    //把JPG流引入
        Image.Picture.Bitmap.Assign(mJpeg) ;
     End
     Else
      if UpperCase(sType)='.BMP' then
        Image.Picture.Bitmap.LoadFromStream(ms) ;    //引入BMP流
   Finally
   ms.Free ;
   mJpeg.Free ;
   End ;
 
End ;
 
//======================   目录操作
procedure DelTree(DirName:String); 
var 
hFindFile:Cardinal; 
FileName: String; 
FindFileData:WIN32_FIND_DATA; 
begin 
if DirName[Length(DirName)]<>'\' then 
  DirName:= DirName + '\'; 
hFindFile:= FindFirstFile(PChar(DirName + '*.*'), FindFileData); 
if hFindFile <> INVALID_HANDLE_VALUE then 
begin 
  repeat 
   FileName:= FindFileData.cFileName; 
   if (FileName <> '.') and (FileName <> '..') then 
   begin 
    if (FindFileData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY) then 
     DelTree(DirName + FileName) 
    else 
     DeleteFile(PChar(DirName + FileName)); 
   end; 
  until FindNextFile(hFindFile, FindFileData) = false; 
  Windows.FindClose(hFindFile); 
  RmDir(DirName); 
end; 
end;   
 
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean):Boolean;
var
SearchRec : TSearchRec; 
Res : Integer; 
begin 
Result := False; 
TheDirectory := Trim(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec); 
try 
while Res = 0 do 
begin 
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then 
begin 
if ((SearchRec.Attr and faDirectory) > 0) and Recursive 
then begin 
EmptyDirectory(TheDirectory + SearchRec.Name, True); 
RemoveDirectory(PChar(TheDirectory + SearchRec.Name)); 
end 
else begin 
DeleteFile(PChar(TheDirectory + SearchRec.Name)) 
end; 
end; 
Res := FindNext(SearchRec); 
end;
Result := True;
finally
FindClose(SearchRec);
//FindClose(SearchRec.FindHandle);
end;
end;
 
procedure creatdesktoplink(Linkname:string);
var
 tmpObject: IUnknown;
 tmpSLink: IShellLink;
 tmpPFile: IPersistFile;
 PIDL: PItemIDList;
 StartupDirectory: array[0..MAX_PATH] of Char;
 StartupFilename: string;
 LinkFilename: WideString;
 Tempstr:string ;
begin
 //StartupFilename := ExtractFilePath(Application.ExeName) + 'xlxt.exe';
 StartupFilename :=Application.ExeName;
 
 if not FileExists(StartupFilename) then Exit;
 tmpObject := CreateComObject(CLSID_ShellLink);
 tmpSLink := tmpObject as IShellLink;
 tmpPFile := tmpObject as IPersistFile;
 tmpSLink.SetPath(pChar(StartupFilename));
 tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename)));
 SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
 SHGetPathFromIDList(PIDL,StartupDirectory);
 
 Tempstr :='\'+ Linkname+'.lnk' ;
 
 LinkFilename := StartupDirectory + Tempstr ;
 
 
 if FileExists(LinkFileName) then
 
  begin
  application.MessageBox('快捷方式己存在,不能重复建立','提示',MB_OK+  MB_ICONEXCLAMATION);
  Exit;
  end
  else
  begin
   tmpPFile.Save(pWChar(LinkFilename), FALSE);
   application.MessageBox('快捷方式己建立','提示',MB_OK+MB_ICONinformation);
  END;
end;
 
 
 
function setadoaccess(mdbpath:string;passwd:string):string;
Const
  SConnectionString       = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
                                +'Jet OLEDB:Database Password=%s;';
begin
  mdbpath:=trim(mdbpath);
  passwd:=trim(passwd);
  result:=format(SConnectionString,[mdbpath,passwd]);
end;
 
 
 
 
end.
 
downloadUntfun.pas Source code - Download Children's mathematical arithmetic software in Delphi source code Source code
Related Source Codes/Software：
Delphi screen touch cash register system source program - From the perspective of directory structure, this ... 2012-02-18
Delphi examples of using the Image control to display and draw text - The Delphi examples through the use of an Image co... 2012-02-18
Delphi kanji literacy software full version - Delphi pupils ' Chinese character recognition soft... 2012-02-18
Delphi uses the MMS protocol to download streaming media file - Delphi uses the MMS protocol to download streaming... 2012-02-18
Delphi implements a simple P2P chat program - This simple P2P chat software used to simple Serve... 2012-02-18
Image selection/editing plug-in v2.0 Delphi Edition - This is a DELPHI graphics you want to use a plugin... 2012-02-18
Magnificent Delphi implementation interface game Lander - Delphi complete source of legends of the game land... 2012-02-18
Delphi source code enterprise generic invoicing system - A common IT industry enters sells saves management... 2012-02-18
Stamp making software Delphi source code - The DELPHI software is very clever, you can achiev... 2012-02-18
Features of Delphi good teaching management system - A written in DLEPHI language teaching management ... 2012-02-18
Delphi car rental company business management system - A car rental company's business management systems... 2012-02-18
Delphi major revision of the human resources management system source code - RedHR owned a large OFFICE of human resources mana... 2012-02-18
DELPHI pawn industry management system source code - Pawn shop of an integrated business management sys... 2012-02-18
Cool interface Delphi chat software source code - Interface is really cool? This is a small LAN chat... 2012-02-18
Delphi shield Ctrl+Alt+Del reqijian method - Real shielding theory of Delphi is this: using a r... 2012-02-18
Classic RPG games with Delphi source code - The actual and Diablo game or scene is similar in ... 2012-02-18
35 Delphi7 Indy instance package - Application example demonstrates a lot of Indy Dem... 2012-02-18
Delphi transportation company business management system - A Delphi transportation company business managemen... 2012-02-18
Using Delphi to achieve control of the camera - This procedure describes how to use DELPHI AVICAP3... 2012-02-18
Cell of the report component for Delphi example source program - UFIDA table company developed a report component, ... 2012-02-18