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

📄 mydate.bak

📁 田径运动会管理系统RAR 用VFP编写
💻 BAK
📖 第 1 页 / 共 4 页
字号:
        #Define AF_SNA        11  && IBM SNA
        #Define AF_DECnet     12  && DECnet
        #Define AF_DLI        13  && Direct data link interface
        #Define AF_LAT        14  && LAT
        #Define AF_HYLinK     15  && NSC Hyperchannel
        #Define AF_APPLETALK  16  && AppleTalk
        #Define AF_NETBIOS    17  && NetBios-style addresses
        #Define AF_VOICEVIEW  18  && VoiceView
        #Define AF_FIREFOX    19  && FireFox
        #Define AF_UNKNOWN1   20  && Somebody is using this!
        #Define AF_BAN        21  && Banyan
        #Define AF_MAX        22
        Local lnIP, lnHOSTENTptr, lcHOSTENT
        Declare integer gethostbyaddr in ws2_32 integer @addr, integer len, integer type
        Declare integer inet_addr in ws2_32 string cp
        lnIP = inet_addr( tcHostIP )
        lnHOSTENTptr = gethostbyaddr(@lnIP, 4, AF_inET)
        If lnHOSTENTptr # 0
            #Define HOSTENT_SIZE  16
            lcHOSTENT = GetMemBuf (lnHOSTENTptr, HOSTENT_SIZE)
            lcReturn = GetMemBuf( buf2dword(SUBSTR(lcHOSTENT, 1,4)), 250)
            lcReturn = SUBSTR(lcReturn, 1, AT(CHR(0),lcReturn)-1)
        Endif
        Declare integer WSACleanup in ws2_32
        = WSACleanup()
    Endif
    Return lcReturn
Endfunc

