⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 我的笔记.txt

📁 田径运动会管理系统RAR 用VFP编写
💻 TXT
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
******************************************
* 文件名：ymd.prg
* 函数功能：返回字符型日期
* 调用方式：cDate = ymd(date1)
*        或 cDate = ymd() 可以直接得到当天的日期
******************************************
Parameters myDate
myDate = Iif(Empty(myDate), Date(), myDate)
Return Str(Year(myDate),4) + '年' + Transform(Month(myDate), '@l 99') + '月' + Transform(Day(myDate), '@l 99') + '日'


*************************************
*  按当前日期和时间备份DBF表        *
*  调用格式：Backup(表名,备份路径)  *
*************************************
Function Backup
Parameters sFileName,sBakPath
If Parameters()=0
	Return
Endif
If Parameters()=1
	sBakPath=""
Endif
sFileName=Forceext(sFileName,".DBF")
If File(sFileName)
	Copy File (sFileName,".DBF")) To (sBakPath+sFileName+"_"+Chrtran(Chrtran(Chrtran(Ttoc(Datetime()),".",""),":","")," ","")+".DBF")
Endif



**在当前工作区中判断指定的字段是否存在，如存在返回真，否则返回假，用法:findfield(<字符型字段名>)
Func findfield
Parameter ff_name
ff_name = Upper(Alltrim(ff_name))
ff_zds = Fcount()
For ff_i = 1 To ff_zds
	If Field(ff_i) == ff_name
		Return .T.
	Endif
Endfor
Return .F.



*!*	给大家在添加一个加密解秘的函数！！！！
*!*	从用户密码到存库的随机伪码之间的变换由两个函数完成，一个是加密函数，一个是解密函数。加密函数的思想是对用户密码（真码）进行复杂化、隐蔽化处理，也就是将真码淹没在20位伪码中，加密函数如下：

Func MAZH1
Para ZMZ
ZMZ=Val(ZMZ)
N1=Rand()*10^9
If N1<=999999999
	N1=N1+10^9
Endi
N1=Int(N1)
C1=Str(N1+ZMZ)+Str(N1)
C2=Subs(C1,5,20)+Subs(C1,1,4)
P1=''
P2=''
For II=1 To 10
	P1=P1+Subs(C2,2*II-1,1)
	P2=P2+Subs(C2,2*II,1)
Endfor
WMZ=P1+P2
Retu WMZ
*!*	---- 若真码为：1234567，则伪码为：64915302152868193982，无论真码是一位还是相同多位，伪码总是具有同样的不确定性和复杂性，所以若想通过简化真码来分析伪码是不可能的。

*!*	---- 解码函数是将数据库中存放的伪码转换成原用户密码，其代码如下：

Func MAZH2
Para WMZ
PP=''
For II=1 To 10
	PP=PP+Subs(WMZ,II,1)+Subs(WMZ,II+10,1)
Endfor
DD=Subs(PP,17,4)+Subs(PP,1,16)
M1=Subs(DD,1,10)
M2=Subs(DD,11,10)
ZMZ=Int(Val(M1)-Val(M2))
Retu ZMZ
*!*	---- 由于提交的系统全是编辑的，非法者是无法得到密码转换函数中的信息的，所以解密方法是不易被发现的。



我也发个小写金额转大写金额的函数：
Procedure CAPP1
Parameters KK
Priv T1,T2,T3,T4,II,T,SS,U
T1 = '分角元拾佰仟万拾佰仟亿  '
T3 = ' ,0,1,2,3,4,5,6,7,8,9,'
T4 = '△零壹贰叁肆伍陆柒捌玖'
T2 = Alltrim(Str(KK,12,2))
SS = ''
II = 1
For T=Len(T2) To 1 Step -1
	U = Substr(T2,T,1)
	If U='.'
		Loop
	Endif
	SS = Subs(T4,At(U,T3),2)+Substr(T1,II,2)+' '+SS
	II = II+2
Endfor
Return SS





万能调用函数,比RUN更强,不但能启动程序,打开文档还能自动到达指定的网址:

FUNCTION XRUN
PARAMETERS MC 
DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER , STRING , STRING , STRING , STRING , INTEGER 
RETURN SHELLEXECUTE(0,'open',MC,'','',1)

示例:
XRUN("P215调速器.PDF")
XRUN("http://www.sld.com.cn";)

使用此函数前你必须保证你所调用的文件是在程序默认目录或用set defa to指定文件所在目录. 

  此帖被 梅子评为 50分 评语: 不错 


