untfun.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