module1.bas

计量器具管理系统

Attribute VB_Name = "Module1"
Public Conn As New ADODB.Connection
Public Czybh As String
Public Czymc As String
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Public log As Boolean
Sub Main()
    Call xtzcjc
    Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\MEMS.mdb;Persist Security Info=False"
    Conn.Open
''    MDIForm1.Show
MainForm.Show
End Sub
Public Function GetJdrq(Bh As String) As Date
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    '''检定信息
    rst.Open "select max(bcjdrq) as jdrq from jlqjjd where bh='" & Bh & "'", Conn, adOpenStatic, adLockReadOnly
    If IsNull(rst!jdrq) = False Then
        GetJdrq = rst!jdrq
    Else
        rst.Close
        rst.CursorLocation = adUseClient
        rst.Open "select jdrq  from jlqjxx where bh='" & Bh & "'", Conn, adOpenStatic, adLockReadOnly
        If rst.EOF = False Then
            GetJdrq = rst!jdrq
        Else
            GetJdrq = CDate("1980-01-01")
        End If
    End If
End Function
Public Function GetXcJdrq(Bh As String) As Date
    Dim D1 As Date
    Dim Zqdw As String
    Dim Jdzq As Integer
    Dim n As Integer
    Dim y As Integer
    Dim r As Integer
    D1 = GetJdrq(Bh)
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select *  from jlqjxx where bh='" & Bh & "'", Conn, adOpenStatic, adLockReadOnly
    If rst.EOF = False Then
        Zqdw = rst!Zqdw
        Jdzq = rst!Jdzq
        Select Case rst!Zqdw
            Case "天"
                GetXcJdrq = D1 + Jdzq
                
            Case "年"
                n = Year(D1) + Jdzq
                y = Month(D1)
                r = Day(D1)
                GetXcJdrq = CDate(Format(CStr(n), "0000") & "-" & Format(CStr(y), "00") & "-" & Format(CStr(r), "00"))
            Case "月"
                n = Year(D1)
                y = Month(D1) + Jdzq
                Do While y > 12
                    y = y - 12
                    n = n + 1
                Loop
                r = Day(D1)
                GetXcJdrq = CDate(Format(CStr(n), "0000") & "-" & Format(CStr(y), "00") & "-01")
                GetXcJdrq = GetXcJdrq + (r - 1)
        End Select
    Else
        GetXcJdrq = CDate("1980-01-01")
        Exit Function
    End If

End Function

 
Sub xtzcjc()
  Dim yjxt As String '开始使用时间
  Dim zcmm As String
  Dim rq As Date
  Dim aa As String
  
  rq = Date
  yjxt = GetSetting("ywsoft", "ywjcy", "yjxt", "")
  zcmm = GetSetting("ywsoft", "ywjcy", "zcm", "")
  If zcmm = "" Then
      If yjxt = "" Then
         SaveSetting "ywsoft", "ywjcy", "yjxt", Format(rq, "yyyy-mm-dd")
      Else
         If (CDate(rq) - CDate(yjxt)) >= 100 Then
             aa = MsgBox("试用期已到，请向远望软件技术有限公司注册！ 现在进行注册吗？", vbYesNo + vbQuestion + vbDefaultButton1, "远望软件提示")
             Select Case aa
             Case 6
                 Frm注册.Show 1
             Case 7
                End
                
                
             End Select
             zcmm = GetSetting("ywsoft", "ywjcy", "zcm", "")
             ll = zcm("c:\")
             If zcmm <> CStr(Int((ll + 1982) / 910) + 7) Then
               End
             End If
         Else
             Exit Sub
         End If
      End If
  Else
      ll = zcm("c:\")
      If zcmm = CStr(Int((ll + 1982) / 910) + 7) Then
        Exit Sub
      Else
           MsgBox "软件注册失败，数据已发生严重错误！", 48, "警告"
           
           End
      End If
  End If
End Sub

Function zcm(sroot As String) As String
      Dim lzcm As Long
      Dim r As Long
      Dim strlabel As String
      Dim strtype As String
      strlabel = Space(255)
      strtype = Space(255)
      r = GetVolumeInformation(sroot, strlabel, Len(strlabel), lzcm, 0, 0, strtype, Len(strtype))
      zcm = CStr(lzcm)
      'zcm = CStr(Int((lzcm + 1982) / 910) + 7)
End Function