frmsplash.frm

出版社图书出货管理系统,包括图书的出库,入库,结果输出

       thankstring = ""
       End If
    
    '读单位名称结束
    
    '进入系统
    Unload frmSplash
    
End Sub

Private Sub Command2_Click()
 End
End Sub



Private Sub Command4_Click()
Unload frmSplash
   Exit Sub
Dim userstring As String
  Dim passwordstring As String
  Dim sysuserpassword As String
  Dim accenumber As Integer
  Dim accedate As Date
  '书商用户
   Dim sysdir As String
   banben = "高级"
    passwordstring = Text1.Text
  '用户名
  userstring = getserialn()
  '口令
 
  If passwordstring = "" Then
   MsgBox "密码不对！"
   Exit Sub
   End If
   'ssss
    sysuserpassword = getpasswordsuper1(userstring)
 ' Label1.Caption = sysuserpassword
  If passwordstring = sysuserpassword Then
   Unload frmSplash
   Exit Sub
  End If
  
   datet = Now()
    If datet > CDate("2006-10-1") Then
      MsgBox "亲爱的用户，感谢您使用本软件。联系方式：[e-mail],QQ:503622690,熊拥军"
      Exit Sub
      End If
      
   If Dir("d:\cbssys\bookcgk.mdb") <> "" Then
      SetAttr "d:\cbssys\bookcgk.mdb", 32
    Else
      MsgBox "请将光盘上的cbssys目录考入D盘的根目录下！"
      Exit Sub
    End If
    '读单位名称
    
     If Dir("d:\cbssys\dw.txt") <> "" Then
       Open "d:\cbssys\dw.txt" For Input As #2
       Line Input #2, dwstring
       Line Input #2, welcomestring
       Line Input #2, thankstring
       Close #2
       Else
       
       dwstring = "——图书馆"
       welcomestring = ""
       thankstring = ""
       End If
    
    '读单位名称结束

'限制使用天数开始
     sysdir = ""
     If Dir("c:\windows\system.ini") <> "" Then
     sysdir = "c:\windows\system\ado421.dll"
     Else
     sysdir = "c:\winnt\system\ado421.dll"
  End If
  If Dir(sysdir) = "" Then
  'not find file,create file
   accenumber = 1
   accedate = Date
   
   Open sysdir For Output As #1

   Print #1, accenumber
   Print #1, accedate
   Close #1
  
    Else
    Open sysdir For Input As #2
    Line Input #2, accenumber1
    Line Input #2, accedate1
    
    Close #2
    accenumber = Val(accenumber1)
    accedate = CDate(accedate1)
    
    If Date <> accedate Then
       accenumber = accenumber + 1
       accedate = Date
       End If
  
    Open sysdir For Output As #3
    Print #3, accenumber
    Print #3, accedate
    Close #3
    
     If accenumber > 30 Then
    ' Label1.Caption = Str(times)
      MsgBox "亲爱的用户，感谢您使用本软件。联系方式：[e-mail],QQ:503622690,熊拥军"
      Exit Sub
    End If
    End If
    
    
 '限制使用天数结束
    
  
 
      
'其它用户
  '取得用户名系统口令
  
  sysuserpassword = getpasswordsuper(userstring)
 ' Label1.Caption = sysuserpassword
  If passwordstring = sysuserpassword Then
   Unload frmSplash
   Exit Sub
   Else
   MsgBox "口令错误"
   End If
End Sub

Private Sub Label3_Click()
   
  Label3.Caption = "给您分配的注册号为：" + getserialn() + ",请与我们联系QQ:503622690。"
 'Text1.Text = getpasswords("349842-229657-154344")
