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