utchpublicfun.pas

delphi底层函数delphi底层函数delphi底层函数delphi底层函数

unit uTchPublicFun;

interface

uses LZExpand,Jpeg,Registry,Math,WinSock,Windows,graphics,Forms,Classes,SysUtils,
     Dialogs,ShellApi,Controls,nb30,StdCtrls,DateEd,TimeEdit,ExtCtrls,ComCtrls,
     Messages,TntStdCtrls;


type
  PTForm=^TForm;
  TtdCompareFunc = function (aData1, aData2 : pointer) : integer;

const C1  =  52845;
const C2  =  22719;

//1.判断处理函数
function YearMonthDay(PID: String): Boolean;
function GetMayKeyValue(Key: Char): Char;


//2.身份证号码函数
function CheckPid(IdNo: String): Boolean;
function ChangeId(IdNo: String): String;
function Pid_To_Sex(Pid: String): Integer;
function Pid_To_Sex_Code(Pid: String): Integer;
function Pid_To_Sex_Chs(Pid: String): String;
function Pid_To_Birthday(Pid: String): TDateTime;

//3.字符串函数
function Semi(var S: String; M: String): String;
function SemiU(var S: WideString; M: WideString): WideString;
function Semiw(var S: String; M: String; K: String): String;
function SemiCount(S: String; M: String): Integer;
function SemiX(var S: String; Sm: String): String;
function IncStr(St: String): String;
function TrimAll(St: String): String;
function TchReplace(Str: String): String;

//4.类型转换函数
function SToI(S: String): LongInt;
function IToS(No: LongInt): String;
function FontToStr(V: TFont): String;
procedure StrToFont(S: String;V: TFont);
function XToD(Const Num: Real): String;

//5.文件处理函数
procedure EncryptFile(InfName, OutFName: String; Key: Word);
procedure DecryptFile(InfName, OutfName: String; Key: Word);
function ExecuteFile(Const FileName, Params, DefaultDir: String;
  ShowCmd: Integer): THandle;
function CutPath(FName: String): String;
function CutName(FName: String): String;
function CombineFile(var Path: String; S: String; Size: LongInt): String;
procedure ExpandFile(var Path: String; S, D: String; Size: LongInt);
function CutFileIntoPath(Dn, NewPath: String; Apart: LongInt): String;
procedure CopyToFile(S, D: String);
function GetApplicationVersion(FileName: String): String;
function GetFileLastAccessTime(sFileName: String): String;
function GetFileIcon(const Filename: String; SmallIcon: Boolean): HIcon;


//6.获取路径函数
function GetTempDirectory: String;
function GetWinDirectory: String;
function GetSysdirectory: String;
function Getmac: String;

//7.组件处理函数
procedure PSetCompentNull(MyForm: TForm);
procedure PSetEnableColor(Frm: PTForm; ObjectColor: Tcolor);


//8.图片处理函数
procedure BmpToJpg(BmpFile: String; JpgFile: String; Quality: Integer);
procedure JpgToBmp(JpgFile, BmpFile: String);


{
//9.串口处理函数
function InitComm(Port: Integer; Rate: LongInt; Stop, Bits: Integer; Pe: String;
  InSize, OutSize: Integer): Integer;
function GetComm(Cid: Integer; Num: Integer): String;
procedure PutComm(Cid: Integer; St: String);
}

//10.注册表相关函数
procedure RegisterAxLib(FileName, Cmd: String);
procedure RunAtStartup(Key, Value: String);

//11.执行程序处理函数
procedure Execute(Ln: Pchar; nShow: Integer);
procedure HideApp;
function CloseApp(ClassName: String): Boolean;
procedure DeleteMe;
function ExeExt(Ext: String): String;
procedure RunDosInMemo(DosApp: String; ResList: TStringList);
function GetAppPath:String;
function GetAppName: String;



//12.磁盘处理函数
procedure GetDisks(Strings: TStringList);
function GetHdID: String;

//13.其它函数
procedure SendKeys(S: String);
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
  Text: String; Alignment: TAlignment; ARightToLeft: Boolean);
function ExtractRes(ResType, ResName, ResNewName: String): Boolean;
function GetIP: String;
function GetBootedTime: Real;
procedure About;
procedure MyMsg(Msg: String);

//14.排序算法
procedure SelectionSort(aList    : TList;         //选择排序
                          aFirst   : integer;
                          aLast    : integer;
                          aCompare : TtdCompareFunc);
procedure InsertionSortStd(aList    : TList;         //插入排序
                             aFirst   : integer;
                             aLast    : integer;
                             aCompare : TtdCompareFunc);




implementation

