userface.pas

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

unit UserFace;

interface

uses
  IniFiles, Variants, WinSock, SysUtils, Windows, StdCtrls,
  Controls, CELLLib_TLB;

type
  TArray2D = array of array of Double;

//  TKeyByte = array[0..5] of Byte;
//  TDesMode = (dmEncry, dmDecry);

const
  MsgCaption = '提示信息';

  DSNUMBER = 16;

  BbFileGS = 'BB';
  FxBbFileGS = 'FxBB';

  INIFILENAME = 'jtpnet.ini';
  INISYSTEMTYPE = 'gjjjglr';
  INIGJJMX = 'Gjjmx';
  INIJGSJJH = 'OnLineConfig';
  INICWBB = 'CwglBb';

  INISERVER = 'ServerName';
  INISERVERIP = 'ServerIp';
  INISERVERPORT = 'ServerPort';
  INIDATABASE = 'DatabaseName';
  INIDATABASETYPE = 'DatabaseSel';

  CONNECTDBUSER = 'jtpsoftadmin';
  CONNECTDBPASSWORD = 'adminconnect';

var
  LoginUserID, LoginUser, LoginPassword, LoginUserQx, LoginUserSsds: string;
  ServerIP: string;
  IfConnect: smallint; // 0---已连接  其他---未连接
  aData: TArray2D;
  bbdm: string;
  UseGat: smallint;

function ConnectServer(const cSystem: string): string;
function ConnectServerIp(const cSystem: string): string;
function ConnectServerPort(const cSystem: string): string;
procedure WriteServerIp(const cSystem, cValue: string);
function ConnectDatabase(const cSystem: string): string;
function DatabaseType(const cSystem: string): integer;
function LocalIP: string;
function ReadIniStr(const Files, Section, IDent: string): string;
procedure WriteIniStr(const Files, Section, IDent, Value: string);
function ReadIniInt(const Files, Section, IDent: string): integer;
procedure WriteIniInt(const Files, Section, IDent: string; const Value: integer);
function ReadIniDate(const Files, Section, IDent: string): tDateTime;
procedure WriteIniDate(const Files, Section, IDent: string; const Value: tDateTime);
function NVL(const varname, varvalue: variant): variant;
function isNil(const varname: variant): boolean;
function IIF(const tj: boolean; const v1, v2: variant): variant;
function PadL(const s: string; const i: smallint; const c: char): string;
function ItoS(const nint: integer; const nlen: smallint): string;
function FtoS(const F: Double; const nlen, dec: smallint): string;
function isDate(const Value: string): boolean;
function isNumber(const Value: string): boolean;
function UpperRMB(nJe: Double): string;
function SystemPath: string;
function Left(const s: string; const len: smallint): string;
function right(const s: string; const len: smallint): string;
function DTOC(const date: tDate): string;

function CellSwapPositionStr(col, row: integer): string;

function DateAdd(const Part: char; const value: smallint; const Date: tDate): tDate;
function MonthDay(const value: smallint; const Date: tDate): tDate;
function DTOS(const date: tDate; const len: smallint = 8): string;
function IsNum(const strg: string): boolean;
procedure LoadCellRelation(Cell: TCell);

function TestIp(var Edit: TEdit): boolean;

implementation

function TestIp(var Edit: TEdit): boolean;
var
  i, k, p1, p2, p3: smallint;
  str1, str2, str3, str4: string;
