Private Sub Form_Load()
Dim Strhostname As String
Dim objFSO
Dim objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strline
Dim mappingserver
Dim cust_code As String
Dim customercodes
Dim i As Integer
StartFlag = True
lblPCName = GetHostName()
txtstatus.Text = ""
'Check for valid tester
Strhostname = GetHostName
If InStr(1, Machines, Strhostname) = 0 Then
MsgBox "Hi " + GetHostName + ", this is not a valid tester/platform." & vbCrLf & "Therefore you are not allow to map to our server!!!" & vbCrLf & "Any issue, pls get back to Test System Group." & vbCrLf & "Thanks. ^-^", 64, "Invalid Tester Platform"
' if he is not a valid user .The combo box will be disable
' if you wan to hide the combo box you can change this coding to " --->>>> cboprogram.visible=False
cboprogram.Enabled = False 'disables the program combo
lblprogram.Visible = False 'hide the lblprogram
cboprogram.Visible = False 'hide the cboprogram combo
cboCusCode.Enabled = False 'disables the custcode combo
cboMapServer.Enabled = False 'disables the cbomapserver
cmdok.Enabled = False 'disables the cmdok combo
cmdexit.Enabled = False 'disables the cmdexit combo
'Exit Sub 'exit the below coding.if you want you can comment this line
End If
validtester = Left(Strhostname, 4) 'assin the valid testername
dex = Me.Height ' Set dex equal to Form Height
dey = Me.Width ' Set dey equal to Form Width
'Center the form on screen
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
'To display the PC Name
'open the text file for reading.
' Set objFile = objFSO.OpenTextFile("C:\Documents and Settings\IA1\My Documents\configfile.txt", 1)
Set objFile = objFSO.OpenTextFile("C:\configfile.txt", 1)
Do Until objFile.AtEndOfStream 'read untill end of file is found
strline = objFile.ReadLine 'read the line
'1.......this part will add the servername code in the combox -start
'SEARCH for string "MappingServer="
If InStr(1, strline, "MappingServer=", vbTextCompare) > 0 Then 'search for the word = , in the line
'if found
Dim strservers
Dim strserver
Dim servername As String
Dim x
'if found then find the return the postion of =
'assing the value of mapping sever in the varriable
cboMapServer.AddItem "Please Select a Server to Map"
mappingserver = Right(strline, (Len(strline) - InStr(1, strline, "=", vbTextCompare))) 'adds the servername in the combo box
'search for string |
' if found
If InStr(1, mappingserver, "|", vbTextCompare) > 0 Then
'spilit the string with respect to |
strservers = Split(mappingserver, "|")
'loop through the array
For x = LBound(strservers) To UBound(strservers)
servername = strservers(x)
'find the servername in the cbo sever combo
strserver = SendMessage(cboMapServer.hwnd, CB_FINDSTRINGEXACT, -1, ByVal servername)
'if not found, then the return value wiil be -1 .Then add the value in the program combo
'if not not found then add the server name
If strserver = -1 Then
cboMapServer.AddItem strservers(x)
End If
Next
Else
'' if not found the | .Then only only one server and add that server
servername = mappingserver
strserver = SendMessage(cboMapServer.hwnd, CB_FINDSTRINGEXACT, -1, ByVal servername)
'if not found, then the return value wiil be -1 .Then add the value in the program combo
If strserver = -1 Then
cboMapServer.AddItem servername
End If
End If
End If
'this part will add the custmer code in the combox -start
If InStr(1, strline, "CustomerCode=", vbTextCompare) > 0 Then 'read the custname name line
cboCusCode.AddItem "Please Select a Customer Code"
'search for the string "customerocode="
cust_code = Right(strline, (Len(strline) - InStr(1, strline, "=", vbTextCompare)))
'if the "customerocode=" string found in the strline varriable, then found the postion of |
' in string "CustomerCode=BC1|CT8|TW3|SM4|SY1|XM1|AK1|SN2|SE2|SM1"
'cut the custumer codes only as "BC1|CT8|TW3|SM4|SY1|XM1|AK1|SN2|SE2|SM1"
If InStr(1, cust_code, "|", vbTextCompare) > 0 Then
'and split the strline varriable with respect to |
customercodes = Split(cust_code, "|")
For i = LBound(customercodes) To UBound(customercodes)
cboCusCode.AddItem customercodes(i) 'add the custumer codes in the combo
Next
End If
End If
''this part will add the custmer code in the combox -End
Loop 'read the next line
Call unmap_drives(False) 'to display the all the mapped servers in the status list
cboMapServer.ListIndex = 0
cboCusCode.ListIndex = 0
StartFlag = False
End Sub
Public Function GetHostName() As String
'Function to get the host name
Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim Info As FIXED_INFO
'Call the api passing null as pFixedInfo.
'The required size of the buffer for the
'data is returned in cbRequired
Call GetNetworkParams(ByVal 0&, cbRequired)
If cbRequired > 0 Then
'create a buffer of the needed size
ReDim buff(0 To cbRequired - 1) As Byte
'and call again
If GetNetworkParams(buff(0), cbRequired) = ERROR_SUCCESS Then
'copy the buffer into a FIXED_INFO type
CopyMemory Info, ByVal VarPtr(buff(0)), LenB(Info)
'and retrieve the host name
GetHostName = TrimNull(StrConv(Info.hostname, vbUnicode))
End If 'If GetNetworkParams
End If 'If cbRequired > 0
End Function
Private Function TrimNull(item As String)
Dim pos As Integer
'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
Private Sub Form_Resize()
On Error Resume Next ' Bypass the error 384. Occurs in Maximized, Minimized or restored mode.
Me.Height = dex ' Set the Form Height equal to dex initial in Form_Load()
Me.Width = dey ' Set the Form Width equal to dey initial in Form_Load()
End Sub
Private Sub MAP_DRIVE(Driveletter As String, servername As String, customer As String, validtest As String, program1 As String)
'Function to map the server connetions
Dim fso As New FileSystemObject
Dim strPassword As String
Dim strLocalDriveLetter As String 'New
Dim strNetworkPathName As String 'New
txtstatus = "Mapping in Process..."
Screen.MousePointer = vbHourglass
strPassword = "flex123"
strLocalDriveLetter = Driveletter 'assing the drive letter
strNetworkPathName = "\\" & servername & "\" & customer & program1 & "\UFLEX" '& validtest
MsgBox strNetworkPathName 'show server path
MsgBox strLocalDriveLetter
If WNetAddConnection(strNetworkPathName, strPassword, strLocalDriveLetter) > 0 Then
MsgBox "An Error occurred mapping the drive", 16, "Error Message"
'End
txtstatus = "Mapping Failed."
Screen.MousePointer = vbDefault
Else
MsgBox txtstatus.Text & ": Drive successfully mapped!", 64, "Information"
Call unmap_drives(False) 'do display all the mapped servers
Screen.MousePointer = vbDefault
End If
End Sub
