Public Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public PathToFolder

 

Public Type OPENFILENAME

lStructSize As Long

hwndOwner As Long

hInstance As Long

lpstrFilter As String

lpstrCustomFilter As String

nMaxCustFilter As Long

nFilterIndex As Long

lpstrFile As String

nMaxFile As Long

lpstrFileTitle As String

nMaxFileTitle As Long

lpstrInitialDir As String

lpstrTitle As String

Flags As Long

nFileOffset As Integer

nFileExtension As Integer

lpstrDefExt As String

lCustData As Long

lpfnHook As Long

lpTemplateName As String

End Type

Private Type PROCESS_INFORMATION

hProcess As Long

hThread As Long

dwProcessID As Long

dwThreadID As Long

End Type

 

Private Type STARTUPINFO

cb As Long

lpReserved As String

lpDesktop As String

lpTitle As String

dwX As Long

dwY As Long

dwXSize As Long

dwYSize As Long

dwXCountChars As Long

dwYCountChars As Long

dwFillAttribute As Long

dwFlags As Long

wShowWindow As Integer

cbReserved2 As Integer

lpReserved2 As Long

hStdInput As Long

hStdOutput As Long

hStdError As Long

End Type

 

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

 

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

 

Private Const INFINITE = -1&

Private Const NORMAL_PRIORITY_CLASS = &H20&

 

Dim FileName As String

 

Private Sub RunFile(FileName)

On Error GoTo Error_mark

 

Dim Process As PROCESS_INFORMATION

Dim Prog As STARTUPINFO

Prog.cb = Len(Prog)

CreateProcessA 0&, FileName, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Prog, Process

WaitForSingleObject Process.hProcess, INFINITE

 

CloseHandle Process.hProcess

 

Exit_mark:

Exit Sub

Error_mark:

'ReportError "RunFile()"

Resume Next

End Sub

 

Public Sub CommandExt(strCommand)

On Error GoTo Error_mark

 

RunFile strCommand

 

Exit_mark:

Exit Sub

 

Error_mark:

'ReportError "CommandExt"

Resume Next

End Sub

Public Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public PathToFolder

'=====

Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Declare Function CreateProcess Lib "kernel32.dll" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As Any, ByRef lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDriectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _

lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _

lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _

ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _

ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _

lpStartupInfo As STARTUPINFO, lpProcessInformation As _

PROCESS_INFORMATION) As Long

'=====

Public Type OPENFILENAME

lStructSize As Long

hwndOwner As Long

hInstance As Long

lpstrFilter As String

lpstrCustomFilter As String

nMaxCustFilter As Long

nFilterIndex As Long

lpstrFile As String

nMaxFile As Long

lpstrFileTitle As String

nMaxFileTitle As Long

lpstrInitialDir As String

lpstrTitle As String

Flags As Long

nFileOffset As Integer

nFileExtension As Integer

lpstrDefExt As String

lCustData As Long

lpfnHook As Long

lpTemplateName As String

End Type

 

Private Type PROCESS_INFORMATION

  hProcess As Long

  hThread As Long

  dwProcessID As Long

  dwThreadID As Long

End Type

Private Type STARTUPINFO

  cb As Long

  lpReserved As Long

  lpDesktop As Long

  lpTitle As Long

  dwX As Long

  dwY As Long

  dwXSize As Long

  dwYSize As Long

  dwXCountChars As Long

  dwYCountChars As Long

  dwFillAttribute As Long

  dwFlags As Long

  wShowWindow As Integer

  cbReserved2 As Integer

  lpReserved2 As Byte

  hStdInput As Long

  hStdOutput As Long

  hStdError As Long

End Type

 

 

Private Const STARTF_USESHOWWINDOW As Long = &H1

Private Const SW_NORMAL As Long = 1

Private Const NORMAL_PRIORITY_CLASS As Long = &H20

Private Const INFINITE As Long = &HFFFFFFFF

 

Public Sub ExecuteAndWait2(CmdLine As String)

  Dim si As STARTUPINFO, pi As PROCESS_INFORMATION

  

  si.cb = Len(si)

  si.dwFlags = STARTF_USESHOWWINDOW

  si.wShowWindow = SW_NORMAL

  

  'CreateProcess vbNullString, "notepad.exe", ByVal 0&, ByVal 0&, 0, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, si, pi

  CreateProcess vbNullString, CmdLine, ByVal 0&, ByVal 0&, 0, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, si, pi

  

  CloseHandle pi.hThread

  

  WaitForSingleObject pi.hProcess, INFINITE

  

  'MsgBox "123!", vbInformation

  

  CloseHandle pi.hProcess

End Sub

 

 

Public Sub ExecuteAndWait3(CmdLine$)

Dim proc As PROCESS_INFORMATION

Dim START As STARTUPINFO

Dim ret As Long

 

' Initialize the STARTUPINFO structure:

START.cb = Len(START)

 

' Start the shelled application:

ret = CreateProcessA(0&, CmdLine$, 0&, 0&, 1&, _

NORMAL_PRIORITY_CLASS, 0&, 0&, START, proc)

If ret Then

' Wait for the shelled application to finish:

ret = WaitForSingleObject(proc.hProcess, INFINITE)

 

End If

CloseHandle (proc.hProcess)

End Sub

Public Function ShellFile(fPathe As String, Optional Arguments As String = "", Optional TypeOfWindow As Long = 1, Optional WaitEnd As Boolean = True)

Dim WshShell As Object

'On Error Resume Next

Set WshShell = CreateObject("WScript.Shell")

If Arguments <> "" Then fPathe = fPathe & " " & Arguments

WshShell.Run fPathe, TypeOfWindow, WaitEnd

Set WshShell = Nothing

End Function

CommandExt "cmd /x /c rmdir /s /q " & Chr(34) & App.Path & "\temp" & Chr(34)

CommandExt "cmd /x /c mkdir " & Chr(34) & App.Path & "\temp" & Chr(34)

CommandExt Chr(34) & App.Path & "z.exe" & Chr(34) & " x -y " & Chr(34) & Trim(PathToArchive) & Chr(34) & " " & Chr(34) & "-o" & App.Path & "\temp" & Chr(34)

CopyWay = App.Path & "\anim\" & Right(List1.List(i - 1), Len(List1.List(i - 1)) - InStrRev(List1.List(i - 1), "\"))

CommandExt "cmd /x /c mkdir " & Chr(34) & CopyWay & Chr(34)

CommandExt "cmd /x /c xcopy /e /c /y " & Chr(34) & List1.List(i - 1) & "\*.*" & Chr(34) & " " & Chr(34) & CopyWay & "\*.*" & Chr(34)

ShellFile "cmd /c rmdir /s /q " & Chr(34) & App.Path & "\temp" & Chr(34)

ShellFile "cmd /c mkdir " & Chr(34) & App.Path & "\temp" & Chr(34)

ShellFile Chr(34) & App.Path & "z.exe" & Chr(34) & " x -y " & Chr(34) & Trim(PathToArchive) & Chr(34) & " " & Chr(34) & "-o" & App.Path & "\temp" & Chr(34)

Public Function ShellFile(fPathe As String, Optional Arguments As String = "", Optional TypeOfWindow As Long = 1, Optional WaitEnd As Boolean = True)

CreateObject("wscript.shell").Run fPathe, , WaitEnd 'TypeOfWindow, WaitEnd

Set WshShell = Nothing

End Function