bas.bas

[smith.rar] - smith原图

Attribute VB_Name = "bas"
Public db As New ADODB.Connection
Public price As Currency
Public jqcount As Integer
Public zxrs As Integer
Public sykw As Integer
Public zrs As Integer
Public tcash As Currency
Public usname As String



Sub openrs(rs As ADODB.Recordset, sqlstr As String)
Set rs.ActiveConnection = db
rs.CursorLocation = adUseServer
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Source = sqlstr
rs.Open
End Sub

Function difftime(sdate As Date, stime As Date, edate As Date, etime As Date) As Long
         difftime = DateDiff("d", sdate, edate) * 24 * 60 + (Hour(etime) - Hour(stime)) * 60 + Minute(etime) - Minute(stime)
End Function

Function getpasswd(username As String) As String

getpasswd = ""
Dim rspass As New ADODB.Recordset
Call openrs(rspass, "select psbit,psd1,psd2,psd3,psd4,psd5,psd6 from passd where user='" + username + "'")
If rspass.EOF() And rspass.BOF() Then
   getpasswd = Chr(13)
   rspass.Close
   Set rspass = Nothing
   Exit Function
End If

Dim i As Integer
For i = 1 To rspass!psbit
    getpasswd = getpasswd & Chr(rspass.Fields(i).Value Xor 188)
Next i
rspass.Close
Set rspass = Nothing
End Function

Sub savepasswd(username As String, keyword As String, isadd As Integer)
Dim passlen As Byte
Dim i As Integer
Dim rspass As New ADODB.Recordset
passlen = Len(keyword)
If isadd = 1 Then
   Call openrs(rspass, "select user,psbit,psd1,psd2,psd3,psd4,psd5,psd6 from passd where user='" + username + "'")
   If rspass.EOF And rspass.BOF Then
      rspass.AddNew
      rspass!User = username
      rspass!psbit = passlen
      For i = 1 To passlen
          rspass.Fields(i + 1).Value = Asc(Mid(keyword, i, 1)) Xor 188
      Next i
      
      rspass.Update
      rspass.Close
      Set rspass = Nothing
   Else
      MsgBox "同名用户已经存在!"
      rspass.Close
      Set rspass = Nothing
      Exit Sub
   End If
Else
   Call openrs(rspass, "select psbit,psd1,psd2,psd3,psd4,psd5,psd6 from passd where user='" + username + "'")
   If rspass.EOF And rspass.BOF Then
      MsgBox "该用户不存在!"
      rspass.Close
      Set rspass = Nothing
      Exit Sub
   Else
      rspass!psbit = passlen
      For i = 1 To passlen
          rspass.Fields(i).Value = Asc(Mid(keyword, i, 1)) Xor 188
      Next i
      rspass.Update
      rspass.Close
      Set rspass = Nothing
   End If
End If
End Sub

Function rscount(rs1 As ADODB.Recordset) As Integer
         rscount = 0
         rs1.MoveFirst
         Do While Not rs1.EOF()
            rscount = rscount + 1
            rs1.MoveNext
         Loop
End Function