frmflashin.frm

< 飞鸿商品>>零售是基于VB+SQL2000开的商品零售管理系统. 开发的很好.可以一看

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form FrmFlashIN 
   BorderStyle     =   0  'None
   ClientHeight    =   4515
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6015
   Picture         =   "FrmFlashIN.frx":0000
   ScaleHeight     =   4515
   ScaleWidth      =   6015
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSWinsockLib.Winsock wskIP 
      Left            =   2940
      Top             =   1650
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer tmrFlash 
      Left            =   4320
      Top             =   3600
   End
End
Attribute VB_Name = "FrmFlashIN"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
Dim Rst As ADODB.Recordset
Dim Cmd As ADODB.Command
Dim CountIP As Integer

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open "select * from sysseting", Conn, adOpenDynamic, adLockReadOnly, adCmdText
If Rst.EOF Then Exit Sub

If DateDiff("d", Rst.Fields(0), Date$) >= Rst.Fields(1) Then
  MsgBox "本软件为试用版，使用期限已到！请与供应商联系。", 64
  Exit Sub
End If

IP = wskIP.LocalIP
Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open "select * from logon where ip='" & IP & "'", Conn, adOpenDynamic, adLockReadOnly, adCmdText
If Rst.EOF Then
  Set Rst = New ADODB.Recordset
  Rst.CursorLocation = adUseClient
  Rst.Open "select count(*) from logon", Conn, adOpenDynamic, adLockReadOnly, adCmdText
  If IsNull(Rst.Fields(0)) Then CountIP = 0 Else CountIP = Val(Rst.Fields(0))
  If CountIP >= 5 Then MsgBox "当前登陆用户数大于限制，因此不能登陆！", 64, "系统提示": End: Exit Sub
  
  Set Cmd = New ADODB.Command
  Cmd.ActiveConnection = Conn
  Cmd.CommandText = "INSERT INTO logon VALUES('" & Format(Time$, "hh:mm:ss") & "','" & IP & "','" & wskIP.LocalHostName & "','')"
  Cmd.CommandType = adCmdText
  Cmd.Execute
  Set Cmd = Nothing
End If
Set Rst = Nothing

  tmrFlash.Interval = 1500
  tmrFlash.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)

frmLogin.Show
Set FrmFlashIN = Nothing
End Sub

Private Sub tmrFlash_Timer()
  tmrFlash.Enabled = False
  Unload Me
End Sub