unit_public.pas

招投标软件代码,很有应用价值,请大家参考下哦,不明白的地方给我留言

{ *********************************************************************** }
{ 程序中公共函数 公共变量                                                 }
{                                                                         }
{                                                                         }
{                                                                         }
{                                                                         }
{                                                                         }
{ *********************************************************************** }
unit Unit_Public;

interface

uses
  Windows, Messages, SysUtils, Variants,Dialogs,forms,SystemObject,CELL50Lib_TLB,DateUtils,
  XMLIntf,Registry,Classes,Controls,ComObj;

type
  TFromClass = class of TForm;

  procedure GetPath;
  function CreatedForm(FromClass: TFromClass): TForm;
  function ShowChildForm(AParam: string): Hwnd;//创建窗体函数
  function format_str(str:string):string;//控制字符串显示格式
  procedure getcellXuhao(Acell:tcell;Astartrow,Arow:Integer); //得到打印序号
  procedure setCellSheet(cell1:tcell;ARecordcount,Atotal:Integer);//得到页数
  function MinToMax(ADateTime:tdatetime):string;
  function GetLeibie(str:string):string;
  procedure setcellColWidth(Acell:tcell;AcellWith,Acol,astartcol:integer);
    //动态设置acell的列数
  function NumToWstr(const n:Double):string;//小写金额变大写
  function mintoMax1(ai:Integer):string;
  Function IsFileInUse(FileName:string):boolean;//判断文件是否已经打开
  function GetFilePath:string;//得到报表保存路径
  function IsExistsPath:boolean;//文件路径是否存在
  Function Rround(x:double;i:integer):double;//四舍五入
  //XML操作函数 (开始）
  //根据节点名获得要查询的子节点
  function GetChildNodeByName(AXmlNode: IXmlNode;AStrName: string): IXmlNode;


  //XML操作函数（结束)
  //注册表操作
  procedure CreateRegDB;//创建节点
  function  RegDBExist:boolean;
  procedure ReadDBLogin;
  function BuildConnectString(Server: string;WindowsMode: Boolean = True;LoginID:string='';LoginPassword:string='';DBName:string=''):string;

  //注册表操作

  function GetSQLServerList(AList: TStrings): Boolean;



var
  SPATH    : string;  //程序存放路径


implementation

uses
  Unit_zhaobiaolx,Unit_biaoduanlx,U_BDXinXi,U_XMXinXi,u_dwxinxi,Unit_zhuanjiaxx,U_YongHu,
  Unit_ToubiaoRz,Unit_toubiaojh,Unit_ZiShenSqr,U_ZiShenWj,Unit_zishenrenwj,Unit_ZiShenPF,
  Unit_tongguozigesqr,unit_ZiShengzz,U_Zigeyspsbg,U_ZigeysTzs,Unit_YaoHao,u_ZhaoBiaowj,U_ZhaoBiaoyqs,
  Unit_BiaoQianhy,U_TouBiaowj,Unit_YeZhuBd,Unit_KaiBiaojl,Unit_QingBiao,unit_condb,
  Unit_pingbiaoj,unit_zhongbiaoqd,Unit_PingBiaohxr,U_ZhongBiaotzs,U_zhongbiaobg,unit_weiyhmd;


function GetSQLServerList(AList: TStrings): Boolean;
var
   i,nServers: integer;
   vSQLServer: Variant;
   vServerList: Variant;
begin
  Result := False;
  if AList = nil then Exit;
  AList.Clear;
  Screen.Cursor := crHourGlass;
  try
    try
      vSQLServer := CreateOleObject('SQLDMO.Application');
      vServerList := vSQLServer.ListAvailableSQLServers;
      nServers := vServerlist.Count;
      for i := 1 to nServers do
        AList.Add (vServerlist.item(i));
      Result := True;
    except
    end;
  finally
    vSQLServer := NULL;
    vServerList := NULL;
    Screen.Cursor := crDefault;
  end;
end;

function  RegDBExist:boolean;
var
  Reg : TRegistry;
begin
  Result:=False;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  if Reg.KeyExists('\Software\HeadSoft\HeadZtb\DBLogin') then
     Result:=True;