* -------------------------------------
* 枚举网上邻居计算机
* -------------------------------------
Function NetEnumResource ( tcTableName, lplIsGetIP )
    * 相当于 !/n COMMAND.COM /C net view>c:\Temp\NetComp.txt
    tcTableName = IIF(TYPE([tcTableName])=[C], tcTableName, [NetEnumCompTable])
    lplIsGetIP = IIF(TYPE([lplIsGetIP])=[L], lplIsGetIP, .F. )
    Create CURSOR (tcTableName) ( LocalName C(254), RemoteName C(254), CompComment C(254), CompProvider C(254), CompIPaddr C(15) )
    #Define RESOURCE_CONNECTED        0x1          && 枚举已连接的资源
    #Define RESOURCE_GLOBALNET        0x2          && 枚举所有资源
    #Define RESOURCE_REMEMBERED       0x3          && 只枚举永久性连接
    #Define RESOURCE_RECENT           0x4
    #Define RESOURCE_CONTEXT          0x5
    #Define RESOURCEUSAGE_ALL         0x0          && 枚举所有资源
    #Define RESOURCEUSAGE_CONNECTABLE 0x1          && 只枚举那些能够连接的资源
    #Define RESOURCEUSAGE_CONTAinER   0x2          && 只枚举包含了其他资源的资源
    #Define RESOURCEUSAGE_ATTACHED    0x10
    #Define RESOURCETYPE_ANY          0x0          && 枚举所有类型的网络资源
    #Define RESOURCETYPE_DISK         0x1          && 枚举磁盘资源
    #Define RESOURCETYPE_PRinT        0x2          && 枚举打印资源
    #Define RESOURCETYPE_UNKNOWN      0xFFFF       && 不知道
    #Define RESOURCEDISPLAYTYPE_DOMAin   1
    #Define RESOURCEDISPLAYTYPE_SERVER   2
    #Define RESOURCEDISPLAYTYPE_GROUP    5
    #Define RESOURCEDISPLAYTYPE_NETWORK  6
    #Define RESOURCEDISPLAYTYPE_ROOT     7
    #Define NETRESOURCE_SIZE            32
    Declare integer WNetOpenEnum in mpr.dll ;
        integer dwScope , ;
        integer dwType , ;
        integer dwUsage , ;
        string  @lpNetResource , ;
        integer @lphEnum
    Declare integer WNetEnumResource in mpr.dll ;
        integer hEnum , ;
        integer @lpcCount , ;
        string  @lpBuffer , ;
        integer @lpBufferSize
    Declare integer WNetCloseEnum in mpr.dll  ;
        integer hEnum
    Local lhEnum
    lhEnum = 0
    If WNetOpenEnum( RESOURCE_CONTEXT, RESOURCETYPE_ANY, 0, 0, @lhEnum ) = 0
        Local lnCount, lnBufferSize, lcBuffer, i资源
        lnCount = -1
        lnBufferSize = 16384
        lcBuffer = Repli( CHR(0), lnBufferSize )
        If WNetEnumResource( lhEnum, @lnCount, @lcBuffer, @lnBufferSize ) = 0
            Local LCENTRY, lnScope, lnType, lnDisplayType, lnUsage, lcLocalName, lcRemoteName, lcComment, lcProvider
            For i资源 = 1 TO lnCount
                LCENTRY = Subs( lcBuffer, (i资源-1)*32+1, 32)
                lnScope       = buf2dword(SUBSTR(LCENTRY, 01, 4))
                lnType        = buf2dword(SUBSTR(LCENTRY, 05, 4))
                lnDisplayType = buf2dword(SUBSTR(LCENTRY, 09, 4))
                lnUsage       = buf2dword(SUBSTR(LCENTRY, 13, 4))
                lcLocalName   = mem2str(buf2dword(SUBSTR(LCENTRY, 17, 4)))
                lcRemoteName  = mem2str(buf2dword(SUBSTR(LCENTRY, 21, 4)))
                lcComment     = mem2str(buf2dword(SUBSTR(LCENTRY, 25, 4)))
                lcProvider    = mem2str(buf2dword(SUBSTR(LCENTRY, 29, 4)))
                *Wait Window ([/]+lcRemoteName+[/]) at 1,1 TimeOut 1
                If !empt(lcRemoteName)
                    Insert Into (tcTableName) values ( lcLocalName, Strt(allt(lcRemoteName), [\\], []), ;
                        lcComment, lcProvider, iif(lplIsGetIP, GetHostIP32( Strt(allt(lcRemoteName), [\\], []) ), []) )
                Endif
            Endfor
        Endif
        = WNetCloseEnum( lhEnum )
    Endif
Endfunc

Function mem2str ( lpnMemBlock )
    #Define BUFFER_SIZE  254
    If lpnMemBlock = 0
        Return []
    Endif
    Local lnPtr, lcResult, lcBuffer, LNPOS
    lnPtr = lpnMemBlock
    lcResult = []
    Do WHILE .T.
        lcBuffer = GetMemCpy( lnPtr, BUFFER_SIZE )
        LNPOS = AT(CHR(0), lcBuffer)
        If LNPOS > 0
            lcResult = lcResult + SUBSTR(lcBuffer, 1, LNPOS-1)
            Return  lcResult
        Else
            lcResult = lcResult + lcBuffer
            lnPtr = lnPtr + BUFFER_SIZE
        Endif
    Enddo
Endfunc

Function GetMemBuf ( lnAddr, lnBufsize )
    Declare RtlMoveMemory in kernel32 As Heap2Str string @Dest, integer Src, integer nLength
    Local lcBuffer
    lcBuffer = Repli(CHR(0), lnBufsize)
    = Heap2Str (@lcBuffer, lnAddr, lnBufsize)
    Return  lcBuffer
Endfunc

Function GetMemCpy ( lnAddr, lnBufsize )
    Declare lstrcpyn in kernel32 As Heap2Str string @Dest, integer Src, integer nLength
    Local lcBuffer
    lcBuffer = Repli(CHR(0), lnBufsize)
    = Heap2Str (@lcBuffer, lnAddr, lnBufsize)
    Return  lcBuffer
Endfunc

