publicfun.pas

北京铁路局住房分配系统,数据库为MSSql2000,依次执行crebas4.sql

unit PublicFun;

interface

uses IniFiles,Variants,NMTime,Windows,SysUtils;

//const
//type

var

  _UserID, _UserPassword, _UserName,_UserPurview:string;
  _UserType: smallint;

  function Connect : smallint;
  function SysAdd(const BH,MC,BZ:string):smallint;
  function SysDel(const BH:string):smallint;
  function XqxxAdd(const XQBH,XQMC,DZ:string):smallint;
  function XqxxDel(const XQBH:string):smallint;
  function LyxxAdd(const LYBH,XQBH,MC,LXBH:string; CS,FJTS:smallint):smallint;
  function LyxxDel(const LYBH:string):smallint;
  function ZfxxAdd(const ZFBH,LYBH,DYH,HXBH,LC,CXBH,DJBH,YTBH,SFFP,KFFP,SFZH,DWBH:string;const area,cost:double):smallint;
  function ZfxxDel(const ZFBH:string):smallint;
  function DwxxAdd(const DWBH,DWMC:string;KFTS,YFTS:smallint):smallint;
  function DwxxDel(const DWBH:string):smallint;
  function GrxxAdd(const SFZH,XM,DWBH,ZW:string):smallint;
  function GrxxDel(const SFZH:string):smallint;
  function ReadInfo(const Section, IDent: string):string;
  procedure WriteInfo(const Section, IDent: string; Value: Variant);
  function SystemPath():string;
  function FpzbAdd(const FPTJBH,FPCS:string;YJSL,EJSL,SJSL,FSEJ,FSSJ,QT,HJ:smallint):smallint;
  function test():smallint;
  function FjfpbAdd(const FPTJBH,YTBH:string;YJSL,EJSL,SJSL,FSEJ,FSSJ,QT,HJ:smallint):smallint;
  function Fjtest():smallint;
  function YtfpbAdd(const DWBH:string;ZGFP,JLFP,CQFP,LDGB,SHYF,GYFW,JDFW,QTYF:smallint):smallint;
  function YtfpbDel(const DWBH:string):smallint;
  procedure YTBTest(var CompA,CompB,nret:smallint);
  function ZgfpbAdd(const DWBH,YTBH:string;YJSL,EJSL,SJSL,FSEJ,FSSJ,QT,HJ:smallint):smallint;
  function ZgfpbDel(const DWBH,YTBH:string):smallint;
  procedure ZGTest0(var CompA,CompB,nhx:smallint;var cyt:string);
  procedure ZGTest1(var CompA,CompB,nyt:smallint;var cdw:string);
  function ZfxxUp(const ZFBH,DWBH:string;var msg:string):smallint;
  function ZfxxUp1(const ZFBH,DWBH,YTBH:string;var msg:string):smallint;
  function ZfxxSet(const ZFBH:string;var msg:string):smallint;
  procedure ZFTest(var CompA,CompB,nhx:smallint;const cdw:string);
  function comp(const s1,s2:string):boolean;
  procedure HXTest(const LYBH,HXBH:string;var HXMC:string);
  procedure CXTest(const LYBH,CXBH:string;var CXMC:string);
  function fLogin(const userid,userpwd: string): smallint;
  procedure fUserInfo;
  function UserSave(const Userid, UserName, UserPassword,UserPurview:string;const Usertype:smallint): smallint;
  function iif(tj :boolean;v1,v2:variant):variant;
  function UserDel(const Userid:string ): smallint;
  procedure fUser(var UserId,UserPassword,UserName,UserPurview: string;var UserType:smallint);

implementation

uses datamodl;


function UserDel(const Userid:string ): smallint;
begin
  Result := datamodule1.UserDel(Userid);
end;

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

function UserSave(const Userid, UserName, UserPassword,UserPurview:string;const Usertype:smallint): smallint;
begin
  Result := datamodule1.UserSave(Userid,UserName,UserPassword,UserPurview,Usertype);
end;

