我的笔记.txt

田径运动会管理系统RAR 用VFP编写

                = FreeLibrary( hLibModule )
                Return .T.
            Endif
        Endif
        = FreeLibrary( hLibModule )
    Endif
    Return .F.
Endfunc

* -------------------------------------
* 获取 启动程序 路径文件名
* -------------------------------------
Function GetMyFileName ()
    Declare integer GetModuleFileName in kernel32 integer  hModule, string @ lpFilename, integer nSize
    Local lcFileName, lnLen
    lcFileName = SPACE(250)
    lnLen = GetModuleFileName (0, @lcFileName, LEN(lcFileName))
    Return Left(lcFileName, lnLen)
Endfunc

* -------------------------------------
* 获取 文件最后更新时间
* -------------------------------------
Function GetFileLastWriteTime ( tcFileName )
    #Define BYTE_2               256
    #Define OF_READ                0
    #Define OF_SHARE_DENY_NONE    64
    #Define HFILE_ERROR           -1
    #Define dwordPlus     4294967296
    Declare integer GetFileTime in kernel32 integer hFile, string @lpCreationTime, string @lpLastAccessTime, string @lpLastWriteTime
    Declare integer FileTimeToLocalFileTime in kernel32 string lpFileTime, string @lpLocalFileTime
    Declare integer FileTimeToSystemTime in kernel32 string FILETIME, string @SYSTEMTIME
    Declare integer OpenFile in kernel32 string lpFileName, string @lpReOpenBuff, integer wStyle
    Declare integer CloseHandle in kernel32 integer hObject

    Local lpCreationTime, lpLastAccessTime, lpLastWriteTime, lcFileName, hFile, FileTimeBuffer
    lpCreationTime = SPACE( 8 )
    lpLastAccessTime = SPACE( 8 )
    lpLastWriteTime = SPACE( 8 )
    lpReOpenBuff = Repli (CHR(0), 250)
    hFile = OpenFile (tcFileName, @lpReOpenBuff, OF_SHARE_DENY_NONE)
    = GetFileTime( hFile, @lpCreationTime, @lpLastAccessTime, @lpLastWriteTime )
    = CloseHandle (hFile)

    Local SystemTimeBuffer, FileTimeBuffer
    FileTimeBuffer = SPACE(8)
    = FileTimeToLocalFileTime( lpLastWriteTime, @FileTimeBuffer )
    SystemTimeBuffer = SPACE(16)
    fResult = FileTimeToSystemTime(FileTimeBuffer, @SystemTimeBuffer)

    If fResult = 0
        lptLastWriteTime = CToT( [1901.01.01 00:00:01] )
    Else
        lnYea = asc(SUBSTR(SystemTimeBuffer,  1, 1)) + (asc(SUBSTR(SystemTimeBuffer,  2, 1))* BYTE_2)
        lnMon = asc(SUBSTR(SystemTimeBuffer,  3, 1)) + (asc(SUBSTR(SystemTimeBuffer,  4, 1))* BYTE_2)
        lnDay = asc(SUBSTR(SystemTimeBuffer,  7, 1)) + (asc(SUBSTR(SystemTimeBuffer,  8, 1))* BYTE_2)
        lnHou = asc(SUBSTR(SystemTimeBuffer,  9, 1)) + (asc(SUBSTR(SystemTimeBuffer, 10, 1))* BYTE_2)
        lnMin = asc(SUBSTR(SystemTimeBuffer, 11, 1)) + (asc(SUBSTR(SystemTimeBuffer, 12, 1))* BYTE_2)
        lnSec = asc(SUBSTR(SystemTimeBuffer, 13, 1)) + (asc(SUBSTR(SystemTimeBuffer, 14, 1))* BYTE_2)
        lptLastWriteTime = CToT( ;
            padl(allt(str(INT(lnYea))),4,[0]) + [.] + ;
            padl(allt(str(INT(lnMon))),2,[0]) + [.] + ;
            padl(allt(str(INT(lnDay))),2,[0]) + [ ] + ;
            padl(allt(str(INT(lnHou))),2,[0]) + [:] + ;
            padl(allt(str(INT(lnMin))),2,[0]) + [:] + ;
            padl(allt(str(INT(lnSec))),2,[0]) )
    Endif
    Return lptLastWriteTime
