الكتابة بالملف

انشيء فورم جديد و انسخ الكود التالي اليه و به 2 function لقراءة الملف بالبايت و 2 fuction لكتابة الملف باليايت

Private Function ReadByteArrayFromBinaryFile(ByVal Filename As String) As Byte()
	Dim FileNo As Integer, FileSize As Long
	Dim ByteArray() As Byte

	FileNo = FreeFile
	Open Filename For Binary Access Read Shared As #FileNo
	'Open Filename For Input As #FileNo
		FileSize = LOF(FileNo)  ' get the file size

		ReDim ByteArray(1 To FileSize)

		Get #FileNo, , ByteArray()
		ReadByteArrayFromBinaryFile = ByteArray()
				MsgBox ByteArray(8)


	Close #FileNo
End Function


Private Sub WriteByteArrayToBinaryFile(ByVal Filename As String, ByRef ByteArray() As Byte)
	Dim FileNo As Integer

	FileNo = FreeFile ' get next available file number
	Open Filename For Binary Access Write Shared As #FileNo

		Put #FileNo, , ByteArray()

	Close #FileNo
End Sub



Private Function ReadBinaryFile(ByVal Filename As String) As String
	Dim FileNo As Integer, FileSize As Long
	Dim i As Long, Loops As Long, Remainder As Long
	Dim Buffer As String
	Dim BinaryData As String

	Const BUFFER_SIZE As Integer = 30000

	FileNo = FreeFile
	Open Filename For Binary Access Read Shared As #FileNo

		FileSize = LOF(FileNo)  ' get the file size
		Loops = Int(FileSize / BUFFER_SIZE)  ' calculate number of loops required

		For i = 1 To Loops
			Buffer = String$(BUFFER_SIZE, Chr$(0))
			Get #FileNo, , Buffer
			BinaryData = BinaryData & Buffer
		Next

		' fill in the leftovers
		'
		Remainder = FileSize Mod BUFFER_SIZE
		If Remainder > 0 Then
			Buffer = String$(Remainder, Chr$(0))
			Get #FileNo, , Buffer
			BinaryData = BinaryData & Buffer
		End If

		ReadBinaryFile = BinaryData

	Close #FileNo
End Function


Private Sub WriteBinaryFile(ByVal Filename As String, ByVal BinaryData As String)
	Dim FileNo As Integer, FileSize As Long
	Dim i As Long, Loops As Long, Remainder As Long
	Dim Buffer As String

	Const BUFFER_SIZE As Integer = 30000

	FileNo = FreeFile ' get next available file number
	Open Filename For Binary Access Write Shared As #FileNo

		Loops = Int(Len(BinaryData) / BUFFER_SIZE)   ' calculate number of loops

		For i = 1 To Loops
			Buffer = String$(BUFFER_SIZE, Chr$(0))
			Buffer = Mid$(BinaryData, (BUFFER_SIZE * (i - 1)) + 1, BUFFER_SIZE)
			Put #FileNo, , Buffer
			Buffer = ""
		Next

		' fill in the leftovers
		'
		Remainder = Len(BinaryData) Mod BUFFER_SIZE
		If Remainder > 0 Then
			Buffer = String$(Remainder, Chr$(0))
			Buffer = Right(BinaryData, Remainder)
			Put #FileNo, , Buffer
			Buffer = ""
		End If

	Close #FileNo
End Sub

Private Sub Command1_Click()
ReadByteArrayFromBinaryFile ("c:\w.ico")
End Sub

مع العلم ان انك تستطيع تجربة الكود عن طريق اضافة command1 و لقد اضفت لك الكود command1_click لكي تستطيع تجربته بمجرد تشغيل المشروع و النقر على ال Command1

لا تنسى ان تشيء ملف في الهارديسك القرص c باسم w.ico حيث انه الملف المستخدم في التجربة .

الرسالة التي ستظهر ستعطيك الحجم بالبايت

شكرا أخي Qousay

وبصراحة هذا ما أردته

Private Sub Command1_Click()
Dim ahmad As Byte
ahmad = 255 'ff
Open "d:\ahmad.txt" For Binary As 1
Put #1, , ahmad
Close (1)
End Sub

والحمد لله حصلت عليه

طبعا كان لجوابك أثر كبير ;)