判断软驱中是否有盘
*chckdisk.prg
parameters tcDrive 
local lcDrive, lnWinErrMode, llCanRead 
declare integer SetErrorMode in Win32API integer nErrorMode 
lcDrive = iif(substr(tcDrive, 2, 1) = ':', left(tcDrive, 2), tcDrive) 
lnWinErrMode = SetErrorMode(1) 
llCanRead = diskspace(lcDrive) <> -1 
SetErrorMode(lnWinErrMode) 
return llCanRead

例如：? chckdisk('A:')
返回：
.T.   存在
.F.   不存在





VFP提供了对变量或字段检测为空的函数:SBLANK()和 EMPTY() ,但没有提供对记录检测为空的函数,但我们可以编写一个:

* 函数: IsBlankRec
*
* 参数: 数值型 | 字符型 - 可选
*
* 数值型表达式是要检查的工作区号,
* 字符型表达式是要检查的别名.
*
FUNCTION IsBlankRec
PARAMETER lAlias
PRIVATE llSeleBack, lnSeleBack, llResult, lcFieldName, IsBlankRec
llSeleBack = .F.
lnSeleBack = SELECT(0)
llResult = .T.
IF PARAMETERS() = 1
 llSeleBack = .T.
 SELECT (lAlias)
ENDIF
FOR IsBlankRec = 1 TO FCOUNT()
 lcFieldName = FIELD(IsBlankRec)
 IF ! empty( &lcFieldName )
  llResult = .F.
  EXIT
 ENDIF
ENDFOR
IF llSeleBack
 SELECT (lnSeleBack)
ENDIF
RETURN llResult 






FUNCTION gcrundoc
  **********************************************************************
  **  函数功能：打开任意文档
  **  调用值: tcdocument 要打开的文件名
  **  返回值: 无
  **********************************************************************
  **  该函数可以用它的默认的关联程序打开任何文档, 相当于在资源管理器中又击该文档时打开它的程序.
  **  用它来调用一个外部程序来打开一个文本文件, 一个 Word 或 Excel 文档, 一个图形文件等等.
  PARAMETERS tcdocument

  LOCAL lnresult

  DECLARE INTEGER ShellExecute ;
    IN SHELL32.DLL ;
    INTEGER nWinHandle, ;
    STRING cOperation, ;
    STRING cFileName, ;
    STRING cParameters, ;
    STRING cDirectory, ;
    INTEGER nShowWindow

  **获得 VFP 主窗口句柄 (该句柄将被 ShellExecute 使用)

  DECLARE INTEGER FindWindow ;
    IN WIN32API ;
    STRING cNull, ;
    STRING cWinName

  lnresult=shellexecute(findwindow( 0, _SCREEN.CAPTION), "Open", tcdocument, "", "", 1)

  ** 在值小于 32 时显示错误信息
  IF lnresult < 32
    DO CASE
    CASE lnresult=2
      WAIT WIND "错误的关联文件或 URL."
    CASE lnresult=31
      WAIT WIND "无关联文件."
    CASE lnresult=29
      WAIT WIND "不能启动应用程序."
    CASE lnresult=30
      WAIT WIND "应用程序已经打开."
    ENDCASE
  ENDIF
  RETURN
  ** -----------------------------------------






[转贴]DBF生成EXCEL文件

****************************************
*            生成EXCEL文件             *
*      许文远 1.0.1 2003.06.30         *
*      许文远 1.0   2003.06.28         *
*　　　　*
****************************************
FUNCTION ToExcel
LPARAMETERS ExcelFile,OutField,PageSet,OtherSet
*ExcelFile-生成的EXCEL文件名 (必需的参数)
*OutField-输出的字段 列1-字段名 列2-标题 列3-宽度(=-1为自动) 列4-格式符 (可省略)
*PageSet-页面设置 列1-设置的项目 列2-设置的值 (可省略,PageSet的可用值请看程序)
*OtherSet-其它设置 (可省略,OtherSet的可用值请看程序)

