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

📄 mydate.bak

📁 田径运动会管理系统RAR 用VFP编写
💻 BAK
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
   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 
 ELSE
  FOR i=1 TO ALEN(OutField,1)
   IF !ISNULL(OutField(i,2)) AND !EMPTY(OutField(i,2)) &&标题名称
    ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,i).value=OutField(i,2)
   ENDIF 

   *IF !ISNULL(OutField(i,3)) AND TYPE("OutField(i,3)")="N" AND OutField(i,3)#-1 &&列宽
   * ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(i,3)
   *ENDIF 

   IF !ISNULL(OutField(i,4)) AND !EMPTY(OutField(i,4)) &&格式模版
    ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).NumberFormatLocal=OutField(i,4)
   ENDIF 
  NEXT 
 ENDIF 
 IF ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&选择标题行范围
  ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
   ExcelApp.Workbooks(1).Sheets(1).Application.Cells( 1,FCOUNT()))
 ELSE
  ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
   ExcelApp.Workbooks(1).Sheets(1).Application.Cells( 1,ALEN(OutField,1)))
 ENDIF
 ExcelAppRang.HorizontalAlignment=3 &&水平居中
 ExcelAppRang.VerticalAlignment=2 &&垂直居中
 ExcelAppRang.Font.Bold = .t.
 IF ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&选择表格范围
  ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
   ExcelApp.Workbooks(1).Sheets(1).Application.Cells(RECCOUNT()+1,FCOUNT()))
 ELSE
  ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
   ExcelApp.Workbooks(1).Sheets(1).Application.Cells(RECCOUNT()+1,ALEN(OutField,1)))
 ENDIF
 IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("FontSize"))#0 &&字体大小
  ExcelAppRang.Font.Size=OtherSet(ASCAN(OtherSet,UPPER("FontSize"))+1)
 ELSE 
  ExcelAppRang.Font.Size=10
 ENDIF 
 IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("FontName"))#0 &&字体
  ExcelAppRang.Font.Name=OtherSet(ASCAN(OtherSet,UPPER("FontName"))+1)
 ELSE 
  ExcelAppRang.Font.Name="宋体"
 ENDIF 
 IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("LineStyle"))#0 &&表格线的类型
  STORE OtherSet(ASCAN(OtherSet,UPPER("LineStyle"))+1) TO 
   ExcelAppRang.Borders(1).LineStyle,;
   ExcelAppRang.Borders(2).LineStyle,;
   ExcelAppRang.Borders(3).LineStyle,;
   ExcelAppRang.Borders(4).LineStyle
 ELSE
  STORE 1 TO 
   ExcelAppRang.Borders(1).LineStyle,;
   ExcelAppRang.Borders(2).LineStyle,;
   ExcelAppRang.Borders(3).LineStyle,;
   ExcelAppRang.Borders(4).LineStyle
 ENDIF 
 IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("Weight"))#0 &&表格线的宽度,当LineStyle=1时有效
  STORE OtherSet(ASCAN(OtherSet,UPPER("Weight"))+1) TO 
   ExcelAppRang.Borders(1).Weight,;
   ExcelAppRang.Borders(2).Weight,;
   ExcelAppRang.Borders(3).Weight,;
   ExcelAppRang.Borders(4).Weight
 ELSE
  STORE 2 TO 
   ExcelAppRang.Borders(1).Weight,;
   ExcelAppRang.Borders(2).Weight,;
   ExcelAppRang.Borders(3).Weight,;
   ExcelAppRang.Borders(4).Weight
 ENDIF 

 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 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)
   ELSE
    ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).AutoFit
   ENDIF 
  NEXT 
 ELSE
  FOR i=1 TO ALEN(OutField,1)
   IF OutField( i, 3)=-1
    ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).AutoFit
   ELSE 
    ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth=OutField( i, 3)
   ENDIF 
  NEXT 
 ENDIF 
 ExcelApp.Workbooks(1).Save() &&保存
 ExcelApp.Quit &&关闭
 RELEASE ExcelApp,ExcelAppRang
RETURN .t.








**************************************
*名称：取得硬盘序列号
*功能：取得硬盘序列号
*使用：drvinfo("C:",3)
*返回：指定硬盘序列号
*作者：老九改进
*************************************
FUNC drvinfo
PARAMETERS c_drv, n_opt
If Empty(c_drv)
   Return .F.