end;

procedure CreateRegDB;//创建节点
var
  Reg : TRegistry;
begin
  Reg:=Tregistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Software\HeadSoft\HeadZtb\DBLogin',true);
    Reg.WriteString('DBServer','');
    Reg.WriteString('LoginMode','');
    Reg.WriteString('LoginID','');
    Reg.WriteString('LoginPassword','');
    Reg.WriteString('DBName','');
    //连接远程数据库
    Reg.WriteString('RemoteDBServer','');
    Reg.WriteString('RemoteLoginID','');
    Reg.WriteString('RemoteLoginPassword','');
    Reg.WriteString('RemoteDBName','');
    Reg.CloseKey;
  finally
    freeandnil(Reg);
  end;
end;

procedure ReadDBLogin;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Software\HeadSoft\HeadZtb\DBLogin',true);
    DBLogin.BsServer := Reg.ReadString('BsServer');
    DBLogin.DBServer := Reg.ReadString('DBServer');
    DBLogin.WinNTMode := Reg.ReadString('LoginMode') <> 'sqlserver';
    DBLogin.LoginID := Reg.ReadString('LoginID');
    DBLogin.LoginPassword := Reg.ReadString('LoginPassword');
    DBLogin.DBName := Reg.ReadString('DBName'); 
    DBLogin.ConnectString := BuildConnectString(DBLogin.DBServer,DBLogin.WinNTMode,DBLogin.LoginID,DBLogin.LoginPassword,DBLogin.DBName);
    DBLogin.RDBServer := Reg.ReadString('RemoteDBServer');
    DBLogin.RLoginID := Reg.ReadString('RemoteLoginID');
    DBLogin.RPwd := Reg.ReadString('RemoteLoginPassword');
    DBLogin.RDBName := Reg.ReadString('RemoteDBName');
    DBLogin.RConnectString := BuildConnectString(DBLogin.RDBServer,False,DBLogin.RLoginID,DBLogin.RPwd,DBLogin.RDBName);
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
end;

function BuildConnectString(Server: string;WindowsMode: Boolean = True;LoginID:string='';LoginPassword:string='';DBName:string=''):string;
begin
  if WindowsMode then
    Result := Format('Provider=SQLOLEDB.1;Persist Security Info=False;Integrated Security=SSPI;Data Source=%s;',[Server])
  else
    Result := Format('Provider=SQLOLEDB.1;Persist Security Info=True;Data Source=%s;User ID=%s;Password=%s;',
      [Server,LoginID,LoginPassword]);
  if Trim(DBName) <> '' then
    Result := Result + Format('Initial Catalog=%s;',[DBName]);
end;

procedure GetPath;
begin
  sPath:=extractfilepath(application.exename);
end;

function GetFilePath:string;
begin
  Result := ExtractFilePath(Application.ExeName)+
    'reports\'+xmbdgc.XM_ISBn+'_'+xmbdgc.BDLX_ID+'_'+xmbdgc.gCLX_ID+'\';
end;

function IsExistsPath:boolean;
begin
  Result:=True;
  if (xmbdgc.XM_ISBn='000') or (xmbdgc.BDLX_ID='0')
    or (xmbdgc.gCLX_ID='0') then
  Result:=False;
end;

Function IsFileInUse(FileName:string):boolean;//判断文件是否已经打开
var
  HFileRes : HFILE;