*使用本函数之前,请先切换到要输出的工作区;其次只支持字段,不支持表达式
*字段也不支持备注型和通用型
*如果用户正在使用EXCEL编辑同名的文件,或者将要生成的EXCEL文件被占用
*也会造成程序出错,使用本函数之前建议关闭EXCEL
 DO CASE 
 CASE PARAMETERS()=1
  STORE null TO OutField,PageSet,OtherSet 
 CASE PARAMETERS()=2
  STORE null TO PageSet,OtherSet
 CASE PARAMETERS()=3
  STORE null TO OtherSet
 ENDCASE 
 LOCAL i,OutFields,ExcelApp,ExcelAppRang

 FOR i=1 TO IIF(TYPE("OutField(1)")="U" OR ISNULL(OutField),0,ALEN(OutField,1))
  OutField(i,1)=UPPER(ALLTRIM(OutField(i,1)))
 NEXT 

 FOR i=1 TO IIF(TYPE("PageSet(1)")="U" OR ISNULL(PageSet),0,ALEN(PageSet,1))
  PageSet(i,1)=UPPER(ALLTRIM(PageSet(i,1)))
 NEXT 

 FOR i=1 TO IIF(TYPE("OtherSet(1)")="U" OR ISNULL(OtherSet),0,ALEN(OtherSet,1))
  OtherSet(i,1)=UPPER(ALLTRIM(OtherSet(i,1)))
 NEXT 

 OutFields=""
 FOR i=1 TO IIF(TYPE("OutField(1)")="U" OR ISNULL(OutField),0,ALEN(OutField,1))
  OutFields=OutFields+IIF(EMPTY(OutFields),"",",")+OutField(i,1)
 NEXT 
 IF ISNULL(OutField) OR OutField(1)="AUTO_SET" AND OutField(2)="-1" &&生成EXCEL文件
  COPY TO (ExcelFile) XL5 
 ELSE
  COPY TO (ExcelFile) FIELDS &OutFields XL5 
 ENDIF 

 ExcelApp=CREATEOBJECT("Excel.application") &&访问EXCEL
 If Type("ExcelApp")#"O"
  WAIT CLEAR 
  MessageBox( "访问Excel失败！请检查你的系统是否正确安装 Excel 软件！"+CHR(13)+CHR(13)+;
   "但已经生成未带格式的 Excel 文件:"+ExcelFile,48,"Excel不正常")
  RETURN .f.
 ENDIF
 ExcelApp.Visible =.f.
 ExcelApp.Caption ="生成EXCEL" &&标题
 ExcelApp.Workbooks.Open(ExcelFile) &&打开文件
 ExcelApp.Workbooks(1).ActiveSheet.Name="Test" &&工作表名
 ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).PageSetup &&页面设置对象
 FOR i=1 TO IIF(TYPE("PageSet(1)")="U" OR ISNULL(PageSet),0,ALEN(PageSet,1))
  DO CASE 
  CASE PageSet(i,1)=UPPER("PaperSize") &&纸张类型
   ExcelAppRang.PaperSize=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("Orientation") &&打印方向
   ExcelAppRang.Orientation=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("TopMargin") &&页顶空
   ExcelAppRang.TopMargin=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("BottomMargin") &&页底空
   ExcelAppRang.BottomMargin=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("LeftMargin") &&页左空
   ExcelAppRang.LeftMargin=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("RightMargin") &&页右空
   ExcelAppRang.RightMargin=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("HeaderMargin") &&页眉位置
   ExcelAppRang.HeaderMargin=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("FooterMargin") &&页脚位置
   ExcelAppRang.FooterMargin=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("PrintTitleRows") &&行标题
   ExcelAppRang.PrintTitleRows=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("PrintTitleColumns") &&列标题
   ExcelAppRang.PrintTitleColumns=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("LeftHeader") &&左页眉
   ExcelAppRang.LeftHeader=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("CenterHeader") &&中页眉
   ExcelAppRang.CenterHeader=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("RightHeader") &&右页眉
   ExcelAppRang.RightHeader=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("LeftFooter") &&左页脚
   ExcelAppRang.LeftFooter=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("CenterFooter") &&中页脚
   ExcelAppRang.CenterFooter=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("RightFooter") &&右页脚
   ExcelAppRang.RightFooter=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("CenterHorizontally") &&页面水平居中
   ExcelAppRang.CenterHorizontally=PageSet(i,2)
  CASE PageSet(i,1)=UPPER("CenterVertically") &&页面垂直居中
   ExcelAppRang.CenterVertically=PageSet(i,2)
  ENDCASE 
 NEXT 
 IF ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1"
  FOR i=1 TO FCOUNT()
   IF !ISNULL(OutField) AND ASCAN(OutField,UPPER(FIELD(i)))>0
    ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,i).value=OutField(ASCAN(OutField,UPPER(FIELD(i)))+1) &&标题
    *IF !ISNULL(OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)) AND TYPE("OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)")="N" AND OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)#-1
    * ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)
    *ENDIF 
    IF !ISNULL(OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)) AND !EMPTY(OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)) &&格式模版
     ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).NumberFormatLocal=OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)
    ENDIF 
   ENDIF 
  NEXT
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -