Hi there,
I'm new to VB but needs to write a program with VB for my project.
My project is to write an application that will check if it's being run on a valid user by reading the PC Name. Next it will allow valid user to select the folder to map to. Drive to map will be W:, X: and Y:, folder to map to will be \\netapp\xxx (got a list of different sub-folders in netapp server to be map to). It also allows valid user to select the 'CustomerCode' and Program to Launch'.
I am using combo for user to select the items in mapping server, customer code, device type and tester platform. But the problem is everything (the date) is store in a text (.txt) file. And i am supposed to get the data from the text file and put it into the different combos as the items accordingly.
If the folder have already been mapped before, it should un-map it first then allow user to map again. When user close the application, the application should unmap whichever folder the user has mapped earlier.
I am not supposed to hardcode the network to map in the program, need to read the server to map from the config.txt file. This program is not supposed to hardcode anything in it. All data are to be read from the same config.txt file. So that when there is a need to modify the program, we only need to modify the data in the config.txt file instead of going to the VB project and change the codings in the application.
Edited Part:
Now that i have most of the problems solved, but i need to modify this program so that i can have a complete workable program.
Here's the question:
1) How to apply the same technique used on the cboCusCode combo (retrieve the customer code from .txt file) on the cboMapServer as well as on the cboProgram combos?
This is because we realised that when we choose CusCode 'SM4', the program to launch will only be 'STMP35XX_FT' and its being repeated 3 times. The correct programs selection in the cboProgram when user select the 'SM4' of the customer code should be 'STMP35XX_FT', 'STMP35XX_WS' & 'NON_STMP35XX_FT'.
2) How do i hide (don't show) the cboProgram and lblProgram (the Program to Launch label and the combo to select item in it.) and disable the cboMapServer (Server to map combo) and cboCusCode (Customer Code) when the program is being run on a invalid platform (from pc name)?
I have attached the Program Coding in a .doc file, the configfile.txt and Interface of the Program on a valid tester as well as on invalid tester (Images).
- NPL_Interface.JPG (On Valid Tester)
- NPL_Interface2.JPG (On Invalid Tester)
- ProgramCodign.doc (Word Document)
Last edited by FiOh; Oct 15th, 2006 at 08:07 PM.
Reason: New Errors occur
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
But there's a compile error saying variable not defined, highlighted objFSO.
How abt this, i post the coding i have done so far.
VB Code:
Option Explicit
'1st 2 lines For No-resize form
Private dex As Long ' Declare variable dex as Long & Private
Private dey As Long ' Declare variable dey as Long & Private
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_DOMAIN_NAME_LEN As Long = 128
Private Const MAX_HOSTNAME_LEN As Long = 128
Private Const MAX_SCOPE_ID_LEN As Long = 256
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type
Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type
Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type
Private Type FIXED_INFO
HostName(0 To (MAX_HOSTNAME_LEN + 3)) As Byte
DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte
CurrentDnsServer As IP_ADDR_STRING
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId(0 To (MAX_SCOPE_ID_LEN + 3)) As Byte
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
'Declaration for map drive function
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long
Const WN_SUCCESS = 0 ' The function was successful.
Const WN_NET_ERROR = 2 ' An error occurred on the network.
Const WN_BAD_PASSWORD = 6 ' The password was invalid.
Private Sub cmdExit_Click()
End
End Sub
Private Sub cmdOK_Click()
If cboMapServer.ListIndex = -1 Then
MsgBox "Please Select a Server to Map!!", 64, "Information"
cboMapServer.SetFocus
'Exit Sub
Else
If cboCusCode.ListIndex = -1 Then
MsgBox "Please Select a Customer Code!!", 64, "Information"
cboCusCode.SetFocus
'Exit Sub
Else
If cboDeviceType.ListIndex = -1 Then
MsgBox "Please Select a Device Type!!", 64, "Information"
cboDeviceType.SetFocus
'Exit Sub
Else
If cboTester.ListIndex = -1 Then
MsgBox "Please Select a Tester Platform!!", 64, "Information"
cboTester.SetFocus
'Exit Sub
End If
End If
End If
End If
'Function to map drive
Call MAP_DRIVE
End Sub
Private Sub cmdTest_Click()
'txtStatus.Refresh
txtStatus = ""
Dim mydata As String
Open "C:\Documents and Settings\IA1\My Documents\MyVBWorks\configtest.txt" For Input As 1
While EOF(1) = False
Line Input #1, mydata
txtStatus = txtStatus & mydata & vbCrLf
cboCusCode.AddItem mydata
Wend
Close 1
End Sub
Private Sub Form_Load()
'Check for valid tester
'If GetHostName = "J750" Or "UFLEX" Or "IFLEX" Then
'MsgBox "Hi" + GetHostName + "U are not running on a valid tester platform."
My current problems are:
1) How should i do if i want to include every data in only 1 text file and use a method to extract the part that i want from the text file to be place into my combo as the item.
2) I need to map to the server to the \\netapp\CusCode.txt\Device.txt\Tester.txt by all reading the data from the text file yet i do not know how to do it.
3) I do not know how do i un-map the mapped drives when the user close the application.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Dear Fioh,
Give a screen shot of you project , and brief the requirements
This is the link for the interface of the project (Production Launcher).
PLauncher Interface
* Note: In the image the PC Name is to display out the name of the PC.
Project Outline Objective
To create a new Production Launcher that allows the user to be able to select the mapping location of the production and datalog network drive.
Reason
The current Production Launcher does not allow the user to choose the mapping location of the production and datalog network drive, it is hard coded in the program. If the user is able to select the mapping location, temporary or permanent migration of the mapping location could be done on the fly instead of modifying the program code.
Specifications
1.User must be able to select the mapping location, customer code, device type and tester platform.
2.The list of mapping location & customer code will be stored in a .txt configuration file.
3.The Production Launcher must be able to check if it’s being run on a valid tester (checking valid PC Name). For Invalid user, a of 'Hi (Name of User),
You are at XXX (PC Name), this is not a valid tester/platform.
Therefore you are not allow to map to our server!!!
Any issue, pls get back to Test System Group.
Thanks.' will appear in a pop up msg box. After the invalid user close the msg box, the Production Launcher will still be launch but all the functions of the combo and command buttons will be disabled.
4.The Production Launcher must be able to check if the production and datalog network drive is being mapped or used.
5.If any production and/or datalog network drive is being mapped or used, the program must be able to un-map the current mapping, before trying to map the network drive.
6.The status of the mapping or un-mapping must be shown in a status window (The multi-line textbox).
7.Once the mapping is done successfully, the Production UI program (another .exe application to be called) must be launched automatically.
8.List of the Production UI program name will be stored in the same .txt configuration file as the mapping location & customer code.
These are what my supervisor had further added in:
- The list item in each ComboxBoxes (mapping location, customer code, device type and tester platform) should be read from a .txt file (the very same config.txt).
- When user close the Production Launcher application, the mapped before location should be un-mapped automatically.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
How do i upload the textfile and image here?
The company blocked most of the sites. I cant get into my registered web host account to upload the image and textfile there for linking.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Do i need to declare anything? Because when i run the program, the compiler error says 'User-defined type not defined' and it hightlighted 'objFSO As New FileSystemObject'.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
danasegarane,
i still got the same compile error... 'User-defined type not defined' and it hightlighted 'objFSO As New FileSystemObject'.
T-T
I'm sorry that i'm causing you so much trouble.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Dear Fioh,
You have to combine the coding of post 16 and Post 17.Then it will run without any compile Error...
Sorry for my slowness here...
By the way, how should i modify the code for the [strNetworkPathName = "\\netapp\BC2_production"] replace the ("\\netapp\BC2_production") with the item selected in the cboMapServer?
Also, for the invalid tester msgBox, how do i make it that each short sentence appears on a different line?
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Dear Fioh,
Here is final coding.I am posting it as Part1 and Part2 .Combine Part1 and Part2.
VB Code:
Part1
VB Code:
Option Explicit
'1st 2 lines For No-resize form
Private dex As Long ' Declare variable dex as Long & Private
Private dey As Long ' Declare variable dey as Long & Private
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_DOMAIN_NAME_LEN As Long = 128
Private Const MAX_HOSTNAME_LEN As Long = 128
Private Const MAX_SCOPE_ID_LEN As Long = 256
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type
Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type
Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type
Private Type FIXED_INFO
hostname(0 To (MAX_HOSTNAME_LEN + 3)) As Byte
DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte
CurrentDnsServer As IP_ADDR_STRING
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId(0 To (MAX_SCOPE_ID_LEN + 3)) As Byte
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
'Declaration for map drive function
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long
Const WN_SUCCESS = 0 ' The function was successful.
Const WN_NET_ERROR = 2 ' An error occurred on the network.
Const WN_BAD_PASSWORD = 6 ' The password was invalid.
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'suspends for process for some time
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'Const Machines = "J750_XX,UFLEX_XX,IFLEX_XX, TSG999_XX" 'To store the valid platform machine numbers.
Const Machines = "J750-,UFLEX,IFLEX,is-s349a"
'you can add your machine numbers here
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const LANG_NEUTRAL = &H0
Const SUBLANG_DEFAULT = &H1
Const ERROR_BAD_USERNAME = 2202&
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Dim custname As String
Dim validtester As String
Private Const CB_FINDSTRINGEXACT = &H158 'constant varriable for find the value in the combo box
'New codes
Private Const ERROR_BAD_NETPATH = 53&
Private Const ERROR_NETWORK_ACCESS_DENIED = 65&
Private Const ERROR_INVALID_PASSWORD = 86&
Private Const ERROR_NETWORK_BUSY = 54&
Dim StartFlag As Boolean
'For running the Version exe and wait untill it finishes --start
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 Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds 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 CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const XL_VersionExePath As String = "C:\Program Files\Teradyne\IG-XL\3.40.09\bin\versionselector.exe"
'For running the Version exe and wait untill it finishes --End
Private Sub cboMapServer_Click()
Dim Findpos As Integer
Dim strtext As String
strtext = "Please Select a Server to Map"
If StartFlag = True Then
Exit Sub
Else
If Trim(cbomapserver.Text) = "Please Select a Server to Map" Then
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
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
validtester = Left(Strhostname, 5) 'assin the valid testername
If InStr(1, Machines, validtester) = 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
cboProgram.Enabled = False
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
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
I saw it le.. thanks. Everything is fine now. Just that i cant map to the server, i think it's the problem with the company's pc and network, i will ask my supervisor for that.
Once again, really thanks for all the troubles.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
'Program Coding
'Make the Cbo Program style to 2
'and the same for Custumer code combo
'This will restrict the user from enterting anything in the combo box
Option Explicit
'1st 2 lines For No-resize form
Private dex As Long ' Declare variable dex as Long & Private
Private dey As Long ' Declare variable dey as Long & Private
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_DOMAIN_NAME_LEN As Long = 128
Private Const MAX_HOSTNAME_LEN As Long = 128
Private Const MAX_SCOPE_ID_LEN As Long = 256
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type
Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type
Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type
Private Type FIXED_INFO
hostname(0 To (MAX_HOSTNAME_LEN + 3)) As Byte
DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte
CurrentDnsServer As IP_ADDR_STRING
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId(0 To (MAX_SCOPE_ID_LEN + 3)) As Byte
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
'Declaration for map drive function
'***********new
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
'Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'suspends for process for some time
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
pLocalName As String
pRemoteName As String
pComment As Long
pProvider As Long
End Type
Private Const RESOURCETYPE_DISK As Long = &H1&
Dim theNetResource As NETRESOURCE
'8888888888888888888 new
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const WN_SUCCESS = 0 ' The function was successful.
Const WN_NET_ERROR = 2 ' An error occurred on the network.
Const WN_BAD_PASSWORD = 6 ' The password was invalid.
'Const Machines = "J750_XX,UFLEX_XX,IFLEX_XX, TSG999_XX" 'To store the valid platform machine numbers.
Const Machines = "J750-,UFLEX,IFLEX,is-s349a"
'you can add your machine numbers here
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Const LANG_NEUTRAL = &H0
Const SUBLANG_DEFAULT = &H1
Const ERROR_BAD_USERNAME = 2202&
Dim custname As String
Dim validtester As String
Private Const CB_FINDSTRINGEXACT = &H158 'constant varriable for find the value in the combo box
'New codes
Private Const ERROR_BAD_NETPATH = 53&
Private Const ERROR_NETWORK_ACCESS_DENIED = 65&
Private Const ERROR_INVALID_PASSWORD = 86&
Private Const ERROR_NETWORK_BUSY = 54&
Dim StartFlag As Boolean
'For running the Version exe and wait untill it finishes --start
Private sMappingservers(4) As String 'For stroring the mapping Server location
Private sProgramlist(4) As String 'For Stroing the Program List
Private Sub cboProgram_Click()
On Error GoTo Progerror
Dim strtext As String
Dim FindPos As Integer
strtext = "Please Select a Program Code"
If Trim(cboProgram.Text) = "Please Select a Program Code" Then
Exit Sub
Else
FindPos = SendMessage(cboProgram.hwnd, CB_FINDSTRINGEXACT, -1, ByVal strtext)
If FindPos > -1 Then
cboProgram.RemoveItem FindPos
End If
End If
Progerror:
MsgBox "An Error Occured .Sorry For the Inconvinence" & vbCrLf & err.Description
Exit Sub
End Sub
Private Sub cmdExit_Click()
'For Ending the program
End
End Sub
Private Sub cboCusCode_Click()
On Error GoTo CustError
Dim FindPos As Integer
Dim strtext As String
'to get the custname
Dim strposition As Integer ' For finding the postion of program code in program combo
Dim objCust 'for opening the text file and search for custumer code
Dim objCust1 'for opening the text file
Dim strline 'to read the text file as lineby line
Dim custcode As String 'for storing the custumer code
Dim programname As String 'for finding the program code in the program combo
Dim sVersion As String
Dim i As Integer
Dim x As Integer
Dim strcustumernew
cboProgram.Clear
custcode = Trim(cbocuscode.Text) & "=" 'for stroing the custumer code
Set objCust = CreateObject("Scripting.FileSystemObject")
'Real tester path
Set objCust1 = objCust.OpenTextFile("C:\testsys\configfile.txt", 1)
Do Until objCust1.AtEndOfStream 'loop through the entries in the text file.Read line by line .Untill the end of file is found
strline = objCust1.ReadLine 'read line by line
If InStr(1, strline, custcode, vbTextCompare) > 0 Then 'search for BC1= or CT8= and so on... . if Found then the it will re
'return a value greater than 0.
'After this find cut the line program code only
'eg if CT8=ProductionUI or BC1=ProductionUI is found then only cut the part ProductionUI
custname = Right(strline, (Len(strline) - InStr(1, strline, "=", vbTextCompare)))
'if the return value is like in the format SM4=STMP35XX_FT|STMP35XX_WS|NON_STMP35XX_FT
If InStr(1, custname, "|", vbTextCompare) > 0 Then
' then check the postion of | .If | found then split that string with respect to |
strcustumernew = Split(custname, "|")
If UBound(strcustumernew) > 0 Then
For i = 0 To 4
sMappingservers(i) = strcustumernew(i)
Next
x = 0
cboProgram.Enabled = True
cboProgram.AddItem "Please Select a Program Code", 0
For i = 5 To 9
If Len(strcustumernew(i)) > 0 Then
cboProgram.AddItem strcustumernew(i)
x = x + 1
End If
Next
If cboProgram.ListCount > -1 Then
' StartFlag = True
cboProgram.ListIndex = 0
End If
End If
End If 'Loop through the array and add the program values in the program combo
End If
Loop 'read the next line
' cboProgram.ListIndex = 0
strtext = "Please Select a Customer Code"
If StartFlag = True Then
Exit Sub
Else
If Trim(cbocuscode.Text) = "Please Select a Customer Code" Then
Exit Sub
Else
FindPos = SendMessage(cbocuscode.hwnd, CB_FINDSTRINGEXACT, -1, ByVal strtext)
If FindPos > -1 Then
cbocuscode.RemoveItem FindPos
End If
End If
End If
Exit Sub
CustError:
MsgBox "An Error Occured .Sorry For the Inconvinence" & vbCrLf & err.Description
Exit Sub
End Sub
Last edited by danasegarane; Nov 14th, 2006 at 05:08 AM.
Private Sub cmdOK_Click()
On Error GoTo okError
Dim strmsg As String
Dim strmsg1 As String
Dim strmsg2 As String
Dim sPath As String
Dim sServername As String
Dim sDriveLetter As String
Dim x As Integer
txtStatus.Text = ""
If Trim(cbocuscode.Text) = "Please Select a Customer Code" Or Trim(cbocuscode.Text) = "" Then
If Trim(strmsg) <> "" Then
strmsg = strmsg & vbCrLf & "Customer Code Not Selected"
Else
strmsg = "Customer Code Not Selected"
End If
End If
If Trim(cboProgram.Text) = "Please Select a Program Code" Or Trim(cboProgram.Text) = "" Then
If Trim(strmsg) <> "" Then
strmsg = strmsg & vbCrLf & "Please Select a Program Code"
Else
strmsg = "Please Select a Program Code"
End If
End If
If Trim(strmsg) = "" Then
Else
txtStatus.Text = strmsg
Exit Sub
End If
Call unmap_drives(True) 'to disconnect all the server connections
'Function to map drive
Screen.MousePointer = vbHourglass
For x = 0 To 4
If Len(sMappingservers(x)) > 0 Then 'if the Mapping server is not empty
sServername = sMappingservers(x) & "\" & Trim(cboProgram.Text)
If x = 0 Then
'For the First mapping assign the Drive Letter as U
sDriveLetter = "U:"
ElseIf x = 1 Then
sDriveLetter = "W:" 'second mapping as "W:"
ElseIf x = 2 Then
sDriveLetter = "X:" 'Third mapping as "X"
ElseIf x = 3 Then
sDriveLetter = "Y:" 'Fouth mapping as "Y:"
ElseIf x = 4 Then 'Fifth Mapping as "Z"
sDriveLetter = "Z:"
End If
'attempt to map the drive
Call MAP_DRIVE(sDriveLetter, sServername)
End If
Next
Screen.MousePointer = vbDefault
'Disable the OK btn after mapping
cmdok.Enabled = False
'frmNPL.WindowState = vbMinimized
Exit Sub
okError:
MsgBox "An Error Occured .Sorry For the Inconvinence" & vbCrLf & err.Description
Exit Sub
End Sub
Private Sub Form_Load()
On Error GoTo FormLoadError
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
cboProgram.Enabled = False
Strhostname = GetHostName
validtester = Left(Strhostname, 5) 'assin the valid testername
If InStr(1, Machines, validtester) = 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
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
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
Dim fso1 As New FileSystemObject
If fso1.FileExists("C:\testsys\configfile.txt") = False Then
'If fso1.FileExists("C:\Documents and Settings\IA1\My Documents\configfile.txt") = False Then
cboProgram.Enabled = False
cbocuscode.Enabled = False 'disables the custcode combo
cbomapserver.Enabled = False 'disables the cbomapserver
cmdok.Enabled = False
Exit Sub
Else
Set objFile = objFSO.OpenTextFile("C:\testsys\configfile.txt", 1)
'Set objFile = objFSO.OpenTextFile("C:\Documents and Settings\IA1\My Documents\configfile.txt", 1)
End If
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="
'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"
cboProgram.AddItem "Please Select a Program Code"
'search for the string "customerocode="
cust_code = Right(strline, (Len(strline) - InStr(1, strline, "=", vbTextCompare)))
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
If cbocuscode.ListCount > -1 Then cbocuscode.ListIndex = 0
Call unmap_drives(False) 'to display the all the mapped servers in the status list
StartFlag = False
Exit Sub
FormLoadError:
MsgBox "An Error Occured .Sorry For the Inconvinence" & vbCrLf & err.Description
Exit Sub
End Sub
Last edited by danasegarane; Nov 14th, 2006 at 05:09 AM.
Reason: code changed
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)
On Error GoTo MappingError
'Function to map the server connetions
Dim fso As New FileSystemObject
Dim strPassword As String
Dim strusername As String
Dim strLocalDriveLetter As String 'New
Dim strNetworkPathName As String 'New
Dim MappingRet As Long
Dim MappingError As String
txtStatus = txtStatus & vbCrLf & "Starts Mapping..." & vbCrLf & "Processing in progress... Please wait. " & vbCrLf
Screen.MousePointer = vbHourglass
strPassword = "flex123"
strusername = "test"
theNetResource.pRemoteName = servername
theNetResource.pLocalName = Driveletter
theNetResource.dwType = RESOURCETYPE_DISK
MappingRet = WNetAddConnection2(theNetResource, strPassword, strusername, 0)
If MappingRet > 0 Then
Select Case MappingRet
Case 53
'IF the return values is 53 , then the network path is not found
MappingError = "The network Path Could not be found"
Case 65
'IF the return values is 65 , then user doesnot have the access to the network path
MappingError = "The Network Access Denied"
Case 54
'IF the return values is 54 , then the network is busy
MappingError = "The Network is Busy.. Try after Some time"
Case 86
'IF the return values is 86 , then the networ path is invaid
MappingError = "The network Path is Invalid"
Case Else
MappingError = APIErrorDescription(MappingRet)
MappingError = MappingError & vbCrLf & "An Error occurred mapping the drive." & vbCrLf & "Mapping Failed." & vbCrLf
End Select
txtStatus = txtStatus & vbCrLf & "Mapping to " & strNetworkPathName & vbCrLf & MappingError
Screen.MousePointer = vbDefault
Else
'Newly added
'This will check wheather the particular drive exist or not.If mapped successfully it will goto the next step
If fso.DriveExists(Driveletter) = True Then
'If the drive is there then it will get the name
'and compare the name with the name that is to be mapped(strnetworkname)
'if It matches it wll display the message,as sucess
If fso.GetDrive(Driveletter).ShareName = strNetworkPathName Then
txtStatus = txtStatus & vbCrLf & "Mapping to " & strNetworkPathName & vbCrLf & "Drive successfully mapped!" & vbCrLf
Call unmap_drives(False) 'do display all the mapped servers
Screen.MousePointer = vbDefault
End If
Else
'else Error messsgage
MappingError = "An Error occurred mapping the drive." & vbCrLf & "Mapping Failed." & vbCrLf
txtStatus = txtStatus & vbCrLf & "Mapping to " & strNetworkPathName & vbCrLf & MappingError
End If
End If
Exit Sub
MappingError:
MsgBox "An Error Occured .Sorry For the Inconvinence" & vbCrLf & err.Description
Exit Sub
End Sub
Private Function unmap_drives(disconnect As Boolean) As Boolean
On Error GoTo err
Dim ret As Long
Dim Drive1 As String
Dim WshNetwork
Dim strmain As String
Dim LDs
Dim SDrive1
Dim disconnectit
Dim drives As String
Dim fsodrive As New FileSystemObject
Dim driveletter1 As String
LDs = fGetDrives
Set WshNetwork = CreateObject("WScript.Network")
SDrive1 = Split(LDs, "\" & vbNullChar) 'get all the drives avaliable
Dim i As Long
For i = LBound(SDrive1) To UBound(SDrive1) 'loop though the drives
If SDrive1(i) <> "" Then
Drive1 = SDrive1(i)
If GetDriveType(Drive1) = 4 Then 'if it is a mapped drive
'Where H: is the drive letter you wish to connect
'The second parameter of this API determines whether to disconnect the drive if
'there are files open on it. If it is passed FALSE, the disconnect will fail if there are open files
'If it is passed TRUE, the disconnect will occur no matter what is open on the drive
If disconnect = True Then
disconnectit = WNetCancelConnection(Drive1, True) 'disconnect the drive
Else
drives = Drive1 & fsodrive.GetDrive(Drive1).ShareName 'to display the drives
txtStatus.Text = drives & vbCrLf & txtStatus.Text
End If
End If
End If
Next
Sleep (100)
unmap_drives = True
'End If
Exit Function
err:
If err.Number <> 0 Then
If err.Number = -2147024811 Then
MsgBox "The local device name is already in use.Please Disconnect and Run WMS", vbInformation
unmap_drives = False
Else
MsgBox err.Description, vbInformation
unmap_drives = False
End If
End If
End Function
Public Function fGetDrives() As String
'Returns all mapped drives
Dim lngRet As Long
Dim strDrives As String * 255
Dim lngTmp As Long
lngTmp = Len(strDrives)
lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
fGetDrives = Left(strDrives, lngRet)
End Function
Public Function APIErrorDescription(ErrorCode As Long) As String
Dim sAns As String
Dim lRet As Long
'PURPOSE: Returns Human Readable Description of
'Error Code that occurs in API function
'PARAMETERS: ErrorCode: System Error Code
'Returns: Description of Error
'Example: After Calling API Function:
'MsgBox (APIErrorDescription(Err.LastDllError))
sAns = Space(255)
lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, _
ErrorCode, 0, sAns, 255, 0)
APIErrorDescription = StripNull(sAns)
End Function
Private Function StripNull(ByVal InString As String) As String
'Input: String containing null terminator (Chr(0))
'Returns: all character before the null terminator
Dim iNull As Integer
If Len(InString) > 0 Then
iNull = InStr(InString, vbNullChar)
Select Case iNull
Case 0
StripNull = Trim(InString)
Case 1
StripNull = ""
Case Else
StripNull = Left$(Trim(InString), iNull - 1)
End Select
End If
End Function
Last edited by danasegarane; Nov 14th, 2006 at 05:10 AM.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Private dex As Long ' Declare variable dex as Long & Private
Private dey As Long ' Declare variable dey as Long & Private
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_DOMAIN_NAME_LEN As Long = 128
Private Const MAX_HOSTNAME_LEN As Long = 128
Private Const MAX_SCOPE_ID_LEN As Long = 256
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type
Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type
Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type
Private Type FIXED_INFO
hostname(0 To (MAX_HOSTNAME_LEN + 3)) As Byte
DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte
CurrentDnsServer As IP_ADDR_STRING
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId(0 To (MAX_SCOPE_ID_LEN + 3)) As Byte
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
'Declaration for map drive function
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long
Const WN_SUCCESS = 0 ' The function was successful.
Const WN_NET_ERROR = 2 ' An error occurred on the network.
Const WN_BAD_PASSWORD = 6 ' The password was invalid.
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'suspends for process for some time
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const Machines = "J750_XX,UFLEX_XX,IFLEX_XX" 'To store the valid platform machine numbers.
'you can add your machine numbers here
Dim custname As String
Dim validtester As String
Private Const CB_FINDSTRINGEXACT = &H158 'constant varriable for find the value in the combo box
Dim StartFlag As Boolean
Private Sub cboMapServer_Click()
Dim Findpos As Integer
Dim strtext As String
strtext = "Please Select a Server to Map"
If StartFlag = True Then
Exit Sub
Else
If Trim(cboMapServer.Text) = "Please Select a Server to Map" Then
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
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Re: [EDITED - New Requirements] Help needed for Project!!
Hi danasegarane,
Here's the new requirements for the project.
Attached is the screen shot of how the newconfigfile.txt looks like.
The MappingServer=168.232.32.23|netapp in the configfile.txt has been deleted. Right now the mapping location and the program to be launch is under all the individual customer code.
In the screen shot, i have colored out the things to take note of. Those in RED are the Mapping Loaction while those in GREEN are the Program to Launch. As for the BLUE, they are the Separator (|).
The format of the customer code is like this, BC1=mappinglocation1|mappinglocation2|mappinglocation3|mappinglocation4|mappinglocation5|Program to Launch 1|Program to Launch 2|Program to Launch 3|Program to Launch 4|Program to Launch 5|Version 1|Version 2|Version3
Right now as you can see, there are some empty space in the Blue separator, those are for future use, we will reserve them 1st.
What the program should do is to read the 1st 5 mapping location from this configfile.txt and pull it into the server to map, the same goes for the program to launch. But the program need to do a checking, check if in-between the blue separators (|), there is any content, if there isnt then this program shall not pull any data from it. Version number is only for SM4, it is in the last three '|'.
Do you get what i mean?
Sorry to trouble you again.
Different personality n character... alone,
difficult to understand n mysterious,
for I am... Princess Cindistine @ Another World.
You should know...
P.C - R.N.A.F. Yeah, that is ME...
Re: [EDITED - New Errors] Help needed for Project!!
Part1
Code:
'Program Coding
'Make the Cbo Program style to 2
'and the same for Custumer code combo
'This will restrict the user from enterting anything in the combo box
Option Explicit
'1st 2 lines For No-resize form
Private dex As Long ' Declare variable dex as Long & Private
Private dey As Long ' Declare variable dey as Long & Private
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_DOMAIN_NAME_LEN As Long = 128
Private Const MAX_HOSTNAME_LEN As Long = 128
Private Const MAX_SCOPE_ID_LEN As Long = 256
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type
Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type
Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type
Private Type FIXED_INFO
hostname(0 To (MAX_HOSTNAME_LEN + 3)) As Byte
DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte
CurrentDnsServer As IP_ADDR_STRING
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId(0 To (MAX_SCOPE_ID_LEN + 3)) As Byte
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
'Declaration for map drive function
'***********new
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
'Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'suspends for process for some time
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
pLocalName As String
pRemoteName As String
pComment As Long
pProvider As Long
End Type
Private Const RESOURCETYPE_DISK As Long = &H1&
Dim theNetResource As NETRESOURCE
'8888888888888888888 new
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const WN_SUCCESS = 0 ' The function was successful.
Const WN_NET_ERROR = 2 ' An error occurred on the network.
Const WN_BAD_PASSWORD = 6 ' The password was invalid.
'Const Machines = "J750_XX,UFLEX_XX,IFLEX_XX, TSG999_XX" 'To store the valid platform machine numbers.
Const Machines = "J750-,UFLEX,IFLEX,is-s349a"
'you can add your machine numbers here
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Const LANG_NEUTRAL = &H0
Const SUBLANG_DEFAULT = &H1
Const ERROR_BAD_USERNAME = 2202&
Dim custname As String
Dim validtester As String
Private Const CB_FINDSTRINGEXACT = &H158 'constant varriable for find the value in the combo box
'New codes
Private Const ERROR_BAD_NETPATH = 53&
Private Const ERROR_NETWORK_ACCESS_DENIED = 65&
Private Const ERROR_INVALID_PASSWORD = 86&
Private Const ERROR_NETWORK_BUSY = 54&
Dim StartFlag As Boolean
'For running the Version exe and wait untill it finishes --start
Private sMappingservers(4) As String 'For stroring the mapping Server location
Private sProgramlist(4) As String 'For Stroing the Program List
Private Sub cboProgram_Click()
On Error GoTo Progerror
Dim strtext As String
Dim FindPos As Integer
strtext = "Please Select a Program Code"
If Trim(cboProgram.Text) = "Please Select a Program Code" Then
Exit Sub
Else
FindPos = SendMessage(cboProgram.hwnd, CB_FINDSTRINGEXACT, -1, ByVal strtext)
If FindPos > -1 Then
cboProgram.RemoveItem FindPos
End If
End If
Exit Sub
Progerror:
MsgBox "An Error Occured .Sorry For the Inconvinence" & vbCrLf & err.Description
Exit Sub
End Sub
Private Sub cmdExit_Click()
'For Ending the program
End
End Sub
Private Sub cboCusCode_Click()
On Error GoTo CustError
Dim FindPos As Integer
Dim strtext As String
'to get the custname
Dim strposition As Integer ' For finding the postion of program code in program combo
Dim objCust 'for opening the text file and search for custumer code
Dim objCust1 'for opening the text file
Dim strline 'to read the text file as lineby line
Dim custcode As String 'for storing the custumer code
Dim programname As String 'for finding the program code in the program combo
Dim sVersion As String
Dim i As Integer
Dim x As Integer
Dim strcustumernew
cboProgram.Clear
custcode = Trim(cbocuscode.Text) & "=" 'for stroing the custumer code
Set objCust = CreateObject("Scripting.FileSystemObject")
'Real tester path
Set objCust1 = objCust.OpenTextFile("C:\testsys\configfile.txt", 1)
Do Until objCust1.AtEndOfStream 'loop through the entries in the text file.Read line by line .Untill the end of file is found
strline = objCust1.ReadLine 'read line by line
If InStr(1, strline, custcode, vbTextCompare) > 0 Then 'search for BC1= or CT8= and so on... . if Found then the it will re
'return a value greater than 0.
'After this find cut the line program code only
'eg if CT8=ProductionUI or BC1=ProductionUI is found then only cut the part ProductionUI
custname = Right(strline, (Len(strline) - InStr(1, strline, "=", vbTextCompare)))
'if the return value is like in the format SM4=STMP35XX_FT|STMP35XX_WS|NON_STMP35XX_FT
If InStr(1, custname, "|", vbTextCompare) > 0 Then
' then check the postion of | .If | found then split that string with respect to |
strcustumernew = Split(custname, "|")
If UBound(strcustumernew) > 0 Then
For i = 0 To 4
sMappingservers(i) = strcustumernew(i)
Next
x = 0
cboProgram.Enabled = True
cboProgram.AddItem "Please Select a Program Code", 0
For i = 5 To 9
If Len(strcustumernew(i)) > 0 Then
cboProgram.AddItem strcustumernew(i)
x = x + 1
End If
Next
If cboProgram.ListCount > -1 Then
cboProgram.ListIndex = 0
End If
End If
End If 'Loop through the array and add the program values in the program combo
End If
Loop 'read the next line
strtext = "Please Select a Customer Code"
If StartFlag = True Then
cboProgram.AddItem "Please Select a Program Code", 0
cboProgram.ListIndex = 0
Exit Sub
Else
If Trim(cbocuscode.Text) = "Please Select a Customer Code" Then
Exit Sub
Else
FindPos = SendMessage(cbocuscode.hwnd, CB_FINDSTRINGEXACT, -1, ByVal strtext)
If FindPos > -1 Then
cbocuscode.RemoveItem FindPos
End If
End If
End If
Exit Sub
CustError:
MsgBox "An Error Occured .Sorry For the Inconvinence" & vbCrLf & err.Description
Exit Sub
End Sub
Please mark you thread resolved using the Thread Tools as shown
[EDITED - New Errors] Help needed for Project!!
Reply With Quote
Re: Help needed for Project!!
Originally Posted by danasegarane
Re: [RESOLVED] [EDITED] Help needed for Project!!