/////////////////////////////////////////////////////
//YearMonthDay                                     
//语法：YearMonthDay(DateStr:String);
//说明：检查身份证号中出生日期是否合法
//参数：DateStr    出生日期
function YearMonthDay(PID: String): Boolean;
begin
  Result := False;
  case StrToInt(Copy(PID, 11, 2)) of
    01, 03, 05, 07, 08, 10, 12:
      begin
        if StrToInt(Copy(PID, 13, 2)) < 32 then
          Result := True
        else
          Result := False;
      end;
    04, 06, 09, 11:
      begin
        if StrToInt(Copy(PID, 13, 2)) < 31 then
          Result := True
        else
          Result := False;
      end;
    02:
      begin
        if ((StrToInt(Copy(PID, 7, 4)) Mod 100 = 0) and
          (StrToInt(Copy(PID, 7, 4)) Mod 400 = 0)) or ((StrToInt(Copy(PID,
          7, 4)) Mod 100 <> 0) and (StrToInt(Copy
          (PID, 7, 4)) Mod 4 = 0)) then
        begin
          if StrToInt(Copy(PID, 13, 2)) < 30 then
            Result := True
          else
            Result := False;
        end
        else
        begin
          if StrToInt(Copy(PID, 13, 2)) < 29 then
            Result := True
          else
            Result := False;
        end;
      end;
  end;
end;

///////////////////////////////////////////////////
//语法：GetMayKeyValue(Key: Char): Char;
//说明：判断输入是否为数字、删除键、小数点。
//参数：Key    输入键值
//返回值：
//  #0：不为数字、删除键、小数点。

