source: DRBLLiveSetupWizard/CommonModule.bas @ 15

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