Public Function LoadTextResource(ByVal ResourceID As String, ByVal sResourceType As String, Optional TempFile) As String
'Returns a text file from a resource file.
'EXAMPLE CALL:
'Text1 = LoadTextResource(101, "Custom", "C:\temp\temp.tmp")
Dim sFilename As String
Dim iFileNum As Integer
Dim sText As String
'Check if the TempFile Name has been specified
If IsMissing(TempFile) Then
'Create a temp file name such as "~res1234.tmp"
GetTempFile "", "~rs", 0, sFilename
Else
'Use the specified temp file name
sFilename = TempFile
End If
'Save the resource item to disk
If SaveResItemToDisk(ResourceID, sResourceType, sFilename) = 0 Then
iFileNum = FreeFile 'Get free file handle
Open sFilename For Input As iFileNum 'Open the file
LoadTextResource = Input(LOF(iFileNum), iFileNum) 'Read all of the text from the file
Close iFileNum
Kill sFilename 'Delete the temp file
End If
End Function
Public Function SaveResItemToDisk(ByVal iResourceNum As String, ByVal sResourceType As String, ByVal sDestFileName As String) As Long
'Saves a resource item to disk
'Returns 0 on success, error number on failure
'Example Call:
'iRetVal = SaveResItemToDisk(101, "CUSTOM", "C:\myImage.gif")
Dim bytResourceData() As Byte
Dim iFileNumOut As Integer
On Error GoTo SaveResItemToDisk_err
'Retrieve the resource contents (data) into a byte array
bytResourceData = LoadResData(iResourceNum, sResourceType)
'Get Free File Handle
iFileNumOut = FreeFile
'Open the output file
Open sDestFileName For Binary Access Write As #iFileNumOut
'Write the resource to the file
Put #iFileNumOut, , bytResourceData
'Close the file
Close #iFileNumOut
'Return 0 for success
SaveResItemToDisk = 0
Exit Function
SaveResItemToDisk_err:
'Return error number
SaveResItemToDisk = Err.Number
End Function
Public Function GetTempFile(ByVal strDestPath As String, ByVal lpPrefixString As String, ByVal wUnique As Integer, lpTempFilename As String) As Boolean
' Get a temporary filename for a specified drive and filename prefix
' PARAMETERS:
' strDestPath - Location where temporary file will be created. If this
' is an empty string, then the location specified by the
' tmp or temp environment variable is used.
' lpPrefixString - First three characters of this string will be part of
' temporary file name returned.
' wUnique - Set to 0 to create unique filename. Can also set to integer,
' in which case temp file name is returned with that integer
' as part of the name.
' lpTempFilename - Temporary file name is returned as this variable.
' RETURN:
' True if function succeeds; false otherwise
If strDestPath = "" Then
' No destination was specified, use the temp directory.
strDestPath = String(255, vbNullChar)
If GetTempPath(255, strDestPath) = 0 Then
GetTempFile = False
Exit Function
End If
End If
lpTempFilename = String(255, vbNullChar)
GetTempFile = GetTempFilename(strDestPath, lpPrefixString, wUnique, lpTempFilename) > 0
lpTempFilename = StripTerminator(lpTempFilename)
End Function
Public Function StripTerminator(ByVal strString As String) As String
' Returns a string without any zero terminator. Typically,
' this was a string returned by a Windows API call.
'
' IN: [strString] - String to remove terminator from
'
' Returns: The value of the string passed in minus any
' terminating zero.
Dim intZeroPos As Integer
intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function
Resource File Trouble (.bat)
Reply With Quote
