tt1.frm

机房计时系统

VERSION 5.00
Begin VB.Form Form2 
   BackColor       =   &H8000000A&
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "            机房自动计费计时系统"
   ClientHeight    =   2745
   ClientLeft      =   3045
   ClientTop       =   4560
   ClientWidth     =   4680
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Icon            =   "tt1.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      Height          =   435
      Index           =   1
      Left            =   4095
      Picture         =   "tt1.frx":08CA
      ScaleHeight     =   375
      ScaleWidth      =   480
      TabIndex        =   6
      Top             =   2100
      Visible         =   0   'False
      Width           =   540
   End
   Begin VB.PictureBox Picture1 
      Height          =   435
      Index           =   0
      Left            =   4095
      Picture         =   "tt1.frx":1194
      ScaleHeight     =   375
      ScaleWidth      =   480
      TabIndex        =   5
      Top             =   1470
      Visible         =   0   'False
      Width           =   540
   End
   Begin VB.Timer Timer2 
      Interval        =   500
      Left            =   4305
      Top             =   840
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   4320
      Top             =   0
   End
   Begin VB.Label Label5 
      Caption         =   "欢迎你到本机房上机"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   840
      TabIndex        =   4
      Top             =   210
      Width           =   3270
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "本系统默认按1小时计时"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   720
      TabIndex        =   3
      Top             =   2280
      Width           =   3150
   End
   Begin VB.Label Label3 
      Caption         =   "Label1"
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   1905
      Width           =   3615
   End
   Begin VB.Label Label2 
      Caption         =   "Label1"
      Height          =   375
      Left            =   360
      TabIndex        =   1
      Top             =   1395
      Width           =   3615
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   870
      Width           =   3615
   End
   Begin VB.Menu menumenu 
      Caption         =   "菜"
      Visible         =   0   'False
      Begin VB.Menu menu1 
         Caption         =   "关于我们(&G)"
      End
      Begin VB.Menu menu2 
         Caption         =   "软件简介(&J)"
      End
      Begin VB.Menu menu3 
         Caption         =   "-"
      End
      Begin VB.Menu menu4 
         Caption         =   "退出系统(&Q)"
      End
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Dim rtn As Long

 Const SWP_HIDEWINDOW = &H80
 Const SWP_SHOWWINDOW = &H40

Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    ucallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Dim t As NOTIFYICONDATA
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long
Private Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" Alias "fRemoveShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String) As Long
Dim begintime
Dim endtime

Public inttime As Integer
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Dim lRecturned As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SCREENSAVERRUNNING = 97
Const WM_CLOSE = &H10
Const WM_QIOT = &H12
Dim HANDLE As Integer, N As Integer
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Sub cctv()
Dim wintext As String
wintext = "注册表编辑器"
HANDLE = FindWindow(vbNullString, wintext)
PostMessage HANDLE, WM_CLOSE, 0, 0
End Sub



Private Sub Form_Click()
If AnotherInstance() Then
    End
End If
Me.Show
End Sub


Private Sub Form_Load()

 Label1.Caption = "你的开始时间为：" & Time
Label2.Caption = "你的现在时间为："
Label3.Caption = "你的结束时间为：" & Hour(Time) + 1 & ":" & Minute(Time) & ":" & Second(Time)
    Picture1(0).Picture = LoadPicture("d:\cheng\1.ico")
    Picture1(1).Picture = LoadPicture("d:\cheng\2.ico")
    t.cbSize = Len(t)
    t.hwnd = Picture1(0).hwnd
    t.uId = 1&
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackMessage = WM_MOUSEMOVE
    t.hIcon = Picture1(0).Picture
    t.szTip = "机房自动计费计时系统" & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t
    Timer2.Enabled = True
    App.TaskVisible = False
