PDA

View Full Version : سوال: اختصاص پسوند فایل ها به نرم افزار من



M_P_1374
سه شنبه 29 بهمن 1387, 09:36 صبح
میخوام یه نرم افزار بنویسم که فایل های تکست رو بخونه میخوام فقط کدش تو فرم باشه و ماژول اینجور چیزا رو نداشته باشه حداکثر کدش هم 30 خط باشه نمیخوام فایل سنگین بشه برای لود کردن عکس رو قبلا داشتم ولی نمیتونستم کدش رو برای تکست هم درست کنم
این کد قبلیه که از سایت v-basic.mihanblog.com


Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Sub SHChangeNotify Lib "shell32.dll" (ByVal wEventId As Long, ByVal uFlags As Long, dwItem1 As Any, dwItem2 As Any)

Private Sub Form_Load()
Image1.Stretch = True
Image1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
'
RegisterFile ".BMP"
RegisterFile ".JPG"
RegisterFile ".GIF"
RegisterFile ".WMF"
RegisterFile ".EMF"
'
On Error Resume Next
If Len(Command()) > 0 Then
Image1.Picture = LoadPicture(FixPath(Command()))
End If
End Sub

Private Sub RegisterFile(strPasvand As String)
Dim sKeyName As String ' Holds Key Name in registry.
Dim sKeyValue As String ' Holds Key Value in registry.
Dim ret& ' Holds error status if any from API calls.
Dim lphKey& ' Holds key handle from RegCreateKey.
Dim path As String

path = App.path
If Right(path, 1) <> "\" Then
path = path & "\"
End If

' This creates a Root entry called "PicturePreview".
sKeyName = "PicturePreview" ' Project Name
sKeyValue = "Picture"
' This creates a Root entry called .BMP;.JPG;.GIF;.WMF associated with "PicturePreview".
sKeyName = strPasvand
sKeyValue = "PicturePreview" ' Project Name
' This sets the command line for "PicturePreview".
sKeyName = "PicturePreview" ' Project Name
sKeyValue = path & App.EXEName & ".exe %1"
' This sets the icon for the file extension
sKeyName = "PicturePreview" ' Project Name
sKeyValue = path & "MyIcon.ico"
ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, sKeyValue, MAX_PATH)

' This notifies the shell that the icon has changed
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
End Sub

Public Function FixPath(strPath As String) As String
Dim strTemp As String
strTemp = strPath
strChar = """"
If Len(strTemp) > 0 Then
If Mid(strTemp, 1, 1) = strChar Then strTemp = Right(strTemp, Len(strTemp) - 1)
If Mid(strTemp, Len(strTemp), 1) = strChar Then strTemp = Left(strTemp, Len(strTemp) - 1)
End If
FixPath = strTemp
End Function

میشه یه نفر منو راهنمایی کنه

M_P_1374
چهارشنبه 30 بهمن 1387, 09:30 صبح
کسی نیست منو راهنماییم کنه

r0ot$harp
چهارشنبه 30 بهمن 1387, 11:14 صبح
دوست عزیز اینم خدمت شما :


Dim Reg As Object
Set Reg = CreateObject("wscript.shell")

Reg.RegWrite "HKEY_CLASSES_ROOT\.taj\", "ehsan"
Reg.RegWrite "HKEY_CLASSES_ROOT\ehsan\shell\Open With Taj\command\", App.Path & "\" & App.EXEName & ".exe %1"
Reg.RegWrite "HKEY_CLASSES_ROOT\ehsan\DefaultIcon\", App.Path & "\" & "Icon.ICO"

If Command$ <> "" Then
Open Command$ For Input As #1
Text1.Text = Command$ & vbNewLine & Input$(LOF(1), 1)
Close #1
End If
End Sub