home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / RM_Secure20301611112006.psc / frmLock.frm < prev    next >
Text File  |  2006-11-11  |  8KB  |  280 lines
  1. VERSION 5.00
  2. Begin VB.Form frmLock 
  3.    BackColor       =   &H00FFFFFF&
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Locked"
  6.    ClientHeight    =   2460
  7.    ClientLeft      =   285
  8.    ClientTop       =   390
  9.    ClientWidth     =   6600
  10.    ControlBox      =   0   'False
  11.    BeginProperty Font 
  12.       Name            =   "Arial Unicode MS"
  13.       Size            =   8.25
  14.       Charset         =   0
  15.       Weight          =   400
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    Icon            =   "frmLock.frx":0000
  21.    MaxButton       =   0   'False
  22.    MinButton       =   0   'False
  23.    ScaleHeight     =   2460
  24.    ScaleWidth      =   6600
  25.    ShowInTaskbar   =   0   'False
  26.    StartUpPosition =   3  'Windows Default
  27.    Begin VB.Timer timCD 
  28.       Enabled         =   0   'False
  29.       Interval        =   1000
  30.       Left            =   6180
  31.       Tag             =   "0"
  32.       Top             =   930
  33.    End
  34.    Begin VB.CommandButton cmdPass 
  35.       Caption         =   "&OK"
  36.       Default         =   -1  'True
  37.       Height          =   300
  38.       Left            =   4395
  39.       TabIndex        =   3
  40.       Top             =   1095
  41.       Visible         =   0   'False
  42.       Width           =   840
  43.    End
  44.    Begin VB.TextBox txtPass 
  45.       Appearance      =   0  'Flat
  46.       BeginProperty Font 
  47.          Name            =   "Wingdings"
  48.          Size            =   8.25
  49.          Charset         =   2
  50.          Weight          =   400
  51.          Underline       =   0   'False
  52.          Italic          =   0   'False
  53.          Strikethrough   =   0   'False
  54.       EndProperty
  55.       Height          =   270
  56.       IMEMode         =   3  'DISABLE
  57.       Left            =   1290
  58.       PasswordChar    =   "l"
  59.       TabIndex        =   2
  60.       Top             =   780
  61.       Visible         =   0   'False
  62.       Width           =   3945
  63.    End
  64.    Begin VB.ListBox lstHidden 
  65.       Height          =   510
  66.       Left            =   5775
  67.       TabIndex        =   1
  68.       Top             =   0
  69.       Visible         =   0   'False
  70.       Width           =   825
  71.    End
  72.    Begin VB.Timer timHide 
  73.       Enabled         =   0   'False
  74.       Interval        =   100
  75.       Left            =   6180
  76.       Top             =   510
  77.    End
  78.    Begin VB.Label lblInfo1 
  79.       Alignment       =   2  'Center
  80.       BackStyle       =   0  'Transparent
  81.       Caption         =   "When the key is inserted tap Enter"
  82.       BeginProperty Font 
  83.          Name            =   "Arial Unicode MS"
  84.          Size            =   12
  85.          Charset         =   0
  86.          Weight          =   400
  87.          Underline       =   0   'False
  88.          Italic          =   0   'False
  89.          Strikethrough   =   0   'False
  90.       EndProperty
  91.       Height          =   765
  92.       Left            =   1560
  93.       TabIndex        =   0
  94.       Top             =   750
  95.       Width           =   3285
  96.    End
  97. End
  98. Attribute VB_Name = "frmLock"
  99. Attribute VB_GlobalNameSpace = False
  100. Attribute VB_Creatable = False
  101. Attribute VB_PredeclaredId = True
  102. Attribute VB_Exposed = False
  103. Option Explicit
  104. Implements IEnumWindowsSink
  105. Dim frmhWnd As Long
  106. Dim FirstTime As Boolean
  107.  
  108. '// Check if password is correct if used
  109. Private Sub cmdPass_Click()
  110.  
  111.     If txtPass.Text = Password Then
  112.         timHide.Enabled = False
  113.         ShowAllWnd lstHidden
  114.         Unload Me
  115.     End If
  116.  
  117. End Sub
  118.  
  119. '// Initialize the locking
  120. Private Sub Form_Load()
  121.  
  122.     FirstTime = True
  123.     EnumerateWindows Me
  124.     frmhWnd = Me.hwnd
  125.     DoEvents
  126.     lblInfo1.Caption = "Locking computer..."
  127.     timHide.Enabled = True
  128.     timCD.Enabled = True
  129.  
  130. End Sub
  131.  
  132. '// Part of enumeration thing
  133. Private Property Get IEnumWindowsSink_Identifier() As Long
  134.  
  135.     IEnumWindowsSink_Identifier = Me.hwnd
  136.     
  137. End Property
  138.  
  139. '// Enumerate all windows and show which ones are visible
  140. '// Pulled from VbAccelerator
  141. '//   http://www.vbaccelerator.com/home/vb/code/Libraries/Windows/Enumerating_Windows/article.asp
  142. Private Sub IEnumWindowsSink_EnumWindow(ByVal hwnd As Long, bStop As Boolean)
  143. On Error Resume Next
  144.  
  145.     Dim IsFound As Boolean
  146.     Dim i As Long
  147.     
  148.     If hwnd <> frmhWnd Then
  149.         If IsWindowVisible(hwnd) = 1 Then
  150.             For i = 0 To lstHidden.ListCount - 1
  151.                     IsFound = False
  152.                     If lstHidden.List(i) = hwnd Then
  153.                         IsFound = True
  154.                         Exit For
  155.                     End If
  156.             Next i
  157.  
  158.             If IsFound = False Then
  159.                 WindowControl hwnd, HideWnd
  160.                 lstHidden.AddItem hwnd
  161.                 Exit Sub
  162.             End If
  163.         End If
  164.     Else
  165.         SetTopMost frmhWnd
  166.     End If
  167.  
  168. End Sub
  169.  
  170. '// Countdown to prepare the form
  171. Private Sub timCD_Timer()
  172.  
  173.     If Val(timCD.Tag) < 3 Then
  174.         timCD.Tag = Val(timCD.Tag) + 1
  175.     End If
  176.     
  177.     If Val(timCD.Tag) = 3 Then
  178.         lblInfo1.Caption = "When the key is inserted tap Enter"
  179.         FirstTime = False
  180.         timCD.Enabled = False
  181.     End If
  182.  
  183. End Sub
  184.  
  185. '// Make sure every window except itself gets hidden.
  186. '// To restore everything properly, we put hidden objects in a list
  187. Private Sub timHide_Timer()
  188.  
  189.     EnumerateWindows Me
  190.     If GetAsyncKeyState(13) <> 0 Then
  191.         If CheckDrives = True Then
  192.             If PassUse = True Then
  193.                 lblInfo1.Visible = False
  194.                 txtPass.Visible = True
  195.                 cmdPass.Visible = True
  196.             Else
  197.                 timHide.Enabled = False
  198.                 ShowAllWnd lstHidden
  199.                 Unload Me
  200.             End If
  201.         End If
  202.     End If
  203.  
  204. End Sub
  205.  
  206. '// Function to check wether a valid drive is inserted
  207. Private Function CheckDrives() As Boolean
  208.  
  209.     Dim fso
  210.     Dim Drive
  211.     Dim DrvChkD(2) As Boolean
  212.     Dim DrvChk As Boolean
  213.  
  214.     DrvChkD(1) = False
  215.     DrvChkD(2) = False
  216.     DrvChk = False
  217.  
  218.     '// Prepare the FSO
  219.     Set fso = CreateObject("Scripting.FileSystemObject")
  220.     DoEvents
  221.     
  222.     If FirstTime = False Then
  223.         lblInfo1.Caption = "Searching keys..."
  224.     End If
  225.     
  226.     '// This part retrieves the serial numbers from the removable media
  227.     For Each Drive In fso.Drives
  228.         If Drive.IsReady = True Then
  229.             If DualDrive = True Then
  230.                 If Drive.SerialNumber = SelDrvSerD(1) Then
  231.                     DrvChkD(1) = True
  232.                 End If
  233.                 
  234.                 If Drive.SerialNumber = SelDrvSerD(2) Then
  235.                     DrvChkD(2) = True
  236.                 End If
  237.             Else
  238.                 If Drive.SerialNumber = SelDrvSer Then
  239.                     DrvChk = True
  240.                 End If
  241.             End If
  242.         End If
  243.     Next
  244.     
  245.     '// Here it will compare the serialnumbers
  246.     If FirstTime = False Then
  247.         If DualDrive = True Then
  248.             If DrvChkD(1) = False Or DrvChkD(2) = False Then
  249.                 lblInfo1.Caption = "When the key is inserted tap Enter"
  250.                 MsgBox ("Key Missing"), vbExclamation, "Key Security"
  251.                 CheckDrives = False
  252.                 Exit Function
  253.             End If
  254.             CheckDrives = True
  255.         Else
  256.             If DrvChk = False Then
  257.                 lblInfo1.Caption = "When the key is inserted tap Enter"
  258.                 MsgBox ("Key Missing"), vbExclamation, "Key Security"
  259.                 CheckDrives = False
  260.             Else
  261.                 CheckDrives = True
  262.             End If
  263.         End If
  264.     Else
  265.         FirstTime = False
  266.     End If
  267.     
  268. End Function
  269.  
  270. '// Show all windows that were hidden
  271. Private Function ShowAllWnd(WndList As Object)
  272.  
  273.     Dim i As Long
  274.     
  275.     For i = 0 To WndList.ListCount - 1
  276.         WindowControl WndList.List(i), ShowWnd
  277.     Next i
  278.  
  279. End Function
  280.