Files_Module

'Send to recycle bin
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
'
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
'
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
'*****************************************
'Get Associated program
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult 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
'
'Open File
#If Win32 Then
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
Declare Function GetDesktopWindow Lib "user32" () As Long
#Else
Declare Function ShellExecute Lib "SHELL" (ByVal hwnd%, ByVal lpszOp$, ByVal lpszFile$, ByVal lpszParams$, ByVal lpszDir$, ByVal fsShowCmd%) As Integer
Declare Function GetDesktopWindow Lib "USER" () As Integer
#End If
Public Const SW_SHOWNORMAL = 1
'*****************************************
'Open and wait to close
Public Declare Function OpenProcess& Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long)
Public Declare Function GetExitCodeProcess& Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long)
Public Declare Function CloseHandle& Lib "kernel32" (ByVal hObject As Long)
'
Public Const STILL_ACTIVE = &H103
Public Const PROCESS_QUERY_INFORMATION = &H400
'*****************************************

Function GetRNDFile(PTH As String, EXT As String, LTR As String) As String
On Error GoTo K
Dim A As Long
A = 1
H:
Open PTH & "#" & AAA(A, LTR) & EXT For Input As #1
Close
'Kill "c:\#" & Space(A) & ".bat"
A = A - (-1)
GoTo H
K:
If Error <> "" Then
GetRNDFile = PTH & "#" & AAA(A, LTR) & EXT
Exit Function
End If
End Function

Private Function AAA(L As Long, LTR As String) As String 'Get RND File
For A = 1 To L
AAA = AAA & LTR
Next
End Function

Function SendToRecycleBin(Fle As String)
Dim SHop As SHFILEOPSTRUCT
Dim strFile As String
strFile = Fle
With SHop
.wFunc = FO_DELETE
.pFrom = strFile
.fFlags = FOF_ALLOWUNDO
End With
SHFileOperation SHop
End Function

Function GetFileNameFromPath(strPath As String) As String
Dim intX As Integer
Dim intPlace As Integer
Dim intLastPlace As Integer
intLastPlace = 0
For intX = 1 To Len(strPath)
intPlace = InStr(intLastPlace + 1, strPath, "\")
If intPlace = 0 Then
GetFileNameFromPath = Right(strPath, Len(strPath) - intLastPlace)
Exit Function
Else
intLastPlace = intPlace
End If
Next intX
End Function

Function GetAssociatedProgram(ByVal Extension As String) As String
Dim Path As String
Dim FileName As String
Dim nRet As Long
Const MAX_PATH As Long = 260
'Create a temporary file
Path = String$(MAX_PATH, 0)
If GetTempPath(MAX_PATH, Path) Then
FileName = String$(MAX_PATH, 0)
If GetTempFileName(Path, "~", 0, FileName) Then
FileName = Left$(FileName, _
InStr(FileName, vbNullChar) - 1)
'Rename it to use supplied extension
Name FileName As Left$(FileName, _
InStr(FileName, ".")) & Extension
FileName = Left$(FileName, _
InStr(FileName, ".")) & Extension
'Get name of associated EXE
Path = String$(MAX_PATH, 0)
Call FindExecutable(FileName, _
vbNullString, Path)
GetAssociatedProgram = Left$( _
Path, InStr(Path, vbNullChar) - 1)
'Delete the temporary file
Kill FileName
End If
End If
End Function

Function OpenFile(DocName As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
OpenFile = ShellExecute(Scr_hDC, "Open", DocName, "", "C:\", SW_SHOWNORMAL)
End Function

Public Sub ShellWaitUntilClosed(strPath As String) 'Open and wait to close
Dim lngPID As Long
Dim lngHP As Long
Dim lngExitCode As Long

lngPID = SHELL(strPath, vbNormalFocus)
lngHP = OpenProcess(PROCESS_QUERY_INFORMATION, False, lngPID)
Do
GetExitCodeProcess lngHP, lngExitCode
DoEvents
Loop While (lngExitCode = STILL_ACTIVE)
CloseHandle lngHP
End Sub

Function CreatInternetShortcut(URlFile As String, URLTarget As String)
'Dim URlFile As String
'Dim URLTarget As String
Dim MyFileNum As Integer
'Replace Yahoo with your desirable shortcut's name
' URlFile = "C:\Windows\Desktop\Yahoo.url"
'Replace http://www.yahoo.com with the address you want to link to
' URLTarget = "http://www.yahoo.com"
MyFileNum = FreeFile
Open URlFile For Output As MyFileNum
Print #MyFileNum, "[InternetShortcut]" & vbNewLine
Print #MyFileNum, "URL=" & URLTarget
Close MyFileNum
End Function