belirlediğim bir şifreyi text dosyasındaki veriye eşitlemek

[olymposss]

sn üstadlarım herkese hayırlı günler

şu aralar lisans kodu girilerek kullanılacak bir kod yazmaya çalışıyorum.aklıma bikaç şey takıldı ve size danışmak istedim.kodlar şu şekilde;

Dim psw As String
psw = "123456789"
If psw = ThisWorkbook.Path & "\password.txt" Then
Exit Sub
Else
'...................
UserForm1.Show
End If

yani açıklamak gerekirse belirlediğim psw değeri password.txt dosyasındaki ile aynı ise exit sub,değilse kodlara devam edecek.

yardımcı olacak arkadaşlara şimdiden teşekkür ederim saygılar:yardim:

 

[Zeki Gürsoy]

VB dosya işlemiyle txt nin okunması gerekir.
Bu durumda olması gereken kod;

Dim psw As String, a As String

Open ThisWorkbook.Path & "\password.txt" For Input As #1
    Input #1, a
Close #1

psw = "123456789"
If psw = a Then
Exit Sub
Else
'...................
UserForm1.Show
End If

olmalıdır.

 

[olymposss]

sn anemos
çok teşekkür ederim emeğinize sağlık
saygılar

 

[Haluk]

Alternatif:

Bilgisayarnızda D:\TestFolder şeklinde bir klasör açtıktan sonra;

a) Bilgisayarda bir ini dosyası oluşturmak ve bu ini dosyasına sözkonusu şifreyi yazmak için;

Declare Function WritePrivateProfileString Lib "kernel32" _
        Alias "WritePrivateProfileStringA" _
        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
         ByVal lpString As Any, ByVal lpFileName As String) As Long
'
Sub InıDosyasinaYaz()
    WritePrivateProfileString "MyPaswIni", "Password", "Raider", "D:\TestFolder\Password.ini"
End Sub

b) Esas şifre kontrolu yapılacak dosyada, ini dosyasından şifreyi almak-okumak için;

Declare Function GetPrivateProfileString Lib "kernel32" Alias _
        "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
         ByVal lpKeyName As Any, ByVal lpDefault As String, _
         ByVal lpReturnedString As String, ByVal nSize As Long, _
         ByVal lpFileName As String) As Long
'
Sub InıDosyasindanOku()
    Dim RetVal As String, Temp As Long
    RetVal = String(255, 0)
    Temp = GetPrivateProfileString("MyPaswIni", "Password", "Hata", RetVal, 255, "D:\TestFolder\Password.ini")
    If Temp <> 0 Then RetVal = Left$(RetVal, Temp)
    MsgBox "Sifre = " & RetVal
End Sub

 

[Haluk]

Aynı işleri MS Word altında ve API kullanmadan çok daha kolay yapabiliyoruz;

Sub InıYaz()
    System.PrivateProfileString("D:\TestFolder\Passw.ini", "MyPass", "Password") = "Raider"
End Sub
'
'
'
Sub InıOku()
    Passw = System.PrivateProfileString("D:\TestFolder\Passw.ini", "MyPass", "Password")
    MsgBox "Sifre = " & Passw
End Sub

 

[Haluk]

MS Word altında API kullanmadan yapabiliyorsak, demektir ki Excel'de bir Word uygulaması oluşturup bununla da yapabiliriz ... :mrgreen:

Excel VBA altında çalışacak kodlar:

Sub WD_InıYaz()
    Dim MyWord As Object
    Set MyWord = CreateObject("Word.Application")
    MyWord.System.PrivateProfileString("D:\TestFolder\Passw.ini", "MyPass", "Password") = "Raider"
    MyWord.Quit
    Set MyWord = Nothing
End Sub
'
'
'
Sub WD_InıOku()
    Dim MyWord As Object
    Set MyWord = CreateObject("Word.Application")
    Passw = MyWord.System.PrivateProfileString("D:\TestFolder\Passw.ini", "MyPass", "Password")
    MsgBox "Sifre = " & Passw
    MyWord.Quit
    Set MyWord = Nothing
End Sub

 

[Orion1]

Sayın Haluk hocam.
Çok değerli bilgileriniz için teşekkür ederim.
Arşivime attım.
İyi çalışmalar.

 

[olymposss]

harika kodlar çok teşekkür ederim
çok faydalı olacağına inanıyorum.
saygılar