begin
  Result := false;
  if not FileExists(FileName) then
    exit;
  HFileRes:=CreateFile(pchar(FileName), GENERIC_READ or GENERIC_WRITE,
     0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
     CloseHandle(HFileRes);
end;

procedure setcellColWidth(Acell:tcell;AcellWith,Acol,astartcol:integer);
begin

end;

function GetLeibie(str:string):string;
begin
  if str='无类别' then
    result:='0'
  else if str='第一类' then
    result:='1'
  else if str='第二类' then
    result:='2'
  else if str='第三类' then
    result:='3'
  else
    result:='-1';
end;

Function Rround(x:double;i:integer):double;//四舍五入
var
  j:integer;
  s:string;
  f:double;
begin
  s:='1';
  for j:=1 to i do
  begin
    s:=s+'0';
  end;
  f:=X*strtoint(s);
  result:=round(f)/strtoint(s);
  if ((trunc(f) mod 2)=0) and (pos('.',floattostr(f))>0) then
    if copy(floattostr(f),pos('.',floattostr(f))+1,1)='5' then
      result:=(trunc(f)+1)/strtoint(s);
end;

function NumToWstr(const n:Double):string;
const
  cNum:WideString='零壹贰参肆伍陆柒捌玖--万仟佰拾亿仟佰拾万仟佰拾元角分';
  cCha:array[0..1,0..12]of string =
    (('零元','零拾','零佰','零仟','零万','零亿','亿万','零零零','零零','零万','零亿','亿万','零元'),
     ('元','零','零','零','万','亿','亿','零','零','万','亿','亿','元'));
var
  i:integer;
  sNum,sTemp:WideString;
begin
  result:='';
  sNum:=format('%15d',[round(n*100)]);
  for i:=0 to 14 do
  begin
    stemp:=copy(snum,i+1,1);
    if stemp=' ' then continue
    else result:=result+cNum[strtoint(stemp)+1]+cNum[i+13];
  end;
  for i:=0 to 12 do
    Result:=StringReplace(Result,cCha[0,i],cCha[1,i],[rfReplaceAll]);
  if pos('零分',result)=0  then
    Result:=StringReplace(Result,'零角','零',[rfReplaceAll])
  else Result:=StringReplace(Result,'零角','整',[rfReplaceAll]);
  Result:=StringReplace(Result,'零分','',[rfReplaceAll]);
end;

function mintoMax1(ai:Integer):string;
const
   cNum:WideString='０一二三四五六七八九';
var
   s,s1:string;
begin
  s:=inttostr(ai);
  s1:='';
  if length(s)=1 then
    s1:=cnum[strtoint(s)+1]
  else if length(s)=2 then
  begin
    if s[1]='1' then
       s1:='十'
    else if strtoint(s[1])>1 then
       s1:= cnum[strtoint(s[1])+1]+'十';
    if s[2]<>'0' then
      s1:=s1+cnum[strtoint(s[2])+1];
  end; 
  result:=s1;

end;

function MinToMax(ADateTime:tdatetime):string;
const
   cNum:WideString='０一二三四五六七八九';
var
   s1,s2,s3:string;
   year,month,day:string;
   i:integer;
   stemp:string;
begin
  year:='';
  month:='';
  day:='';
  s1:=inttostr(yearof(ADateTime));
  s2:=inttostr(monthof(ADateTime));
  s3:=inttostr(dayof(ADateTime));
  for i:=0 to length(s1) do
  begin
    stemp:=copy(s1,i+1,1);
    if stemp<>'' then
     year:=year+cnum[strtoint(stemp)+1];
  end;
  IF length(s2)=1 then
    month:=cnum[strtoint(s2[1])+1]
  else if length(s2)=2 then
  begin
    if s2[1]='1' then
       month:='十'
    else if strtoint(s2[1])>1 then
       month:= cnum[strtoint(s2[1])+1]+'十';
    if s2[2]<>'0' then
      month:=month+cnum[strtoint(s2[2])+1];
  end;
  IF length(s3)=1 then
    day:=cnum[strtoint(s3[1])+1]
  else if length(s3)=2 then
  begin
    if s3[1]='1' then
       day:='十'
    else if strtoint(s3[1])>1 then
       day:= cnum[strtoint(s3[1])+1]+'十';
    if s3[2]<>'0' then
      day:=day+cnum[strtoint(s3[2])+1];
  end;
  result:=year+'年'+month+'月'+day+'日';
end;

procedure setCellSheet(cell1:tcell;ARecordcount,Atotal:Integer);   //需要加的页数
var
 jj,ii,ll,iirow:Integer;
begin
  jj:=aRecordCount div Atotal;
  iirow:=aRecordCount mod Atotal;
  //cell1.SetCellString(1,1,0,xmbdgc.XM_NAME);//在项目的页眉控制