Function buf2dword (lcBuffer)
    Return asc(SUBSTR(lcBuffer, 1,1)) + ;
        asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
        asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
        asc(SUBSTR(lcBuffer, 4,1)) * 16777216
Endfunc












获取操作系统版本
* -------------------------------------
Function GetOSVer ( )
    Declare integer GetVersionEx in kernel32 string @lpVersioninformation
    OsVersioninfo = int2Str(148) + replicate(CHR(0), 144)
    = GetVersionEx(@OsVersioninfo)
    Return Str2int(SUBSTR(OsVersioninfo, 17, 4))
Endfunc

Function int2Str
    Lparameters lnLongVal
    Private i, retustr
    retustr = []
    For i = 24 TO 0 Step -8
        retustr = CHR(int(lnLongVal/(2^i))) + retustr
        lnLongVal = mod(lnLongVal, (2^i))
    Next
    Return retustr
Endfunc

Function Str2int
    Lparameters tcLongStr
    Private i, RetuVal
    RetuVal = 0
    For i = 0 TO 24 Step 8
        RetuVal = RetuVal + (asc(tcLongStr) * (2^i))
        tcLongStr = RIGHT(tcLongStr, LEN(tcLongStr) - 1)
    Next
    Return RetuVal
Endfunc

* -------------------------------------
* 获得操作系统的安装目录
* -------------------------------------
Function GetWindowsDir ()
    Declare integer GetWindowsDirectory in kernel32 string @lpBuffer, integer nSize
    Local lpBuffer, nSizeRet
    #Define MAX_PATH 260
    lpBuffer = SPACE( MAX_PATH )
    nSizeRet = GetWindowsDirectory (@lpBuffer, LEN(lpBuffer))
    If nSizeRet <> 0
        lpBuffer = SUBSTR (lpBuffer, 1, nSizeRet)
    Endif
    Return allt(lpBuffer)
Endfunc

* -------------------------------------
* 获得操作系统的系统目录
* -------------------------------------
Function GetSystemDir ( )
    Declare integer GetSystemDirectory in kernel32 string @lpBuffer, integer nSize
    Local lpBuffer, nSizeRet
    #Define MAX_PATH 260
    lpBuffer = SPACE( MAX_PATH )
    nSizeRet = GetSystemDirectory (@lpBuffer, LEN(lpBuffer))
    If nSizeRet <> 0
        lpBuffer = SUBSTR (lpBuffer, 1, nSizeRet)
    Endif
    Return allt(lpBuffer)
Endfunc

* -------------------------------------
* 获得 Windows 登录用户的临时目录
* -------------------------------------
Function GetUserTempDir ( )
    Declare Integer GetTempPath in kernel32 Integer nBufferLength, String @lpBuffer
    Local lpBuffer, nSizeRet
    #Define MAX_PATH 260
    lpBuffer = SPACE( MAX_PATH )
    nSizeRet = GetTempPath( LEN(lpBuffer), @lpBuffer )
    If nSizeRet <> 0
        lpBuffer = PADR(lpBuffer, nSizeRet)
    Endif
    Return allt(lpBuffer)
Endfunc

* -------------------------------------
* 获取“我的文档”路径
* -------------------------------------
Function GetMyDocuments ( )
    Local IsOK, lcRetu, lcOldonError, loWshShell
    IsOK = .T.
    lcRetu = []
    lcOldonError = ON([Error])
    On Error IsOK = .F.
    loWshShell = CREATEOBJECT("WScript.Shell")
    lcRetu = loWshShell.SpecialFolders("MyDocuments")
    On Error &lcOldonError.
    Return lcRetu
Endfunc