procedure fUser(var UserId,UserPassword,UserName,UserPurview: string;var UserType:smallint);
begin
  UserId := trim(datamodule1.ADOQry.FieldByName('userid').AsString);
  UserPassword := trim(datamodule1.ADOQry.FieldByName('userpassword').AsString);
  UserName := trim(datamodule1.ADOQry.FieldByName('username').AsString);
  UserPurview := trim(datamodule1.ADOQry.FieldByName('userpurview').AsString);
  UserType := datamodule1.ADOQry.FieldByName('usertype').AsInteger;
end;

procedure fUserInfo;
begin
  datamodule1.UserInfo;
end;

function Login(const userid,userpwd: string;var username,userpurview: string;var usertype: smallint): smallint;
//登录
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.ProcedureName:='P_UserLogin;1';
  datamodule1.ADOSP.Parameters.Refresh;
  with datamodule1.ADOSP.Parameters do
  begin
    ParamByName('@userid').Value := userid;
    ParamByName('@userpassword').Value := userpwd;
    ParamByName('@userpurview').Value := '';
    ParamByName('@nret').Value := -1;
  end;
  datamodule1.ADOSP.ExecProc;
  Result := datamodule1.ADOSP.Parameters.ParamByName('@nret').Value;
  with datamodule1.ADOSP.Parameters do
  begin
    UserName := ParamByName('@username').value;
    UserPurview := ParamByName('@userpurview').value;
    UserType := ParamByName('@usertype').value;
  end;
  datamodule1.ADOSP.Close;
end;


function fLogin(const UserId,UserPwd: string): smallint;
var
  username,userpurview: string;
  usertype,nRet: smallint;
begin
  if trim(UserID) = '' then
  begin
    result :=6;
  end
  else
  begin
    nRet := Login(Userid,UserPwd,username,userpurview,usertype);
    if nRet = 0 then
    begin
      _UserID := UserID;
      _UserPassword := UserPwd;
      _UserName := UserName;
      _UserType := UserType;
      _UserPurview := UserPurview;
    end;
    Result := nRet;
  end;
end;


function Connect : smallint;
begin
  Result := datamodule1.Connect;
end;

function comp(const s1,s2:string):boolean;
var
  i,j:smallint;
begin
  j:=-1 ;
  for i:=1 to length(s1)-length(s2)+1 do
    if copy(s1,i,length(s2))= s2 then j:=i;
  if j <> -1 then
    result:= true
  else
    result:= false;
end;

function SystemPath():string;
//SYSTEM 或 SYSTEM32 路径
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
  begin
    cPath := cPath +'\';
  end;
  Result := cPath;
end;

function ReadInfo(const Section, IDent: string):string;
//数据库设置信息
var
  mIni: tIniFile;
  cIniFile, cItem: string;
begin
  cIniFile := SystemPath() + 'zffp.ini';
  cItem := '';
  if FileExists(cIniFile) then
  begin
    mIni := tIniFile.Create(cIniFile);
    cItem := mIni.ReadString(Section, Ident, '');
    mIni.Free;
  end;
  Result := cItem;
end;

procedure WriteInfo(const Section, IDent: string; Value: Variant);
//写数据库设置信息
var
  mIni: tIniFile;
  cIniFile: string;
begin
  cIniFile := SystemPath() + 'zffp.ini';
  mIni := tIniFile.Create(cIniFile);
  mIni.WriteString(Section,Ident,Value);
  mIni.Free;
end;

function test():smallint;
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@nret').Value := -1;
  datamodule1.ADOSP.ExecProc;
  result := datamodule1.ADOSP.Parameters.ParamByName('@nret').Value;
  datamodule1.ADOSP.Close;
end;

function Fjtest():smallint;
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@nret').Value := -1;
  datamodule1.ADOSP.ExecProc;
  result := datamodule1.ADOSP.Parameters.ParamByName('@nret').Value;
  datamodule1.ADOSP.Close;
end;

procedure YTBTest(var CompA,CompB,nret:smallint);
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nret').Value := -1;
  datamodule1.ADOSP.ExecProc;
  CompA := datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value;
  CompB := datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value;
  nret := datamodule1.ADOSP.Parameters.ParamByName('@nret').Value;
  datamodule1.ADOSP.Close;
end;