begintime = Now
 Dim lResult As Long
  '          lresult = OSfCreateShellLink("..\..\desktop", "机房自动计费计时系统", _
   '                                  "c:\exe\ttt1.exe", "")
  '          lresult = OSfCreateShellLink("..\..\start menu", "机房自动计费计时系统", _
  '                                 "c:\exe\ttt1.exe", "")
    '    lresult = OSfCreateShellLink("test", "机房自动计费计时系统", _
     '                              "c:\exe\ttt1.exe", "")
If AnotherInstance() Then
    End
End If

RegisterServiceProcess GetCurrentProcessId, 1
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
Firstform
guan
shubiao
Call noshow

End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If AnotherInstance() Then
    End
End If

Form2.WindowState = 1
End Sub


Private Sub Form_Unload(Cancel As Integer)

    Timer2.Enabled = False
    t.cbSize = Len(t)
    t.hwnd = Picture1(0).hwnd
    t.uId = 1&
    Shell_NotifyIcon NIM_DELETE, t
endtime = Now
N = DateDiff("N", begintime, endtime)
Dim fso As New FileSystemObject, txtfile As TextStream
If fso.FileExists("c:\aa\开机记录.txt") Then
Set txtfile = fso.CreateTextFile("c:\aa\开机记录.txt", True)
Set txtfile = fso.OpenTextFile(("c:\windows\开机记录.txt"), ForAppending, True)
Else
Set txtfile = fso.OpenTextFile(("c:\exe\开机记录.txt"), ForAppending, True)
End If
txtfile.Write "开机时间为：" & begintime
txtfile.Write "            " & "关机时间为：" & endtime
txtfile.Write "            " & "时间长度为：" & N & "分钟"
txtfile.WriteBlankLines 2


End Sub


Private Sub menu1_Click()
MsgBox "这是我用Visual Basic 6.0开发的一个小的应用程序，主要用各种机房的计费计时" & _
"我学vb已经快一年的时间了。同时希望大家好好学习，不要沉迷于OICQ和各类游戏之中。" & _
"欢迎大家与我联系，E-Mail:[e-mail]主页：www.cheng.51.net.", vbInformation, "机房自动计费计时系统"
End Sub

Private Sub menu2_Click()
MsgBox "这是一个应用于机房的小软件，功能不能算太强大。它可以隐藏任务栏，关闭注册表,开机自动运行" & _
"计费计时，反密码窍取工具等功能。本软件体积小巧，不占内存，并且可以自带安装程序。", vbInformation, "机房自动计费计时系统"
End Sub

Private Sub menu4_Click()
frmLogin.Show
End Sub

Private Sub timer1_Timer()
guan
 cctv
    If AnotherInstance() Then End

inttime = inttime + 1
If inttime = 2 Then
Me.WindowState = 1
End If
If inttime = 3600 Then
Form4.Show
If cheng = False Then
    rtn = FindWindow("Shell_traywnd", "") 'get the Window
     Call SetWindowPos(rtn, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End If
Form4.Label1.Caption = "对不起，你的上机时间(1个小时)已到，欢迎你下次再来."
Form4.Label3.Caption = "如果你要继续上机,请与机房的管理员联系,谢谢合作!"
Form4.WindowState = 2
End If
If inttime = 3420 Then
Form4.Show
Form4.Label1.Caption = "对不起,你的上机时间还有3分钟,请你做好存盘及其它工作."
cheng = False
End If
If inttime = 3423 Then
Form4.Hide
End If
Label2.Caption = "你现在的时间为：" & Time
End Sub


Private Sub picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Hex(x) = "1E3C" Then
        Me.PopupMenu menumenu
    End If
End Sub


Private Sub timer2_Timer()
    cctv
    Static i As Long, img As Long
    t.cbSize = Len(t)
    t.hwnd = Picture1(0).hwnd
    t.uId = 1&
    t.uFlags = NIF_ICON
    t.hIcon = Picture1(i).Picture
    Shell_NotifyIcon NIM_MODIFY, t
    Timer1.Enabled = True
    i = i + 1
    If i = 2 Then i = 0
End Sub