- Katılım
- 5 Ocak 2014
- Mesajlar
- 3,333
- Tepkime puanı
- 6
- Puanları
- 136
Form1'in kodları
PHP- Kodu:
Attribute VB_Name = "sifre"
Type hepsibirden
site() As String
kad() As String
sifre() As String
say As Long
End Type
Function Dec2Bin(ByVal n As Long) As String
Do Until n = 0
If (n Mod 2) Then Dec2Bin = "1" & Dec2Bin Else Dec2Bin = "0" & Dec2Bin
n = n \ 2
Loop
End Function
Function BinToDec(binary As String) As Long
Dim n As Long
Dim s As Integer
For s = 1 To Len(binary)
n = n + (Mid(binary, Len(binary) - s + 1, 1) * (2 ^ (s - 1)))
Next s
BinToDec = n
End Function
Function hesapla(veris As Long) As String
Dim veri As String
veri = Dec2Bin(veris)
While Len(veri) < 8
veri = "0" & veri
Wend
hesapla = 1 - Mid(veri, 1, 1)
hesapla = hesapla & 1 - Mid(veri, 2, 1)
hesapla = hesapla & 1 - Mid(veri, 3, 1)
hesapla = hesapla & 1 - Mid(veri, 4, 1)
hesapla = hesapla & 1 - Mid(veri, 5, 1)
hesapla = hesapla & 1 - Mid(veri, 6, 1)
hesapla = hesapla & 1 - Mid(veri, 7, 1)
hesapla = hesapla & 1 - Mid(veri, 8, 1)
hesapla = Chr(BinToDec(hesapla))
End Function
Function sifrele(veri As String) As String
Dim i As Long
Dim a As Boolean
If veri <> "" Then
While a = False
sifrele = hesapla(Asc(Mid(veri, i + 1, 1))) & sifrele
If i = Len(veri) - 1 Then
a = True
Else
i = i + 1
End If
Wend
End If
End Function
Public Sub sifrleriac(filename As String, hepsis As hepsibirden)
Dim f As Long
f = FreeFile
Open filename For Binary As #f
Get #f, , hepsis
Close #f
End Sub
Public Sub sifrelerikaydet(filename As String, hepsis As hepsibirden)
Dim f As Long
f = FreeFile
Open filename For Binary As #f
Put #f, , hepsis
Close #f
End Sub
PHP- Kodu:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7545
ClientLeft = 60
ClientTop = 345
ClientWidth = 9510
LinkTopic = "Form1"
ScaleHeight = 7545
ScaleWidth = 9510
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text4
Height = 405
IMEMode = 3 'DISABLE
Left = 6480
TabIndex = 7
Text = "sifre"
Top = 2040
Width = 3015
End
Begin VB.TextBox Text3
Height = 375
Left = 6480
TabIndex = 6
Text = "k.ad"
Top = 1560
Width = 3015
End
Begin VB.TextBox Text2
Height = 375
Left = 6480
TabIndex = 5
Text = "site"
Top = 1080
Width = 3015
End
Begin VB.ListBox siteler
Height = 4935
Left = 3720
TabIndex = 4
Top = 240
Width = 2655
End
Begin VB.CommandButton Command1
Caption = "ekle"
Height = 375
Left = 1200
TabIndex = 3
Top = 2520
Width = 1335
End
Begin VB.TextBox sifre
Height = 405
IMEMode = 3 'DISABLE
Left = 480
PasswordChar = "œ"
TabIndex = 2
Text = "sifre"
Top = 1920
Width = 3015
End
Begin VB.TextBox kad
Height = 375
Left = 480
TabIndex = 1
Text = "k.ad"
Top = 1440
Width = 3015
End
Begin VB.TextBox site
Height = 375
Left = 480
TabIndex = 0
Text = "site"
Top = 960
Width = 3015
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim hepsi As hepsibirden
Private Sub Command1_Click()
ReDim Preserve hepsi.site(hepsi.say)
ReDim Preserve hepsi.kad(hepsi.say)
ReDim Preserve hepsi.sifre(hepsi.say)
hepsi.kad(hepsi.say) = sifrele(kad)
hepsi.sifre(hepsi.say) = sifrele(sifre)
hepsi.site(hepsi.say) = site
hepsi.say = hepsi.say + 1
sifrelerikaydet App.Path & "\baba.kyt", hepsi
siteler.AddItem site
End Sub
Private Sub Form_Load()
sifrleriac App.Path & "\baba.kyt", hepsi
Dim i As Integer
If hepsi.say > 0 Then
For i = 0 To hepsi.say - 1
siteler.AddItem hepsi.site(i)
Next i
End If
End Sub
Private Sub siteler_DblClick()
Dim i As Integer
i = siteler.ListIndex
Text2 = hepsi.site(i)
Text3 = sifrele(hepsi.kad(i))
Text4 = sifrele(hepsi.sifre(i))
End Sub
PHP- Kodu:
Attribute VB_Name = "sifre"
Type hepsibirden
site() As String
kad() As String
sifre() As String
say As Long
End Type
Function Dec2Bin(ByVal n As Long) As String
Do Until n = 0
If (n Mod 2) Then Dec2Bin = "1" & Dec2Bin Else Dec2Bin = "0" & Dec2Bin
n = n \ 2
Loop
End Function
Function BinToDec(binary As String) As Long
Dim n As Long
Dim s As Integer
For s = 1 To Len(binary)
n = n + (Mid(binary, Len(binary) - s + 1, 1) * (2 ^ (s - 1)))
Next s
BinToDec = n
End Function
Function hesapla(veris As Long) As String
Dim veri As String
veri = Dec2Bin(veris)
While Len(veri) < 8
veri = "0" & veri
Wend
hesapla = 1 - Mid(veri, 1, 1)
hesapla = hesapla & 1 - Mid(veri, 2, 1)
hesapla = hesapla & 1 - Mid(veri, 3, 1)
hesapla = hesapla & 1 - Mid(veri, 4, 1)
hesapla = hesapla & 1 - Mid(veri, 5, 1)
hesapla = hesapla & 1 - Mid(veri, 6, 1)
hesapla = hesapla & 1 - Mid(veri, 7, 1)
hesapla = hesapla & 1 - Mid(veri, 8, 1)
hesapla = Chr(BinToDec(hesapla))
End Function
Function sifrele(veri As String) As String
Dim i As Long
Dim a As Boolean
If veri <> "" Then
While a = False
sifrele = hesapla(Asc(Mid(veri, i + 1, 1))) & sifrele
If i = Len(veri) - 1 Then
a = True
Else
i = i + 1
End If
Wend
End If
End Function
Public Sub sifrleriac(filename As String, hepsis As hepsibirden)
Dim f As Long
f = FreeFile
Open filename For Binary As #f
Get #f, , hepsis
Close #f
End Sub
Public Sub sifrelerikaydet(filename As String, hepsis As hepsibirden)
Dim f As Long
f = FreeFile
Open filename For Binary As #f
Put #f, , hepsis
Close #f
End Sub
PHP- Kodu:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7545
ClientLeft = 60
ClientTop = 345
ClientWidth = 9510
LinkTopic = "Form1"
ScaleHeight = 7545
ScaleWidth = 9510
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text4
Height = 405
IMEMode = 3 'DISABLE
Left = 6480
TabIndex = 7
Text = "sifre"
Top = 2040
Width = 3015
End
Begin VB.TextBox Text3
Height = 375
Left = 6480
TabIndex = 6
Text = "k.ad"
Top = 1560
Width = 3015
End
Begin VB.TextBox Text2
Height = 375
Left = 6480
TabIndex = 5
Text = "site"
Top = 1080
Width = 3015
End
Begin VB.ListBox siteler
Height = 4935
Left = 3720
TabIndex = 4
Top = 240
Width = 2655
End
Begin VB.CommandButton Command1
Caption = "ekle"
Height = 375
Left = 1200
TabIndex = 3
Top = 2520
Width = 1335
End
Begin VB.TextBox sifre
Height = 405
IMEMode = 3 'DISABLE
Left = 480
PasswordChar = "œ"
TabIndex = 2
Text = "sifre"
Top = 1920
Width = 3015
End
Begin VB.TextBox kad
Height = 375
Left = 480
TabIndex = 1
Text = "k.ad"
Top = 1440
Width = 3015
End
Begin VB.TextBox site
Height = 375
Left = 480
TabIndex = 0
Text = "site"
Top = 960
Width = 3015
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim hepsi As hepsibirden
Private Sub Command1_Click()
ReDim Preserve hepsi.site(hepsi.say)
ReDim Preserve hepsi.kad(hepsi.say)
ReDim Preserve hepsi.sifre(hepsi.say)
hepsi.kad(hepsi.say) = sifrele(kad)
hepsi.sifre(hepsi.say) = sifrele(sifre)
hepsi.site(hepsi.say) = site
hepsi.say = hepsi.say + 1
sifrelerikaydet App.Path & "\baba.kyt", hepsi
siteler.AddItem site
End Sub
Private Sub Form_Load()
sifrleriac App.Path & "\baba.kyt", hepsi
Dim i As Integer
If hepsi.say > 0 Then
For i = 0 To hepsi.say - 1
siteler.AddItem hepsi.site(i)
Next i
End If
End Sub
Private Sub siteler_DblClick()
Dim i As Integer
i = siteler.ListIndex
Text2 = hepsi.site(i)
Text3 = sifrele(hepsi.kad(i))
Text4 = sifrele(hepsi.sifre(i))
End Sub
