公用函数

{*******************************************************}
{                                                       }
{       公用函数                                        }
{                                                       }
{       版权所有 (C) 2007 咏南工作室                    }
{                                                       }
{*******************************************************}

unit uCommFunc;

interface

uses
  SysUtils, Forms, Windows, Controls, Messages, Dialogs, db, Classes,
  ComObj,IniFiles,ShellAPI,WinSock;

//==============================================================================
// INI文件
//==============================================================================

Function ReadIniFile(const FileName,Section, Ident:string;
  Default: string):string; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: integer):integer; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: Double):Double; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: Boolean):Boolean; overload;
Function ReadIniFile(const FileName,Section, Ident:string;
  Default: TdateTime):TdateTime; overload;

procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:string);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:integer);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:Double);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:Boolean);overload;
procedure WriteIniFile(const FileName,Section, Ident:string;
  Value:TdateTime);overload;

//==============================================================================
// 字符串
//==============================================================================
function StrToStrEx(Value: string; strflag: string;Len: Integer;
  FillChar: Char = '0'): string;
function FindStr(ShortStr: String; LongStrIng: String): Integer;
{ 人民币小写转大写 }
function RMB(AMoney: Double): String;
{ 四舍五入 }
function RoundEx (const Value: Double): integer;
{ 得到汉字拼音助记码 }
function GetPy(const AHzStr: string): string;
{ 条形码 }
function EAN13(t_str: string): string;
{ 打开网址 }
procedure OpenURL(URL: string);
function GetAppPath: string;
function GetINIFile:string;
function GetMDB:string;

//==============================================================================
// 日期时间
//==============================================================================

function GetYear(Date: TDate): string;
function GetMonth(Date: TDate): string;
function GetDay(ADate: TDate): string;
procedure CheckDate(aDate: string);
{ 得到当前日期 }
function GetCurDate: string;

Function GetLocateIp(InternetIp:Boolean=False):String;

//==============================================================================
// 其它
//==============================================================================
procedure IsSelAll(aStr: string);
{ 通用窗口创建 }
procedure OpenChildForm(FormClass:TFormClass;var Form:TForm;Mark:Integer=0);
procedure ClearMemory;
{
  提供一个系统空闲时间函数（ms）,你可以用timer控件定时监测，
  如果系统空闲时间超过指定时间则做你想做的事：
  系统空闲-指系统无任何操作，包括键盘和鼠标）
}
function LastInput:dword;

implementation

var
  myinifile:TIniFile;

function LastInput:dword;
var
  LInput: TLastInputInfo;
begin
  LInput.cbsize := sizeof(TLastInputInfo);
  GetLastInputInfo(LInput);
  result := GetTickCount - LInput.dwtime;
end; 

procedure ClearMemory;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then  //指定Win32平台的标识符
  begin
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
    Application.ProcessMessages;
  end;
end;

//获取本机IP地址
Function GetLocateIp(InternetIp:Boolean=False):String;
type
  TaPInAddr = Array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: Array[0..63] of Char;
  I: Integer;
  GInitData: TWSAData;
  IP: String;
begin
  Screen.Cursor := crHourGlass;
  try
    WSAStartup($101, GInitData);
    IP:='0.0.0.0';
    GetHostName(Buffer, SizeOf(Buffer));
    phe := GetHostByName(buffer);
    if phe = nil then
    begin
      ShowMessage(IP);
      Result:=IP;
      Exit;
    end;
    pPtr := PaPInAddr(phe^.h_addr_list);
    if InternetIp then
    begin
      I := 0;
      while pPtr^[I] <> nil do
      begin
        IP := inet_ntoa(pptr^[I]^);
        Inc(I);
      end;
    end
    else
      IP:=StrPas(inet_ntoa(pptr^[0]^));
    WSACleanup;
    Result:=IP;//如果上网则为上网ip否则是网卡ip
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure OpenURL(URL: string);
begin
  ShellExecute(0, nil, PAnsiChar(URL), nil, nil, SW_NORMAL);
end;

function EAN13(t_str: string): string;  
var
  s: array[2..13] of integer;
  answer: string;
begin
  t_str:=trim(t_str);
  result:='';
  //空格跳出
  if length(t_str) < 12 then
    exit;
  s[13] := strtointdef(t_str[1], -1);
  s[12] := strtointdef(t_str[2], -1);
  s[11] := strtointdef(t_str[3], -1);
  s[10] := strtointdef(t_str[4], -1);
  s[9] := strtointdef(t_str[5], -1);
  s[8] := strtointdef(t_str[6], -1);
  s[7] := strtointdef(t_str[7], -1);
  s[6] := strtointdef(t_str[8], -1);
  s[5] := strtointdef(t_str[9], -1);
  s[4] := strtointdef(t_str[10], -1);
  s[3] := strtointdef(t_str[11], -1);
  s[2] := strtointdef(t_str[12], -1);
  if s[13] < 0 then exit;
  if s[12] < 0 then exit;
  if s[11] < 0 then exit;
  if s[10] < 0 then exit;
  if s[9] < 0 then exit;
  if s[8] < 0 then exit;
  if s[7] < 0 then exit;
  if s[6] < 0 then exit;
  if s[5] < 0 then exit;
  if s[4] < 0 then exit;
  if s[3] < 0 then exit;
  if s[2] < 0 then exit;
  answer := inttostr((s[2] + s[4] + s[6] + s[8] + s[10] + s[12]) * 3 +
   s[3] + s[5] + s[7] + s[9] + s[11] + s[13]);
  answer := inttostr(10 - (strtoint(answer) mod 10));  //计算校验码
  result := t_str + copy(answer, 1, 1);
