frmlogin.frm

[smith.rar] - smith原图

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录"
   ClientHeight    =   1545
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   3750
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   912.837
   ScaleMode       =   0  'User
   ScaleWidth      =   3521.047
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox txtUserName 
      Height          =   345
      Left            =   1290
      TabIndex        =   1
      Top             =   135
      Width           =   2325
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   390
      Left            =   495
      TabIndex        =   4
      Top             =   1020
      Width           =   1140
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   390
      Left            =   2100
      TabIndex        =   5
      Top             =   1020
      Width           =   1140
   End
   Begin VB.TextBox txtPassword 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1290
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   525
      Width           =   2325
   End
   Begin VB.Label lblLabels 
      Caption         =   "用户名称(&U):"
      Height          =   270
      Index           =   0
      Left            =   105
      TabIndex        =   0
      Top             =   150
      Width           =   1080
   End
   Begin VB.Label lblLabels 
      Caption         =   "密码(&P):"
      Height          =   270
      Index           =   1
      Left            =   105
      TabIndex        =   2
      Top             =   540
      Width           =   1080
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public LoginSucceeded As Boolean
Dim a As String
Dim folder1 As Folder
Dim fsoTest As New FileSystemObject, file1 As File, ts As TextStream
Dim s, s0, s1, s2, s3 As String
Dim s30 As Integer


Private Sub cmdCancel_Click()
db.Close
Set db = Nothing
Unload Me
End Sub

Private Sub cmdOK_Click()
Dim getpass As String
getpass = bas.getpasswd(txtUserName.Text)
If getpass <> txtPassword.Text Then
   MsgBox "用户名或口令错误!"
   Exit Sub
Else
   usname = txtUserName.Text
   db.Close
   Set db = Nothing
   Load Form1
   Form1.Show
   Unload Me
End If
End Sub

Private Sub Form_Load()
a = "\test.dll"      '设置文件名

Set folder1 = fsoTest.GetSpecialFolder(SystemFolder)  '设定为系统文件夹

On Error GoTo err:

read:
Set file1 = fsoTest.GetFile(folder1 & a)
Set ts = file1.OpenAsTextStream(ForReading)
'读取一行
s0 = ts.ReadLine
s1 = ts.ReadLine
s2 = ts.ReadLine
s3 = ts.ReadLine

'MsgBox s
ts.Close



If CDate(s1) > Date Then
    MsgBox "对不起，你在本软件的试用期间不可以修改系统日期及时间，如果你想继续使用本软件。请你恢复系统日期，谢谢合作!", 48, "提示信息"
    End
End If

If CDate(s1) = Date And CDate(s3) > Time Then
    MsgBox "对不起，你在本软件的试用期间不可以修改系统日期及时间，如果你想继续使用本软件。请你恢复系统日期，谢谢合作!", 48, "提示信息"
    End
End If

s1 = Date
s3 = Time
w:
     Set file1 = fsoTest.GetFile(folder1 & a)
     Set ts = file1.OpenAsTextStream(ForWriting)
     ts.WriteLine s0
     ts.WriteLine s1
     ts.WriteLine s2
     ts.WriteLine s3
ts.Close
   



'开始检测是否超期
s30 = Date - CDate(s0)
If s30 >= CInt(s2) Then '设定试用期为30天
     MsgBox "已经到了30天的试用期如果你想继续使用本软件，请你到本公司注册并购买正版的软件!", 48, "提示信息"

    End
Else
'仍在试用期内

MsgBox "欢迎使用本系统，你还有" & s2 - s30 & "天的试用期，祝你今天工作愉快！", 48, "提示信息"

'mainForm.Show '启动你的主窗体

End If

'Exit Sub





db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\WBSF\DATA.mdb;Persist Security Info=False"
db.Open
Exit Sub

err:

'创建新文件

Set fsoTest = CreateObject("Scripting.FileSystemObject")
fsoTest.CreateTextFile (folder1 & a)
    
    Set file1 = fsoTest.GetFile(folder1 & a)
    Set ts = file1.OpenAsTextStream(ForWriting)
    
    ts.Write Date ' 写入一行。
   
    ts.WriteBlankLines (1) ' 向文件中写入一个换行符。
    
    ts.WriteLine Date ' 写入一行带有换行符的文本。
    
    ts.WriteLine 30  '设定使用期限
    
    ts.WriteLine Time ' 写入一行带有换行符的文本。
    
    ts.Close
    
    MsgBox "这是你第一次启动本系统!你的试用期为30天，今天是第一天，谢谢使用!", 64, "提示信息"

GoTo read
End Sub