VERSION 5.00
Begin VB.Form frmInfo 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Info"
   ClientHeight    =   9300
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   15825
   ControlBox      =   0   'False
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   9300
   ScaleWidth      =   15825
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Visible         =   0   'False
   Begin VB.TextBox txt_Info 
      Height          =   8340
      Left            =   255
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   135
      Width           =   15180
   End
   Begin VB.CommandButton btn_OK 
      Caption         =   "OK"
      Height          =   465
      Left            =   6720
      TabIndex        =   0
      Top             =   8715
      Width           =   1875
   End
End
Attribute VB_Name = "frmInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F
Private Const SCREEN_NAME As String = "frmDPC_BOM"
Private Const SW_SHOWNORMAL = 1

Private Const LOCALE_SDECIMAL = &HE ' Decimal separator
Private Const LOCALE_STHOUSAND = &HF ' Thousand separator
Private Const LOCALE_USER_DEFAULT = &H400
Private Const C_ERRORRAISE As Long = 2500
Private Const C_MSG_ID_BASE As Long = 9700

Public LoginName                    As String       'contain loginname

Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
    QuietException = vbObjectError + 12          ' do not display error message
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

Private Sub btn_OK_Click()
  Me.Hide
End Sub

Public Sub CreateInfo()
On Error GoTo ErrHandler
Dim ls_Info As String

  ls_Info = ""
  ls_Info = ls_Info & "Application Name" & " - " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf
  ls_Info = ls_Info & "Application Path" & " - " & App.Path & vbCrLf
  ls_Info = ls_Info & "LoginName" & " - " & LoginName & vbCrLf
  ls_Info = ls_Info & "PC Name" & " - " & getPCname & vbCrLf
  ls_Info = ls_Info & "ArmSysCOM" & " - " & GetFileVersion("C:\Arm_Apps\Dll\A_SysCOM.dll") & vbCrLf
  ls_Info = ls_Info & "A_Icons" & " - " & GetFileVersion("C:\Arm_Apps\Dll\A_Icons.dll") & vbCrLf
  
  ls_Info = ls_Info & "c:\windows\system32\msvbvm60.dll" & " - " & GetFileVersion("c:\windows\system32\msvbvm60.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\mscomctl.ocx" & " - " & GetFileVersion("c:\windows\system32\mscomctl.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\mscomct2.ocx" & " - " & GetFileVersion("c:\windows\system32\mscomct2.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\Asycfilt.dll" & " - " & GetFileVersion("c:\windows\system32\Asycfilt.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\Comcat.dll" & " - " & GetFileVersion("c:\windows\system32\Comcat.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\oleaut32.dll" & " - " & GetFileVersion("c:\windows\system32\oleaut32.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\olepro32.dll" & " - " & GetFileVersion("c:\windows\system32\olepro32.dll") & vbCrLf
  
  ls_Info = ls_Info & "c:\windows\system32\comdlg32.ocx" & " - " & GetFileVersion("c:\windows\system32\comdlg32.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\msflxgrd.ocx" & " - " & GetFileVersion("c:\windows\system32\msflxgrd.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\system32\fm20.dll" & " - " & GetFileVersion("c:\windows\system32\fm20.dll") & vbCrLf
  
  
  ls_Info = ls_Info & "c:\windows\syswow64\msvbvm60.dll" & " - " & GetFileVersion("c:\windows\syswow64\msvbvm60.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\mscomctl.ocx" & " - " & GetFileVersion("c:\windows\syswow64\mscomctl.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\mscomct2.ocx" & " - " & GetFileVersion("c:\windows\syswow64\mscomct2.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\Asycfilt.dll" & " - " & GetFileVersion("c:\windows\syswow64\Asycfilt.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\Comcat.dll" & " - " & GetFileVersion("c:\windows\syswow64\Comcat.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\oleaut32.dll" & " - " & GetFileVersion("c:\windows\syswow64\oleaut32.dll") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\olepro32.dll" & " - " & GetFileVersion("c:\windows\syswow64\olepro32.dll") & vbCrLf
  
  ls_Info = ls_Info & "c:\windows\syswow64\comdlg32.ocx" & " - " & GetFileVersion("c:\windows\syswow64\comdlg32.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\msflxgrd.ocx" & " - " & GetFileVersion("c:\windows\syswow64\msflxgrd.ocx") & vbCrLf
  ls_Info = ls_Info & "c:\windows\syswow64\fm20.dll" & " - " & GetFileVersion("c:\windows\syswow64\fm20.dll") & vbCrLf
  
  txt_Info.Text = ls_Info
  Exit Sub
ErrHandler:
  Call MsgBox("Error: " & Err.Number & "." & Err.Description)
End Sub

Function getPCname() As String
    Dim loNetObject  As Object
    Dim ls_Result As String

    ls_Result = ""

    Set loNetObject = CreateObject("WScript.Network")
    ' BUG IN FUNCTION RETURNING COMPUTER NAME. ONLY RETURN THE FIRST 14 CHARACTERS
    ls_Result = Left(loNetObject.ComputerName, 50)
    Set loNetObject = Nothing

    getPCname = ls_Result
    Exit Function
ErrHandler:
End Function

Public Function GetFileVersion(ByVal as_filePath As String) As String

    Dim ls_FileVersion As String
    ls_FileVersion = ""
    
    On Error GoTo onError
    Dim lo_FSO As Scripting.FileSystemObject
    Dim lo_File As Scripting.File
    
    Set lo_FSO = CreateObject("Scripting.FileSystemObject")
    
    If lo_FSO.FileExists(as_filePath) Then
      ls_FileVersion = lo_FSO.GetFileVersion(as_filePath)
      Set lo_File = lo_FSO.GetFile(as_filePath)
      ls_FileVersion = ls_FileVersion & " created: " & lo_File.DateCreated
    Else
      ls_FileVersion = "Not found"
    End If
    GetFileVersion = ls_FileVersion
    Set lo_FSO = Nothing
    Exit Function
onError:
    Set lo_FSO = Nothing
    GetFileVersion = "Error " & Err.Number & "." & Err.Description
End Function