function GetMayKeyValue(Key: Char): Char;
begin
  Result := Key;
  if ((Key < #48) or (Key > #57)) and (Key <> #8) then
    Result := #0;
end;

////////////////////////////////////////////////////////////////
//语法：CheckPid(IdNo:String):Boolean;
//说明：身份证号码校验。
//参数：IdNo    身份证号码
//返回值：
//  True：身份证号码正确。
//  False：非法身份证号码。

function CheckPid(IdNo: String): Boolean;
var
  Str1, Str2, Str3: String;
  Int1: Integer;
begin
  Result := False;
  if StrLen(PChar(IdNo)) = 18 then
  begin
    Str1 := UpperCase(IdNo);
    Str3 := Copy(Str1, 18, 1);
    Int1 := (StrToInt(Copy(Str1, 1, 1)) * 7 + StrToInt(Copy(Str1, 2, 1)) * 9 +
      StrToInt(Copy(Str1, 3, 1)) * 10 + StrToInt(Copy(Str1, 4, 1)) * 5 +
      StrToInt(Copy(Str1, 5, 1)) * 8 + StrToInt(Copy(Str1, 6, 1)) * 4 +
      StrToInt(Copy(Str1, 7, 1)) * 2 + StrToInt(Copy(Str1, 8, 1)) * 1 +
      StrToInt(Copy(Str1, 9, 1)) * 6 + StrToInt(Copy(Str1, 10, 1)) * 3 +
      StrToInt(Copy(Str1, 11, 1)) * 7 + StrToInt(Copy(Str1, 12, 1)) * 9 +
      StrToInt(Copy(Str1, 13, 1)) * 10 + StrToInt(Copy(Str1, 14, 1)) * 5 +
      StrToInt(Copy(Str1, 15, 1)) * 8 + StrToInt(Copy(Str1, 16, 1)) * 4 +
      StrToInt(Copy(Str1, 17, 1)) * 2) Mod 11;
    if Int1 = 0 then
      Str2 := '1';
    if Int1 = 1 then
      Str2 := '0';
    if Int1 = 2 then
      Str2 := 'X';
    if (Int1 <> 0) and (Int1 <> 1) and (Int1 <> 2) then
      Str2 := IntToStr((12 - Int1));
    if Str2 = Str3 then
      Result := True
    else
      Result := False;
  end;
end;


//////////////////////////////////////////////////////////////////////
//语法：ChangeId(IdNo:String):String;
//说明：15位到18位身份证号码转换。
//参数：IdNo    身份证号码

function ChangeId(IdNo: String): String;
var
  Str1, Str2: String;
  Int1: Integer;
begin
  if (Length(IdNo) <> 15) and (Length(IdNo) <> 18) then
    ShowMessage('身份证号码位数不正确!');
  if Length(IdNo) = 18 then
    if not CheckPid(IdNo) then
      ShowMessage('无效的身份证号码！');
  if Length(IdNo) = 15 then
  begin
    Str1 := Copy(IdNo, 1, 6) + '19' + Copy(IdNo, 7, 15);
    Int1 := (StrToInt(Copy(Str1, 1, 1)) * 7 + StrToInt(Copy(Str1, 2, 1)) * 9 +
      StrToInt(Copy(Str1, 3, 1)) * 10 + StrToInt(Copy(Str1, 4, 1)) * 5 +
      StrToInt(Copy(Str1, 5, 1)) * 8 + StrToInt(Copy(Str1, 6, 1)) * 4 +
      StrToInt(Copy(Str1, 7, 1)) * 2 + StrToInt(Copy(Str1, 8, 1)) * 1 +
      StrToInt(Copy(Str1, 9, 1)) * 6 + StrToInt(Copy(Str1, 10, 1)) * 3 +
      StrToInt(Copy(Str1, 11, 1)) * 7 + StrToInt(Copy(Str1, 12, 1)) * 9 +
      StrToInt(Copy(Str1, 13, 1)) * 10 + StrToInt(Copy(Str1, 14, 1)) * 5 +
      StrToInt(Copy(Str1, 15, 1)) * 8 + StrToInt(Copy(Str1, 16, 1)) * 4 +
      StrToInt(Copy(Str1, 17, 1)) * 2) Mod 11;
    if Int1 = 0 then
      Str2 := '1';
    if Int1 = 1 then
      Str2 := '0';
    if Int1 = 2 then
      Str2 := 'X';
    if (Int1 <> 0) and (Int1 <> 1) and (Int1 <> 2) then
      Str2 := IntToStr((12 - Int1));
    Result := Str1 + Str2;
  end
  else
    Result := IdNo;
end;

///////////////////////////////////////////////////////////////
//语法：Pid_To_Sex(Pid: String) : Integer;
//说明：从身份证号码中截取性别代号。
//参数：Pid    身份证号码

function Pid_To_Sex(Pid: String): Integer;
var
  S: String;
begin
  Result := 5;
  if Length(Pid) <> 18 then
    Exit;
  S := Copy(Pid, 17, 1);
  Result := (StrToInt(S) Mod 2);
end;
//////////////////////////////////////////////////////////////////////
//语法：Pid_To_Sex_Code(Pid: String): Integer;
//说明：从身份证号码中截取性别代号。
//参数：Pid     身份证号码
//返回值：
//0：女
//1：男
//9：未知或无效证号

function Pid_To_Sex_Code(Pid: String): Integer;
var
  S: String;
begin
  if Length(Pid) = 15 then
    S := Copy(Pid, 15, 1)
  else if Length(Pid) = 18 then
    S := Copy(Pid, 17, 1)
  else
  begin
    Result := 9;
    Exit;
  end;
  Result := (StrToInt(S) Mod 2);
end;

/////////////////////////////////////////////////////
//语法：Pid_To_Sex_Chs(Pid: String): String;
//说明：从身份证号码中截取性别代号。
//参数：Pid     身份证号码

function Pid_To_Sex_Chs(Pid: String): String;
var
  S: String;
begin
  if Length(Pid) = 15 then
    S := Copy(Pid, 15, 1)
  else if Length(Pid) = 18 then
    S := Copy(Pid, 17, 1)
  else
  begin
    Result := '未知';
    Exit;
  end;
  case (StrToInt(S) Mod 2) of
    0: Result := '女';
    1: Result := '男';
  end;
end;
//////////////////////////////////////////////////////////////
//语法：Pid_To_Birthday(Pid : String) : TDateTime;
//说明：从18位身份证号码中截取出生日期。
//参数：Pid   身份证号码

function Pid_To_Birthday(Pid: String): TDateTime;
var
  P, S, Str: String;
begin
  Str := '';
  S := DateSeparator;
  P := Pid;
  if YearMonthDay(P) then
    Str := Copy(P, 7, 4) + s + Copy(P, 11, 2) + s + Copy(P, 13, 2);
  Result := StrToDate(Str);
end;

/////////////////////////////////////////////////////////
//语法：Semi(var S:String;M:String):String;
//说明：从固定分隔符字符串中找出相应的子串。如：A$B$C$
//参数：S    固定分隔字符串
//参数：M    子串

function Semi(var S: String; M: String): String;
var
  N: Integer;
begin
  N := Pos(M, S);
  if N = 0 then
  begin
    Semi := S;
    S := '';
  end
  else
  begin
    Semi := Copy(S, 1, N - 1);
    S := Copy(S, N + Length(M), 65535);
  end;
end;
function SemiU(var S: WideString; M: WideString): WideString;
var
  N: Integer;
begin
  N := Pos(M, S);
  if N = 0 then
  begin
    SemiU := S;
    S := '';
  end
  else
  begin
    SemiU := Copy(S, 1, N - 1);
    S := Copy(S, N + Length(M), 65535);
  end;
end;

//////////////////////////////////////////////////////////////
//语法：Semiw(var S:String;M:String;K:String):String;
//说明：从不同分隔符字符串中取出相应的子串。如：A&B<
//参数：S    不同分隔符字符串
//参数：M    子串前面的分隔符
//参数：K    子串后面的分隔符

function Semiw(var S: String; M: String; K: String): String;
var
  N, L: Integer;
begin
  if M = '' then
    N := 0
  else
  begin
    N := Pos(M, S);
    if N = 0 then
      N := 564;
  end;
  if K = '' then
    L := 566
  else
    L := Pos(K, S);
  if L = 0 then
    L := 566;
  Result := Copy(S, N + 1, L - 1 - N);
end;

/////////////////////////////////////////////////////////
//语法：SemiCount(S: String; M: String): Integer;
//说明：通过字串M得到S中以字串M分隔的子串总数
//EX:
//SemiCount('adelbdelcdel','del') ->3
//SemiCount('a,b,c',',') ->3
//参数：S    字符串
//参数：M    子串

function SemiCount(S: String; M: String): Integer;
var
  T: String;
begin
  Result := 0;
  while S <> '' do
  begin