Arama butonu
Bu konudaki kullanıcılar: 1 misafir
1
Cevap
296
Tıklama
0
Öne Çıkarma
Visual Basic Ustasıyım Diyenler, bi bakıverin
X
20 yıl
Binbaşı
Konu Sahibi

Arkadaşlar, visual basic'te ufak bir program yzmak istiyorum ama kafama bir iki şey takıldı;

Kendi belirleyeceğim bir dosya uzantısına tıklandığında yazmış olduğum programın çalıştırılmasını istiyorum. Yani diyelim ki belirlediğim dosya uzantısı ".xen" olsun. Bu uzantıya sahip bir dosyaya çift tıklandığında dosyayı açmaya çalışmak yerine direk benim yazdığım program açılsın. Bunu nasıl yapabilirim? Bilen var mı?

Bir de diyelim ki yukarıdakini yapmayı başardım, program açıldığında hangi dosyaya tıklanarak çalıştırıldığını öğrenebilir miyim? Yani program içinde dosyanın bulunduğu adresi ve dosya ismini kullanabileceğim işlemler yapabilir miyim???

DH forumlarında vakit geçirmekten keyif alıyor gibisin ancak giriş yapmadığını görüyoruz.

Üye olduğunda özel mesaj gönderebilir, beğendiğin konuları favorilerine ekleyip takibe alabilir ve daha önce gezdiğin konulara hızlıca erişebilirsin.

Üye Ol Şimdi Değil



G
20 yıl
Yüzbaşı

' Bunları bir modüle koyuver

Public Sub savekey(Hkey As Long, strPath As String)

Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub


Public Function getstring(Hkey As Long, strPath As String, strValue As String)

Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)

If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)

If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))

If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If

End If

End If

End Function


Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)

Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub


Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long

Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)

If lResult = ERROR_SUCCESS Then

If lValueType = REG_DWORD Then
getdword = lBuf
End If

End If

r = RegCloseKey(keyhand)
End Function


Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)

Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
r = RegCloseKey(keyhand)
End Function


Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)

Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function


Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)

Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function


'Burdan Sonrasını da Formun Kod Kısmına


Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long

Private Sub Form_Load()

Dim strString As String
Dim lngDword As Long

If Command$ <> "%1" Then
MsgBox (Command$ & " is the file you need To open!"), vbInformation
'Add to Recent file folder
lReturn = fCreateShellLink("..\..\Recent", _
Command$, Command$, "")
End If


Call savestring(HKEY_CLASSES_ROOT, "\.gns", "", "ganshfile")

Call savestring(HKEY_CLASSES_ROOT, "\.gns", "Content Type", "text/plain")

Call savestring(HKEY_CLASSES_ROOT, "\ganshfile", "", "Dosya Türü için Açıklama Buraya")

Call SaveDword(HKEY_CLASSES_ROOT, "\ganshfile", "EditFlags", "0000")



Call savestring(HKEY_CLASSES_ROOT, "\ganshfile\DefaultIcon", "", App.Path & "\ICON.ico")

Call savestring(HKEY_CLASSES_ROOT, "\ganshfile\Shell", "", "")

Call savestring(HKEY_CLASSES_ROOT, "\ganshfile\Shell\Open", "", "")

Call savestring(HKEY_CLASSES_ROOT, "\ganshfile\Shell\Open\command", "", App.Path & "\Project1.exe %1")
End Sub


Kolay Gelsin...



DH Mobil uygulaması ile devam edin. Mobil tarayıcınız ile mümkün olanların yanı sıra, birçok yeni ve faydalı özelliğe erişin. Gizle ve güncelleme çıkana kadar tekrar gösterme.