www.pudn.com > textmanager.rar > FrmClient.frm, change:2005-04-12,size:4989b


VERSION 5.00 
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" 
Begin VB.Form FrmClient  
   BorderStyle     =   0  'None 
   Caption         =   "Form1" 
   ClientHeight    =   30 
   ClientLeft      =   150 
   ClientTop       =   435 
   ClientWidth     =   1530 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   30 
   ScaleWidth      =   1530 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   3  '窗口缺省 
   Visible         =   0   'False 
   Begin VB.TextBox TXTINI  
      Height          =   270 
      Left            =   1260 
      TabIndex        =   1 
      Text            =   "Text1" 
      Top             =   900 
      Visible         =   0   'False 
      Width           =   645 
   End 
   Begin MSWinsockLib.Winsock WinC  
      Left            =   1110 
      Top             =   390 
      _ExtentX        =   741 
      _ExtentY        =   741 
      _Version        =   393216 
   End 
   Begin VB.PictureBox Pic  
      Height          =   555 
      Left            =   105 
      Picture         =   "FrmClient.frx":0000 
      ScaleHeight     =   495 
      ScaleWidth      =   555 
      TabIndex        =   0 
      Top             =   135 
      Visible         =   0   'False 
      Width           =   615 
   End 
   Begin VB.Menu M_Caozuo  
      Caption         =   "操作" 
      Visible         =   0   'False 
      Begin VB.Menu M_Login  
         Caption         =   "登录考试系统(&L)" 
      End 
      Begin VB.Menu q  
         Caption         =   "-" 
      End 
      Begin VB.Menu M_Exit  
         Caption         =   "退出监控系统(&Q)" 
      End 
   End 
End 
Attribute VB_Name = "FrmClient" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
Dim resp As Long 
 
Private Sub Form_Load() 
   '连接数据库 
  'Set DB = New Connection 
 ' DB.CursorLocation = adUseClient 
  'DB.Open "PROVIDER=SQLOLEDB.1;driver={SQL Server};uid=sa;pwd=phf;database=question;" 
 ' DB.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" + App.Path + "\question.mdb;Jet OLEDB:" 
If App.PrevInstance = True Then 
   End 
End If 
 
  '隐藏任务 
RemoveProgramFromList 
 '对任务栏编程 
'下列语句建立一个实现状态区图标操作的功能 
Dim resp As Long 
tnid.hwnd = Pic.hwnd 
tnid.uID = 1 '图标的标识号 
tnid.uFlags = NIF_MESSAGE + NIF_TIP + NIF_ICON 
tnid.uCallbackMessage = WM_MOUSEMOVE 
tnid.hIcon = Pic.Picture.Handle 
tnid.szTip = "考试管理系统消息服务器" + Chr$(0) 
tnid.cbSize = Len(tnid) 
gHW = Me.hwnd 
resp = Shell_NotifyIcon(NIM_ADD, tnid) 
 
'连接数据库的连接 
Set LocalConn = New Connection 
LocalConn.CursorLocation = adUseClient 
LocalConn.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" + App.Path + "\data\temp.mdb;Jet OLEDB:" 
 
'测试数据库的连接 
 On Error GoTo lin: 
 InIpath = App.Path + "\data\Server.ini" 
 If Dir(InIpath) = "" Then 
   CreateInI "Server", "sa", "", "question" 
 End If 
 Dim SName As String, Lname As String, PW As String, DatabaseName As String 
'读INI 
  Dim ServerName As String * 20 
  Dim LoginName As String * 20 
  Dim Pass As String * 20 
  Dim DbName As String * 20 
  Dim Result As Long 
   
  Result = GetPrivateProfileString("Server", "ServerName", "Server", ServerName, Len(ServerName), InIpath) 
  TXTINI = ServerName 
  SName = TXTINI 
  Result = GetPrivateProfileString("Server", "LoginName", "sa", LoginName, Len(LoginName), InIpath) 
  TXTINI = LoginName 
  Lname = TXTINI 
  Result = GetPrivateProfileString("Server", "Password", "", Pass, Len(Pass), InIpath) 
  TXTINI = Pass 
  PW = TXTINI 
  Result = GetPrivateProfileString("Server", "Database", "question", DbName, Len(DbName), InIpath) 
  TXTINI = DbName 
  DatabaseName = TXTINI 
  
 '连接数据库 
 ConnString = "PROVIDER=SQLOLEDB.1;driver={SQL Server};server=" + SName + ";uid=" + Lname + ";pwd=" + PW + ";database=" + DatabaseName + ";" 
 Dim ConnDB As Connection 
 Set ConnDB = New Connection 
 ConnDB.CursorLocation = adUseClient 
 ConnDB.ConnectionString = ConnString 
 ConnDB.Open 
 Set ConnDB = Nothing 
 frmLogin.Show 
 
 Exit Sub 
  
lin: 
 MsgBox "数据库连接失败,请重新配置服务器连接信息!或者查看SQL Server是否已经启动!" 
 frmServerSet.Show 
 Unload Me 
 
End Sub 
 
Private Sub M_Exit_Click() 
  Unload Me 
  End 
End Sub 
 
Private Sub M_Login_Click() 
  frmLogin.Show 
End Sub 
 
Private Sub Pic_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
Select Case x / Screen.TwipsPerPixelX 
 '左键单击 
  Case WM_LBUTTONDOWN 
     Me.PopupMenu M_Caozuo 
 '右键单击 
  Case WM_RBUTTONDOWN 
    
End Select 
 
End Sub 
Private Sub Form_Unload(Cancel As Integer) 
 InIpath = App.Path + "\data\server.ini" 
 Dim resp As Long 
 resp = Shell_NotifyIcon(NIM_DELETE, tnid) 
  
 Exit Sub 
  
 '自动运行写入注册表 
 If Right(App.Path, 1) = "\" Then 
  AutoRun "SYSClient", App.Path + "SYSClient.exe" 
 Else 
  AutoRun "SYSClient", App.Path + "\SYSClient.exe" 
 End If 
End Sub