Follow the instruction and you may not get an error.
Do this:
>> Go to MySQL Administrator >> Startup Variable >> Advanced Networking >>
Change Max. Pocket Size to 4M or 16M >> Apply Changes >> Exit.
1. Create a table in your MYSQL Database
Database name: "photo"
Table name: "tblpicture"
Fields name and type:
>> "Picture" as LONG BLOB 'where you can save the Image using Binary Data
>> "Picturesize" as Integer 'where you can save the File Size of the Image
>> "ID" as Number , check Autoincrement
2. Then Go to Your Visual Basic 6.0
>>You Need:
Two Modules , One Form and One Picture in your Folder name "No Picture.jpg"
>> In your Form you need two "Image" , Stretch = True
Name: "Image2" and "Image3"
>> three "Command Buttons"
Name: "cmdUpload" and "cmdSave" and "cmdRetrieve"
>>One "CommonDialog"
Name: "CommonDialog1"
3. Code (Form) >> Copy/Paste
'Declaration
Option Explicit
Dim picdialog As Integer
Dim PictureFileName As String
Private Sub cmdUpload_Click()
'For Browsing Pictures
On Error GoTo errhandler
CommonDialog1.CancelError = True
CommonDialog1.Filter = "All Picture Files|*.jpg;*.gif;*.bmp;*.wmf;*.ico|JPEG Images(*.jpg)|*.jpg|Bitmap Images (*.bmp)|*.bmp|Word Meta Files (*.wmf)|*.wmf|GIF Images (*.gif)|*.gif"
CommonDialog1.DialogTitle = "Insert Picture"
CommonDialog1.ShowOpen
picdialog = 2
Image2.Visible = True
Image2.Picture = LoadPicture(CommonDialog1.filename)
PictureFileName = CommonDialog1.filename
If Image2.Picture = Picture Then
Image3.Visible = True
Else
Image3.Visible = False
End If
Exit Sub
errhandler:
Select Case Err
Case 32755 ' Dialog Cancelled
MsgBox "you cancelled the dialog box"
Case Else
MsgBox "Unexpected error. Err " & Err & " : " & Error
End Select
End Sub
Private Sub cmdSave_Click()
With rsPhoto
.AddNew
If MsgBox("Are you sure you want to save picture?", vbQuestion + vbYesNo, "Save") = vbYes Then
If picdialog = 1 Then
CommonDialog1.filename = App.Path & "\No Picture.jpg"
GetPhoto CommonDialog1.filename, rsPhoto, "Picture", "Picturesize"
.Update
ElseIf picdialog = 2 Then
If Not IsNull(CommonDialog1.filename) Then GetPhoto CommonDialog1.filename, rsPhoto, "Picture", "Picturesize"
.Update
End If
MsgBox "Record Save", vbInformation, "Save"
Image3.Picture = LoadPicture(App.Path & "\No Picture.jpg")
Image2.Picture = LoadPicture(App.Path & "\No Picture.jpg")
Image2.Visible = False
Image3.Visible = True
Else
.CancelUpdate
End If
End With
End Sub
Private Sub cmdRetrieve_Click()
Image3.Visible = False
Image2.Visible = True
If Not IsNull(rsPhoto!Picture) Then FillPhoto rsPhoto, "Picture", "Picturesize", Image2 Else: Image3.Visible = True
End Sub
Private Sub Form_Load()
picdialog = 1
Image2.Visible = False
Closerecordset
Openrecordset ("Select * from tblpicture")
End Sub
Private Sub Form_Unload(Cancel As Integer)
rsPhoto.Close
Set rsPhoto = Nothing
CloseConnection
End Sub
4. Module (Name: "ADOConnection") >> Copy/Paste
Global con As New ADODB.Connection
Global conn As New ADODB.Connection
Global rsPhoto As New ADODB.Recordset
Global imsConnectionString As String
Public Sub main()
On Error Resume Next
DoEvents
imsConnectionString = "Driver={MySQL ODBC 5.1 Driver};Server=localhost;Database=Photo;User='root';Password=''"
con.ConnectionString = imsConnectionString
Debug.Print "Connection Object Created"
con.Open
If con.State = adStateClosed Then
MsgBox "Unable to connect to database", vbCritical
Form1.Show
Exit Sub
End If
con.CursorLocation = adUseClient
Form1.Show
End Sub
Public Sub CloseConnection()
con.Close
Set con = Nothing
End Sub
Public Function Openrecordset(YourQuery As String)
If rsPhoto.State = 0 Then rsPhoto.Open YourQuery, con, adOpenDynamic, adLockOptimistic
End Function
Public Function Closerecordset()
If rsPhoto.State = 1 Then rsPhoto.Close
End Function
5. Module (Name : "modGenDec") >> Copy/Paste
'Declaration for Save/Load Picture
Public StudentIDselect As String
Public costumerpic As IPictureDisp
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
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Const MAX_PATH = 260
Public Const BLOCK_SIZE = 10000
Public frm2Show As String
Public Sub FillPhoto(rstMain As Recordset, PFName As String, SizeField As String, picEmp As Image)
On Error Resume Next
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single
'me.imgPhoto.Visible = False
Screen.MousePointer = vbHourglass
DoEvents
' Get a temporary file name.
file_name = TemporaryFileName()
' Open the file.
file_num = FreeFile
Open file_name For Binary As #file_num
' Copy the data into the file.
file_length = rstMain(SizeField)
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE
For block_num = 1 To num_blocks
bytes() = rstMain(PFName).GetChunk(BLOCK_SIZE)
Put #file_num, , bytes()
Next block_num
If left_over > 0 Then
bytes() = rstMain(PFName).GetChunk(left_over)
Put #file_num, , bytes()
End If
Close #file_num
picEmp.Picture = LoadPicture(file_name)
Screen.MousePointer = vbDefault
End Sub
Public Sub GetPhoto(filename As String, rstMain As Recordset, FieldName As String, SizeField As String)
On Error Resume Next
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
file_num = FreeFile
Open filename For Binary Access Read As #file_num
file_length = LOF(file_num)
If file_length > 0 Then
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE
rstMain(SizeField) = file_length
ReDim bytes(BLOCK_SIZE)
For block_num = 1 To num_blocks
Get #file_num, , bytes()
rstMain(FieldName).AppendChunk bytes()
Next block_num
If left_over > 0 Then
ReDim bytes(left_over)
Get #file_num, , bytes()
rstMain(FieldName).AppendChunk bytes()
End If
Close #file_num
End If
Exit Sub
End Sub
Public Function TemporaryFileName() As String
Dim temp_path As String
Dim temp_file As String
Dim Length As Long
' Get the temporary file path.
temp_path = VBA.Space$(MAX_PATH)
Length = GetTempPath(MAX_PATH, temp_path)
temp_path = Left$(temp_path, Length)
' Get the file name.
temp_file = VBA.Space$(MAX_PATH)
GetTempFileName temp_path, "per", 0, temp_file
TemporaryFileName = Left$(temp_file, InStr(temp_file, VBA.Chr$(0)) - 1)
End Function
******Remember**********
>> In your "Project Explorer" right side of your window screen,then "Project Property" Right click
set the "Startup Object" to "Sub Main" then Run your Program
*****Oooopsss!!!********
>> In the "cmdRetrieve_Click()" you can now use your "LOGIC" to retrieve the picture you want :)
ENJOY :)
Do this:
>> Go to MySQL Administrator >> Startup Variable >> Advanced Networking >>
Change Max. Pocket Size to 4M or 16M >> Apply Changes >> Exit.
1. Create a table in your MYSQL Database
Database name: "photo"
Table name: "tblpicture"
Fields name and type:
>> "Picture" as LONG BLOB 'where you can save the Image using Binary Data
>> "Picturesize" as Integer 'where you can save the File Size of the Image
>> "ID" as Number , check Autoincrement
2. Then Go to Your Visual Basic 6.0
>>You Need:
Two Modules , One Form and One Picture in your Folder name "No Picture.jpg"
>> In your Form you need two "Image" , Stretch = True
Name: "Image2" and "Image3"
>> three "Command Buttons"
Name: "cmdUpload" and "cmdSave" and "cmdRetrieve"
>>One "CommonDialog"
Name: "CommonDialog1"
3. Code (Form) >> Copy/Paste
'Declaration
Option Explicit
Dim picdialog As Integer
Dim PictureFileName As String
Private Sub cmdUpload_Click()
'For Browsing Pictures
On Error GoTo errhandler
CommonDialog1.CancelError = True
CommonDialog1.Filter = "All Picture Files|*.jpg;*.gif;*.bmp;*.wmf;*.ico|JPEG Images(*.jpg)|*.jpg|Bitmap Images (*.bmp)|*.bmp|Word Meta Files (*.wmf)|*.wmf|GIF Images (*.gif)|*.gif"
CommonDialog1.DialogTitle = "Insert Picture"
CommonDialog1.ShowOpen
picdialog = 2
Image2.Visible = True
Image2.Picture = LoadPicture(CommonDialog1.filename)
PictureFileName = CommonDialog1.filename
If Image2.Picture = Picture Then
Image3.Visible = True
Else
Image3.Visible = False
End If
Exit Sub
errhandler:
Select Case Err
Case 32755 ' Dialog Cancelled
MsgBox "you cancelled the dialog box"
Case Else
MsgBox "Unexpected error. Err " & Err & " : " & Error
End Select
End Sub
Private Sub cmdSave_Click()
With rsPhoto
.AddNew
If MsgBox("Are you sure you want to save picture?", vbQuestion + vbYesNo, "Save") = vbYes Then
If picdialog = 1 Then
CommonDialog1.filename = App.Path & "\No Picture.jpg"
GetPhoto CommonDialog1.filename, rsPhoto, "Picture", "Picturesize"
.Update
ElseIf picdialog = 2 Then
If Not IsNull(CommonDialog1.filename) Then GetPhoto CommonDialog1.filename, rsPhoto, "Picture", "Picturesize"
.Update
End If
MsgBox "Record Save", vbInformation, "Save"
Image3.Picture = LoadPicture(App.Path & "\No Picture.jpg")
Image2.Picture = LoadPicture(App.Path & "\No Picture.jpg")
Image2.Visible = False
Image3.Visible = True
Else
.CancelUpdate
End If
End With
End Sub
Private Sub cmdRetrieve_Click()
Image3.Visible = False
Image2.Visible = True
If Not IsNull(rsPhoto!Picture) Then FillPhoto rsPhoto, "Picture", "Picturesize", Image2 Else: Image3.Visible = True
End Sub
Private Sub Form_Load()
picdialog = 1
Image2.Visible = False
Closerecordset
Openrecordset ("Select * from tblpicture")
End Sub
Private Sub Form_Unload(Cancel As Integer)
rsPhoto.Close
Set rsPhoto = Nothing
CloseConnection
End Sub
4. Module (Name: "ADOConnection") >> Copy/Paste
Global con As New ADODB.Connection
Global conn As New ADODB.Connection
Global rsPhoto As New ADODB.Recordset
Global imsConnectionString As String
Public Sub main()
On Error Resume Next
DoEvents
imsConnectionString = "Driver={MySQL ODBC 5.1 Driver};Server=localhost;Database=Photo;User='root';Password=''"
con.ConnectionString = imsConnectionString
Debug.Print "Connection Object Created"
con.Open
If con.State = adStateClosed Then
MsgBox "Unable to connect to database", vbCritical
Form1.Show
Exit Sub
End If
con.CursorLocation = adUseClient
Form1.Show
End Sub
Public Sub CloseConnection()
con.Close
Set con = Nothing
End Sub
Public Function Openrecordset(YourQuery As String)
If rsPhoto.State = 0 Then rsPhoto.Open YourQuery, con, adOpenDynamic, adLockOptimistic
End Function
Public Function Closerecordset()
If rsPhoto.State = 1 Then rsPhoto.Close
End Function
5. Module (Name : "modGenDec") >> Copy/Paste
'Declaration for Save/Load Picture
Public StudentIDselect As String
Public costumerpic As IPictureDisp
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
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Const MAX_PATH = 260
Public Const BLOCK_SIZE = 10000
Public frm2Show As String
Public Sub FillPhoto(rstMain As Recordset, PFName As String, SizeField As String, picEmp As Image)
On Error Resume Next
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single
'me.imgPhoto.Visible = False
Screen.MousePointer = vbHourglass
DoEvents
' Get a temporary file name.
file_name = TemporaryFileName()
' Open the file.
file_num = FreeFile
Open file_name For Binary As #file_num
' Copy the data into the file.
file_length = rstMain(SizeField)
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE
For block_num = 1 To num_blocks
bytes() = rstMain(PFName).GetChunk(BLOCK_SIZE)
Put #file_num, , bytes()
Next block_num
If left_over > 0 Then
bytes() = rstMain(PFName).GetChunk(left_over)
Put #file_num, , bytes()
End If
Close #file_num
picEmp.Picture = LoadPicture(file_name)
Screen.MousePointer = vbDefault
End Sub
Public Sub GetPhoto(filename As String, rstMain As Recordset, FieldName As String, SizeField As String)
On Error Resume Next
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
file_num = FreeFile
Open filename For Binary Access Read As #file_num
file_length = LOF(file_num)
If file_length > 0 Then
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE
rstMain(SizeField) = file_length
ReDim bytes(BLOCK_SIZE)
For block_num = 1 To num_blocks
Get #file_num, , bytes()
rstMain(FieldName).AppendChunk bytes()
Next block_num
If left_over > 0 Then
ReDim bytes(left_over)
Get #file_num, , bytes()
rstMain(FieldName).AppendChunk bytes()
End If
Close #file_num
End If
Exit Sub
End Sub
Public Function TemporaryFileName() As String
Dim temp_path As String
Dim temp_file As String
Dim Length As Long
' Get the temporary file path.
temp_path = VBA.Space$(MAX_PATH)
Length = GetTempPath(MAX_PATH, temp_path)
temp_path = Left$(temp_path, Length)
' Get the file name.
temp_file = VBA.Space$(MAX_PATH)
GetTempFileName temp_path, "per", 0, temp_file
TemporaryFileName = Left$(temp_file, InStr(temp_file, VBA.Chr$(0)) - 1)
End Function
******Remember**********
>> In your "Project Explorer" right side of your window screen,then "Project Property" Right click
set the "Startup Object" to "Sub Main" then Run your Program
*****Oooopsss!!!********
>> In the "cmdRetrieve_Click()" you can now use your "LOGIC" to retrieve the picture you want :)
ENJOY :)
