home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
blob
/
blob_tes.frm
next >
Wrap
Text File
|
1994-03-09
|
8KB
|
277 lines
VERSION 2.00
Begin Form BLOB_Test
BackColor = &H8000000F&
Caption = "BLOB Test Form"
ClientHeight = 4296
ClientLeft = 816
ClientTop = 1476
ClientWidth = 6372
Height = 4692
Left = 780
LinkTopic = "Form1"
ScaleHeight = 4296
ScaleWidth = 6372
Top = 1116
Width = 6444
Begin CommandButton Command4
Caption = "Add New Record"
Height = 372
Left = 2160
TabIndex = 10
Top = 3360
Width = 1692
End
Begin TextBox Text2
DataField = "Input_Size"
DataSource = "Data1"
Enabled = 0 'False
Height = 288
Index = 2
Left = 120
TabIndex = 9
Top = 3120
Width = 972
End
Begin TextBox Text2
DataField = "File_Name"
DataSource = "Data1"
Enabled = 0 'False
Height = 288
Index = 1
Left = 120
TabIndex = 8
Top = 2760
Width = 6012
End
Begin TextBox Text2
DataField = "CNT"
DataSource = "Data1"
Enabled = 0 'False
Height = 288
Index = 0
Left = 120
TabIndex = 7
Top = 2400
Width = 972
End
Begin CommandButton Command3
Caption = "Write File"
Height = 372
Left = 4440
TabIndex = 4
Top = 1800
Width = 1812
End
Begin CommandButton Command2
Caption = "Read File"
Height = 372
Left = 2400
TabIndex = 3
Top = 1800
Width = 1812
End
Begin TextBox Text1
Height = 288
Index = 1
Left = 120
TabIndex = 2
Top = 1320
Width = 6132
End
Begin CommonDialog CMDialog1
DefaultExt = "*.*"
DialogTitle = "Select File"
Filename = "*.*"
Filter = "All (*.*)|*.*"
Left = 5880
Top = 0
End
Begin CommandButton Command1
Caption = "Get File Name"
Height = 372
Left = 120
TabIndex = 1
Top = 1800
Width = 2052
End
Begin Data Data1
Caption = "Data1"
Connect = ""
DatabaseName = "BLOBTEST.MDB"
Exclusive = 0 'False
Height = 252
Left = 2040
Options = 0
ReadOnly = 0 'False
RecordSource = "Blob_Test_Table"
Top = 3840
Width = 1872
End
Begin TextBox Text1
Height = 288
Index = 0
Left = 120
TabIndex = 0
Top = 480
Width = 6132
End
Begin Label Label1
BackColor = &H8000000F&
Caption = "Output File && Path Name"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 9.6
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 228
Index = 1
Left = 120
TabIndex = 6
Top = 1080
Width = 3132
End
Begin Label Label1
BackColor = &H8000000F&
Caption = "Input File && Path Name"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 9.6
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 228
Index = 0
Left = 120
TabIndex = 5
Top = 240
Width = 3132
End
End
Option Explicit
Declare Function GetModuleFileName Lib "Kernel" (ByVal hModule As Integer, ByVal lpFilename As String, ByVal nSize As Integer) As Integer
Sub Command1_Click ()
CMDialog1.Action = 1
Text1(0) = CMDialog1.Filename
Text1(1) = "C:\TEMP\" & CMDialog1.Filetitle
End Sub
Sub Command2_Click ()
If Data1.Recordset.RecordCount = 0 Then
Data1.Recordset.AddNew
Data1.Recordset.Update
End If
If (Len(Text1(0)) = 0) Then
MsgBox "Require File Name To Read." & Chr(10) & "Select 'Get File Name' first."
Exit Sub
End If
ReadBigFile (Text1(0))
End Sub
Sub Command3_Click ()
If (Len(Text1(1)) = 0) Then
MsgBox "Require File Name To Read." & Chr(10) & "Select 'Get File Name' first or edit 'Output File Name'."
Exit Sub
End If
WriteBigFile (Text1(1))
End Sub
Sub Command4_Click ()
Data1.Recordset.AddNew
Data1.Recordset.Update
End Sub
Sub Form_Load ()
Dim temp As String
temp = Left$(App.Path, 1)
ChDrive temp
ChDir App.Path
End Sub
Sub ReadBigFile (FName As String)
'AppendChunk Method Example
'This example uses AppendChunk with a data control to save the contents of a separate file into a field. You would call this
'procedure with the path and name of the file you want to put into your database. This procedure works for either Memo or Long
'Binary fields.
Dim TotalSize As Long, CurChunk As String
Dim I As Integer, FNum As Integer, ChunkSize As Integer
Screen.MousePointer = 11
ChunkSize = 12000 ' Set size of chunk.
Data1.Recordset.Edit ' Enter Edit mode.
Data1.Recordset.Fields(Field_Name) = "" ' Clear Comments field.
FNum = FreeFile ' Get free file number.
Open FName For Binary As #FNum ' Open the file.
TotalSize = LOF(FNum)
Text2(1) = FName
Text2(2) = TotalSize
Do While Not EOF(FNum)
If TotalSize - Seek(FNum) < ChunkSize Then
ChunkSize = TotalSize - Seek(FNum)
If ChunkSize <= 0 Then Exit Do
End If
CurChunk = String$(ChunkSize + 1, 32)
Get #FNum, , CurChunk ' Read chunk from file.
' Append chunk to Comments field.
Data1.Recordset.Fields(Field_Name).AppendChunk (CurChunk)
Loop
Data1.Recordset.Update ' Save the record.
Close FNum ' Close the file.
Screen.MousePointer = 0
MsgBox "Stored file " & FName & Chr(10) & "Input file size = " & TotalSize & Chr(10) & "Into '" & Field_Name & "'."
End Sub
Sub WriteBigFile (FName As String)
'GetChunk and FieldSize Methods Example
'This example uses GetChunk with a data control to save the contents of a field to a separate file. You would call this procedure
'with the path and name of the file where you want to save the contents of the field. This procedure works for either text or binary
'fields.
Dim NumChunks As Long, TotalSize As Long
Dim RemChunk As Integer, CurSize As Integer
Dim I As Integer, FNum As Integer, CurChunk As String
Screen.MousePointer = 11
ChunkSize = 2000 ' Set size of chunk.
' Get field size.
TotalSize = Data1.Recordset.Fields(Field_Name).FieldSize()
NumChunks = TotalSize \ ChunkSize ' Set number of chunks.
' Set number of remaining bytes.
RemChunk = TotalSize Mod ChunkSize
' Set starting size of chunk.
CurSize = ChunkSize
FNum = FreeFile ' Get free file number.
Open FName For Binary As #FNum ' Open the file.
For I = 0 To NumChunks
If I = NumChunks Then CurSize = RemChunk
CurChunk = Data1.Recordset.Fields(Field_Name).GetChunk(I * ChunkSize, CurSize)
Put #FNum, , CurChunk ' Write chunk to file.
Next I
TotalSize = LOF(FNum)
Close FNum
Screen.MousePointer = 0
MsgBox "Output file " & FName & Chr(10) & "Output file size = " & TotalSize & Chr(10) & "From '" & Field_Name & "'."
End Sub