begin
  result := false;
  if trim(Edit.Text) = '' then
    exit;
  k := 0;
  p1 := 0;
  p2 := 0;
  p3 := 0;
  for i := 1 to length(trim(Edit.Text)) do
    if copy(trim(Edit.Text), i, 1) = '.' then
    begin
      k := k + 1;
      if k = 1 then
        p1 := i;
      if k = 2 then
        p2 := i;
      if k = 3 then
        p3 := i;
    end;
  if k <> 3 then
    exit;
  if (p1 = 1) or (p2 - p1 = 1) or (p3 - p2 = 1) or (p3 = length(trim(Edit.Text)))
    then
    exit;
  if length(copy(trim(Edit.Text), p3 + 1, length(trim(Edit.Text)) - p3)) > 3
    then
    exit;
  if length(copy(trim(Edit.Text), p2 + 1, p3 - p2 - 1)) > 3 then
    exit;
  if length(copy(trim(Edit.Text), p1 + 1, p2 - p1 - 1)) > 3 then
    exit;
  if length(copy(trim(Edit.Text), 1, p1 - 1)) > 3 then
    exit;
  if strtoint(copy(trim(Edit.Text), p3 + 1, length(trim(Edit.Text)) - p3)) > 255
    then
    exit;
  if strtoint(copy(trim(Edit.Text), p2 + 1, p3 - p2 - 1)) > 255 then
    exit;
  if strtoint(copy(trim(Edit.Text), p1 + 1, p2 - p1 - 1)) > 255 then
    exit;
  if strtoint(copy(trim(Edit.Text), 1, p1 - 1)) > 255 then
    exit;

  str4 := inttostr(strtoint(copy(trim(Edit.Text), p3 + 1, length(trim(Edit.Text))
    - p3)));
  str3 := inttostr(strtoint(copy(trim(Edit.Text), p2 + 1, p3 - p2 - 1)));
  str2 := inttostr(strtoint(copy(trim(Edit.Text), p1 + 1, p2 - p1 - 1)));
  str1 := inttostr(strtoint(copy(trim(Edit.Text), 1, p1 - 1)));
  Edit.Text := str1 + '.' + str2 + '.' + str3 + '.' + str4;
  result := true;
end;

function DTOC(const date: tDate): 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 := c;
end;

procedure LoadCellRelation(Cell: TCell);
{装载财务报表勾稽公式}
var
  para1, para2: array[1..5] of smallint;
  FuncDepiction, FuncType: olevariant;
begin
  FuncType := '报表勾稽公式函数';

  para1[1] := 0;
  para1[2] := 0;
  para2[1] := 0;
  para2[2] := 0;
  FuncDepiction := '提取当前报表某个数据,GJDATA(列号,行号)'
    + chr(13) + chr(10) + '参数:列号、行号:原表的实际列号与行号'
    + chr(13) + chr(10) + '注意：提取的是当前表中的数据可能是未存盘的数据';
  Cell.DoAddUserFunctionEX(FuncType, 'GJDATA', 0, 2, para1[1], para2[1], FuncDepiction);

  para1[1] := 0;
  para1[2] := 0;
  para1[3] := 1;
  para2[1] := 0;
  para2[2] := 0;
  para2[3] := 1;
  FuncDepiction := '提取某报表数据,GJGET(列号,行号,[表号])'
    + chr(13) + chr(10) + '参数:列号、行号:原表的实际列号与行号；'
    + chr(13) + chr(10) + '     表号: (可缺省)报表表号，默认值为当前报表；'
    + chr(13) + chr(10) + '注意：提取的是存盘后的数据';
  Cell.DoAddUserFunctionEX(FuncType, 'GJGET', 0, 3, para1[1], para2[1], FuncDepiction);
end;

function IsNum(const strg: string): boolean;
var
  i: smallint;
begin
  result := false;
  for i := 1 to length(strg) do
  begin
    if strg[i] in ['0'..'9'] then
      result := true
    else
    begin
      result := false;
      break;
    end;
  end;
end;

function LocalIP: string;
//求取本机IP地址
var
  Ipstr: string;
  buffer: array[1..32] of char;
  ni: integer;
  WSData: TWSAData;
  Host: PHostEnt;
begin
  Ipstr := '';
  if WSAstartup(2, WSData) = 0 then //为程序使用WS2_32.DLL初始化
  begin
    if gethostname(@buffer[1], 32) = 0 then
    begin
      Host := gethostbyname(@buffer[1]);
      if Host <> nil then
      begin
        for ni := 1 to 4 do
        begin
          Ipstr := Ipstr + inttostr(Ord(Host.h_addr^[ni - 1]));
          if ni < 4 then
            Ipstr := Ipstr + '.'
        end;
      end;
    end;
  end;
  result := Ipstr;
end;

function ReadIniStr(const Files, Section, IDent: string): string;
//读取ini文件中的字符串内容
var
  mIni: tIniFile;
  cItem: string;
begin
  cItem := '';
  if FileExists(Files) then
  begin
    mIni := tIniFile.Create(Files);
    cItem := mIni.ReadString(Section, Ident, '');
    mIni.Free;
  end;
  Result := cItem;