Endfunc

* -------------------------------------












 
* ------------------------------------------------
* 程序: 播放媒体文件或文件列表
* 设计: 红雨
* 日期: 2003年10月19日
* ------------------------------------------------
* 调用示例:
* ------------------------------------------------
* 1、播放媒体文件(只播一次)
= PlayMicList( [Z:\OKSong\高胜美\记得我们有约.mpg], .F. )
Return

* 2、播放文件列表(循环播放)
Local lcSysPath
lcSysPath = addb(JustPath(SYS(16,1)))
= PlayMicList( FileToStr( addb(lcSysPath)+[PlayMicList.txt] ), .T. )

Return

* ------------------------------------------------
* 主体代码:
* ------------------------------------------------
Function PlayMicList( tcPlayListStr, tlISRePlayMic )
 * ------------------------------------------------
 * 功能: 主函数,播放媒体文件或文件列表串
 * 参数: tcPlayListStr - 播放文件列表字符串,文件间用回车换行符分隔
 *       tISRePlayMic  - 是否循环播放列表,默认为.T.
 * ------------------------------------------------
 If Type([tcPlayListStr])=[C]
  If !empt(tcPlayListStr)
   If VarType(_Screen.MicTime) = [O]
    _Screen.RemoveObject([MicTime])
   Endif
   _Screen.AddObject([MicTime], [MicTime])
   With _Screen.MicTime
    If Para()=2 and VarType(tlISRePlayMic) = [L]
     .ISRePlayMic = tlISRePlayMic
    Endif
    Local lcCR, lcList, lnFile, liFile, lcFile
    lcCR = Chr(13) + Chr(10)
    lcList = lcCR + tcPlayListStr + lcCR
    lnFile = Occu( lcCR, lcList ) - 1
    For liFile = 1 to lnFile
     lnBeg = at( lcCR, lcList, liFile ) + 2
     lnEnd = at( lcCR, lcList, liFile + 1 )
     lcFile = subs( lcList, lnBeg, lnEnd-lnBeg )
     If File(lcFile)
      If MicCanBeOpen(lcFile) > 0
       .nMicCount = .nMicCount + 1
       Dime .aMicList(.nMicCount)
       .aMicList(.nMicCount) = lcFile
      Endif
     Endif
    Endfor
    = SendMciString( [Close MICTEMP] )
    = SendMciString( [Close MICVFPPLAY] )
    .Enabled = .T.
   Endwith
  Endif
 Endif
Endfunc

Function MicCanBeOpen( tcFileName )
 tcFileName = iif(Type([tcFileName])=[C], tcFileName, [])
 Local lnMicLength
 lnMicLength = 0
 If SendMciString( [Open ] + GetShortFile(tcFileName) + [ Alias MICTEMP] )#[MicError]
  lnMicLength = Val( SendMciString([Status MICTEMP Length]) ) && 取媒体长度
  = SendMciString( [Close MICTEMP] )
 Endif
 Return lnMicLength
Endfunc

Function OpenAndPlayMicFile( tcPlayFile )
 tcPlayFile = Iif(Type([tcPlayFile])=[C],tcPlayFile,[])
 If !Empt(tcPlayFile) And File(tcPlayFile)
  Local lcShotFile, lnVideoHwnd
  lcShotFile = GetShortFile(tcPlayFile)
  = SendMciString( [Close MICVFPPLAY] )
  = SendMciString( [Open ] + lcShotFile + [ Alias MICVFPPLAY] )
  lnMicLength = Val(SendMciString( [Status MICVFPPLAY Length] ) )
  = SendMciString( [Play MICVFPPLAY From 0] )
 Endif
Endfunc

Function SendMciString( tcMCIcmd )
 Declare integer mciSendString     in WINMM String, String, integer,integer
 Declare integer mciGetErrorString in WINMM integer, String, integer
 Local lcRetStr, lcErrStr, lnRetVal
 lcRetStr = Space( 80)
 lnRetVal = mciSendString( tcMCIcmd, @lcRetStr, Len(lcRetStr), 0 )
 If lnRetVal = 0
  Return Trim(Strtran(lcRetStr,chr(0),[]))
 Else
  Return [MicError]
 Endif
Endfunc

