un_utl.pas

读取网通或电信电话交换机（华为）数据给酒店管理数据库

COPY_R := COPY(S, LENGTH(S) - COUNT + 1 - (INDEX-1) , COUNT);
END;

//产生空白
FUNCTION SPACE(Count: INTEGER): STRING;
VAR I :INTEGER;
    S , RETURN_S :STRING;
BEGIN
S := ' ';  RETURN_S := '';
for I := 1 to COUNT do RETURN_S := RETURN_S + S;

SPACE := RETURN_S ;
END;

{ 字符串复制  }
FUNCTION REPLICATE(VSTR1:STRING;VLEN:SMALLINT):STRING;
VAR VI:INTEGER ;
    VSTR2:STRING;
BEGIN
  VSTR2:='';
  FOR VI:=1 TO VLEN DO
    VSTR2:=VSTR2+VSTR1;
  REPLICATE:=VSTR2;
END; {REPLICATE}



{ 字符串填满  }
FUNCTION FILL_STR(FILL_STR, STR, KIND:STRING; TOTAL_LENGTH:INTEGER):STRING;
VAR T_STR:STRING;
    L_LENGTH, R_LENGTH :INTEGER;
BEGIN

IF KIND = 'L' THEN
   BEGIN
   T_STR := REPLICATE( FILL_STR,TOTAL_LENGTH-LENGTH(STR) ) + STR;
   IF (LENGTH(T_STR)>TOTAL_LENGTH) THEN T_STR := COPY_R(T_STR,1,TOTAL_LENGTH);
   END ELSE
IF KIND = 'R' THEN
   BEGIN
   T_STR := STR + REPLICATE( FILL_STR,TOTAL_LENGTH-LENGTH(STR) );
   IF (LENGTH(T_STR)>TOTAL_LENGTH) THEN T_STR := COPY(T_STR,1,TOTAL_LENGTH);
   END;
IF KIND = 'C' THEN
   BEGIN
   L_LENGTH := (TOTAL_LENGTH - LENGTH(STR)) DIV 2;
   R_LENGTH := TOTAL_LENGTH - L_LENGTH - LENGTH(STR);
   T_STR := REPLICATE( FILL_STR,R_LENGTH) + STR + REPLICATE( FILL_STR,R_LENGTH);
   IF (LENGTH(T_STR)>TOTAL_LENGTH) THEN T_STR := COPY(T_STR,1,TOTAL_LENGTH);
   END;


RESULT := T_STR;
END;


{ 字符串累加  }
FUNCTION STR_INC(FILL_STR, STR:STRING; T_START, T_END, T_CNT:INTEGER):STRING;
VAR L_STR, M_STR, R_STR :STRING;
    TOTAL_LENGTH, M_LENGTH :INTEGER;
BEGIN
RESULT := '';

IF STRTOINTDEF(COPY(STR,T_START,T_END),-1) < 0 THEN EXIT;

TOTAL_LENGTH := LENGTH(STR);
L_STR := COPY(STR,1,T_START-1);
M_STR := COPY(STR,T_START,T_END-T_START+1);
R_STR := COPY(STR,T_END+1,TOTAL_LENGTH-T_END);
M_LENGTH := LENGTH(M_STR);

M_STR := INTTOSTR(STRTOINTDEF(M_STR,0) + T_CNT);
M_STR := REPLICATE(FILL_STR,M_LENGTH - LENGTH(M_STR) ) + M_STR;

RESULT := L_STR+M_STR+R_STR;
END;

{ 字符串转浮点  }
FUNCTION STRTOFLOATDEF(STR:STRING;FDEFAULT:REAL):REAL;
BEGIN
IF CHECK_FLOATINT(STR) = TRUE THEN
   BEGIN
   RESULT := STRTOFLOAT(TRIM(STR));
   END ELSE BEGIN
   RESULT := FDEFAULT;
   END;
END;

