الرجاء ساعدوني الله خليكم ،ابغى رد على هذا السؤال

لنفترض انك قمت بتحميل فيجوال بيسك على المجلد الافتراضي فاذهب الى المسار التالي في جهازك

C:Program FilesMicrosoft Visual StudioVB98WizardsPDWizardSetup1

سوف تجد في هذا المسار برنامج التنصيب الخاص بفيجوال بيسك كاملا مع الكود طبعا بعد عمل كومايل لهذا البرنامج سوف يخرج لك ملف اسمه setup1.exe يتم تشغيل هذا البرنامج عن طريق برنامج افتراضي اسمه setup.exe تم عمله بواسطة فيجوال سي على ما اعتقد الان بواسطة setup.exe يتم نسخ بعض الملفات الضرورية الخاصة لتشغيل ال setup1.exe المعمول بواسطة فيجوال بيسك

قم بوضع الكود التالي داخل البرنامج قبل عمل كومبايل له

Public Sub CreatShortCut()



On Error GoTo er:

Dim wShortcut As IWshShortcut_Class

Dim result As Long

    



    Set wShell = New IWshShell_Class

    

    DesktopPath = GetFolderPath(CSIDL_DESKTOP)

    SendTpPath = GetFolderPath(CSIDL_SENDTO)



    

    If Right$(SendTpPath, 1) <> "" Then SendTpPath = SendTpPath & ""

    Set wShortcut = wShell.CreateShortcut(SendTpPath & "Application name" & ".lnk")

    wShortcut.TargetPath = ss & "FilePart.exe"

    wShortcut.Save

    If Err.Number <> 0 Then MsgBox "cant creat short cut", vbCritical Or vbOKOnly, ""



    result = MsgBox("did you want creat short cut", vbQuestion Or vbYesNo, "")

    If result = vbNo Then Exit Sub

    If Right$(DesktopPath, 1) <> "" Then DesktopPath = DesktopPath & ""

    Set wShortcut = wShell.CreateShortcut(DesktopPath & "Application name" & ".lnk")

    wShortcut.TargetPath = ss & "FilePart.exe"

    wShortcut.Save

    

Exit Sub

er:

MsgBox "", vbCritical Or vbOKOnly, ""

    

End Sub





Public Function GetFolderPath(CSIDL As Long) As String



Dim sPath As String

Dim sTmp As String

Dim ffs As String



   sPath = Space$(260)

   

   If SHGetFolderPath(Me.hwnd, CSIDL, 0&, &H0, sPath) = 0 Then

       sTmp = Left$(sPath, InStr(sPath, Chr$(0)) - 1)

   End If

     

10    If sTmp = "" Then

        ffs = WindowsDirectory

        Select Case CSIDL

            Case &H6 'Favorit

                sTmp = ffs & "Favorites"

            Case &H9 ' SentTo

                sTmp = ffs & "SendTo"

            Case &H21 'Cookies

                sTmp = ffs & "Cookies"

            Case &H0 'Desktop

                sTmp = ffs & "Desktop"

            Case &H7 'Startup

        End Select

    End If

            

   

   GetFolderPath = sTmp

Exit Function

er:

End Function

في حال لم تستطع التعديل على الكود سوف اقوم بارفاقه لك مع مثال كامل

حفظك الله

نريد المثال .. إذا تكرمت

محبك/أبو زيد

جزاك الله الف خير ارفق المثال إذا تكرمت

الملف مرفق ويمكنك تحميله الان لنقل هذا الكود نسيت ان اقول لك يجب ان تقوم بتضمين بعض المكتبات من خلال

من القائمة Project ثم references

قم باختيار المكتبات التالي

vb-frindly shell interface

windows script host object model

ضمن المثال هي مرفقة ولكن حتى تتمكن من نقل الكود بنجاح لاتنسى تضمين هذه المكاتب وعند عملية اعداد برنامج الاعداد سوف يضيف مكتبة ضمن الملفات اعتقد اسمها shfolder.dll

على العموم اقوم حاليا باصلاح قسم الدروس ويوجد درس كامل بخصوص الاعداد يمكنك الرجوع اليه

shortcut.zip