End Sub
Function getpasswords(users As String) As String
   Dim a1, a2, a3, a4, a5 As Long
   Dim a As Long
   a = 0
   userpass = users
   If Len(userpass) < 20 Then
      userpass = userpass + String(20 - Len(userpass), "X")
      Else
      userpass = Left(userpass, 20)
      End If
   For i = 1 To 20
     a = a + Asc(Mid(userpass, i, 1))
   Next i
      a1 = Asc(Mid(userpass, 1, 1)) + Asc(Mid(userpass, 6, 1)) + Asc(Mid(userpass, 11, 1)) + Asc(Mid(userpass, 16, 1))
      a2 = Asc(Mid(userpass, 2, 1)) + Asc(Mid(userpass, 7, 1)) + Asc(Mid(userpass, 12, 1)) + Asc(Mid(userpass, 17, 1))
      a3 = Asc(Mid(userpass, 3, 1)) + Asc(Mid(userpass, 8, 1)) + Asc(Mid(userpass, 13, 1)) + Asc(Mid(userpass, 18, 1))
      a4 = Asc(Mid(userpass, 4, 1)) + Asc(Mid(userpass, 9, 1)) + Asc(Mid(userpass, 14, 1)) + Asc(Mid(userpass, 19, 1))
      a5 = Asc(Mid(userpass, 5, 1)) + Asc(Mid(userpass, 10, 1)) + Asc(Mid(userpass, 15, 1)) + Asc(Mid(userpass, 20, 1))
        a = (a Mod 42) + 48
       a1 = (a1 Mod 42) + 48
       a2 = (a2 Mod 42) + 48
       a3 = (a3 Mod 42) + 48
       a4 = (a4 Mod 42) + 48
       a5 = (a5 Mod 42) + 48
       getpasswords = Chr(a) + Chr(a1) + Chr(a2) + Chr(a3) + Chr(a4) + Chr(a5)
End Function
Function getpasswordspda(users As String) As String
   Dim a1, a2, a3, a4, a5 As Long
   Dim a As Long
   a = 1
   userpass = users
   If Len(userpass) < 20 Then
      userpass = userpass + String(20 - Len(userpass), "X")
      Else
      userpass = Left(userpass, 20)
      End If
   For i = 1 To 20
     a = a + Asc(Mid(userpass, i, 1)) * 7
   Next i
      a1 = Asc(Mid(userpass, 1, 1)) * Asc(Mid(userpass, 6, 1)) + Asc(Mid(userpass, 11, 1)) + Asc(Mid(userpass, 16, 1))
      a2 = Asc(Mid(userpass, 2, 1)) * Asc(Mid(userpass, 7, 1)) + Asc(Mid(userpass, 12, 1)) + Asc(Mid(userpass, 17, 1))
      a3 = Asc(Mid(userpass, 3, 1)) * Asc(Mid(userpass, 8, 1)) + Asc(Mid(userpass, 13, 1)) + Asc(Mid(userpass, 18, 1))
      a4 = Asc(Mid(userpass, 4, 1)) * Asc(Mid(userpass, 9, 1)) + Asc(Mid(userpass, 14, 1)) + Asc(Mid(userpass, 19, 1))
      a5 = Asc(Mid(userpass, 5, 1)) * Asc(Mid(userpass, 10, 1)) + Asc(Mid(userpass, 15, 1)) + Asc(Mid(userpass, 20, 1))
        a = (a Mod 42) + 48
       a1 = (a1 Mod 42) + 48
       a2 = (a2 Mod 42) + 48
       a3 = (a3 Mod 42) + 48
       a4 = (a4 Mod 42) + 48
       a5 = (a5 Mod 42) + 48
       getpasswordspda = Chr(a) + Chr(a1) + Chr(a2) + Chr(a3) + Chr(a4) + Chr(a5)
End Function
Function getpasswordsuper(users As String) As String
   Dim a1, a2, a3, a4, a5 As Long
   Dim a As Long
   a = 0
   userpass = users
   If Len(userpass) < 20 Then
      userpass = userpass + String(20 - Len(userpass), "X")
      Else
      userpass = Left(userpass, 20)
      End If
   For i = 1 To 20
     a = a + Asc(Mid(userpass, i, 1))
   Next i
      a1 = Asc(Mid(userpass, 1, 1)) + Asc(Mid(userpass, 18, 1)) + Asc(Mid(userpass, 15, 1)) + Asc(Mid(userpass, 12, 1))
      a2 = Asc(Mid(userpass, 5, 1)) + Asc(Mid(userpass, 2, 1)) + Asc(Mid(userpass, 19, 1)) + Asc(Mid(userpass, 16, 1))
      a3 = Asc(Mid(userpass, 9, 1)) + Asc(Mid(userpass, 6, 1)) + Asc(Mid(userpass, 3, 1)) + Asc(Mid(userpass, 20, 1))
      a4 = Asc(Mid(userpass, 13, 1)) + Asc(Mid(userpass, 10, 1)) + Asc(Mid(userpass, 7, 1)) + Asc(Mid(userpass, 4, 1))
      a5 = Asc(Mid(userpass, 17, 1)) + Asc(Mid(userpass, 14, 1)) + Asc(Mid(userpass, 11, 1)) + Asc(Mid(userpass, 8, 1))
        a = (a Mod 42) + 48
       a1 = (a1 Mod 42) + 48
       a2 = (a2 Mod 42) + 48
       a3 = (a3 Mod 42) + 48
       a4 = (a4 Mod 42) + 48
       a5 = (a5 Mod 42) + 48
       getpasswordsuper = Chr(a) + Chr(a1) + Chr(a2) + Chr(a3) + Chr(a4) + Chr(a5)
