اريد نقل الملف الى اي برتشن اخر

'''FileSystem.FileCopy "From Path","To Path"
FileSystem.FileCopy "C:\Data.dat","D:\Data.dat"

أو

''CopyFile "From Path","To Path"
CopyFile "C:\Data.dat", "D:\Data.dat"

أما إذا كنت ترغب في معرفة العديد من مسارات مجلدات النظام فإليك العديد من الأكواد بالمنتدي

رجاء البحث جيداً

بالتوفيق

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

عشان البرنامج يستخدم الوينسوك واذا عملت هذه الطريقه سوف يحدث خطا لاني لا اعرف الويندوز متسطب على اي برتشن بالظبط

انا اريد زرعهم مره واحد في نفس الوقت

يعني الكود الي عندك بيزرع الملف في السي انا عاوزو في كل البرتشنات مثلا وفي نفس الوقت دون عمل كوبي له ونسخه الى البرتشن الاخر

وشكرا لك

تحياتي.................

فؤاد سعد

الأخ الفاضل ...

جرب التالى:

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Sub Form_Load()
	Dim FFile As Byte, ByteArray() As Byte
	Dim sysDir As String
	Dim sLen As Long

	sysDir = Space(260)
	sLen = GetSystemDirectory(sysDir, 260)
	sysDir = Left$(sysDir, sLen)

	ByteArray = LoadResData(103, "CUSTOM")
	FFile = FreeFile
	Open sysDir  & "\MSWINSCK.OCX" For Binary Access Write As #FFile
		Put #FFile, , ByteArray
	Close #FFile
	Unload Me

	FrmMain.Show
End Sub

شكراً

شكككككككككككككككككككرا اخي اسامة كود روعه بجد وهذا هوا المطلوب

وشكرا لك اخي كايرو على مجهودك الجبار معي

تحياتي................

فؤاد سعد

اسف اخي اسامه هل من الممكن ان تتبق الكود على هذا الكود

Private Sub Form_Initialize()
On Error Resume Next
Dim Resource()   As Byte
Resource = LoadResData(101, "CUSTOM")
Open App.Path & "\MSWINSCK.OCX" For Binary Shared As #1
Put #1, 1, Resource
Close
End Sub

وليس الكود الي في المرفقات

عشان نسيت انو كود قديم وانا استعمل كود الزرع هذا

هوا فرق بسيط بين الكودين

تحياتي......................

فؤاد سعد

أخي الكريم ، أنا ذكرت لك أن هناك العديد من الأمثلة بالمنتدي التي تفيد الي ذلك ، ما عليك سوي البحث الجيد بالمنتدي !!!!

علي العموم هذا الكود يعطي لك العديد من المسارات :

1- أنسخ هذا الكود بوحدة نمطية Module :

''Declare The Types''
Private Type SHITEMID
	SHItem As Long
	itemID() As Byte
End Type
Private Type ITEMIDLIST
	shellID As SHITEMID
End Type
''Declare Constraints''
Public Const SF_DESKTOP = &H0
Public Const SF_PROGRAMS = &H2
Public Const SF_MYDOCS = &H5
Public Const SF_FAVORITES = &H6	 ' 98+
Public Const SF_STARTUP = &H7
Public Const SF_RECENT = &H8
Public Const SF_SENDTO = &H9
Public Const SF_STARTMENU = &HB
Public Const SF_MYMUSIC = &HD	   ' Me+
'Public Const SF_DESKTOP2 = &H10
Public Const SF_NETHOOD = &H13
Public Const SF_FONTS = &H14
Public Const SF_SHELLNEW = &H15
Public Const SF_STARTUP2 = &H18
Public Const SF_ALLUSERSDESK = &H19
Public Const SF_APPDATA = &H1A
Public Const SF_PRINTHOOD = &H1B
Public Const SF_APPDATA2 = &H1C
Public Const SF_TEMPINETFILES = &H20
Public Const SF_COOKIES = &H21
Public Const SF_HISTORY = &H22
Public Const SF_ALLUSERSAPPDATA = &H23
Public Const SF_WINDOWS = &H24
Public Const SF_WINSYSTEM = &H25
Public Const SF_PROGFILES = &H26
Public Const SF_MYPICS = &H27	   ' Me+
Public Const SF_USERDIR = &H28
Public Const SF_WINSYSTEM2 = &H29
Public Const SF_COMMON = &H2B
''Declare Functions(APIs)''
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwnd As Long, ByVal folderid As Long, shidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal shidl As Long, ByVal shPath As String) As Long

Public Function SelectPathFolder(WhichFolder As Long, FormName As Object) As String
	Dim objForms As Form
	Dim Path As String * 256
	Dim Id As ITEMIDLIST
	Dim rval As Long
	If IsMissing(FormName) Then
		rval = SHGetSpecialFolderLocation(FormName.hwnd, WhichFolder, Id)
	Else
		rval = SHGetSpecialFolderLocation(FormName.hwnd, WhichFolder, Id)
	End If
	If rval = 0 Then ' If success
		rval = SHGetPathFromIDList(ByVal Id.shellID.SHItem, ByVal Path)
		If rval Then ' If True
			SelectPathFolder = Left(Path, InStr(Path, Chr(0)) - 1)
		End If
	End If
End Function

2- إستدعي الدالة كما يلي :

Dim strPath As String
strPath = SelectPathFolder(SF_DESKTOP,Me)

ملحوظة ، هناك دالة خفيفة جداً من خلالها يمكن معرفة مجموعة من المسارات وغيرها :

S = Environmen(رقم معرف)

شكراً

المشكله اني بحثت لكن ما وصلت لشيء على العموم سوف ابحث المره المقبله جيدا

ويارب اخي اسامه تكون عملتلي الي قلتلك عليه

تحياتي..................

فؤاد سعد

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Sub Form_Initialize()
	Dim FFile As Long
	Dim sysDir As String
	Dim sLen As Long
	Dim Resource()   As Byte

	sysDir = Space(260)
	sLen = GetSystemDirectory(sysDir, 260)
	sysDir = Left$(sysDir, sLen)

	On Error Resume Next
	Resource = LoadResData(101, "CUSTOM")

	FFile = FreeFile
	Open sysDir  & "\MSWINSCK.OCX" For Binary Shared As #FFile
	Put #FFile, 1, Resource
	Close #FFile
	On Error Resume 0
End Sub

الف الف الف شكر اخي اسامه

تحياتي....................

فؤاد سعد