Function GetShortFile( tcPathFileName )
 tcPathFileName = iif(Type([tcPathFileName])=[C],tcPathFileName,[])
 Local lcRetuShotFile, lnRetuShotFile
 Declare integer GetShortPathName in kernel32 String, String, integer
 lcRetuShotFile = Space(255)
 lnRetuShotFile = GetShortPathName(tcPathFileName, @lcRetuShotFile, Len(tcPathFileName))
 lcRetuShotFile = IIF(empt(lcRetuShotFile), tcPathFileName, Left(lcRetuShotFile, lnRetuShotFile) )
 Return lcRetuShotFile
Endfunc

Define CLASS MicTime AS Timer
 Interval = 1000
 Name = [MicTime]
 Enabled = .F.
 nMicCount = 0
 nMicvalue = 0
 ISPlayInit = .T.
 ISRePlayMic = .T.
 Dime aMicList(1)
 aMicList(1) = []
 Procedure Timer
  With This
   lnMicLength = Val(SendMciString( [Status MICVFPPLAY Length] ) )    && 取媒体总长度
   lnMicPosition = Val(SendMciString( [Status MICVFPPLAY Position]) ) && 取当前的播放位置
   If lnMicPosition >= lnMicLength
    = SendMciString( [Close MICVFPPLAY] )
    If .nMicCount = 0
     .Enabled = .F.
    Else
     If .ISPlayInit
         .nMicvalue = 1
      .ISPlayInit = .F.
      = OpenAndPlayMicFile( .aMicList(.nMicvalue) )
     Else
      If .nMicCount <= .nMicvalue
       If .ISRePlayMic
        .nMicvalue = 1
        = OpenAndPlayMicFile( .aMicList(.nMicvalue) )
       Else
        .Enabled = .F.
       Endif
      Else
       .nMicvalue = .nMicvalue + 1
       = OpenAndPlayMicFile( .aMicList(.nMicvalue) )
      Endif
     Endif
    Endif
   Endif
  Endwith
 Endproc
Enddefine
 







 技巧篇7：让注册表记住VFP应用程序的使用次数
注册表是Windows操作系统中保存系统的硬件信息、应用程序信息和用户信息的一个数据库，它为应用程序提供了保存参数设置的最佳场所。在Windows操作系统中，当我们运行“RegEdit.exe”文件，从打开的注册表编辑窗口中可以看出，注册表由左右两个部分组成： 左侧各项目的第一层称为注册表的主键，双击各主键时延伸出的各键称之为子键；窗口的右侧是各子键的键值，每一个子键都有其相应的默认值和用不同的键值名表示的键值（其中默认值的键值名为一空串）。

　　在VFP应用程序中读写注册表数据需借助WIN32API（即Windows 32位应用程序接口）函数，为了像使用其它VFP函数一样调用WIN32API函数，必须先用DECLARE命令对每一个被调用函数进行注册（声明），其格式为DECLARE [cFunctionType] FunctionName IN LibraryName [AS AliasName] ;

　　[cParamType1 [@] ParamName1,cParamType2 [@] ParamName2, ...]

　　其中各参数的意义为：①cFunctionType为函数的返回值类型，可是SHORT、INTEGER或LONG、SINGLE、DOUBLE、STRING之一，如果函数没有返回值，则省略cFunctionType；②FunctionName指出被调用WIN32API函数名，请注意大小写，否则VFP将在.DLL库（LibraryName）中搜索不到该函数而出错， 如果该函数名与VFP的函数同名，可用AS子句另取一个合法的VFP函数名；③LibraryName指定外部Windows .DLL的名称，如取WIN32API，则VFP就在KERNEL32.DLL, GDI32.DLL, USER32.DLL, MPR.DLL和ADVAPI32.DLL中搜索FunctionName；④cParamType指定各参数的类型，可为INTEGER或LONG、SINGLE、DOUBLE、STRING之一，在VFP中向函数传递参数的方式有两种：按值传递和按名（引用）传递，前者只把变量（也可为常数）的值传给函数，因而在函数内部不能修改该变量的值；后者是把变量（不能用常数）的地址传给函数，因而在函数内部可修改该变量的值，适用于需要在函数内部修改该变量的值或在变量中放置返回值的情况。VFP中如在变量名前加“@”表示按引用传递参数，不加“@”表示按值传递参数。至于本示例程序中各参数是按引用传递还是按值传递，从DECLARE命令和函数调用语句中一看便知。
　下面的示例程序每运行一次，就将注册表中HKEY_CURRENT_USER\SOFTWARE\LYTAPP子键的TimesForUse名下的值加1，直到运行12次为止：
* 各主键与一个整数（INTEGER）值相对应，即：