procedure ZGTest0(var CompA,CompB,nhx:smallint;var cyt:string);
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nhx').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@cyt').Value := '';
  datamodule1.ADOSP.ExecProc;
  CompA := datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value;
  CompB := datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value;
  nhx := datamodule1.ADOSP.Parameters.ParamByName('@nhx').Value;
  cyt := datamodule1.ADOSP.Parameters.ParamByName('@cyt').Value;
  datamodule1.ADOSP.Close;
end;

procedure ZGTest1(var CompA,CompB,nyt:smallint;var cdw:string);
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nyt').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@cdw').Value := '';
  datamodule1.ADOSP.ExecProc;
  CompA := datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value;
  CompB := datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value;
  nyt := datamodule1.ADOSP.Parameters.ParamByName('@nyt').Value;
  cdw := datamodule1.ADOSP.Parameters.ParamByName('@cdw').Value;
  datamodule1.ADOSP.Close;
end;

procedure ZFTest(var CompA,CompB,nhx:smallint;const cdw:string);
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.ProcedureName:='P_TestZFXXB;1';
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@nhx').Value := -1;
  datamodule1.ADOSP.Parameters.ParamByName('@DWBH').Value := cdw;
  datamodule1.ADOSP.ExecProc;
  CompA := datamodule1.ADOSP.Parameters.ParamByName('@nCompA').Value;
  CompB := datamodule1.ADOSP.Parameters.ParamByName('@nCompB').Value;
  nhx := datamodule1.ADOSP.Parameters.ParamByName('@nhx').Value;
  datamodule1.ADOSP.Close;
end;

procedure HXTest(const LYBH,HXBH:string;var HXMC:string);
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.ProcedureName:='P_TestHX;1';
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@LYBH').Value := LYBH;
  datamodule1.ADOSP.Parameters.ParamByName('@BH').Value := HXBH;
  datamodule1.ADOSP.Parameters.ParamByName('@HXMC').Value := '';
  datamodule1.ADOSP.Parameters.ParamByName('@nRet').Value := -1;
  datamodule1.ADOSP.ExecProc;
  HXMC:= datamodule1.ADOSP.Parameters.ParamByName('@HXMC').Value;
  //nret:= datamodule1.ADOSP.Parameters.ParamByName('@nRet').Value;
  datamodule1.ADOSP.Close;
end;

procedure CXTest(const LYBH,CXBH:string;var CXMC:string);
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.ProcedureName:='P_TestCX;1';
  datamodule1.ADOSP.Parameters.Refresh;
  datamodule1.ADOSP.Parameters.ParamByName('@LYBH').Value := LYBH;
  datamodule1.ADOSP.Parameters.ParamByName('@BH').Value := CXBH;
  datamodule1.ADOSP.Parameters.ParamByName('@CXMC').Value := '';
  datamodule1.ADOSP.Parameters.ParamByName('@nRet').Value := -1;
  datamodule1.ADOSP.ExecProc;
  CXMC:= datamodule1.ADOSP.Parameters.ParamByName('@CXMC').Value;
  //nret:= datamodule1.ADOSP.Parameters.ParamByName('@nRet').Value;
  datamodule1.ADOSP.Close;
end;


function SysAdd(const BH,MC,BZ:string):smallint;
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.Parameters.Refresh;
  with datamodule1.ADOSP.Parameters do
  begin
    ParamByName('@BH').Value := BH;
    ParamByName('@MC').Value := MC;
    ParamByName('@BZ').Value := BZ;
    ParamByName('@nret').Value := -1;
  end;
  datamodule1.ADOSP.ExecProc;
  result := datamodule1.ADOSP.Parameters.ParamByName('@nret').Value;
  datamodule1.ADOSP.Close;
end;

function XqxxAdd(const XQBH,XQMC,DZ:string):smallint;
begin
  if  datamodule1.ADOSP.Active=true then datamodule1.ADOSP.Close;
  datamodule1.ADOSP.Parameters.Refresh;
  with datamodule1.ADOSP.Parameters do
  begin
    ParamByName('@XQBH').Value := XQBH;
    ParamByName('@XQMC').Value := XQMC;