PDA

View Full Version : بررسی کد اضافه نمودن تصویر به بانک و رفع اشکال آن



asef-khan
سه شنبه 18 بهمن 1384, 11:38 صبح
با سلام
این سئوال چگونگی اضافه کردن تصویر به یک بانک اطلاعاتی و بازیابی اون برای من هم مدتهاست بدون
جواب مونده . این بار من کد برنامه ایی که نوشتم رو برای بررسی برای دوستان می ذارم البته این کد ها رو بعد از جستجو پیدا کردم و بنا بر نیاز تغییر دادم
می خوام یه عکس رو به بانک اضافه کنم و سپس بتونم در صورت نیاز از بانک بازیابی و در یک imag
نشان بدم .
ایندر این برنامه فرقی نداره از اکسس یا sql server بشه .
من بعد از اجرای متوجه شدم تصویر در بانک فرستاده می شه . چون اندازه سایز فایل تصویر با اندازه واقعی می خونه .
اما وقتی می خوانم تصویر رو به فایلی موقت منتقل کنم فایل ایجاد شده به روشی که در برنامه امده ناقص هست و امکان نمایش اون وجود نداره .
Private Sub addnewimage_Click()

Dim STRSQL As String
Dim file_num As String
Dim file_length As Long
Dim bytes() As Byte
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim sTitle As String, sFileName As String

Dim rstTemp As New ADODB.Recordset
Dim cn As New ADODB.Connection
cn.ConnectionString = path1
cn.Open

sFileName = "e:\myallpic\Asalem1.JPG"

STRSQL = "select * from s1 where name='test'"

rstTemp.Open STRSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText





file_num = FreeFile
Open sFileName For Binary Access Read As #3

MsgBox Str(LOF(3))

file_length = LOF(3)
MsgBox file_length
If file_length > 0 Then
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE

rstTemp("psize1") = file_length

ReDim bytes(BLOCK_SIZE)
For block_num = 1 To num_blocks
Get #3, , bytes()
rstTemp("phot").AppendChunk bytes()
Next block_num

If left_over > 0 Then
ReDim bytes(left_over)
Get #3, , bytes()
rstTemp("phot").AppendChunk bytes()
End If

Close #3
End If


rstTemp.Update



End Sub


Private Sub givepic_Click()

Dim rstTemp As New ADODB.Recordset
Dim cn As New ADODB.Connection
Dim STRSQL As String
Dim byteChunk() As Byte
Dim strNote As String
Dim Offset As Long
Dim Totalsize As Long
Dim Remainder As Long
Dim NumOfChuncks As Long
Dim CurrentRecPos As Long
Dim FieldSize As Long
Dim FileNumber As Integer
Const HeaderSize As Long = 78
Const ChunkSize As Long = 100



cn.ConnectionString = path1
cn.Open
STRSQL = "select * from s1 where name='test'"

rstTemp.Open STRSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText
FieldSize = rstTemp("PHOT").ActualSize

FieldSize = rstTemp!psize1
MsgBox FieldSize
FileNumber = FreeFile

Open "TempFile.JPG" For Binary Access Write As FileNumber
Totalsize = FieldSize - HeaderSize ' Substract it from the total size.
byteChunk() = rstTemp("PHOT").GetChunk(HeaderSize) ' Get rid of the header.
NumOfChuncks = Totalsize \ ChunkSize
Remainder = Totalsize Mod ChunkSize
If Remainder > 0 Then
byteChunk() = rstTemp("PHOT").GetChunk(Remainder)
Put FileNumber, , byteChunk()
End If
Offset = Remainder
Do While Offset < Totalsize
byteChunk() = rstTemp("PHOT").GetChunk(ChunkSize)
Put FileNumber, , byteChunk()
Offset = Offset + ChunkSize
Loop

MsgBox Str(LOF(FileNumber))

Close FileNumber

pic.Picture = LoadPicture(TempFile.JPG)

End Sub
حالا اگه دوستان عزیز من و بقیه کسانی هنوز دنبال جواب این سوال هستند رو راهنمایی کنند
باتشکر فراوان