home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Folder_Loc2065985162007.psc / FolderLock / frmMain.frm < prev    next >
Text File  |  2007-05-16  |  6KB  |  170 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BackColor       =   &H00C0C0FF&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Lock / Unlock Folder"
  6.    ClientHeight    =   2715
  7.    ClientLeft      =   45
  8.    ClientTop       =   630
  9.    ClientWidth     =   3375
  10.    Icon            =   "frmMain.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2715
  15.    ScaleWidth      =   3375
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.CommandButton cmdUnLk 
  18.       BackColor       =   &H00C0C0FF&
  19.       Caption         =   "Unlock"
  20.       BeginProperty Font 
  21.          Name            =   "MS Sans Serif"
  22.          Size            =   12
  23.          Charset         =   0
  24.          Weight          =   700
  25.          Underline       =   0   'False
  26.          Italic          =   0   'False
  27.          Strikethrough   =   0   'False
  28.       EndProperty
  29.       Height          =   420
  30.       Left            =   2160
  31.       MouseIcon       =   "frmMain.frx":AB7A
  32.       MousePointer    =   99  'Custom
  33.       Style           =   1  'Graphical
  34.       TabIndex        =   3
  35.       ToolTipText     =   "Unlock Selected Folder"
  36.       Top             =   1560
  37.       Width           =   1095
  38.    End
  39.    Begin VB.CommandButton cmdLk 
  40.       BackColor       =   &H00C0C0FF&
  41.       Caption         =   "Lock"
  42.       BeginProperty Font 
  43.          Name            =   "MS Sans Serif"
  44.          Size            =   12
  45.          Charset         =   0
  46.          Weight          =   700
  47.          Underline       =   0   'False
  48.          Italic          =   0   'False
  49.          Strikethrough   =   0   'False
  50.       EndProperty
  51.       Height          =   390
  52.       Left            =   2160
  53.       MouseIcon       =   "frmMain.frx":BFC4
  54.       MousePointer    =   99  'Custom
  55.       Style           =   1  'Graphical
  56.       TabIndex        =   2
  57.       ToolTipText     =   "Lock Selected Folder"
  58.       Top             =   840
  59.       Width           =   1095
  60.    End
  61.    Begin VB.DirListBox dir 
  62.       Height          =   2115
  63.       Left            =   120
  64.       TabIndex        =   1
  65.       Top             =   480
  66.       Width           =   1830
  67.    End
  68.    Begin VB.DriveListBox drv 
  69.       Height          =   315
  70.       Left            =   120
  71.       TabIndex        =   0
  72.       Top             =   120
  73.       Width           =   1845
  74.    End
  75.    Begin VB.Menu mnuLst 
  76.       Caption         =   "Help"
  77.       Begin VB.Menu mnuIns 
  78.          Caption         =   "Instructions"
  79.       End
  80.       Begin VB.Menu mnuSep 
  81.          Caption         =   "-"
  82.       End
  83.       Begin VB.Menu mnuAb 
  84.          Caption         =   "About"
  85.       End
  86.    End
  87. End
  88. Attribute VB_Name = "frmMain"
  89. Attribute VB_GlobalNameSpace = False
  90. Attribute VB_Creatable = False
  91. Attribute VB_PredeclaredId = True
  92. Attribute VB_Exposed = False
  93. Const AlterExtn = ".{f39a0dc0-9cc8-11d0-a599-00c04fd64433}" 'Class ID for Channel File
  94. Public Nm, Pw As String
  95. Dim FSO As New FileSystemObject
  96. Dim MyDir
  97. Private Sub cmdLk_Click()
  98. On Error GoTo Err_Rep
  99. If InStr(1, MyDir, ".", vbTextCompare) = 0 Then
  100. frmL.Show vbModal, frmMain
  101. If Nm <> "" And Pw <> "" Then
  102. Open MyDir & "\Protect.dat" For Output As #1
  103. Print #1, Nm
  104. Print #1, Pw
  105. Close #1
  106. Name MyDir As MyDir & AlterExtn
  107. Call MsgBox("The folder has been locked." & vbCrLf & vbCrLf & "You can Unlock it anytime by providing the same Name and PassWord.", vbInformation, "Folder Locked")
  108. Clear
  109. End If
  110. Else
  111. Call MsgBox("This folder is already Locked by other users.", vbExclamation, "Access Denied")
  112. End If
  113. Err_Rep:
  114. If Err Then
  115. Call MsgBox(Err.Description, vbCritical, "Error !")
  116. End If
  117. End Sub
  118. Private Sub cmdUnLk_Click()
  119. On Error GoTo Err_Rep
  120. If InStr(1, MyDir, ".", vbTextCompare) > 0 Then
  121. Dim TempNm, TempPw As String
  122. frmUnL.Show vbModal, frmMain
  123. If Nm <> "" And Pw <> "" Then
  124. Open MyDir & "\Protect.dat" For Input As #2
  125. Line Input #2, TempNm
  126. Line Input #2, TempPw
  127. Close #2
  128. If TempNm <> Nm Or TempPw <> Pw Then
  129. Call MsgBox("You are not authorised to Unlock this folder." & vbCrLf & vbCrLf & "This folder has been Locked by other users and can be Unlocked exclusively by the Owner user.", vbExclamation, "Unauthorised intrusion not allowed.")
  130. Exit Sub
  131. End If
  132. Kill MyDir & "\Protect.dat"
  133. Name MyDir As Mid(MyDir, 1, InStr(1, MyDir, ".", vbTextCompare) - 1)
  134. Call MsgBox("The folder has been unlocked." & vbCrLf & vbCrLf & "You can now access it.", vbInformation, "Folder Unlocked")
  135. Clear
  136. End If
  137. Else
  138. Call MsgBox("This folder isn't Locked at all. You are free to access it.", vbExclamation, "Access Denied")
  139. End If
  140. Err_Rep:
  141. If Err Then
  142. Call MsgBox(Err.Description, vbCritical, "Error !")
  143. End If
  144. End Sub
  145. Private Sub dir_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  146. MyDir = dir.List(dir.ListIndex)
  147. End Sub
  148. Private Sub drv_Change()
  149. On Error GoTo Err_Rep
  150. dir.Path = drv.Drive
  151. Err_Rep:
  152. If Err Then
  153. Call MsgBox(Err.Description, vbCritical, "Error !")
  154. End If
  155. End Sub
  156. Private Sub Form_Load()
  157. dir.Path = FSO.GetParentFolderName(dir.Path)
  158. End Sub
  159. Private Sub Clear()
  160. Nm = ""
  161. Pw = ""
  162. dir.Refresh
  163. End Sub
  164. Private Sub mnuAb_Click()
  165. Call MsgBox("This Application has been designed by -" & vbCrLf & "               Subarno Banerjee." & vbCrLf & "Inspired by the motivation of his friend, Subhasish Hazra." & vbCrLf & vbCrLf & "This application can be very useful in protecting personal or confidential files. Besides, it also helps those who have to share their resources like that in a cyber-cafe or school. You are free to use, comment on, suggest and modify this code.", vbInformation, "About")
  166. End Sub
  167. Private Sub mnuIns_Click()
  168. Call MsgBox("Select the desired folder in the Directory List Box and click on the 'Lock' or 'Unlock' button to lock or unlock the folder as desired. Feed your User Name and Password correctly and your job is done. Folders protected by this application won't open in Windows Explorer unless you Unlock it.", vbInformation, "Instructions")
  169. End Sub
  170.