{ 字符串替换  }
FUNCTION STR_REPLACE(STR, SUBSTR1,SUBSTR2:STRING):STRING;
VAR A, B:STRING;
BEGIN
WHILE POS(SUBSTR1,STR) > 0 DO
   BEGIN
   A := COPY(STR,1, POS(SUBSTR1,STR)-1 );
   B := COPY(STR,POS(SUBSTR1,STR)+LENGTH(SUBSTR1), LENGTH(STR) );
   STR := A + SUBSTR2 + B;
   END;

RESULT := STR;
END;

{ 字符串插入  }
FUNCTION STR_INSERT(STR, S1, S2:STRING; FB:BOOLEAN):STRING;
VAR A, B, T_RETURN:STRING;
BEGIN

IF POS(S1,STR) <= 0 THEN
   BEGIN
   IF FB = TRUE  THEN RESULT := S2  + STR;
   IF FB = FALSE THEN RESULT := STR + S2;
   END ELSE BEGIN
   A := COPY(STR,1, POS(S1,STR)-1 );
   B := COPY(STR,POS(S1,STR)+LENGTH(S1), LENGTH(STR) );
   IF FB = TRUE  THEN
      BEGIN
      RESULT := A + S2 + S1 + B;
      END;
   IF FB = FALSE THEN
      BEGIN
      RESULT := A + S1 + S2 + B;
      END;
   END;

END;


{ 数据字符串找寻  }
FUNCTION STR_DB_FIELDBYNO(STR, RAIL:STRING;FIELD_NO:INTEGER):STRING;
VAR T, T_RETURN:STRING;
    I : INTEGER;
BEGIN

FOR I := 1 TO FIELD_NO DO
    BEGIN
    T   := COPY(STR,1,POS(RAIL,STR)-1);
    IF POS(RAIL,STR) <= 0 THEN T_RETURN := STR
                          ELSE T_RETURN := T;
    STR := COPY(STR,POS(RAIL,STR)+1,LENGTH(STR)-POS(RAIL,STR));
    END;

RESULT := T_RETURN;
END;

{ 删除数据字符串  }
FUNCTION TRIM_STR(STR, TRIMSTR:STRING):STRING;
BEGIN
WHILE COPY(STR,1,1) = TRIMSTR DO  STR := COPY(STR,2,LENGTH(STR)-1);
RESULT := STR;
END;

{ 整数 转 字符串 再补零 }
FUNCTION INTTOSTR_REP(TINT,REP:INTEGER):STRING;
VAR S:STRING;
BEGIN
S := INTTOSTR(TINT);
RESULT := REPLICATE('0',REP-LENGTH(S) ) + S;
END;

{ BOOLEAN TRUE FALSE 转 01 }
FUNCTION BOOLEANTOSTR(TB : BOOLEAN):STRING;
BEGIN
RESULT := '0';
IF TB= TRUE THEN RESULT := '1' ELSE RESULT := '0';
END;


{ 检查是否为整数 }
FUNCTION CHECK_INT(T_STR:STRING):BOOLEAN;
BEGIN
RESULT := FALSE;
IF POS('-',T_STR) <= 0 THEN
   BEGIN
   IF (STRTOINTDEF(T_STR,-1) >= 0) THEN RESULT := TRUE;
   END ELSE BEGIN
   IF (STRTOINTDEF(COPY(T_STR,2,LENGTH(T_STR)),-1) >= 0) THEN RESULT := TRUE;
   END;
END;

{ 检查是否为浮点数 }
FUNCTION CHECK_FLOAT(T_STR:STRING):BOOLEAN;
VAR T_A,T_B:STRING;
BEGIN
T_A   := TRIM(COPY(T_STR,1,POS('.',T_STR)-1)  );
T_B   := TRIM(COPY(T_STR,POS('.',T_STR)+1,LENGTH(T_STR))  );
IF (STRTOINTDEF(T_A,-1) >= 0) AND
   (STRTOINTDEF(T_B,-1) >= 0) THEN
   RESULT := TRUE ELSE
   RESULT := FALSE;
END;

