mydate.bak

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

* -------------------------------------
* 完整的长文件名 -> DOS短文件名
* -------------------------------------
Function GetShortName ( tcPathName )
    tcPathName = iif(Type([tcPathName])=[C], tcPathName, [])
    Declare integer GetShortPathName in kernel32.dll String lpszLongPath, String @lpszShortPath, integer cchBuffer
    Private lpBuffer, nSizeRet
    #Define MAX_PATH 260
    lpBuffer = SPACE( MAX_PATH )
    nSizeRet = GetShortPathName( tcPathName, @lpBuffer, LEN(lpBuffer) )
    If nSizeRet <> 0
        lpBuffer = PADR(lpBuffer, nSizeRet)
    Endif
    Return allt(lpBuffer)
Endfunc

* -------------------------------------
* DOS短文件名 -> 完整的长文件名
* -------------------------------------
Function GetLongName( tcPathName )
    tcPathName = iif(Type([tcPathName])=[C], tcPathName, [])
    Declare integer GetLongPathName in vb5stkit.dll String lpszShortPath, String @lpszLongPath, integer cchBuffer
    Private lpBuffer, nSizeRet
    #Define MAX_PATH 260
    nSizeRet = 0
    lpBuffer = SPACE( MAX_PATH )
    nSizeRet = GetLongPathName( tcPathName, @lpBuffer, LEN(lpBuffer) )
    If nSizeRet <> 0
        lpBuffer = PADR(lpBuffer, nSizeRet)
    Endif
    Return allt(lpBuffer)
Endfunc

* -------------------------------------
* 获得文件的默认打开方式(程序)
* -------------------------------------
Function GetOpenFileExec ( tcPathFileName )
    tcPathFileName = IIF(TYPE([tcPathFileName])=[C], tcPathFileName, [])
    Local lpBuffer, lnRetuEr
    #Define MAX_PATH 260
    lpBuffer = SPACE( MAX_PATH )
    If !empt(tcPathFileName) AND FILE(tcPathFileName)
        Declare Integer FindExecutable IN shell32 String lpFile, String lpDirectory, String @lpResult
        lnRetuEr = FindExecutable( tcPathFileName, [], @lpBuffer )
        If lnRetuEr > 32
            lnRetuEr = Left(lpBuffer, AT(CHR(0), lpBuffer)-1)
        Endif
    Endif
    Return allt(lpBuffer)
Endfunc

* -------------------------------------
* 动态注册(dll、ocx)控件
* -------------------------------------
Function DllRegister ( lpLibFileName, isReg )
    isReg = IIF(TYPE([isReg])=[U], .T., isReg)
    lpProcName = IIF(isReg, "DllRegisterServer", "DllUnregisterServer" )
    Declare integer LoadLibrary in kernel32 string lpLibFileName
    Declare integer FreeLibrary in kernel32 integer hLibModule
    Declare integer GetProcAddress in kernel32 integer hModule, string lpProcName
    Declare integer CallWindowProc in user32 integer lpPrevWndFunc, integer hwnd, integer Msg, integer wParam, integer lParam

    Local hLibModule, lnAddress
    hLibModule = LoadLibrary( lpLibFileName )
    If hLibModule # 0
        lnAddress = GetProcAddress( hLibModule, lpProcName )
        If lnAddress # 0
            If CallWindowProc( lnAddress, 0,0,0,0) = 0
                = 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