'---------------------------------------------------------------------------------------
' Module      : cExtractRes
' DateTime    : 24/10/2007 05:31
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' Purpose     : Extract data from a resource and save it a to a file.
' Requirements: None
'---------------------------------------------------------------------------------------
Option Explicit

Private Declare Function FileExists Lib "kernel32" Alias "GetShortPathNameA" ( _
    ByVal sFile As String, _
    ByVal nu As Any, _
    ByVal nu As Long) As Long
Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" ( _
    ByVal lpExistingFileName As String, _
    ByVal lpNewFileName As String, _
    ByVal dwFlags As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" ( _
    ByVal lLongPath As String, _
    ByVal lShortPath As String, _
    ByVal lBuffer As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" ( _
    ByVal lpFileName As String) As Long

Private c_bDelete       As Boolean
Private c_sFile         As String
'
'---------------------------------------------------------------------------------------
' Procedure : ExtractResource
' Purpose   : Extract resource information and save it to a file.
' Parameters:
'            sDstFile: Destination File
'            sResName: Resource name
'            sResSection: Resource Section
'            bReplace: Replace existing file
'            bDeleteOnUnaload: Delete file on unload
'            Returns True on success
'---------------------------------------------------------------------------------------
Public Function ExtractResource( _
       ByVal sDstFile As String, _
       ByVal sResName As String, _
       Optional ByVal sResSection As String = "CUSTOM", _
       Optional ByVal bReplace As Boolean = False, _
       Optional ByVal bDeleteOnUnaload As Boolean = True) As Boolean

    On Local Error GoTo ExtractResource_Error

    c_bDelete = bDeleteOnUnaload
    c_sFile = sDstFile

    If Not (FileExists(sDstFile, 0&, 0) = 0) Then
        If Not bReplace Then
            ExtractResource = True
            Exit Function
        Else
            If DeleteFile(sDstFile) = 0 Then
                c_bDelete = False
                Exit Function
            End If
        End If
    End If
    
    Dim bvBuffer() As Byte
    
    If IsNumeric(sResName) Then
        bvBuffer = LoadResData(Val(sResName), sResSection)
    Else
        bvBuffer = LoadResData(sResName, sResSection)
    End If
    If UBound(bvBuffer) = 0 Then
        c_bDelete = False
        Exit Function
    End If
            
    Dim iFile As Integer
        
    iFile = FreeFile
    Open sDstFile For Binary Access Write As iFile
    Put iFile, , bvBuffer
    Close iFile
    
    ExtractResource = True
    
    On Error GoTo 0
    Exit Function

ExtractResource_Error:
    Close iFile
End Function

Private Function GetShortPath(ByVal sFile As String) As String
    Dim lLen        As Long
    Dim sBuffer     As String

    sBuffer = Space(254)
    lLen = GetShortPathName(sFile, sBuffer, 255)
    GetShortPath = Left$(sBuffer, lLen)
End Function

Private Sub Class_Terminate()
    If c_bDelete Then
        If DeleteFile(c_sFile) = 0 Then
            Call MoveFileEx(GetShortPath(c_sFile), &H0, &H4)
        End If
    End If
End Sub

Set f_cRes = New cExtractRes
Call f_cRes.ExtractResource(App.Path & "\ASD.OCX", "CUSTOM_0")