[boty]

أهلا اصدقائي كيف الحال اليوم :o
أريد خدمة صغيرة
لدي مثلا برنامج صغير لا يحتوي الا على rich box
كيف اجعل برنامجي بديلا عن النوتباد بحيث عند النقر مرتين على اي ملف له امتداد txt يفتح تلقائيا برنامجي و يذكر ما كتب في rich box
و انا اعرف الكود لكي نجعله يفتح عن طريق open file dialog من داخل البرنامج

لكنه اريده ان يفتح كانوت باد حتى و ان كان البرنامج مغلقا
ما الحل ؟

[AHMED HUSSIEN]

PHP كود :

Public Sub NewFileType(ByRef ProgramPath As String, ByVal Extension As String, ByRef FileIcon As String, ByRef Description As String)
        Dim W As Object
        Dim E As String
        W = CreateObject("Wscript.shell")
        If VB.Left(Extension, 1) <> "." Then
            E = "." & Extension & "\"
        Else
            E = Extension & "\"
            Extension = Mid(Extension, 2)
        End If
        W.regwrite("HKCR\" & E, Extension & " File")
        W.regwrite("HKCR\" & Extension & " File\", Description)
        W.regwrite("HKCR\" & Extension & " File\DefaultIcon\", FileIcon)
        W.regwrite("HKCR\" & Extension & " File\Shell\Open\Command\", ProgramPath & " %1")
        W.regwrite("HKCR\" & Extension & " File\Shell\", "Open")
    End Sub 


الأستخدام :

PHP كود :

NewFileType(Application.ExecutablePath, "txt", "G:\Icon_96.ico", "Notepad Files") 


يجب عمل ما فى الصورة كى يعمل الكود

[AHMED HUSSIEN]

نسيت لقراءة الملف ضع الكود التالى فى Form_Load

PHP كود :

If Trim(VB.Command()) <> "" Then
            If Dir(Trim(VB.Command())) <> "" Then
                Try
                    RichTextBox1.LoadFile(Trim(VB.Command()))
                Catch ex As Exception
                    Try
                        RichTextBox1.LoadFile(Trim(VB.Command()))
                    Catch eh As Exception
                        Me.RichTextBox1.Text = My.Computer.FileSystem.ReadAllText(Trim(VB.Command()))
                    End Try
                End Try
            End If
        End If 


[boty]

شكرا اخي جاري التجربة

[boty]

ahmed hussien كتب :

PHP كود :

public sub newfiletype(byref programpath as string, byval extension as string, byref fileicon as string, byref description as string)
        dim w as object
        dim e as string
        w = createobject("wscript.shell")
        if vb.left(extension, 1) <> "." then
            e = "." & extension & "\"
        else
            e = extension & "\"
            extension = mid(extension, 2)
        end if
        w.regwrite("hkcr\" & e, extension & " file")
        w.regwrite("hkcr\" & extension & " file\", description)
        w.regwrite("hkcr\" & extension & " file\defaulticon\", fileicon)
        w.regwrite("hkcr\" & extension & " file\shell\open\command\", programpath & " %1")
        w.regwrite("hkcr\" & extension & " file\shell\", "open")
    end sub 


الأستخدام :

PHP كود :

newfiletype(application.executablepath, "txt", "g:\icon_96.ico", "notepad files") 


يجب عمل ما فى الصورة كى يعمل الكود

هناك خطأ في هذا الكود ارجو لحل

إقتباس :if vb.left(extension, 1) <> "." then

يقول ان هناك خطا في vb

[AHMED HUSSIEN]

اسف نسيت
ضع هذا السطر فى الأعلى (اول سطر)

Imports VB = Microsoft.VisualBasic

[boty]

الصراحة اخي انا مش فاهم حاجة نهااااائي

و البرنمج فتح و قفل و عمل العجايب O.o

[AHMED HUSSIEN]

تم حل المشكلة وتم تجربة الكود

PHP كود :

Imports Microsoft.Win32

Public Class Form1
    Dim p As String = ""

    Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
        If p <> "" Then
            RichTextBox1.SaveFile(p)
        End If
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim r As RegistryKey = Registry.ClassesRoot.OpenSubKey("\txtFile\Shell\Open\Command", True)
        r.SetValue(Nothing, Application.ExecutablePath & " %1")
        If Trim(Microsoft.VisualBasic.Command()) <> "" Then
            If Dir(Trim(Microsoft.VisualBasic.Command())) <> "" Then
                Try
                    RichTextBox1.LoadFile(Trim(Microsoft.VisualBasic.Command()))
                Catch ex As Exception
                    Try
                        RichTextBox1.LoadFile(Trim(Microsoft.VisualBasic.Command()))
                    Catch eh As Exception
                        Me.RichTextBox1.Text = My.Computer.FileSystem.ReadAllText(Trim(Microsoft.VisualBasic.Command()))
                    End Try
                End Try
                p = Microsoft.VisualBasic.Command()
            End If
        End If
    End Sub

End Class 


ليس من الضروى تشغيل البرنامج كمسؤول يعنى يمكنك اعادة السطر الذى فى الصورة التى فى الأعلى الى ما كان عليه

[boty]

اشكرك أخي لكني عندما ضغطت على run ظهر خطأ في هذا الكود

إقتباس :Dim r As RegistryKey = Registry.ClassesRoot.OpenSubKey("\txtFile\Shell\Open\Command", True)

و رسالة الخطأ تقول

إقتباس :Requested registry access is not allowed.

ما العمل الآن ؟

[AHMED HUSSIEN]

اسف اخى اعد عمل الذى فى الصورة التى بالأعلى
وانشاء الله لن يحدث اى خطأ تانى