* -------------------------------------
* 获取系统相关路径
* 调用: ? [我的文档: ->], GetWinSystemDir( 0x0005 )
* -------------------------------------
Function GetWinSystemDir ( tnFolderID, tlCreateNew )
    #Define SHGFP_TYPE_CURRENT        0x0000 && 当前路径
    #Define SHGFP_TYPE_DEFAULT        0x0001 && 默认目录
    #Define CSIDL_PERSONAL             0x0005 && \My Documents
    #Define CSIDL_APPDATA              0x001A && \<user name>\Application Data
    #Define CSIDL_PROGRAM_FILES_COMMON 0x002B && \Program Files\Common
    #Define CSIDL_LOCAL_APPDATA        0x001C && \<user name>\Local Settings\Applicaiton Data (non roaming)
    #Define CSIDL_COMMON_APPDATA       0x0023 && \<All Users>\Application Data
    #Define CSIDL_WINDOWS              0x0024 && \Windows
    #Define CSIDL_SYSTEM               0x0025 && \<Windows>\System
    #Define CSIDL_PROGRAM_FILES        0x0026 && \Program Files
    #Define CSIDL_FLAG_CREATE          0x8000 && 不存在则创建文件夹

    If Vartype(tnFolderID)#"N"
        Return []
    Endif
    Local lcFolder, lnFolder
    lnFolder = tnFolderID
    If Vartype(tlCreateNew)=[L] AND tlCreateNew
        lnFolder = lnFolder + CSIDL_FLAG_CREATE
    Endif
    lcFolder = SPACE(260)
    Declare Integer SHGetFolderPath In SHFolder ;
        Integer hwndOwner, ;
        Integer nFolder, ;
        Integer hToken, ;
        Integer dwFlags, ;
        String  @pszPath
    If SHGetFolderPath(0, lnFolder, 0, SHGFP_TYPE_CURRENT, @lcFolder) # 0
        Return []
    Else
        Return Allt(Chrtran(lcFolder ,CHR(0),[]))
    Endif
Endfunc

* -------------------------------------
* 获取系统相关路径
* 调用: ? [我的文档: ->], GetWinSysFolder(5)
* -------------------------------------
Function GetWinSysFolder( tnFolderID )
    #Define ZSM_PROGRAMS                 2 &&Program Groups Folder
    #Define ZSM_PERSONAL                 5 &&Personal Documents Folder
    #Define ZSM_FAVORITES                6 &&Favorites Folder
    #Define ZSM_STARTUP                  7 &&Startup Group Folder
    #Define ZSM_RECENT                   8 &&Recently Used Documents Folder
    #Define ZSM_SENDTO                   9 &&Send To Folder
    #Define ZSM_STARTMENU               11 &&Start Menu Folder
    #Define ZSM_DESKTOPDIRECTORY        16 &&Desktop Folder
    #Define ZSM_NETHOOD                 19 &&Network Neighborhood Folder
    #Define ZSM_TEMPLATES               21 &&Document Templates Folder
    #Define ZSM_COMMON_STARTMENU        22 &&Common Start Menu Folder
    #Define ZSM_COMMON_PROGRAMS         23 &&Common Program Groups Folder
    #Define ZSM_COMMON_STARTUP          24 &&Common Startup Group Folder
    #Define ZSM_COMMON_DESKTOPDIRECTORY 25 &&Common Desktop Folder
    #Define ZSM_APPDATA                 26 &&Application Data Folder
    #Define ZSM_PRINTHOOD               27 &&Printers Folder
    #Define ZSM_COMMON_FAVORITES        31 &&Common Favorites Folder
    #Define ZSM_INTERNET_CACHE          32 &&Temp. Internet Files Folder
    #Define ZSM_COOKIES                 33 &&Cookies Folder
    #Define ZSM_HISTORY                 34 &&History Folder

    If Vartype(tnFolderID)#"N"
        Return []
    Endif
    Local lcFolder
    Declare SHGetSpecialFolderPath IN Shell32 ;
        Integer hwndOwner, ;
        String @cSpecialFolderPath, ;
        Integer nWhichFolder
    lcFolder = Space(260)
    = SHGetSpecialFolderPath( 0, @lcFolder, tnFolderID )
    lcFolder = Allt(Chrtran(lcFolder ,CHR(0),[]))
    Return lcFolder
Endfunc

⌨️ 快捷键说明

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