userface.pas

公积金监管系统客户端,是新疆公积金监管系统的客户端软件

    exit;
  end;
  cD := s;
  if (length(cD) > 2) or (length(cD) < 1) then
  begin
    result := false;
    exit;
  end;
  iD := strtoint(s);
  if (iD < 1) or (length(cD) > 2) or (length(cD) < 1) then
  begin
    result := false;
    exit;
  end;
  case iM of
    4, 6, 9, 11:
      begin
        if (iD > 30) then
          result := false;
      end;
    2:
      begin
        if (iY mod 4 <> 0) or ((iY mod 100 = 0) and (iY mod 400 <> 0)) then
        begin
          if (iD > 28) then
            result := false;
        end
        else
          if (iD > 29) then
            result := false;
      end;
  else
    if (iD > 31) then
    begin
      result := false;
    end;
  end;
end;

function isNumber(const Value: string): boolean;
//判断字符串是否是数值型
var
  NumSet: set of '-'..'9';
  c: char;
  i, ilen: integer;
  s: string;
  ret: boolean;
begin
  NumSet := ['-', '.', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
  s := stringreplace(Value, ' ', '', [rfReplaceAll]);
  ilen := length(s);
  ret := true;
  for i := 1 to ilen do
  begin
    c := s[i];
    if not (c in NumSet) then
    begin
      ret := false;
      break;
    end;
  end;
  result := ret;
  if not ret then
    exit;
  i := pos('-', s);
  if i > 1 then
  begin
    result := false;
    exit;
  end;
  if i = 1 then
  begin
    s := copy(s, 2, ilen - 1);
    if Pos('-', s) > 0 then
    begin
      result := false;
      exit;
    end;
  end;
  i := pos('.', s);
  if i = 1 then
  begin
    result := false;
    exit;
  end;
  if i > 1 then
  begin
    s := copy(s, i + 1, ilen - i);
    if pos('.', s) > 0 then
    begin
      result := false;
      exit;
    end;
  end;
end;

function UpperRMB(nJe: Double): string;
const
  Nums = '分角圆拾佰仟万拾佰仟亿拾佰仟万拾佰仟万';
  Units = '零壹贰叁肆伍陆柒捌玖';
var
  cJe, cUJe, cJeR: string;
  i, j, l: smallint;
begin
  cJe := trim(inttostr(trunc(nJe * 100)));
  j := length(cJe);
  i := 0;
  cUje := '';
  while j > 0 do
  begin
    cUJe := copy(Nums, i * 2 + 1, 2) + cUje;
    cUje := copy(Units, strtoint(copy(cJe, j, 1)) * 2 + 1, 2) + cUje;
    dec(j);
    inc(i);
  end;
  i := 1;
  cJeR := '';
  while i < length(cUje) do
  begin
    if (copy(cUje, i, 2) = '零') then
    begin
      if (copy(cUje, i + 2, 2) = '万') then
      begin
        l := length(cJeR);
        if (copy(cjer, l - 1, 2) = '零') then
          cJeR := copy(cJeR, 1, l - 2) + '万'
        else
          cJeR := cJeR + '万';
      end;
      if (copy(cUje, i + 2, 2) = '圆') then
      begin
        l := length(cJeR);
        if (copy(cjer, l - 1, 2) = '零') then
          cJeR := copy(cJeR, 1, l - 2) + '圆'
        else
          cJeR := cJeR + '圆';
      end;
      if (copy(cUje, i + 2, 2) = '亿') then
      begin
        l := length(cJeR);
        if (copy(cjer, l - 1, 2) = '零') then
          cJeR := copy(cJeR, 1, l - 2) + '亿'
        else
          cJeR := cJeR + '亿';
      end;
      j := length(cJeR);
      if (copy(cJer, j - 1, 2) <> '零') then
      begin
        cJeR := cJeR + '零';
      end;
    end
    else
    begin
      cJeR := cJeR + copy(cUje, i, 4);
    end;
    i := i + 4;
  end;
  j := length(cJeR);
  if (copy(cJer, j - 3, 4) = '圆零') then
  begin
    cJeR := copy(cJeR, j - 1, 2) + '整';
  end;
  j := length(cJeR);
  if (copy(cJer, j - 3, 4) = '角零') then
  begin
    cJeR := copy(cJeR, j - 1, 2) + '整';
  end;
  j := length(cJeR);
  if (copy(cJer, j - 1, 2) = '零') then
  begin
    cJeR := copy(cJeR, j - 1, 2) + '圆整';
  end;
  if (cJer = '圆整') then
  begin
    cJeR := '零圆整';
  end;
  result := cJeR;
end;

function SystemPath: string;
var
  cSysPath: Pchar;
  cPath: string;
begin
  cSysPath := StrAlloc(sizeof(char) * 255);
  GetSystemDirectory(cSysPath, 200);
  cPath := trim(cSysPath);
  StrDispose(cSysPath);
  if copy(cPath, length(cPath), 1) <> '\' then
    cPath := cPath + '\';
  result := cPath;
end;


function ConnectServer(const cSystem: string): string;
begin
  Result := ReadIniStr(SystemPath() + INIFILENAME, cSystem, INISERVER);
end;

function ConnectServerIp(const cSystem: string): string;
begin
  Result := ReadIniStr(SystemPath() + INIFILENAME, cSystem, INISERVERIP);
end;

function ConnectServerPort(const cSystem: string): string;
begin
  Result := ReadIniStr(SystemPath() + INIFILENAME, cSystem, INISERVERPORT);
end;

procedure WriteServerIp(const cSystem, cValue: string);
begin
  WriteIniStr(SystemPath() + INIFILENAME, cSystem, INISERVERIP, cValue);
end;

function ConnectDatabase(const cSystem: string): string;
begin
  Result := ReadIniStr(SystemPath() + INIFILENAME, cSystem, INIDATABASE);
end;

function DatabaseType(const cSystem: string): Integer;
begin
  Result := ReadIniInt(SystemPath() + INIFILENAME, cSysTem, INIDATABASETYPE);
end;

{function isIPAddr(const Value: string):boolean;
var
  s,c1,c2,c3,c4 : string;
  c : char;
  i1 : smallint;
  ret : boolean;
begin
  s:=value;
  ret := true;
  for i1 := 1 to length(Value) do
  begin
    c := s[i1];
    if not(c in ['.','0'..'9']) then
    begin
      ret := false;
      break;
    end;
  end;
  if not ret then
  begin
    result := false;
    exit;
  end;
  i1:= pos('.',s);
  if (i1<2) or (i1>3) then
  begin
    result := false;
    exit;
  end;
  c1 := copy(s,1,i1-1);
  if (strtoint(c1) > 255) or (strtoint(c1)<1) then
  begin
    result := false;
    exit;
  end;
  s := copy(s,i1+1,length(s)-i1);
  i1:= pos('.',s);
  if (i1<2) or (i1>3) then
  begin
    result := false;
    exit;
  end;
  c2 := copy(s,1,i1-1);
  if (strtoint(c2) > 255) or (strtoint(c2)<0) then
  begin
    result := false;
    exit;
  end;
  s := copy(s,i1+1,length(s)-i1);
  i1:= pos('.',s);
  if (i1<2) or (i1>3) then
  begin
    result := false;
    exit;
  end;
  c3 := copy(s,1,i1-1);
  if (strtoint(c3) > 255) or (strtoint(c3)<0) then
  begin
    result := false;
    exit;
  end;
  s := copy(s,i1+1,length(s)-i1);
  i1:= pos('.',s);
  if (i1>0) or (length(s)=0)then
  begin
    result := false;
    exit;
  end;
  c4 := s;
  if (strtoint(c4) > 255) or (strtoint(c4)<0) then
  begin
    result := false;
    exit;
  end;
  s := copy(s,i1+1,length(s)-i1);
  result := true;
end;
}

function Left(const s: string; const len: smallint): string;
begin
  result := copy(s, 1, len);
end;

function CellSwapPositionStr(col, row: integer): string;
//将数值型坐标转成字符坐标
var
  str: string;
  ni: integer;
begin
  str := '';
  while col > 25 do
  begin
    ni := col mod 26;
    col := (col div 26) - 1;
    str := chr(ni + 65) + str;
  end;
  result := trim(str + chr(col + 65) + str + trim(inttostr(row + 1)));
end;

function right(const s: string; const len: smallint): string;
var
  i, j: smallint;
begin
  i := length(s);

  if i <= len then
    j := 1
  else
    j := i - len;
  result := copy(s, j, len);
end;


function DateAdd(const Part: char; const value: smallint; const Date: tDate): tDate;
var
  Y, M, D: word;
  m1, y1: integer;
  cD: string;
begin
  result := date;
  decodedate(date, y, m, d);
  if uppercase(Part) = 'Y' then
  begin
    y1 := y + value;
    if (m = 2) and (d = 29) then
    begin
      cD := trim(inttostr(y1)) + '-2-29';
      if not isdate(cd) then
        cD := trim(inttostr(y1)) + '-2-28';
    end
    else
    begin
      cD := trim(inttostr(y1)) + '-' + trim(inttostr(m)) + '-' + trim(inttostr(d));
    end;
    result := strtodate(cd);
  end
  else
    if uppercase(Part) = 'M' then
    begin
      m1 := (m + value) mod 12;
      if m1 = 0 then m1 := 12;
      y1 := y + ((m + value - 1) div 12);
      case m1 of
        2: if d > 28 then
          begin
            cD := trim(inttostr(y1)) + '-2-29';
            if not isdate(cd) then
            begin
              cD := trim(inttostr(y1)) + '-2-28';
            end;
          end
          else cD := trim(inttostr(y1)) + '-2-28';
        4, 6, 9, 11: begin
            if d = 31 then
              cD := trim(inttostr(y1)) + '-' + trim(inttostr(m1)) + '-30'
            else
              cD := trim(inttostr(y1)) + '-' + trim(inttostr(m1)) + '-' + trim(inttostr(d));
          end;
      else cD := trim(inttostr(y1)) + '-' + trim(inttostr(m1)) + '-' + trim(inttostr(d));
      end;
      result := strtodate(cd);
    end
    else
      if uppercase(Part) = 'D' then
      begin
        Result := Date + value;
      end;
end;

function MonthDay(const value: smallint; const Date: tDate): tDate;
var
  Y, M, D: word;
  cd: string;
begin
  decodedate(date, y, m, d);
  cD := trim(inttostr(y)) + '-' + trim(inttostr(m)) + '-' + trim(inttostr(value));
  if not isdate(cd) then
  begin
    cD := trim(inttostr(y)) + '-' + trim(inttostr(m)) + '-' + trim(inttostr(value - 1));
    if not isdate(cd) then
    begin
      cD := trim(inttostr(y)) + '-' + trim(inttostr(m)) + '-' + trim(inttostr(value - 1));
      if not isdate(cd) then
      begin
        cD := trim(inttostr(y)) + '-' + trim(inttostr(m)) + '-' + trim(inttostr(value - 1));
      end;
    end;
  end;
  result := strtodate(cd);
end;

function DTOS(const date: tDate; const len: smallint = 8): string;
var
  Y, M, D: word;
  c: string;
begin
  DeCodeDate(Date, Y, M, D);
  c := padl(trim(inttostr(Y)), 4, '0') + padl(trim(inttostr(M)), 2, '0') + padl(trim(inttostr(D)), 2, '0');
  Result := copy(c, 1, len);
end;


end.