Attribute VB_Name = "CommonModule" Option Explicit '''''Global Variable'''' Public Const G_LibPath = "lib\" Dim G_DriveID ''''' Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextW" (ByVal hwnd As Long, ByVal lpString As String) As Long Public 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 Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Public Declare Function GetTempPath Lib "kernel32.dll" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Public Declare Function OpenProcess _ Lib "kernel32" ( _ ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessID As Long) _ As Long Public Declare Function WaitForSingleObject _ Lib "kernel32" ( _ ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) _ As Long Public Declare Function CloseHandle _ Lib "kernel32" ( _ ByVal hObject As Long) _ As Long Public Const SYNCHRONIZE = &H100000 Public Const INFINITE = &HFFFF Public 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 Public Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadID As Long End Type ' Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal _ ' hHandle As Long, ByVal dwMilliseconds As Long) As Long Public Declare Function CreateProcessA Lib "kernel32" (ByVal _ lpApplicationName As String, 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 String, _ lpStartupInfo As STARTUPINFO, lpProcessInformation As _ PROCESS_INFORMATION) As Long ' Public Declare Function CloseHandle Lib "kernel32" _ ' (ByVal hObject As Long) As Long Public Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, lpExitCode As Long) As Long Public Const NORMAL_PRIORITY_CLASS = &H20& ' Public Const INFINITE = -1& Public Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long iFilterIndex 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 Public Enum OFNFlagsEnum OFN_ALLOWMULTISELECT = &H200 OFN_CREATEPROMPT = &H2000 OFN_ENABLEHOOK = &H20 OFN_ENABLETEMPLATE = &H40 OFN_ENABLETEMPLATEHANDLE = &H80 OFN_EXPLORER = &H80000 OFN_EXTENSIONDIFFERENT = &H400 OFN_FILEMUSTEXIST = &H1000 OFN_HIDEREADONLY = &H4 OFN_LONGNAMES = &H200000 OFN_NOCHANGEDIR = &H8 OFN_NODEREFERENCELINKS = &H100000 OFN_NOLONGNAMES = &H40000 OFN_NONETWORKBUTTON = &H20000 OFN_NOREADONLYRETURN = &H8000 OFN_NOTESTFILECREATE = &H10000 OFN_NOVALIDATE = &H100 OFN_OVERWRITEPROMPT = &H2 OFN_PATHMUSTEXIST = &H800 OFN_READONLY = &H1 OFN_SHAREAWARE = &H4000 OFN_SHAREFALLTHROUGH = 2 OFN_SHARENOWARN = 1 OFN_SHAREWARN = 0 OFN_SHOWHELP = &H10 End Enum Public Function ShellAndWait(CommandLine As String) Dim ShellId As Long Dim ShellHandle As Long Dim ret As Long ShellId = Shell(CommandLine, vbHide) 'vbNormalFocus ShellHandle = OpenProcess(SYNCHRONIZE, 0, ShellId) If ShellHandle <> 0 Then ret& = WaitForSingleObject(ShellHandle, INFINITE) CloseHandle ShellHandle ShellAndWait = ret& End If End Function Public Function ExecCmd(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(vbNullString, cmdline$, 0&, 0&, 1&, _ NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc) ' Wait for the shelled application to finish: ret& = WaitForSingleObject(proc.hProcess, INFINITE) Call GetExitCodeProcess(proc.hProcess, ret&) Call CloseHandle(proc.hThread) Call CloseHandle(proc.hProcess) ExecCmd = ret& End Function Public Sub AlwaysOnTop(FrmID As Form, OnTop As Integer) ' =========================================== ' Requires the following declaration ' For VB3: ' Declare Function SetWindowPos Lib "user" (ByVal h%, ByVal hb%, ByVal x%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer ' For VB4: ' Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long ' =========================================== ' Usage: ' AlwaysOnTop Me, -1 ' To make always on top ' AlwaysOnTop Me, -2 ' To make NOT always on top ' =========================================== Const SWP_NOMOVE = 2 Const SWP_NOSIZE = 1 Const flags = SWP_NOMOVE Or SWP_NOSIZE Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2 If OnTop = -1 Then OnTop = SetWindowPos(FrmID.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags) Else OnTop = SetWindowPos(FrmID.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags) End If End Sub ' Show the common dialog to select a file to open. Returns the path of the ' selected file or a null string if the dialog is canceled ' Parameters: ' - sFilter is used to specify what type(s) of files will be shown ' - sDefExt is the default extension associated to a file name if no one is ' specified by the user ' - sInitDir is the directory that will be open when the dialog is shown ' - lFlag is a combination of Flags for the dialog. Look at the Common ' Dialogs' Help for more informations ' - hParent is the handle of the parent form ' Example: ' Dim sFilter As String ' 'set the filter: show text files and all the files ' sFilter = "Text files (*.txt)|*.txt|All files (*.*)|*.*" ' 'let the user select a file, ensuring that it exists ' MsgBox "File selected: " & ShowOpenFileDialog(sFilter, "txt", ' "C:\Documents", OFN_FILEMUSTEXIST) Function ShowOpenFileDialog(ByVal sFilter As String, Optional ByVal sDefExt As _ String, Optional ByVal sInitDir As String, Optional ByVal lFlags As Long, _ Optional ByVal hParent As Long) As String Dim OFN As OPENFILENAME On Error Resume Next ' set the values for the OpenFileName struct With OFN .lStructSize = Len(OFN) .hwndOwner = hParent .lpstrFilter = Replace(sFilter, "|", vbNullChar) & vbNullChar .lpstrFile = Space$(255) & vbNullChar & vbNullChar .nMaxFile = Len(.lpstrFile) .flags = lFlags .lpstrInitialDir = sInitDir .lpstrDefExt = sDefExt End With ' show the dialog, non-zero means success If GetOpenFileName(OFN) Then ' extract the selected file (including the path) ShowOpenFileDialog = Left$(OFN.lpstrFile, InStr(OFN.lpstrFile, _ vbNullChar) - 1) End If End Function ' Return True if a file exists Function FileExists(ByVal FileName As String) As Boolean On Error GoTo ErrorHandler ' get the attributes and ensure that it isn't a directory FileExists = (GetAttr(FileName) And vbDirectory) = 0 ErrorHandler: ' if an error occurs, this function returns False End Function Public Function GetTempDir() As String ' Returns the temp directory from the OS system Dim sBuffer As String Dim HoldBuffer As String Dim iBuffLen As Long Dim iReturn As Long Const BUFFER_LENGTH = 256 iBuffLen = BUFFER_LENGTH sBuffer = Space(BUFFER_LENGTH) iReturn = GetTempPath(iBuffLen, sBuffer) '* get rid of the null character HoldBuffer = Left$(sBuffer, iBuffLen - 1) GetTempDir = Left$(HoldBuffer, InStr(HoldBuffer, vbNullChar) - 1) End Function Public Function GetDriveID() As String GetDriveID = G_DriveID End Function Public Function SetDriveID(ByVal drive As String) G_DriveID = drive End Function Public Function IsUnicodeFile(ByVal fname As String) Dim uniCode(0 To 1) As Byte Dim Res() As String Dim isUniCode As Boolean Open fname For Binary As #1 Get #1, , uniCode isUniCode = False If uniCode(0) = &HFF And uniCode(1) = &HFE Then isUniCode = True End If Close #1 IsUnicodeFile = isUniCode End Function Public Function MapIndex(ByVal idxStr As String) As Integer idxStr = LCase(idxStr) If idxStr = "sel_usb_drv" Then MapIndex = 0 Exit Function End If If idxStr = "fmt_usb_drv" Then MapIndex = 1 Exit Function End If If idxStr = "pls_sel_usb_drv" Then MapIndex = 2 Exit Function End If If idxStr = "next" Then MapIndex = 3 Exit Function End If If idxStr = "exit" Then MapIndex = 4 Exit Function End If If idxStr = "usb_drv" Then MapIndex = 5 Exit Function End If If idxStr = "mk_usb_drv_boot" Then MapIndex = 6 Exit Function End If If idxStr = "sel_img" Then MapIndex = 7 Exit Function End If If idxStr = "inst_img" Then MapIndex = 8 Exit Function End If If idxStr = "browse" Then MapIndex = 9 Exit Function End If If idxStr = "pls_sel_arch_file" Then MapIndex = 10 Exit Function End If If idxStr = "usb_drv_boot" Then MapIndex = 11 Exit Function End If If idxStr = "close" Then MapIndex = 12 Exit Function End If If idxStr = "inst_ok" Then MapIndex = 13 Exit Function End If If idxStr = "confirm" Then MapIndex = 14 Exit Function End If If idxStr = "no_hp_fmt_tool" Then MapIndex = 15 Exit Function End If If idxStr = "pre" Then MapIndex = 16 Exit Function End If If idxStr = "sel_lang" Then MapIndex = 17 Exit Function End If MapIndex = -1 End Function Public Function ParseUnicodeFile(ByVal fname As String) As String() Dim OutRec As String, uniCode As String, str() As String, Res() As String ReDim Res(30) Dim idx As Integer Open fname For Binary As #1 uniCode = InputB(2, #1) OutRec = "" Do While Not EOF(1) uniCode = InputB(2, #1) If EOF(1) Then Exit Do End If Select Case AscW(uniCode) Case AscW(vbNewLine) uniCode = InputB(2, #1) If Trim$(OutRec) <> "" Then str = Split(OutRec, "=") If UBound(str) > 0 Then idx = MapIndex(str(0)) If idx >= UBound(Res) Then ReDim Res(UBound(Res) + idx + 10) End If Res(idx) = str(1) End If End If OutRec = "" Case Else OutRec = OutRec & uniCode End Select Loop If Trim$(OutRec) <> "" Then str = Split(OutRec, "=") If UBound(str) > 0 Then Res(MapIndex(str(0))) = str(1) End If End If Close #1 ParseUnicodeFile = Res End Function Public Function ParseAsciiFile(ByVal fname As String) As String() Dim OutRec As String Dim str() As String, Res() As String ReDim Res(30) Dim idx As Integer Open fname For Binary As #1 Do While Not EOF(1) Line Input #1, OutRec If Trim$(OutRec) <> "" Then str = Split(OutRec, "=") If UBound(str) > 0 Then idx = MapIndex(str(0)) If idx >= UBound(Res) Then ReDim Res(UBound(Res) + idx + 10) End If Res(idx) = str(1) End If End If Loop Close #1 ParseAsciiFile = Res End Function