#DEFINE HKEY_CLASSES_ROOT bitset(0,31) &&-2147483648
#DEFINE HKEY_CURRENT_USER bitset(0,31)+1 &&-2147483647
#DEFINE HKEY_LOCAL_MACHINE bitset(0,31)+2 &&-2147483646
#DEFINE HKEY_USER bitset(0,31)+3 &&-2147483645
#DEFINE HKEY_CURRENT_CONFIG bitset(0,31)+5 &&-2147483643
#DEFINE HKEY_DYN_DATA bitset(0,31)+6 &&-2147483642

* 键值的数据类型：1-字符串，3-二进制，4-整数

#DEFINE REG_SZ 1
#DEFINE REG_BINARY 3
#DEFINE REG_DWORD 4

* 当以下API函数返回0时，操作成功。

DECLARE Integer RegOpenKey IN Win32API ;
Integer nHKey, String @cSubKey, Integer @nResult

DECLARE Integer RegCreateKey IN Win32API ;
Integer nHKey, String @cSubKey, Integer @nResult

DECLARE Integer RegSetvalueEx IN Win32API ;
Integer hKey, String lpszvalueName, Integer dwReserved,;
Integer fdwType, String lpbData, Integer cbData

DECLARE Integer RegQueryvalueEx IN Win32API ;
Integer nHKey, String lpszvalueName, Integer dwReserved,;
Integer @lpdwType,string @lpbData, Integer @lpcbData

* DECLARE Integer RegDeleteKey IN Win32API ;
* Integer nHKey, String @cSubKey

* DECLARE Integer RegDeletevalue IN Win32API ;
* Integer nHKey, String cSubKey

* DECLARE Integer RegCloseKey IN Win32API ;
* Integer nHKey

csubkey='Software\lytapp'
nresult=0 
if regopenkey(HKEY_CURRENT_USER,@csubkey,@nresult)#0 
RegCreateKey(HKEY_CURRENT_USER,csubkey,@nresult)
endif

* 在nresult中存放了指向子键“HKEY_CURRENT_USER\Software\lytapp”的长整数值

lpdwtype=0
lpbdata=space(256)
lpcbdata=len(lpbdata)
if RegQueryvalueEx(nresult,'TimesForUse',0,@lpdwtype,@lpbdata,@lpcbdata)=0
do case 
case lpdwtype=REG_SZ
lpbdata=left(lpbdata,lpcbdata-1)
if val(lpbdata)<12
lpbdata=alltrim(str(val(lpbdata)+1))
messagebox('本程序在未注册之前只能使用12次！'+CHR(13)+' 您现在是第'+ ;
lpbdata+'次使用本程序。')
lpbdata=lpbdata+chr(0)
cbdata=len(lpbdata)
RegSetvalueEx(nresult,'TimesForUse',0,REG_SZ,lpbdata,cbdata)
else
messagebox(" 程序已过期作废！"+CHR(13)+" 请与作者联系注册事宜。")
endif
case lpdwtype=REG_BINARY
messagebox('该键值为二进制数据。')
case lpdwtype=REG_DWORD
messagebox('该键值为长整数数据，请用 NN=0'+CHR(13)+'for i=1 to 4'+CHR(13)+ ;
'NN=NN+VAL(SUBSTR(lpbdata,i,1)*16^(2*i-2)'+CHR(13)+ ;
'endfor 读取此数值。')
otherwise
messagebox('未知数据！')
endcase
else
lpbdata='1'
messagebox('本程序在未注册之前只能使用12次！'+CHR(13)+' 您现在是第'+lpbdata+'次使用本程序。')
lpbdata=lpbdata+chr(0)
RegSetvalueEx(nresult,'TimesForUse',0,REG_SZ,lpbdata,2)
endif

　* 警告：当用户不熟悉注册表时最好不要修改其中的内容，否则，可能造成系统的崩溃。若用户想对注册表修改，建议修改前最好将注册表备份。