{ 检查是否为浮点数 和 整数}
FUNCTION CHECK_FLOATINT(T_STR:STRING):BOOLEAN;
VAR T_A,T_B:STRING;
BEGIN
IF POS('.',T_STR) >0 THEN
   BEGIN
   T_A   := TRIM(COPY(T_STR,1,POS('.',T_STR)-1)  );
   T_B   := TRIM(COPY(T_STR,POS('.',T_STR)+1,LENGTH(T_STR))  );
   IF (STRTOINTDEF(T_A,-99999999) >= -99999998) AND
      (STRTOINTDEF(T_B,-99999999) >= -99999998) THEN
      RESULT := TRUE ELSE RESULT := FALSE;
   END ELSE BEGIN
   IF (STRTOINTDEF(T_STR,-99999999) >= -99999998) THEN
      RESULT := TRUE ELSE RESULT := FALSE;
   END;
END;

{ 取 浮点数 , 小数点位数 }
FUNCTION FLOAT_LENGTH(T_STR:STRING;T_LENGTH:INTEGER):STRING;
VAR T_A,T_B:STRING;
BEGIN
IF POS('.',T_STR) > 0 THEN
   BEGIN
   IF T_LENGTH <= 0 THEN  RESULT := TRIM(COPY(T_STR,1,POS('.',T_STR)-1)  );
   IF T_LENGTH >  0 THEN
      BEGIN
      T_A   := TRIM(COPY(T_STR,1,POS('.',T_STR)-1)  );
      T_B   := TRIM(COPY(T_STR,POS('.',T_STR)+1,T_LENGTH)  );
      IF (T_A =  '') AND (T_B =  '') THEN RESULT := '0' +'.'+    REPLICATE('0',T_LENGTH);
      IF (T_A <> '') AND (T_B =  '') THEN RESULT := T_A +'.'+    REPLICATE('0',T_LENGTH);
      IF (T_A =  '') AND (T_B <> '') THEN RESULT := '0' +'.'+T_B+REPLICATE('0',T_LENGTH-LENGTH(T_B));
      IF (T_A <> '') AND (T_B <> '') THEN RESULT := T_A +'.'+T_B+REPLICATE('0',T_LENGTH-LENGTH(T_B));
      END;
   END ELSE
   BEGIN
   IF T_LENGTH <= 0 THEN RESULT := T_STR;
   IF T_LENGTH >  0 THEN RESULT := T_STR +'.'+ REPLICATE('0',T_LENGTH);
   END;

END;

{ 浮点数 转 整数 }
FUNCTION FLOATTOINT(T_FLOAT:REAL):INTEGER;
VAR A,B : INTEGER;
    STR : STRING;
BEGIN
A := 0; B := 0;
STR := FLOATTOSTR(T_FLOAT);

IF POS('.',STR) >  0 THEN           //有小数点
   BEGIN
   A := STRTOINT(COPY(STR,1,POS('.',STR)-1));
   B := STRTOINT(COPY(STR,POS('.',STR)+1,2));
   IF A >=0 THEN IF B >=5 THEN A := A + 1;
   IF A < 0 THEN IF B >=5 THEN A := A - 1;
//   T := COPY(T,1,POS('.',T)-1)
   END ELSE BEGIN                   //无小数点
   A := STRTOINT(STR);
   END;

RESULT := A;
END;



{ 浮点数 转 整数 PS: 无条件小数第一位进位}
FUNCTION FLOATTOINT_ROUND(T_FLOAT:REAL):INTEGER;
VAR A,B : INTEGER;
    STR : STRING;
BEGIN
A := 0; B := 0;
STR := FLOATTOSTR(T_FLOAT);

IF POS('.',STR) >  0 THEN           //有小数点
   BEGIN
   A := STRTOINT(COPY(STR,1,POS('.',STR)-1));
   B := STRTOINT(COPY(STR,POS('.',STR)+1,2));
   IF A >=0 THEN IF B >=1 THEN A := A + 1;
   IF A < 0 THEN IF B >=1 THEN A := A - 1;