end;

procedure WriteIniStr(const Files, Section, IDent, Value: string);
//写入ini文件中的字符串内容
var
  mIni: tIniFile;
begin
  mIni := tIniFile.Create(Files);
  mIni.WriteString(Section, Ident, Value);
  mIni.Free;
end;

function ReadIniInt(const Files, Section, IDent: string): integer;
//读取ini文件中的整型内容
var
  mIni: tIniFile;
  iItem: integer;
begin
  iItem := 0;
  if FileExists(Files) then
  begin
    mIni := tIniFile.Create(Files);
    iItem := mIni.ReadInteger(Section, iDent, 0);
    mIni.Free;
  end;
  Result := iItem;
end;

procedure WriteIniInt(const Files, Section, IDent: string; const Value: integer);
//写入ini文件中的整型内容
var
  mIni: tIniFile;
begin
  mIni := tIniFile.Create(Files);
  mIni.WriteInteger(Section, Ident, Value);
  mIni.Free;
end;

function ReadIniDate(const Files, Section, IDent: string): tDateTime;
//读取ini文件中的日期内容
var
  mIni: tIniFile;
  dItem: tDateTime;
begin
  dItem := date();
  if FileExists(Files) then
  begin
    mIni := tIniFile.Create(Files);
    dItem := mIni.ReadDateTime(Section, IDent, dItem);
    mIni.Free;
  end;
  Result := dItem;
end;

procedure WriteIniDate(const Files, Section, IDent: string; const Value: tDateTime);
//写入ini文件中的日期内容
var
  mIni: tIniFile;
begin
  mIni := tIniFile.Create(Files);
  mIni.WriteDateTime(Section, Ident, Value);
  mIni.Free;
end;

function NVL(const varname, varvalue: variant): variant;
//如果变量VarName是NULL,则返回VarValue所指的值
var
  ntype: integer;
begin
  ntype := vartype(varname);
  case ntype of
    varempty, varnull, varunknown, 14: result := varvalue;
  else result := varname;
  end;
end;

function isNil(const varname: variant): boolean;
var
  ntype: integer;
begin
  ntype := vartype(varname);
  case ntype of
    varempty, varnull, varunknown, 14: result := true;
  else result := false;
  end;
end;

function IIF(const tj: boolean; const v1, v2: variant): variant;
//条件函数
begin
  if tj then
    Result := v1
  else
    Result := v2;
end;

function PadL(const s: string; const i: smallint; const c: char): string;
//左填充函数
var
  ilen: smallint;
begin
  ilen := length(s);
  if ilen >= i then
    Result := copy(s, 1, i)
  else
    Result := stringreplace(format('%' + trim(inttostr(i)) + 's', [s]), ' ', c, [rfReplaceAll]);
end;

function ItoS(const nint: integer; const nlen: smallint): string;
//将Integer类型转换成定长字符串
var
  cstr: string;
begin
  str(nint: nlen, cstr);
  result := cstr;
end;

function FtoS(const F: Double; const nlen, dec: smallint): string;
//将double类型转换成定长字符串
var
  cstr: string;
begin
  str(F: nlen: dec, cstr);
  result := cstr;
end;

function isDate(const Value: string): boolean;
//判断字符串是否是日期
var
  NumSet: set of '-'..'9';
  c: char;
  i, ilen, iY, iM, iD: integer;
  s, cY, cM, cD: 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 = 0 then
  begin
    result := false;
    exit;
  end;
  cY := copy(s, 1, i - 1);
  if (length(cY) > 4) or (length(cY) < 1) then
  begin
    result := false;
    exit;
  end;
  iY := strtoint(cY);
  s := copy(s, i + 1, ilen - i);
  ilen := length(s);
  i := pos('-', s);
  if (i = 0) then
  begin
    result := false;
    exit;
  end;
  cM := copy(s, 1, i - 1);
  if (length(cM) > 2) or (length(cM) < 1) then
  begin
    result := false;
    exit;
  end;
  iM := strtoint(cM);
  s := copy(s, i + 1, ilen - i);
  i := pos('-', s);
  if (iM < 1) or (iM > 12) then
  begin
    result := false;
    exit;
  end;
  if i <> 0 then
  begin
    result := false;