end;

function GetPy(const AHzStr: string): string;
const
  ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
    (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
    (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
    (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
    (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
  i, j, HzOrd: Integer;
begin
  Result:='';
  i := 1;
  while i <= Length(AHzStr) do
  begin
    if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
    begin
      HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
      for j := 0 to 25 do
      begin
        if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
        begin
          Result := Result + Char(Byte('A') + j);
          Break;
        end;
      end;
      Inc(i);
    end else Result := Result + AHzStr[i];
    Inc(i);
  end;
end;

function RoundEx (const Value: Double): integer;
var
  x: Real;
begin
  x := Value - Trunc(Value);
  if x >= 0.5 then
    Result := Trunc(Value) + 1
  else Result := Trunc(Value);
end;
   
function RMB(AMoney: Double): String;
const s1: String = '零壹贰叁肆伍陆柒捌玖'; s2: String = '分角元拾佰仟万拾佰仟亿拾佰仟万';
var s, dx: String; i, Len: Integer;
function StrTran(const S, S1, S2: String): String; begin Result := StringReplace(S, S1, S2, [rfReplaceAll]); end;
begin
  if AMoney < 0 then begin dx := '负'; AMoney := -amoney; end;
  s := Format('%.0f', [AMoney]); Len := Length(s);
  for i := 1 to Len do dx := dx + Copy(s1, (Ord(s[i]) - Ord('0'))*2 + 1, 2) + Copy(s2, (Len - i)*2 + 1, 2);
  dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟', '零'), '零佰', '零'), '零拾', '零'), '零角', '零'), '零分', '整');
  dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零', '零'), '零零', '零'), '零亿', '亿'), '零万', '万'), '零元', '元');
  if dx = '整' then Result := '零元整' else Result := StrTran(StrTran(StrTran(dx, '亿万', '亿零'), '零整', '整'), '零零', '零');
end; 

//==============================================================================
// if mark=0 then Tform.show else Tform.showmodal
//==============================================================================

procedure OpenChildForm(FormClass:TFormClass;var Form:TForm;Mark:Integer=0);
begin
  if Mark=0 then
  begin
    if not Assigned(form) then Application.CreateForm(FormClass,Form);
    if Form.WindowState=wsminimized then Form.WindowState:=wsNormal;
  end else begin
    form:=FormClass.Create(nil);
    Form.ShowModal;
    Form.Free;
  end;
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: integer): integer;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadInteger(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: string): string;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadString(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: Boolean): Boolean;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadBool(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: Double): Double;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadFloat(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: TdateTime): TdateTime;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadDateTime(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: integer);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteInteger(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: string);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteString(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: Boolean);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteBool(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: Double);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteFloat(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: TdateTime);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteDateTime(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

{ 格式：2007-01-01 }
function GetCurDate: string;
begin
  Result:=getyear(Date)+'-'+strtostrex(getmonth(Date),'front',2)+
    '-'+strtostrex(getday(Date),'front',2);
end;

procedure CheckDate(aDate: string);
begin
  try
    StrToDate(aDate);
  except
    Application.MessageBox('不正确的日期格式',
      '错误', MB_OK + MB_ICONSTOP);
    Exit;
  end;
  if Length(aDate) <> 10 then
  begin
    Application.MessageBox('不正确的日期格式',
      '错误', MB_OK + MB_ICONSTOP);
  end;
end;

//==============================================================================
// 返回特定子串在字符串中的位置
//==============================================================================

function FindStr(ShortStr, LongStrIng: String): Integer;
var
  locality: integer;
begin
   locality := Pos(ShortStr, LongStrIng); 
   if locality = 0 then Result := 0 else Result := locality;
end;

//==============================================================================
// 扩展字符串转字符串函数(默认填充'0')
// Example1: temps2 := StrToStrEx(temps2, 'back', 2); //不足两位的后面补0
// Example2: temps1 := StrToStrEx(temps1, 'front', 4);//不足四位的前面补0
//==============================================================================

function StrToStrEx(Value: string; strflag: string;
  Len: Integer; FillChar: Char = '0'): string;
begin
  result := Value;
  while Length(result) < Len do
  begin
    if strflag = 'front' then
      result := FillChar + Result;
    if strflag = 'back' then
      result := result + fillchar;
  end;
end;

function GetYear(Date: TDate): string;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := IntToStr(y);
end;

function GetMonth(Date: TDate): string;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := IntToStr(m);
end;

function GetDay(ADate: TDate): string;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := IntToStr(d);
end;

function GetAppPath: string;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

function GetINIFile:string;
begin
  Result:=GetAppPath+'db.ini';
end;

function GetMDB:string;
begin
  Result:=GetAppPath+'tmpgrp.mdb';
end;

//==============================================================================
// 不输入任何查询条件即是查询所有
// 遇到数据量大的时候，会让用户等很长时间
// 因此在查询所有的前面友好地提示用户是有必要的
//==============================================================================

procedure IsSelAll(aStr: string);
begin
  if aStr='' then
    if Application.MessageBox('查询所有将花费较长时间，确认继续','询问',
      MB_YESNOCANCEL + MB_ICONQUESTION) <> IDYES then Abort;
end;

end.