1.ipaddress 取IP地址
2.configDsn 配置ODBC
3.errhand 错误处理函数
4.checksql 检查SQL查询是否出错，及出错说明
5.setpath 设置程序运行路径
6.tostr 各种变量变为字符串返回
7.ntoc 小数转为大数，不限制长度，可达几个亿 ntoc 自动调用ntoc2
func ipaddress
local IPSocket
crlf=chr(13)+chr(10)
local IPSocket
public IPAddress,LocalHostName,remotehost,remotehostip
* 显示本地 ip 地址
IPSocket = CreateObject("MSWinsock.Winsock")
if type(''''IPSocket'''')=''''O''''
IPAddress = IPSocket.LocalIP
localhostname = IPSocket.localhostname
remotehost = IPSocket.remotehost
remotehostip = IPSocket.remotehostip
* MessageBox ("本地 IP = " + IPAddress+crlf+"本地 host = "+localhostname;
*+crlf+"Remotehost = "+remotehost+crlf+"Remotehostip = "+remotehostip)
else
* MessageBox ("Winsock 未安装!")
retu ''''''''
endif
retu allt(IPAddress)
func ConfigDSN
para lcODBCName,lcODBCServer,lcODBCDatabase
DECLARE INTEGER SQLConfigDataSource IN odbccp32.dll ;
INTEGER nHwndParent, ;
INTEGER nRequest, ;
STRING cDriver, ;
STRING cAttributes
lnWindowHandle=0
lcODBCDriver=''''SQL Server'''' &&DRIVER类型
*lcODBCName=''''try'''' &&数据源名字
lcODBCDesc=lcODBCName &&数据源描述
*lcODBCServer=''''x.x.x.x'''' &&SQL SERVER名字
*lcODBCDatabase=''''systemargument'''' &&要连接的数据库名字
**先试图修改已有的ODBC，如果不存在，返回0。
lreturn=SQLConfigDataSource(lnWindowHandle, 2, lcODBCDriver, ;
''''DSN='''' + lcODBCName + CHR(0) ;
+ ''''Description='''' + lcODBCDesc + CHR(0) ;
+ ''''Server='''' + lcODBCServer + CHR(0) ;
+" network=DBMSSOCN" + CHR(0) ;
+" AutoTranslate=No"+CHR(0) ;
+ ''''Database='''' + lcODBCDatabase + CHR(0))
IF lreturn=0 &&不存在
**添加新的ODBC
lreturn=SQLConfigDataSource(lnWindowHandle, 1, lcODBCDriver, ;
''''DSN='''' + lcODBCName + CHR(0) ;
+ ''''Description='''' + lcODBCDesc + CHR(0) ;
+ ''''Server='''' + lcODBCServer + CHR(0) ;
+" network=DBMSSOCN" + CHR(0) ;
+" AutoTranslate=No"+CHR(0) ;
+ ''''Database='''' + lcODBCDatabase + CHR(0))
IF lreturn=0 &&失败
* MESSAGEBOX(''''添加ODBC数据源失败'''',16,''''BUFFER'''')
retu -1
else
* MESSAGEBOX(''''添加ODBC数据源OK'''',64,''''BUFFER'''')
retu 1
ENDIF
ELSE
* MESSAGEBOX(''''修改ODBC数据源OK'''',64,''''BUFFER'''')
retu 2
ENDIF
*!* ?sqlgetprop(lreturn,"DataSource")
*!* ?sqlgetprop(lreturn,"userid")
*!* ?sqlgetprop(lreturn,"password")
*!* ?sqlgetprop(lreturn,"connectstring")
retu 1
***************************************
*ON ERROR DO errhand WITH ;
* ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO()
****************************
PROCEDURE errhand
PARAMETER merror, mess, mess1, mprog, mlineno
DEFI wind errhand from 1,20 to 15,78 colo sche 12
Acti wind errhand
PRIV olddevi,oldprin,tmpstr
olddevi='''' set devi to ''''+set(''''devi'''')
oldprin='''' set prin ''''+set(''''prin'''')
SET devi to scre
SET prin off
?chr(7)
m.tmpstr=''''出错代号: '''' + LTRIM(STR(merror))+chr(13)+chr(10)
? ''''请记录以下出错信息并通知电脑部. 谢谢.''''
? ''''''''
? ''''出错代号: '''' + LTRIM(STR(merror))
? ''''''''
? ''''出错信息: '''' + mess
? ''''''''
? ''''出错代码行: '''' + mess1
? ''''''''
? ''''出错行号: '''' + LTRIM(STR(mlineno))
? ''''''''
? ''''出错程序名: '''' + mprog
tmp=inkey(0)
m.tmpstr=''''出错代号: '''' + LTRIM(STR(merror))+chr(13)+chr(10)
m.tmpstr=m.tmpstr+''''出错信息: '''' + mess+chr(13)+chr(10)
m.tmpstr=m.tmpstr+''''出错代码行: '''' + mess1+chr(13)+chr(10)
m.tmpstr=m.tmpstr+''''出错行号: '''' + LTRIM(STR(mlineno)) +chr(13)+chr(10)
m.tmpstr=m.tmpstr+''''出错程序名: '''' + mprog+chr(13)+chr(10)
=strtofile(''''[''''+dtos(date())+'''' ''''+time()+'''']''''+chr(13),''''jjyw.log'''',.t.)
=strtofile(m.tmpstr,''''system.log'''',.t.)
=strtofile(''''[----------------]''''+chr(13)+chr(10)+chr(13)+chr(10),''''jjyw.log'''',.t.)
Rele wind errhand
ON key label f1
QUIT
RETURN
PROCEDURE checksql
*首先要执行_sqlretu=sqle("xxx","XXX")
IF m._sqlretu<0
= AERROR(aErrorArray) && 靠近错误的数据
m._sqlerrstr=''''注 意：本次SQL语句执行失败！！！''''+chr(10)+chr(13)+chr(10)+chr(13)+;
''''具体信息：''''+aErrorArray(2)
=messagebox(_sqlerrstr+chr(13)+chr(10)+_sqlstr,64,''''经纪业务系统：--------------------------SQL 错误信息--------------------------'''')
WAIT wind ''''本次SQL语句执行失败！！！ ''''+chr(13)+chr(10)+;
iif(not empty(m.odbc_nouse),''''系统INI文件指示不用建立部门''''+m.odbc_nouse+''''的ODBC连接，请检查是否是这个原因。'''','''''''') nowait
*ELSE
* WAIT wind ''''远程SQL语句执行完毕。'''' nowait
ENDIF
RETU
FUNCTION SetPath()
LOCAL lcSys16, lcProgram
lcSys16 = SYS(16) &&查询当前运行程序名
lcProgram = SUBSTR(lcSys16, AT(":", lcSys16) - 1)
CD LEFT(lcProgram, RAT("\", lcProgram))
*-- If we are running MAIN.PRG directly, then
*-- CD up to the parent directory
IF RIGHT(lcProgram, 8) = "MAIN.FXP"
CD ..
ENDIF
SET PATH TO PROGS, FORMS, LIBS, ;
MENUs, DATA, ;
REPORTS, INCLUDE, HELP, ;
graphics,about
** SET CLASSLIB TO MAIN ,vfptool
ENDFUNC
**各种类型转换为字符串
FUNC tostr
PARA tmpstr
LOCAL i
i=type(''''m.tmpstr'''')
DO case
CASE i=''''C''''
RETU allt(m.tmpstr)+'''' ''''
CASE i=''''D''''
RETU dtos(m.tmpstr)+'''' ''''
OTHE
i=allt(str(m.tmpstr,14,2))
IF righ(i,3)=''''.00''''
i=left(i,at(''''.'''',i)-1)
ENDIF
RETU i+'''' ''''
ENDC
RETU '''' ''''
****小写转换为大写
FUNC ntoc
PARA num
LOCAL string,string1,string2
IF num<100000000
RETU ntoc2(num)
ENDIF
STRING=allt(str(num,20,2))
string1=right(string,11)
string2=substr(string,1,len(string)-11)
string1=ntoc2(val(string1))
string2=ntoc2(val(string2))
STRING=left(string2,len(string2)-4)+''''亿''''+string1
IF right(string,6)=''''零元正''''
STRING=substr(string,1,len(string)-6)+''''元正''''
ENDIF
RETU string
FUNC ntoc2
PARAMETERS NUM
PRIV NUM,CHAR,POSI,I,STR,TEMP,ii
DIMENSION CHAR(10),POSI(7)
**wait wind str(num,14,2)
CHAR(1) =''''壹''''
CHAR(2) =''''贰''''
CHAR(3) =''''叁''''
CHAR(4) =''''肆''''
CHAR(5) =''''伍''''
CHAR(6) =''''陆''''
CHAR(7) =''''柒''''
CHAR(8) =''''捌''''
CHAR(9) =''''玖''''
CHAR(10)=''''零''''
POSI(1) =''''分''''
POSI(2) =''''角''''
POSI(3) =''''元''''
POSI(4) =''''拾''''
POSI(5) =''''佰''''
POSI(6) =''''仟''''
POSI(7) =''''万''''
STR=''''''''
IF NUM>=100000000 &&一亿
RETURN ''''*********''''
ENDIF
NUM=NUM*100
I=1
ii=1
lasttemp=1
DO WHILE NUM>=1
NUM=NUM/10
TEMP=INT((NUM-INT(NUM))*10)
I=IIF(I=8,4,I)
IF temp#0 &&char(iif(temp=0,10,temp))#''''零''''
STR=CHAR(IIF(TEMP=0,10,TEMP))+POSI(I)+STR
ELSE
IF(i=3)
STR=''''元''''+str
ENDIF
IF (i=7)
STR=''''万''''+str
ENDIF
ENDIF
IF temp=0.and.i>1.and.lasttemp#temp.and.;
left(str,2)#''''元''''.and.left(str,2)#''''万''''
STR=''''零''''+str
ENDIF
I=I+1
ii=ii+1
lasttemp=temp
ENDDO
IF right(str,2)#''''分''''
STR=str+''''正''''
ENDIF
IF str=''''正''''
STR=''''零元正''''
ENDIF
RETURN STR