//   T := COPY(T,1,POS('.',T)-1)
   END ELSE BEGIN                   //无小数点
   A := STRTOINT(STR);
   END;

RESULT := A;
END;




{ 整数 个位数 四舍五入  }
FUNCTION ROUND_1(T_INT:INTEGER):INTEGER;
VAR T, T1, T2 : STRING;
BEGIN
RESULT := 0;
T  := INTTOSTR(T_INT);
IF T_INT >= 0 THEN
   BEGIN
   IF LENGTH(T) =0 THEN RESULT := 0;
   IF LENGTH(T) =1 THEN
      BEGIN
      IF T_INT >=5  THEN RESULT :=  10;
      IF T_INT <=4  THEN RESULT :=   0;
      END;
   IF LENGTH(T) >1 THEN
      BEGIN
      T1 := COPY_R(T,1,1);
      T2 := COPY(T,1,LENGTH(T)-1);
   //   SHOWMESSAGE(T1+'='+T2);
      IF STRTOINT(T1) >= 5 THEN RESULT := (STRTOINT(T2)+1)*10;
      IF STRTOINT(T1) <= 4 THEN RESULT := (STRTOINT(T2)  )*10;
      END;
END ELSE BEGIN
   IF LENGTH(T) =2 THEN
      BEGIN
      IF T_INT <=-5  THEN RESULT := -10;
      IF T_INT >=-4  THEN RESULT :=   0;
      END;
   IF LENGTH(T) >2 THEN
      BEGIN
      T1 := COPY_R(T,1,1);
      T2 := COPY(T,1,LENGTH(T)-1);
   //   SHOWMESSAGE(T1+'='+T2);
      IF STRTOINT(T1) >= 5 THEN RESULT := (STRTOINT(T2)-1)*10;
      IF STRTOINT(T1) <= 4 THEN RESULT := (STRTOINT(T2)  )*10;
      END;
{   IF LENGTH(T) <-1 THEN
      BEGIN
      T1 := COPY_R(T,1,1);
      T2 := COPY(T,1,LENGTH(T)-1);
      IF STRTOINT(T1) <= -5 THEN RESULT := (STRTOINT(T2)+1)*10;
      IF STRTOINT(T1) >= -4 THEN RESULT := (STRTOINT(T2)  )*10;
      END;
}      
END;


END;



{ 整数 次方 }
FUNCTION INT_CUBE(T_INT,T_CUBE:INTEGER):INTEGER;
VAR R, I : INTEGER;
BEGIN
R := T_INT;
FOR I := 1 TO T_CUBE-1 DO R := R * T_INT;
IF T_CUBE >=1 THEN RESULT := R ELSE RESULT := 1;
END;

{ 16 进位 转 整数  }
FUNCTION HEXTOINT(THEX:STRING):INTEGER;
VAR TLEN, TINT, T1, I : INTEGER;
    TX: STRING;
BEGIN
TLEN := LENGTH(THEX);
TINT := 0;

FOR I := 1 TO TLEN DO
  BEGIN
  TX := COPY_R(THEX,I,1);
                   T1 := 0;
  IF TX = '0' THEN T1 := 0;
  IF TX = '1' THEN T1 := 1;
  IF TX = '2' THEN T1 := 2;
  IF TX = '3' THEN T1 := 3;
  IF TX = '4' THEN T1 := 4;
  IF TX = '5' THEN T1 := 5;
  IF TX = '6' THEN T1 := 6;
  IF TX = '7' THEN T1 := 7;
  IF TX = '8' THEN T1 := 8;
  IF TX = '9' THEN T1 := 9;
  IF TX = 'A' THEN T1 :=10;
  IF TX = 'B' THEN T1 :=11;
  IF TX = 'C' THEN T1 :=12;
  IF TX = 'D' THEN T1 :=13;
  IF TX = 'E' THEN T1 :=14;
  IF TX = 'F' THEN T1 :=15;
  TINT := TINT + (  T1 *  (  INT_CUBE(16,(I-1))  ));
  END;

RESULT := TINT;
END;





