📄 un_utl.pas
字号:
EXIT;
END;
IF (LENGTH(CDATE) > 7 ) then
BEGIN
IF WARNING = TRUE THEN showmessage('日期长度不能超过7个!');
RESULT := FALSE;
EXIT;
END;
IF (LENGTH(CDATE) < 6 ) then
BEGIN
IF WARNING = TRUE THEN showmessage('日期长度不能小于6个!');
RESULT := FALSE;
EXIT;
END;
//==========================================================
IF (LENGTH(CDATE) = 7 ) AND
(CHECK_DAY( STRTOINT(COPY(CDATE,4,2)),STRTOINT(COPY(CDATE,6,2)) ,TRUE)=FALSE )then
BEGIN
RESULT := FALSE;
EXIT;
END;
//==========================================================
IF (LENGTH(CDATE) = 6 ) AND
(CHECK_DAY( STRTOINT(COPY(CDATE,3,2)),STRTOINT(COPY(CDATE,5,2)) ,TRUE)=FALSE )then
BEGIN
RESULT := FALSE;
EXIT;
END;
//==========================================================
RESULT := TRUE;}
END;
FUNCTION CHECK_DAY(MONTH,DAY:INTEGER;WARNING:BOOLEAN):BOOLEAN;
BEGIN
IF (MONTH > 12 ) OR (MONTH < 1 ) THEN
BEGIN
IF WARNING = TRUE THEN showmessage('月份格式不正确!');
RESULT := FALSE;
EXIT;
END;
CASE MONTH OF
1,3,5,7,8,10,12 :BEGIN
IF (DAY > 31 ) OR (DAY < 1 ) THEN
BEGIN
IF WARNING = TRUE THEN showmessage('日期格式不正确!');
RESULT := FALSE;
EXIT;
END;
END;
4,6,9,11 :BEGIN
IF (DAY > 30 ) OR (DAY < 1 ) THEN
BEGIN
IF WARNING = TRUE THEN showmessage('日期格式不正确!');
RESULT := FALSE;
EXIT;
END;
END;
2 :BEGIN
IF (DAY > 29 ) OR (DAY < 1 ) THEN
BEGIN
IF WARNING = TRUE THEN showmessage('2月份日期格式不正确!');
RESULT := FALSE;
EXIT;
END;
END;
END;
RESULT := TRUE;
END;
FUNCTION CHECK_TIME(TIME:STRING;WARNING:BOOLEAN):BOOLEAN;
BEGIN
IF (STRTOINTDEF(COPY(TIME,1,2),-1) < 0 ) OR
(STRTOINTDEF(COPY(TIME,1,2),-1) >= 24 ) OR
(STRTOINTDEF(COPY(TIME,4,2),-1) < 0 ) OR
(STRTOINTDEF(COPY(TIME,4,2),-1) >= 60 ) OR
(COPY(TIME,3,1) <> ':' ) THEN
BEGIN
IF WARNING = TRUE THEN showmessage('时间格式不正确!');
RESULT := FALSE;
EXIT;
END;
IF (LENGTH(TIME) > 5 ) then
BEGIN
IF WARNING = TRUE THEN showmessage('时间长度不能超过5个!');
RESULT := FALSE;
EXIT;
END;
IF (LENGTH(TIME) < 5 ) then
BEGIN
IF WARNING = TRUE THEN showmessage('时间长度不能小于5个!');
RESULT := FALSE;
EXIT;
END;
RESULT := TRUE;
END;
FUNCTION CHECK_LONGTIME(TIME:STRING;WARNING:BOOLEAN):BOOLEAN;
BEGIN
IF (STRTOINTDEF(COPY(TIME,1,2),-1) < 0 ) OR
(STRTOINTDEF(COPY(TIME,1,2),-1) >= 29 ) OR
(STRTOINTDEF(COPY(TIME,4,2),-1) < 0 ) OR
(STRTOINTDEF(COPY(TIME,4,2),-1) >= 60 ) OR
(COPY(TIME,3,1) <> ':' ) THEN
BEGIN
IF WARNING = TRUE THEN showmessage('时间格式不正确!');
RESULT := FALSE;
EXIT;
END;
IF (LENGTH(TIME) > 5 ) then
BEGIN
IF WARNING = TRUE THEN showmessage('时间长度不能超过5个!');
RESULT := FALSE;
EXIT;
END;
IF (LENGTH(TIME) < 5 ) then
BEGIN
IF WARNING = TRUE THEN showmessage('时间长度不能小于5个!');
RESULT := FALSE;
EXIT;
END;
RESULT := TRUE;
END;
// 计算 当月 日数
FUNCTION CYEARMONTH_DAYS(CYEARMONTH:STRING):INTEGER;
VAR T_D1, THIS_MONTH:STRING;
T_MONTHDAYS:INTEGER;
BEGIN
T_MONTHDAYS := 30;
T_D1 := CDATE_TO_EDATE(CYEARMONTH+'01');
THIS_MONTH := DATE_GET_MONTH(T_D1);
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+27)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 28;
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+28)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 29;
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+29)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 30;
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+30)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 31;
RESULT := T_MONTHDAYS;
END;
// 计算 当月 日数
FUNCTION EYEARMONTH_DAYS(EYEARMONTH:STRING):INTEGER;
VAR T_D1, THIS_MONTH:STRING;
T_MONTHDAYS:INTEGER;
BEGIN
T_MONTHDAYS := 30;
T_D1 := DATE_GET_YEAR(EYEARMONTH)+'/'+DATE_GET_MONTH(EYEARMONTH)+'/'+'01';
THIS_MONTH := DATE_GET_MONTH(T_D1);
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+27)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 28;
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+28)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 29;
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+29)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 30;
IF DATE_GET_MONTH(DATETOSTR(STRTODATE(T_D1)+30)) = TRIM_STR(THIS_MONTH,'0') THEN T_MONTHDAYS := 31;
RESULT := T_MONTHDAYS;
END;
// 英文 日期 - 日期 减法
FUNCTION EDATE_SUB_EDATE(DAT1, DAT2 : TDATETIME):INTEGER;
VAR DAT3 : TDATETIME;
Y1, M1, D1: Word;
R : INTEGER;
BEGIN
R := 0;
IF DAT2 = DAT1 THEN
BEGIN
R := 0;
END;
IF DAT2 > DAT1 THEN
BEGIN
DAT3 := DAT2 - DAT1 + 1;
DecodeDate(DAT3 , Y1, M1, D1);
//加上年
R := R + ( (Y1-1900)*365 );
//加上月
IF M1 = 1 THEN R := R + 0 ;
IF M1 = 2 THEN R := R + 31 ;
IF M1 = 3 THEN R := R + 31 +28 ;
IF M1 = 4 THEN R := R + 31 +28 +31 ;
IF M1 = 5 THEN R := R + 31 +28 +31 +30 ;
IF M1 = 6 THEN R := R + 31 +28 +31 +30 +31 ;
IF M1 = 7 THEN R := R + 31 +28 +31 +30 +31 +30 ;
IF M1 = 8 THEN R := R + 31 +28 +31 +30 +31 +30 +31 ;
IF M1 = 9 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 ;
IF M1 =10 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 +30 ;
IF M1 =11 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 +30 +31 ;
IF M1 =12 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 +30 +31 +30 ;
//加上日
R := R + D1;
END;
IF DAT2 < DAT1 THEN
BEGIN
DAT3 := DAT1 - DAT2 + 1;
DecodeDate(DAT3 , Y1, M1, D1);
//加上年
R := R + ( (Y1-1900)*365 );
//加上月
IF M1 = 1 THEN R := R + 0 ;
IF M1 = 2 THEN R := R + 31 ;
IF M1 = 3 THEN R := R + 31 +28 ;
IF M1 = 4 THEN R := R + 31 +28 +31 ;
IF M1 = 5 THEN R := R + 31 +28 +31 +30 ;
IF M1 = 6 THEN R := R + 31 +28 +31 +30 +31 ;
IF M1 = 7 THEN R := R + 31 +28 +31 +30 +31 +30 ;
IF M1 = 8 THEN R := R + 31 +28 +31 +30 +31 +30 +31 ;
IF M1 = 9 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 ;
IF M1 =10 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 +30 ;
IF M1 =11 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 +30 +31 ;
IF M1 =12 THEN R := R + 31 +28 +31 +30 +31 +30 +31 +31 +30 +31 +30 ;
//加上日
R := R + D1;
R := 0 - R ;
END;
RESULT := R ;
END;
// 英文 年份 减法
FUNCTION EYEAR_SUB(CYEAR:STRING;T_SUB:INTEGER):STRING;
VAR T_D1 :INTEGER;
T_DX2 :STRING;
BEGIN
RESULT := CYEAR;
T_D1 := STRTOINTDEF(TRIM( COPY(CYEAR,1,POS('/',CYEAR)-1) ),1);
T_DX2 := TRIM( COPY(CYEAR,POS('/',CYEAR), 10) ) ;
T_D1 := T_D1 - T_SUB;
RESULT := INTTOSTR(T_D1) + T_DX2;
END;
// 中文 月份 减一
FUNCTION CYEARMONTH_SUB(CYEARMONTH:STRING;T_SUB:INTEGER):STRING;
VAR T_D1, T_D2 : INTEGER;
T_DX2 :STRING;
BEGIN
RESULT := CYEARMONTH;
IF STRTOINTDEF(CYEARMONTH,-1) < 0 THEN EXIT;
T_D1 := STRTOINTDEF(COPY(CYEARMONTH,1,2),1);
T_D2 := STRTOINTDEF(COPY(CYEARMONTH,3,2),1);
IF T_D2 > T_SUB THEN
BEGIN
T_D2 := T_D2 - T_SUB;
END ELSE BEGIN
T_D1 := T_D1 - 1;
T_D2 := T_D2 + 12 - T_SUB;
END;
T_DX2 := INTTOSTR(T_D2);
IF LENGTH(T_DX2) < 2 THEN T_DX2 := '0' + T_DX2;
IF LENGTH(T_DX2) < 2 THEN T_DX2 := '0' + T_DX2;
RESULT := INTTOSTR(T_D1) + T_DX2;
END;
//====================================================================================
// 密码---------------------------------------------
{*******************************************************
* Standard Encryption algorithm - Copied from Borland *
*******************************************************}
FUNCTION Encrypt(const InSTRING:STRING; StartKey,MultKey,AddKey:INTEGER): STRING;
var
I : Byte;
BEGIN
Result := '';
for I := 1 to Length(InSTRING) do
BEGIN
Result := Result + CHAR(Byte(InSTRING[I]) xor (StartKey shr 8));
StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;
END;
END;
{*******************************************************
* Standard Decryption algorithm - Copied from Borland *
*******************************************************}
FUNCTION Decrypt(const InSTRING:STRING; StartKey,MultKey,AddKey:INTEGER): STRING;
var
I : Byte;
BEGIN
Result := '';
for I := 1 to Length(InSTRING) do
BEGIN
Result := Result + CHAR(Byte(InSTRING[I]) xor (StartKey shr 8));
StartKey := (Byte(InSTRING[I]) + StartKey) * MultKey + AddKey;
END;
END;
// 文件相关功能 ================================================================
//测试文件是否可以打开
FUNCTION TEST_OPEN_FILE(FILENAME:STRING):BOOLEAN;
VAR FileHandle : INTEGER;
BEGIN
FileHandle := FileOpen(FILENAME, fmOpenWrite);
FileClose(FileHandle);
IF FileHandle < 0 then
BEGIN
TEST_OPEN_FILE:= FALSE; // SHOWMESSAGE(FILENAME+'路径文件名设定错误, 文件无法打开!');
END ELSE BEGIN
TEST_OPEN_FILE:= TRUE;
END;
END;
//建立新文件
FUNCTION FILE_CREATE(FILENAME:STRING):BOOLEAN;
var FileHandle : INTEGER;
BEGIN
FileHandle := FileOpen(FILENAME, fmOpenWrite);
FileClose(FileHandle);
IF FileHandle < 0 then
BEGIN
FileHandle := FileCREATE(FILENAME);
FileClose(FileHandle);
END;
RESULT:= TRUE;
END;
//清除文件
FUNCTION FILE_REWRITE(FILENAME:STRING):BOOLEAN;
VAR TF :TEXTFILE;
BEGIN
RESULT:= FALSE;
IF FileExists(FILENAME) = FALSE THEN
BEGIN
FILE_CREATE(FILENAME);
RESULT:= FALSE;
END;
IF FileExists(FILENAME) = TRUE THEN
BEGIN
AssignFile(TF,FILENAME);
Rewrite(TF);
CloseFile(TF);
RESULT:= TRUE;
END;
END;
//写入文件
FUNCTION FILE_APPEND_LOG(FILENAME,TITLE,TXT:STRING):BOOLEAN;
VAR TF :TEXTFILE;
BEGIN
RESULT:= FALSE;
IF FileExists(FILENAME) = FALSE THEN
BEGIN
FILE_CREATE(FILENAME);
RESULT:= FALSE;
END;
IF FileExists(FILENAME) = TRUE THEN
BEGIN
AssignFile(TF,FILENAME);
Append(TF);
Writeln(TF,TITLE +'~'+CHR(1)+CHR(2)+CHR(3)+'~'+ TXT);
CloseFile(TF);
RESULT:= TRUE;
END;
END;
//写入文件单行
FUNCTION FILE_WRITELN_REC(FILENAME,TITLE,TXT:STRING):STRING;
VAR TF1, TF2 : TEXTFILE;
STR :STRING;
BEGIN
IF FileExists(FILENAME) = TRUE THEN
BEGIN
AssignFile(TF1,FILENAME);
RESET(TF1);
FILE_Rewrite('~LOG.TMP');
AssignFile(TF2,'~LOG.TMP');
Rewrite(TF2);
WHILE NOT EOF(TF1) DO
BEGIN
Readln (TF1,STR);
Writeln(TF2,STR);
END;
CloseFile(TF1);
CloseFile(TF2);
AssignFile(TF1,FILENAME);
Rewrite(TF1);
AssignFile(TF2,'~LOG.TMP');
Reset(TF2);
WHILE NOT EOF(TF2) DO
BEGIN
READLN(TF2,STR);
IF TITLE = COPY(STR,1,POS('~'+CHR(1)+CHR(2)+CHR(3)+'~',STR)-1) THEN
BEGIN
Writeln(TF1,TITLE+'~'+CHR(1)+CHR(2)+CHR(3)+'~'+TXT);
Break;
END;
END;
CloseFile(TF1);
CloseFile(TF2);
END;
END;
//读出文件单行
FUNCTION FILE_READLN_REC(FILENAME,TITLE:STRING):STRING;
VAR TF :TEXTFILE;
STR :STRING;
BEGIN
IF FileExists(FILENAME) = TRUE THEN
BEGIN
AssignFile(TF,FILENAME);
Reset(TF);
WHILE NOT EOF(TF) DO
BEGIN
READLN(TF,STR);
IF TITLE = COPY(STR,1,POS('~'+CHR(1)+CHR(2)+CHR(3)+'~',STR)-1) THEN
BEGIN
RESULT := TRIM(COPY(STR,POS('~'+CHR(1)+CHR(2)+CHR(3)+'~',STR)+5,100 ) );
Break;
END;
END;
CloseFile(TF);
END;
END;
// TEXT读出文件 行数
FUNCTION TEXTFILE_RECCNT(FILENAME:STRING):INTEGER;
VAR TF :TEXTFILE; STR: STRING; I :INTEGER;
BEGIN
I := 0;
IF FileExists(FILENAME) = TRUE THEN
BEGIN
AssignFile(TF,FILENAME);
Reset(TF);
WHILE NOT EOF(TF) DO
BEGIN
Readln(TF,STR);
INC(I);
END;
CloseFile(TF);
END;
RESULT := I;
END;
// 文件相关功能 ================================================================
//copy 由右至左
FUNCTION Copy_R(S: STRING; Index, Count: INTEGER): STRING;
BEGIN
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -