Şifre depolama kodları

[AgentWalter]

Ayyıldız2 | 2008 TR Yapısı • 1-99 Orta Emek Destan • Oto Avsız • 10 Temmuz 21:00 HEMEN TIKLA!

Form1'in kodları

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

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

 

[turkmmouser03]

Teşşekurler . Kaliteli Bir Konu Olmuş .