End Function
 Function getserialn() As String
     Dim inputseial As String
     Dim n As String
     Dim n1 As String
     Dim n2 As String
     Dim p As Long
     Dim p1 As Long
     Dim p2 As Long
     p = 0
     p1 = 0
     p2 = 0
     n = ""
     n1 = ""
     n2 = ""
     n = GetSerialNumber("c:\")
    ' MsgBox numberc
     n1 = n
     n2 = n
     If Len(n) < 20 Then
     n = n + String(20 - Len(n), "Z")
     n1 = n1 + String(20 - Len(n1), "A")
     n2 = n2 + String(20 - Len(n2), "H")
     ElseIf Len(n) > 20 Then
     n = Left(n, 20)
     n1 = Left(n1, 20)
     n2 = Left(n2, 20)
     End If
        
     For i = 1 To 20
     p = p + Asc(Mid(n, i, 1)) * 199
     p1 = p1 + Asc(Mid(n1, i, 1)) * 179
     p2 = p2 + Asc(Mid(n2, i, 1)) * 109
     Next
     inputseial = Format(p) + "-" + Format(p1) + "-" + Format(p2)
     getserialn = inputseial
 End Function
 Function GetSerialNumber(strDrive As String) As Long
     Dim SerialNum As Long
     Dim Res As Long
     Dim Temp1 As String
     Dim Temp2 As String
     Temp1 = String$(255, Chr$(0))
     Temp2 = String$(255, Chr$(0))
     Res = GetVolumeInformation(strDrive, Temp1, _
     Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
     GetSerialNumber = SerialNum
     End Function
Function getpasswordsuper1(users As String) As String
   Dim a1, a2, a3, a4, a5 As Long
   Dim a As Long
   a = 0
   userpass = users
   If Len(userpass) < 20 Then
      userpass = userpass + String(20 - Len(userpass), "X")
      Else
      userpass = Left(userpass, 20)
      End If
   For i = 1 To 20
     a = a + Asc(Mid(userpass, i, 1))
   Next i
      a1 = Asc(Mid(userpass, 1, 1)) + Asc(Mid(userpass, 18, 1)) + Asc(Mid(userpass, 15, 1)) + Asc(Mid(userpass, 12, 1))
      a2 = Asc(Mid(userpass, 5, 1)) + Asc(Mid(userpass, 2, 1)) + Asc(Mid(userpass, 19, 1)) + Asc(Mid(userpass, 16, 1))
      a3 = Asc(Mid(userpass, 9, 1)) + Asc(Mid(userpass, 6, 1)) + Asc(Mid(userpass, 3, 1)) + Asc(Mid(userpass, 20, 1))
      a4 = Asc(Mid(userpass, 13, 1)) + Asc(Mid(userpass, 10, 1)) + Asc(Mid(userpass, 7, 1)) + Asc(Mid(userpass, 4, 1))
      a5 = Asc(Mid(userpass, 17, 1)) + Asc(Mid(userpass, 14, 1)) + Asc(Mid(userpass, 11, 1)) + Asc(Mid(userpass, 8, 1))
        a = (a Mod 31) + 48
       a1 = (a1 Mod 34) + 48
       a2 = (a2 Mod 37) + 48
       a3 = (a3 Mod 39) + 48
       a4 = (a4 Mod 41) + 48
       a5 = (a5 Mod 40) + 48
       getpasswordsuper1 = Chr(a) + Chr(a1) + Chr(a2) + Chr(a3) + Chr(a4) + Chr(a5)
End Function