//ممكن مساعدة حول أدراج الصور في قاعدة بيانات //

Private Declare Function GetTempFileName Lib "Kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Public Function GetTMPFileName() As String
	GetTMPFileName = String(1024, 0)

	GetTempFileName Environ("Temp"), "TCP", 0, GetTMPFileName
	GetTMPFileName = Replace(GetTMPFileName, Chr(0), "")
End Function
Public Function SavePicToDB(ByVal Field As ADODB.Field, ByVal Picture As IPictureDisp) As Boolean
   On Error GoTo Err:

	Dim TMPPath As String
	Dim iStream As ADODB.Stream
	Set iStream = New ADODB.Stream

	iStream.Type = adTypeBinary
	iStream.Open

	TMPPath = GetTMPFileName
	If Picture.Handle <> 0 Then
		SavePicture Picture, TMPPath
		iStream.LoadFromFile TMPPath
		Field.Value = iStream.Read
	Else
		Field.Value = ""
	End If

	Set iStream = Nothing

	Kill TMPPath
	SavePicToDB = True

	Exit Function
Err:
	RaiseError Err.Number, Err.Description
	If IsExist(TMPPath) Then
		Kill TMPPath
	End If
End Function
Public Function GetPicFromDB(ByVal Field As ADODB.Field) As IPictureDisp
	On Error GoTo Err:

	Dim TMPPath As String
	Dim iStream As ADODB.Stream
	Set iStream = New ADODB.Stream

	iStream.Type = adTypeBinary
	iStream.Open

	iStream.Write Field.Value

	TMPPath = GetTMPFileName
	iStream.SaveToFile TMPPath, adSaveCreateOverWrite

	Set GetPicFromDB = LoadPicture(TMPPath)

	Set iStream = Nothing

	Kill TMPPath

	Exit Function
Err:
	Err.Clear
	Set GetPicFromDB = Nothing
	If IsExist(TMPPath) Then
		Kill TMPPath
	End If
End Function