procedure Delay(n: INTEGER);
VAR     start: LongInt;
BEGIN
        start := GetTickCount;
        repeat Application.ProcessMessages;
        until (GetTickCount - start) >= n;
END;

FUNCTION EXCHANGE_CAL(T_EXCHG:STRING;T_LENGTH:INTEGER):STRING;
VAR T1, T2: STRING;
BEGIN
T1 := TRIM(COPY(T_EXCHG,1                 ,POS(':',T_EXCHG)-1)  );
T2 := TRIM(COPY(T_EXCHG,POS(':',T_EXCHG)+1, 10)                 );

IF ( (CHECK_FLOAT(T1) = TRUE) AND (CHECK_FLOAT(T2) = TRUE) ) OR
   ( (CHECK_FLOAT(T1) = TRUE) AND (CHECK_INT  (T2) = TRUE) ) OR
   ( (CHECK_INT  (T1) = TRUE) AND (CHECK_FLOAT(T2) = TRUE) ) OR
   ( (CHECK_INT  (T1) = TRUE) AND (CHECK_INT  (T2) = TRUE) ) THEN
   BEGIN                      //台币  / 外币
   RESULT := FLOAT_LENGTH( FLOATTOSTR( STRTOFLOAT(T2) / STRTOFLOAT(T1) ),T_LENGTH );
   END ELSE BEGIN
   RESULT := '1';
   END;
END;





//打印机 输出入 ================================================================
procedure Out32(PortAddress:smallint;Value:smallint);stdcall;export;
VAR ByteValue:Byte;
BEGIN
  ByteValue:=Byte(Value);
  asm
     push dx
     mov dx,PortAddress
     mov al, ByteValue
     out dx,al
     pop dx
  END;
END;

FUNCTION Inp32(PortAddress:smallint):smallint;stdcall;export;
VAR ByteValue:byte;
BEGIN
  asm
      push dx
      mov dx, PortAddress
      //////////////in al,dx
      mov ByteValue,al
      pop dx
  END;
  Inp32:=smallint(ByteValue) and $00FF;
END;

FUNCTION COMPORT_OUT(PortNAME,EXPRESS:STRING):BOOLEAN;
VAR TF :TEXTFILE;
BEGIN
  RESULT := FALSE;
  IF TEST_OPEN_FILE(PortNAME) = TRUE THEN
     BEGIN
     TRY
       AssignFile(TF,PortNAME);   Rewrite(TF);
       WRITE(TF,EXPRESS);    CloseFile(TF);
       RESULT := TRUE;
     EXCEPT
       SHOWMESSAGE('无法送出资料!');
       RESULT := FALSE;
     END;
     END;
END;

FUNCTION  COMPORT_OUTLN(PortNAME,EXPRESS:STRING):BOOLEAN;
VAR TF :TEXTFILE;
BEGIN
  RESULT := FALSE;
  IF TEST_OPEN_FILE(PortNAME) = TRUE THEN
     BEGIN
     TRY
       AssignFile(TF,PortNAME);   Rewrite(TF);
       Writeln(TF,EXPRESS);    CloseFile(TF);
       RESULT := TRUE;
     EXCEPT
       SHOWMESSAGE('无法送出资料!');
       RESULT := FALSE;
     END;
     END;
END;
//打印机 输出入 ================================================================









// CPU ID ==================================================
FUNCTION IsCPUID_Available : BOOLEAN; register;
asm
  PUSHFD		{direct access to flags no possible, only via stack}
  POP     EAX		{flags to EAX}
  MOV     EDX,EAX	{save current flags}
  XOR     EAX,ID_BIT	{not ID bit}
  PUSH    EAX		{onto stack}
  POPFD			{from stack to flags, WITH not ID bit}
  PUSHFD		{back to stack}
  POP     EAX		{get back to EAX}
  XOR     EAX,EDX	{check IF ID bit affected}
  JZ      @exit		{no, CPUID not availavle}
  MOV     AL,TRUE	{Result=TRUE}
  @exit:
END;

FUNCTION GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}