Endif
If Empty(n_opt)
   Return ""
Endif
DECL INTEGER GetVolumeInformation IN Win32API AS _GetVolumeInformation_ STRING @, STRING @, INTEGER, INTEGER @, INTEGER @, INTEGER @, STRING @, INTEGER
DECL INTEGER GetDriveType IN Win32API AS _GetDriveType_ STRING @

lcrootpathname = Allt(c_drv)+"\"
ndrivetype = _getdrivetype_(@lcrootpathname)
DO CASE
     CASE ndrivetype=1
          cdrivetype = "驱动器未找到"
     CASE ndrivetype=2
          cdrivetype = "可移动驱动器"
     CASE ndrivetype=3
          cdrivetype = "固定驱动器"
     CASE ndrivetype=4
          cdrivetype = "网络驱动器"
     CASE ndrivetype=5
          cdrivetype = "光盘驱动器"
     CASE ndrivetype=6
          cdrivetype = "虚拟驱动器"
     OTHE
          cdrivetype = "无法确定的驱动器" 
ENDC
STOR SPACE(256) TO lcvolumenamebuffer, lcfilesystemnamebuffer
STOR 256 TO lnvolumenamesize, lnfilesystemnamesize
STOR 0 TO lnvolumeserialnumber, lnmaximumcomponentlength, lnfilesystemflags
lnerror = _getvolumeinformation_(@lcrootpathname,@lcvolumenamebuffer,lnvolumenamesize,@lnvolumeserialnumber,@lnmaximumcomponentlength,@lnfilesystemflags,@lcfilesystemnamebuffer,lnfilesystemnamesize)
Do Case
   Case n_opt=1
        return Upper(lcrootpathname)   &&驱动器名 
   Case n_opt=2
        Return LEFT(lcvolumenamebuffer, AT(CHR(0), lcvolumenamebuffer)-1)   &&驱动器卷标
   Case n_opt=3
        Return allt(str(ABS(lnvolumeserialnumber)))   &&驱动器序列号
   Case n_opt=4
        Return cDrivetype   &&驱动器类型
EndCase














检查 yyyymm 输入 是否有效（如199912，200408）
*********************** yymm 检查 ***************************
FUNCTION CHK_YYMM
PARAMETER tcYYMM   &&tcYYMM 6位年月字符,如199906
LOCAL lcYY, lcMM
IF LEN(ALLT(tcYYMM))<6
 lcYY = LEFT(ALLT(tcYYMM),2)
 tcYYMM = IIF(VAL(lcYY)>70,"19"+ALLT(tcYYMM),"20"+ALLT(tcYYMM))
ENDIF
lcYY = LEFT(tcYYMM,4)
lcMM = RIGHT(tcYYMM,2)
IF VAL(lcYY)<1970 OR VAL(lcYY)>2070 OR VAL(lcMM)<1 OR VAL(lcMM)>12
 = MESSAGEBOX("日期非法！",0+16+0,"Error")
 tcYYMM = cStartYM
ENDIF
RETURN tcYYMM




* -------------------------------------
* 获取本地机器名
* -------------------------------------
Function GetLocalHostName32
    #Define WSADATA_SIZE  398
    #Define WS_VERSION    514
    #Define SOCKET_ERROR  -1
    Declare integer WSAStartup in ws2_32 integer wVerRq, string @lpWSAData
    Local lcWSADATA
    lcWSADATA = Repli(CHR(0), WSADATA_SIZE)
    If WSAStartup (WS_VERSION, @lcWSADATA) = 0
        Declare integer gethostname in ws2_32 string @cName, integer nNamelen
        Local lcBuffer, lnResult, lcReturn
        lcBuffer = SPACE(250)
        lnResult = gethostname (@lcBuffer, LEN(lcBuffer))
        lcReturn = IIF(lnResult=0, SUBSTR(lcBuffer, 1,AT(CHR(0),lcBuffer)-1), [] )
        Declare integer WSACleanup in ws2_32
        = WSACleanup()
        Return lcReturn
    Else
        Return []
    Endif
Endfunc

