{*******************************************************}
{ }
{ 公用函数 }
{ }
{ 版权所有 (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.
