MODULE eklenecek;
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
BrowseForFolder = sPath
End Function
FORM1
Option Explicit
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
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 Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim nid As NOTIFYICONDATA
#If Win16 Then
Declare Function ShowWindow Lib "User" (ByVal hWnd As Integer, ByVal flgs As Integer) As Integer
Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal wIndx As Integer) As Integer
Declare Function GetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal wIndx As Integer) As Long
Declare Function GetWindowText Lib "User" (ByVal hWnd As Integer, ByVal lpSting As String, ByVal nMaxCount As Integer) As Integer
Declare Function GetWindowTextLength Lib "User" (ByVal hWnd As Integer) As Integer
Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal insaft As Integer, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal flgs As Integer) As Integer
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function ShowWindow Lib "USER32" (ByVal hWnd As Long, ByVal flgs As Long) As Long
Private Declare Function GetWindow Lib "USER32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowWord Lib "USER32" (ByVal hWnd As Long, ByVal wIndx As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal wIndx As Long) As Long
Private Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpSting As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowTextLength Lib "USER32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function SetWindowPos Lib "USER32" (ByVal hWnd As Long, ByVal insaft As Long, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal flgs As Long) As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
Const WM_CLOSE = &H10
Const WM_MINIMIZE = &H20000000
Const HWND_TOP = 0
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_SHOWWINDOW = &H40
Const GW_HWNDFIRST = 0
Const GW_HWNDNEXT = 2
Const GWL_STYLE = (-16)
Const SW_RESTORE = 9
Const WS_VISIBLE = &H10000000
Const WS_BORDER = &H800000
Const WS_CLIPSIBLINGS = &H4000000
Const WS_THICKFRAME = &H40000
Const WS_GROUP = &H20000
Const WS_TABSTOP = &H10000
Dim Prog As Long
Dim EklenenKlasor As String
Dim kls As String
Dim klsgeri As String
Dim sayacno
Sub TumunuAl()
Dim hwCurr As Long
Dim Boyut As Long
Dim PencereAdi As String
AktifPencereler.Clear
hwCurr = GetWindow(Me.hWnd, GW_HWNDFIRST)
Do While hwCurr
If hwCurr Me.hWnd And Pencere(hwCurr) Then
Boyut = GetWindowTextLength(hwCurr) + 1
PencereAdi = Space$(Boyut)
Boyut = GetWindowText(hwCurr, PencereAdi, Boyut)
If Boyut > 0 Then
AktifPencereler.AddItem PencereAdi
AktifPencereler.ItemData(AktifPencereler.NewIndex) = hwCurr
End If
End If
hwCurr = GetWindow(hwCurr, GW_HWNDNEXT)
Loop
End Sub
Function Pencere(hwCurr As Long) As Long
Dim Stil As Long
Stil = GetWindowLong(hwCurr, GWL_STYLE)
If (Stil And Prog) = Prog Then Pencere = True
End Function
Function KlasoruYokEt()
Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, kls)
If winHwnd 0 Then
PostMessage winHwnd, WM_CLOSE, 0&, 0&
Else
End If
End Function
Function DogruSifre()
Dim i
Call ShellExecute(&O0, vbNullString, kls, vbNullString, vbNullString, vbNormalFocus)
SifrelenenKlasorler.RemoveItem (sayacno)
SifreDurumu.RemoveItem (sayacno)
SifreDurumu.AddItem "Şifresiz", sayacno
Open App.Path & "sfk.dll" For Output As #1
For i = 0 To SifrelenenKlasorler.ListCount - 1
Print #1, SifrelenenKlasorler.List(i)
Next
Close #1
End Function
Function YanlısSifre()
Dim boy, yer, son, i
boy = Len(kls)
For i = 1 To boy
yer = InStr(i, kls, "")
If yer = 0 Then
yer = son
Exit For
Else
End If
son = yer
Next
klsgeri = Left(kls, yer - 1)
Call ShellExecute(&O0, vbNullString, klsgeri, vbNullString, vbNullString, vbNormalFocus)
End Function
Function KlasorleriOku()
Dim sfklr
Open App.Path & "sfk.dll" For Input As #1
While Not EOF(1)
Input #1, sfklr
If sfklr = "" Then
Close #1
Exit Function
Else
End If
SifrelenenKlasorler.AddItem sfklr
SifrelenecekKlasorler.AddItem sfklr
SifreDurumu.AddItem "Şifrelendi"
Wend
Close #1
End Function
Private Sub mnac_Click()
Me.Visible = True
End Sub
Private Sub mncıkar_Click()
SifrelenecekKlasorler.RemoveItem SifrelenecekKlasorler.ListIndex
SifreDurumu.RemoveItem SifreDurumu.ListIndex
End Sub
Private Sub mncıkıs_Click()
Unload Me
End Sub
Private Sub Form_Load()
KlasorleriOku
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = False
Toolbar1.Buttons(4).Enabled = False
mncıkar.Enabled = False
mnsifrele.Enabled = False
mnsifkal.Enabled = False
nid.cbSize = Len(nid)
nid.hWnd = Form1.hWnd
nid.uId = vbNull
nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nid.uCallBackMessage = WM_MOUSEMOVE
nid.hIcon = Form1.Icon
nid.szTip = "Klas 1.0" & vbNullChar
Shell_NotifyIcon NIM_ADD, nid
Me.Visible = False
End Sub
Private Sub Form_Terminate()
Shell_NotifyIcon NIM_DELETE, nid
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim snc
snc = MsgBox("Programı sonlandırmak şifrelenmiş tum klasorlerin şifrelerini kaldırır. Programdan cıkmak istediğinize emin misiniz?", vbExclamation + vbYesNo, "Dikkat!")
If snc = vbNo Then
Cancel = -1
Else
End
End If
Shell_NotifyIcon NIM_DELETE, nid
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As Long
msg = X / Screen.TwipsPerPixelX
Select Case msg
Case WM_LBUTTONDOWN
Case WM_LBUTTONUP
Case WM_LBUTTONDBLCLK 'sol tus cift klik
mnac_Click
Case WM_RBUTTONDOWN 'sag tus basili
PopupMenu mntsk, , , , mnac
Case WM_RBUTTONUP 'sag tus basilip birakildi
Case WM_RBUTTONDBLCLK 'sag tus cift klik
End Select
End Sub
Private Sub mncks_Click()
mncıkıs_Click
End Sub
Private Sub mnekle_Click()
EklenenKlasor = BrowseForFolder(Me.hWnd, "Şifrelenecek Klasoru Seciniz")
If EklenenKlasor = "" Then
Exit Sub
ElseIf EklenenKlasor = "A:" Or EklenenKlasor = "B:" Or EklenenKlasor = "C:" Or EklenenKlasor = "D:" Or EklenenKlasor = "E:" Or EklenenKlasor = "F:" Or EklenenKlasor = "G:" Or EklenenKlasor = "H:" Or EklenenKlasor = "I:" Then
MsgBox EklenenKlasor & " şifrelenemez.", vbCritical, "Hata"
Exit Sub
Else
SifrelenecekKlasorler.AddItem EklenenKlasor
SifreDurumu.AddItem "Şifresiz"
End If
End Sub
Private Sub KlasorTara_Timer()
Dim i, j, cvp
For i = 0 To AktifPencereler.ListCount - 1
For j = 0 To SifrelenenKlasorler.ListCount - 1
If AktifPencereler.List(i) = SifrelenenKlasorler.List(j) Then
sayacno = j
kls = SifrelenenKlasorler.List(j)
KlasoruYokEt
Form2.Show
KlasorTara.Enabled = False
Exit Sub
Else
End If
Next j
Next i
End Sub
Private Sub mnsfrdeg_Click()
mnsifdeg_Click
End Sub
Private Sub mnsifdeg_Click()
Form3.Show
End Sub
Private Sub mnsifkal_Click()
Dim i, j
If SifreDurumu.List(SifrelenecekKlasorler.ListIndex) = "Şifresiz" Then
Exit Sub
Else
For j = 0 To SifrelenenKlasorler.ListCount - 1
If SifrelenenKlasorler.List(j) = SifrelenecekKlasorler.List(SifrelenecekKlasorler.L istIndex) Then
SifrelenenKlasorler.RemoveItem j
Else
End If
Next j
SifreDurumu.RemoveItem SifrelenecekKlasorler.ListIndex
SifreDurumu.AddItem "Şifresiz", SifrelenecekKlasorler.ListIndex
SifreDurumu.ListIndex = SifrelenecekKlasorler.ListIndex
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(3).Enabled = True
Toolbar1.Buttons(4).Enabled = False
mncıkar.Enabled = True
mnsifrele.Enabled = True
mnsifkal.Enabled = False
Open App.Path & "sfk.dll" For Output As #1
For i = 0 To SifrelenenKlasorler.ListCount - 1
Print #1, SifrelenenKlasorler.List(i)
Next
Close #1
End If
End Sub
Private Sub mnsifrele_Click()
Dim i
If SifreDurumu.List(SifrelenecekKlasorler.ListIndex) = "Şifrelendi" Then
Exit Sub
Else
SifrelenenKlasorler.AddItem SifrelenecekKlasorler.List(SifrelenecekKlasorler.L istIndex)
SifreDurumu.RemoveItem SifrelenecekKlasorler.ListIndex
SifreDurumu.AddItem "Şifrelendi", SifrelenecekKlasorler.ListIndex
SifreDurumu.ListIndex = SifrelenecekKlasorler.ListIndex
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = False
Toolbar1.Buttons(4).Enabled = True
mncıkar.Enabled = False
mnsifrele.Enabled = False
mnsifkal.Enabled = True
Open App.Path & "sfk.dll" For Output As #1
For i = 0 To SifrelenenKlasorler.ListCount - 1
Print #1, SifrelenenKlasorler.List(i)
Next
Close #1
End If
End Sub
Private Sub PencereTara_Timer()
Prog = WS_VISIBLE Or WS_BORDER
TumunuAl
End Sub
Private Sub SifrelenecekKlasorler_Click()
SifreDurumu.ListIndex = SifrelenecekKlasorler.ListIndex
If SifreDurumu.List(SifreDurumu.ListIndex) = "Şifrelendi" Then
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = False
Toolbar1.Buttons(4).Enabled = True
mncıkar.Enabled = False
mnsifrele.Enabled = False
mnsifkal.Enabled = True
ElseIf SifreDurumu.List(SifreDurumu.ListIndex) = "Şifresiz" Then
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(3).Enabled = True
Toolbar1.Buttons(4).Enabled = False
mncıkar.Enabled = True
mnsifrele.Enabled = True
mnsifkal.Enabled = False
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "ekle"
mnekle_Click
Case "cıkar"
mncıkar_Click
Case "sifrele"
mnsifrele_Click
Case "sifreac"
mnsifkal_Click
Case "sifredegistir"
mnsifdeg_Click
Case "hakkında"
Case "cıkıs"
mncıkıs_Click
Case "gizle"
nid.cbSize = Len(nid)
nid.hWnd = Form1.hWnd
nid.uId = vbNull
nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nid.uCallBackMessage = WM_MOUSEMOVE
nid.hIcon = Form1.Icon
nid.szTip = "Klas 1.0" & vbNullChar
Shell_NotifyIcon NIM_ADD, nid
Me.Visible = False
End Select
End Sub
FORM2
Dim izin
Private Sub Giris_Click()
SifreKontrolEt
End Sub
Private Sub Kapat_Click()
Unload Me
End Sub
Function SifreKontrolEt()
izin = 1
If Form1.Sifre.Text = SifreGiris.Text Then
Form1.DogruSifre
Form1.KlasorTara.Enabled = True
Unload Me
Else
MsgBox "Şifre yanlış. Bu klasoru acılamıyor.", vbCritical, "Yanlış Şifre"
Form1.YanlısSifre
Form1.KlasorTara.Enabled = True
Unload Me
End If
End Function
Private Sub Form_Load()
izin = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
If izin = 0 Then
Form1.YanlısSifre
Form1.KlasorTara.Enabled = True
Else
End If
End Sub
Private Sub SifreGiris_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Giris_Click
End If
End Sub
FORM3
Private Sub DegisecekSifre_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Giris_Click
End If
End Sub
Private Sub Giris_Click()
If DegisecekSifre.Text = Form1.Sifre.Text Then
Form4.Show
Unload Me
ElseIf DegisecekSifre.Text = "" Then
MsgBox "Lutfen değişmesini istediğiniz şifreyi giriniz.", vbExclamation, "Şifre Değiştir"
Exit Sub
Else
MsgBox "Yanlış şifre.", vbCritical, "Hata"
Unload Me
End If
End Sub
Private Sub Kapat_Click()
Unload Me
End Sub
FORM4
Dim sfkar(108) As String
Function SifreSifrele()
Dim uzunluk
Dim harf
uzunluk = Len(YeniSifre2.Text)
Text1.Text = ""
For X = 1 To uzunluk
harf = Mid(YeniSifre2.Text, X, 1)
For Y = 1 To 107
If harf = sfkar(Y) Then
If harf = sfkar(107) Then
Text1.Text = Text1.Text & sfkar(107)
GoTo 10
End If
Text1.Text = Text1.Text & sfkar(Y + 1)
10 End If
Next
Next
Open App.Path & "sfr.dll" For Output As 1
Print #1, Text1.Text
Close #1
End Function
Function sifrecoz()
Dim sif As String
Dim uzunluk
Dim harf
Open App.Path & "sfr.dll" For Input As 1
While Not EOF(1)
Input #1, sif
Text1.Text = sif
Wend
Close #1
uzunluk = Len(Text1.Text)
For X = 1 To uzunluk
harf = Mid(Text1.Text, X, 1)
For Y = 1 To 107
If harf = sfkar(Y) Then
If harf = sfkar(107) Then
Text2.Text = Text2.Text & sfkar(107)
GoTo 20
End If
Text2.Text = Text2.Text & sfkar(Y - 1)
20 End If
Next
Next
Form1.Sifre.Text = Text2.Text
Form5.Text1.Text = Text2.Text
End Function
Private Sub Form_Load()
sfkar(1) = "%"
sfkar(2) = "]"
sfkar(3) = "/"
sfkar(4) = "^"
sfkar(5) = "f"
sfkar(6) = "k"
sfkar(7) = "o"
sfkar(8) = "ş"
sfkar(9) = "v"
sfkar(10) = "."
sfkar(11) = "4"
sfkar(12) = "9"
sfkar(13) = "$"
sfkar(14) = "_"
sfkar(15) = "="
sfkar(16) = "b"
sfkar(17) = "g"
sfkar(18) = "l"
sfkar(19) = "p"
sfkar(20) = "u"
sfkar(21) = "w"
sfkar(22) = ","
sfkar(23) = "1"
sfkar(24) = "5"
sfkar(25) = "#"
sfkar(26) = "["
sfkar(27) = "-"
sfkar(28) = "*"
sfkar(29) = "&"
sfkar(30) = "c"
sfkar(31) = "h"
sfkar(32) = "j"
sfkar(33) = "n"
sfkar(34) = "s"
sfkar(35) = "u"
sfkar(36) = "z"
sfkar(37) = "q"
sfkar(38) = "A"
sfkar(39) = "F"
sfkar(40) = "M"
sfkar(41) = "T"
sfkar(42) = "X"
sfkar(43) = "2"
sfkar(44) = "7"
sfkar(45) = ""
sfkar(46) = """"
sfkar(47) = "