VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Const BLOCKSIZE = 4096 '每次讀寫塊的大小
Private Declare Function SHFileExists Lib "shell32" Alias "#45" (ByVal szPath As String) As Long
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
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Function OpenFile(ByVal hWnd As Long, ByVal sFile As String, ByVal iShow As vbOpenFile)
    OpenFile = ShellExecute(hWnd, "open", sFile, "", "", iShow)
End Function
Public Function ImageToField(ByRef fld As ADODB.Field, DiskFile As String) As Boolean
Dim byteData() As Byte '定義數據塊數組
Dim NumBlocks As Long '定義數據塊個數
Dim FileLength As Long '標識文件長度
Dim LeftOver As Long '定義剩余字節長度
Dim SourceFile As Long '定義自由文件號
Dim i As Long '定義循環變量
On Error GoTo Err:
    If Not FileExists(DiskFile) Then
        ImageToField = False
        Exit Function
    End If
    SourceFile = FreeFile '提供一個尚未使用的文件號
    Open DiskFile For Binary Access Read As SourceFile '打開文件
    FileLength = LOF(SourceFile) '得到文件長度
    If FileLength = 0 Then '判斷文件是否存在
        Close SourceFile
    Else
        NumBlocks = FileLength \ BLOCKSIZE '得到數據塊的個數
        LeftOver = FileLength Mod BLOCKSIZE '得到剩余字節數
        fld.value = Null
        ReDim byteData(BLOCKSIZE) '重新定義數據塊的大小
        For i = 1 To NumBlocks
            Get SourceFile, , byteData() ' 讀到內存塊中
            fld.AppendChunk byteData() '寫入FLD
            Next i
        ReDim byteData(LeftOver) '重新定義數據塊的大小
        Get SourceFile, , byteData() '讀到內存塊中
        fld.AppendChunk byteData() '寫入FLD
        Close SourceFile '關閉源文件
    End If
    ImageToField = True
    Exit Function
Err:
    ImageToField = False
End Function
Public Function FieldToImage(ByVal fld As ADODB.Field, Optional ByVal sType As String = "") As String
  Dim temp_image() As Byte
  Dim image_fileName As String
  If IsNull(fld) Then
    FieldToImage = ""
    Exit Function
  End If
  image_fileName = getVBTempFileName() + IIf(sType = "", "", "." + sType)
  
  temp_image() = fld.value
  
  '建立臨時文件
  Open image_fileName For Binary As #1
  Put #1, , temp_image()
  Close #1
  FieldToImage = image_fileName
End Function
Public Function getVBTempFileName() As String
Dim temppath As String  ' receives name of temporary file path
Dim tempfile As String  ' receives name of temporary file
Dim slength As Long  ' receives length of string returned for the path
Dim lastfour As Long  ' receives hex value of the randomly assigned ????
Dim tmpFileName As String
    ' Get Windows's temporary file path
    temppath = Space(255)  ' initialize the buffer to receive the path
    slength = GetTempPath(255, temppath)  ' read the path name
    temppath = Left(temppath, slength)  ' extract data from the variable

    ' Get a uniquely assigned random file
    tempfile = Space(255)  ' initialize buffer to receive the filename
    lastfour = getTempFileName(temppath, "", 0, tempfile)  ' get a unique temporary file name
    ' (Note that the file is also created for you in this case.)
    tempfile = Left(tempfile, InStr(tempfile, vbNullChar) - 1) ' extract data from the variable
    If g_sTempFileName = "" Then
        g_sTempFileName = tempfile
    Else
        g_sTempFileName = g_sTempFileName + "," + tempfile
    End If
    getVBTempFileName = tempfile
End Function
Public Function FileExists(FileName As String) As Boolean
Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
        If fso.FileExists(FileName) Then
            FileExists = True
        Else
            FileExists = False
        End If
    Set fso = Nothing
End Function
Public Sub InitFileList()
    g_sTempFileName = ""
End Sub
Public Sub DisposeFileList()
Dim arrTempFileName() As String
Dim i As Integer
On Error Resume Next
    arrTempFileName = Split(g_sTempFileName, ",")
    For i = 0 To UBound(arrTempFileName)
        Call Kill(arrTempFileName(i))
    Next i
Err.Clear
End Sub