* -------------------------------------
* 根据 IP 获取 Mac 地址
* -------------------------------------
Function GetHostMac32 ( tcHostname )
    tcHostname = iif(Type([tcHostname])=[C],tcHostname,[])
    #Define WSADATA_SIZE  398
    #Define WS_VERSION    514
    Declare integer WSAStartup in ws2_32 integer wVerRq, string @lpWSAData

    * 初始化 SOCKET
    Local lcMacStr, lcWSADATA
    lcMacStr = [00-00-00-00-00-00]
    lcWSADATA = Repli(CHR(0), WSADATA_SIZE)
    If WSAStartup (WS_VERSION, @lcWSADATA) = 0
        * 发送ARP查询包获得远程MAC地址
        Declare integer inet_addr in ws2_32 string cp
        Declare integer SendARP in Iphlpapi integer nHost, integer unsigned, string @, integer @
        Local lnRemoteAddr, lcMacAddress, iRet, iMac
        lnRemoteAddr = inet_addr( tcHostname )
        lcMacAddress = Space(6)
        iRet = SendARP(lnRemoteAddr, 0, @lcMacAddress, 6)
        If iRet = 0
            lcMacStr = []
            For iMac = 1 to 6
                lcMacStr = lcMacStr + [-] + Right(Transform(asc(subs(lcMacAddress,iMac,1)),[@0]),2)
            Endfor
            lcMacStr = subs(lcMacStr,2)
        Endif
        Declare integer WSACleanup in ws2_32
        = WSACleanup()
    Endif
    Return lcMacStr
Endfunc

* -------------------------------------
* 根据名称获取 IP 地址
* -------------------------------------
Function GetHostIP32 ( tcHostname )
    #Define WSADATA_SIZE  398
    #Define WS_VERSION    514
    #Define HOSTENT_SIZE  16
    Declare integer WSAStartup in ws2_32 integer wVerRq, string @lpWSAData
    Local lcWSADATA, lcReturn
    lcReturn = []
    lcWSADATA = Repli(CHR(0), WSADATA_SIZE)
    If WSAStartup (WS_VERSION, @lcWSADATA) = 0
        Local lnHOSTENTptr, lcHOSTENT, lnAddrlistPtr
        Declare integer gethostbyname in ws2_32 string hostname
        lnHOSTENTptr = gethostbyname(tcHostname)
        If lnHOSTENTptr <> 0
            lcHOSTENT = GetMemBuf (lnHOSTENTptr, HOSTENT_SIZE)
            Local lcReturn, lnAddrlistPtr, lnDataAddress
            lnAddrlistPtr = buf2dword( SUBSTR(lcHOSTENT, 13,4) )
            lnDataAddress = buf2dword( GetMemBuf (lnAddrlistPtr, 4) )
            If lnDataAddress <> 0
                lcACSAddress = GetMemBuf(lnDataAddress, 4)
                Local iIP
                For iIP = 1 TO 4
                    lcReturn = lcReturn + [.] + ltrim(STR(asc(Subs(lcACSAddress, iIP,1))))
                Endfor
                lcReturn = Subs(lcReturn,2)
            Endif
        Endif
        Declare integer WSACleanup in ws2_32
        = WSACleanup()
    Endif
    Return lcReturn
Endfunc

* -------------------------------------
* 根据 IP 地址获取名称
* -------------------------------------
Function GetHostName32 ( tcHostIP )
    #Define WSADATA_SIZE  398
    #Define WS_VERSION    514
    #Define HOSTENT_SIZE   16
    Local lcWSADATAln, lcReturn
    lcReturn = []
    lcWSADATA = Repli(CHR(0), WSADATA_SIZE)
    Declare integer WSAStartup in ws2_32 integer wVerRq, string @lpWSAData
    If WSAStartup (WS_VERSION, @lcWSADATA) = 0
        #Define AF_UNSPEC      0  && unspecified
        #Define AF_UNIX        1  && local to host (pipes, portals)
        #Define AF_inET        2  && internetwork: UDP, TCP, etc.
        #Define AF_IMPLinK     3  && arpanet imp addresses
        #Define AF_PUP         4  && pup protocols: e.g. BSP
        #Define AF_CHAOS       5  && mit CHAOS protocols
        #Define AF_IPX         6  && IPX and SPX
        #Define AF_NS          6  && XEROX NS protocols
        #Define AF_ISO         7  && ISO protocols
        #Define AF_OSI         7  && OSI is ISO
        #Define AF_ECMA        8  && european computer manufacturers
        #Define AF_DATAKIT     9  && datakit protocols
        #Define AF_CCITT      10  && CCITT protocols, X.25 etc
1234

⌨️ 快捷键说明

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