Gözcü (Visual Basic)

Eray T dedi:

Olay bu .

Eki Görüntüle 897510

Genişletmek için tıkla...

Buğra S dedi:

Site ne zaman gelecek hocam .
Geldikten sonra da yazdığım gibi yapancı forumlara konu açın biraz yayılsın program.

Genişletmek için tıkla...

TahaEren dedi:

@Eray T hocam bu ekranda ne yapmam gerek?

Eki Görüntüle 897538

Genişletmek için tıkla...

Pmw dedi:

Lisans sorunu için çözümü buldum. Techspot'un kodunda oynamalar yaparak daha uygun hale getirdim. license_key.vbs Dosyasının içindekilerini bunlarla değiştirirseniz sorun çözülür.

Sürprizbozan: Kod

[CODE lang="csharp" title="Kodlar"]Option Explicit
Dim objshell,path,DigitalID, Result
Set objshell = CreateObject("WScript.Shell")
'Set registry key path
Path = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
'Registry key value
DigitalID = objshell.RegRead(Path & "DigitalProductId")
Dim ProductName,ProductID,ProductKey,ProductData
'ProductKey
ProductKey = "Urun Anahtari: " & ConvertToKey(DigitalID)
ProductData = ProductKey
'Show messbox if save to a file
If vbYes = MsgBox(ProductData & vblf & vblf & "Dosyaya kaydetmek ister misiniz?", vbYesNo + vbQuestion, "BackUp Windows Key Information") then
Save ProductData
End If
'Convert binary to chars
Function ConvertToKey(Key)
Const KeyOffset = 52
Dim isWin8, Maps, i, j, Current, KeyOutput, Last, keypart1, insert
'Check if OS is Windows 8
isWin8 = (Key(66) \ 6) And 1
Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
i = 24
Maps = "BCDFGHJKMPQRTVWXY2346789"
Do
Current= 0
j = 14
Do
Current = Current* 256
Current = Key(j + KeyOffset) + Current
Key(j + KeyOffset) = (Current \ 24)
Current=Current Mod 24
j = j -1
Loop While j >= 0
i = i -1
KeyOutput = Mid(Maps,Current+ 1, 1) & KeyOutput
Last = Current
Loop While i >= 0

If (isWin8 = 1) Then
keypart1 = Mid(KeyOutput, 2, Last)
insert = "N"
KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
If Last = 0 Then KeyOutput = insert & KeyOutput
End If
ConvertToKey = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5)
End Function
'Save data to a file
Function Save(Data)
Dim fso, fName, txt,objshell,UserName
Set objshell = CreateObject("wscript.shell")
'Get current user name
UserName = objshell.ExpandEnvironmentStrings("%UserName%")
'Create a text file on desktop
fName = "C:\Users\" & UserName & "\Desktop\WindowsUrunAnahtari.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.CreateTextFile(fName)
txt.Writeline Data
txt.Close
End Function[/CODE]

Genişletmek için tıkla...

Buğra S dedi:

Yalnız hocam siz kapalı kaynak programın içini açtınız .

Genişletmek için tıkla...

Measterpo dedi:

Canım sıkıldı, dersler yüzünden Adobe uygulamalarının yüzüne bakamıyordum hazır boş duruyorken biraz arayüzü geliştirsek nasıl olur diye düşündüm, sizin tasarımınızı bozmadan biraz güzelleştirmeye çalıştım sadece, olduğu kadar diyelim. Anlam veremediğim şekilde pikselleşmiş fotoğraflar, kalite için kusura bakmayın. Şimdi fark ediyorum sol taraftaki menüde unuttuğum sekmeler var, ve sekmeler biraz büyük olmuş, gözümden kaçtı sanırım. Kaliteli kaydedip yarına kadar atmış olurum muhtemelen.
Eki Görüntüle 897780

Eki Görüntüle 897768

Genişletmek için tıkla...

Eray T dedi:

Hocam arayüzü nasıl değiştirmeyi başardınız?

Genişletmek için tıkla...