home *** CD-ROM | disk | FTP | other *** search
/ Master 95 #1 / MASTER95_1.iso / microsof / vbasic4 / vb4-6.cab / serverdt.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-26  |  14.7 KB  |  389 lines
  1. VERSION 4.00
  2. Begin VB.Form frmRemoteServerDetails 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "#"
  5.    ClientHeight    =   4545
  6.    ClientLeft      =   3195
  7.    ClientTop       =   2400
  8.    ClientWidth     =   7800
  9.    ControlBox      =   0   'False
  10.    Height          =   4950
  11.    Icon            =   "SERVERDT.frx":0000
  12.    Left            =   3135
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   4545
  17.    ScaleWidth      =   7800
  18.    Top             =   2055
  19.    Width           =   7920
  20.    Begin VB.CommandButton cmdCancel 
  21.       Caption         =   "#"
  22.       Height          =   375
  23.       Left            =   5580
  24.       TabIndex        =   5
  25.       Top             =   3930
  26.       Width           =   1935
  27.    End
  28.    Begin VB.CommandButton cmdOK 
  29.       Caption         =   "#"
  30.       Default         =   -1  'True
  31.       Enabled         =   0   'False
  32.       Height          =   375
  33.       Left            =   3540
  34.       TabIndex        =   4
  35.       Top             =   3930
  36.       Width           =   1935
  37.    End
  38.    Begin VB.ComboBox cboNetworkProtocol 
  39.       Height          =   300
  40.       Left            =   2400
  41.       Style           =   2  'Dropdown List
  42.       TabIndex        =   3
  43.       Top             =   3165
  44.       Width           =   5100
  45.    End
  46.    Begin VB.TextBox txtNetworkAddress 
  47.       Height          =   300
  48.       Left            =   2400
  49.       TabIndex        =   1
  50.       Top             =   2535
  51.       Width           =   5100
  52.    End
  53.    Begin VB.Frame Frame1 
  54.       Height          =   555
  55.       Left            =   225
  56.       TabIndex        =   7
  57.       Top             =   1395
  58.       Width           =   7290
  59.       Begin VB.Label lblServerName 
  60.          Alignment       =   2  'Center
  61.          AutoSize        =   -1  'True
  62.          Caption         =   "#"
  63.          BeginProperty Font 
  64.             name            =   "MS Sans Serif"
  65.             charset         =   0
  66.             weight          =   700
  67.             size            =   8.25
  68.             underline       =   0   'False
  69.             italic          =   0   'False
  70.             strikethrough   =   0   'False
  71.          EndProperty
  72.          Height          =   195
  73.          Left            =   135
  74.          TabIndex        =   8
  75.          Top             =   240
  76.          Width           =   7020
  77.          WordWrap        =   -1  'True
  78.       End
  79.    End
  80.    Begin VB.Label lblNetworkProtocol 
  81.       AutoSize        =   -1  'True
  82.       Caption         =   "#"
  83.       Height          =   195
  84.       Left            =   210
  85.       TabIndex        =   2
  86.       Top             =   3165
  87.       Width           =   2100
  88.       WordWrap        =   -1  'True
  89.    End
  90.    Begin VB.Label lblNetworkAddress 
  91.       AutoSize        =   -1  'True
  92.       Caption         =   "#"
  93.       Height          =   195
  94.       Left            =   225
  95.       TabIndex        =   0
  96.       Top             =   2535
  97.       Width           =   2100
  98.       WordWrap        =   -1  'True
  99.    End
  100.    Begin VB.Label lblRemoteServerDetails 
  101.       AutoSize        =   -1  'True
  102.       Caption         =   "#"
  103.       BeginProperty Font 
  104.          name            =   "MS Sans Serif"
  105.          charset         =   0
  106.          weight          =   400
  107.          size            =   9.75
  108.          underline       =   0   'False
  109.          italic          =   0   'False
  110.          strikethrough   =   0   'False
  111.       EndProperty
  112.       Height          =   240
  113.       Left            =   360
  114.       TabIndex        =   6
  115.       Top             =   360
  116.       Width           =   7020
  117.       WordWrap        =   -1  'True
  118.    End
  119. Attribute VB_Name = "frmRemoteServerDetails"
  120. Attribute VB_Creatable = False
  121. Attribute VB_Exposed = False
  122. Option Explicit
  123. Option Compare Text
  124. Private fNetworkAddressSpecified As Boolean
  125. Private fNetworkProtocolSpecified As Boolean
  126. #If Win32 Then
  127. Private Declare Function RpcNetworkIsProtseqValid Lib "rpcrt4.dll" Alias "RpcNetworkIsProtseqValidA" (ByVal strProtseq As String) As Long
  128. #End If
  129. #If Win32 Then
  130. 'Determines whether a given protocol sequence is supported and available on this machine
  131. Function fIsProtocolSeqSupported(ByVal strProto As String, ByVal strProtoFriendlyName) As Boolean
  132.     Const RPC_S_OK = 0&
  133.     Const RPC_S_PROTSEQ_NOT_SUPPORTED = 1703&
  134.     Const RPC_S_INVALID_RPC_PROTSEQ = 1704&
  135.     Dim rcps As Long
  136.     Static fUnexpectedErr As Boolean
  137.     On Error Resume Next
  138.     fIsProtocolSeqSupported = False
  139.     rcps = RpcNetworkIsProtseqValid(strProto)
  140.     Select Case rcps
  141.         Case RPC_S_OK
  142.             fIsProtocolSeqSupported = True
  143.         Case RPC_S_PROTSEQ_NOT_SUPPORTED
  144.             LogNote ResolveResString(resNOTEPROTOSEQNOTSUPPORTED, "|1", strProto, "|2", strProtoFriendlyName)
  145.         Case RPC_S_INVALID_RPC_PROTSEQ
  146.             LogWarning ResolveResString(resNOTEPROTOSEQINVALID, "|1", strProto, "|2", strProtoFriendlyName)
  147.         Case Else
  148.             If Not fUnexpectedErr Then
  149.                 MsgWarning ResolveResString(resPROTOSEQUNEXPECTEDERR), vbOKOnly Or vbInformation, gstrTitle
  150.                 fUnexpectedErr = True
  151.             End If
  152.     End Select
  153. End Function
  154. #End If
  155. Private Sub cboNetworkProtocol_Click()
  156.     cmdOK.Enabled = fValid()
  157. End Sub
  158. Private Sub cmdCancel_Click()
  159.     ExitSetup frmRemoteServerDetails, gintRET_EXIT
  160. End Sub
  161. Private Sub cmdOK_Click()
  162.     Hide
  163. End Sub
  164. Private Sub Form_Load()
  165.     Dim fMoveControlsUp As Boolean 'Whether or not to move controls up to fill in an empty space
  166.     Dim yTopCutoff As Integer 'We will move all controls lower down than this y value
  167.     Caption = ResolveResString(resREMOTESERVERDETAILSTITLE)
  168.     lblRemoteServerDetails.Caption = ResolveResString(resREMOTESERVERDETAILSLBL)
  169.     lblNetworkAddress.Caption = ResolveResString(resNETWORKADDRESS)
  170.     lblNetworkProtocol.Caption = ResolveResString(resNETWORKPROTOCOL)
  171.     cmdOK.Caption = ResolveResString(resOK)
  172.     cmdCancel.Caption = ResolveResString(resCANCEL)
  173.     FillInProtocols
  174.     'Now we selectively turn on/off the available controls depending on how
  175.     '  much information we need from the user.
  176.     If fNetworkAddressSpecified Then
  177.         'The network address has already been filled in, so we can hide this
  178.         '  control and move all the other controls up
  179.         txtNetworkAddress.Visible = False
  180.         lblNetworkAddress.Visible = False
  181.         fMoveControlsUp = True
  182.         yTopCutoff = txtNetworkAddress.Top
  183.     ElseIf fNetworkProtocolSpecified Then
  184.         'The network protocol has already been filled in, so we can hide this
  185.         '  control and move all the other controls up
  186.         cboNetworkProtocol.Visible = False
  187.         lblNetworkProtocol.Visible = False
  188.         fMoveControlsUp = True
  189.         yTopCutoff = cboNetworkProtocol.Top
  190.     End If
  191.     If fMoveControlsUp Then
  192.         'Find out how much to move the controls up
  193.         Dim yDiff As Integer
  194.         yDiff = cboNetworkProtocol.Top - txtNetworkAddress.Top
  195.         
  196.         Dim c As Control
  197.         For Each c In Controls
  198.             If c.Top > yTopCutoff Then
  199.                 c.Top = c.Top - yDiff
  200.             End If
  201.         Next c
  202.         
  203.         'Finally, shrink the form
  204.         Height = Height - yDiff
  205.     End If
  206.     'Center the form
  207.     Top = (Screen.Height - Height) \ 2
  208.     Left = (Screen.Width - Width) \ 2
  209. End Sub
  210. '-----------------------------------------------------------
  211. ' SUB: GetServerDetails
  212. ' Requests any missing information about a remote server from
  213. ' the user.
  214. ' Input:
  215. '   [strRegFile] - the name of the remote registration file
  216. '   [strNetworkAddress] - the network address, if known
  217. '   [strNetworkProtocol] - the network protocol, if known
  218. ' Ouput:
  219. '   [strNetworkAddress] - the network address either passed
  220. '                         in or obtained from the user
  221. '   [strNetworkProtocol] - the network protocol either passed
  222. '                          in or obtained from the user
  223. '-----------------------------------------------------------
  224. Public Sub GetServerDetails( _
  225.     ByVal strRegFile As String, _
  226.     strNetworkAddress As String, _
  227.     strNetworkProtocol As String _
  228.     Dim i As Integer
  229.     'See if anything is missing
  230.     fNetworkAddressSpecified = (strNetworkAddress <> "")
  231.     fNetworkProtocolSpecified = (strNetworkProtocol <> "")
  232.     If fNetworkAddressSpecified And fNetworkProtocolSpecified Then
  233.         'Both the network address and protocol sequence have already
  234.         'been specified in SETUP.LST.  There is no need to ask the
  235.         'user for more information.
  236.         
  237.         'However, we do need to check that the protocol sequence specified
  238.         'in SETUP.LST is actually installed and available on this machine
  239.         '(32-bit only).
  240.         CheckSpecifiedProtocolSequence strNetworkProtocol, strGetServerName(strRegFile)
  241.         
  242.         Exit Sub
  243.     End If
  244.     lblServerName.Caption = strGetServerName(strRegFile)
  245.     'Show the form and extract necessary information from the user
  246.     Show 1
  247.         
  248.     If fNetworkProtocolSpecified Then
  249.         'The network protocol sequence had already been specified
  250.         'in SETUP.LST.  We need to check that the protocol sequence specified
  251.         'in SETUP.LST is actually installed and available on this machine
  252.         '(32-bit only).
  253.         CheckSpecifiedProtocolSequence strNetworkProtocol, strGetServerName(strRegFile)
  254.     End If
  255.     If Not fNetworkAddressSpecified Then
  256.         strNetworkAddress = txtNetworkAddress
  257.     End If
  258.     If Not fNetworkProtocolSpecified Then
  259.         strNetworkProtocol = gProtocol(cboNetworkProtocol.ListIndex + 1).strName
  260.     End If
  261.     Unload Me
  262. End Sub
  263. '-----------------------------------------------------------
  264. ' SUB: FillInProtocols
  265. ' Fills in the protocol combo with the available protocols from
  266. '   setup.lst
  267. '-----------------------------------------------------------
  268. Private Sub FillInProtocols()
  269.     Dim i As Integer
  270.     Dim fSuccessReading As Boolean
  271.     cboNetworkProtocol.Clear
  272.     fSuccessReading = ReadProtocols(gstrSetupInfoFile, gstrINI_SETUP)
  273.     If Not fSuccessReading Or gcProtocols <= 0 Then
  274.         MsgError ResolveResString(resNOPROTOCOLSINSETUPLST), vbExclamation Or vbOKOnly, gstrTitle
  275.         ExitSetup frmRemoteServerDetails, gintRET_FATAL
  276.     End If
  277.     For i = 1 To gcProtocols
  278.         #If Win32 Then
  279.         If fIsProtocolSeqSupported(gProtocol(i).strName, gProtocol(i).strFriendlyName) Then
  280.         #End If
  281.             cboNetworkProtocol.AddItem gProtocol(i).strFriendlyName
  282.         #If Win32 Then
  283.         End If
  284.         #End If
  285.     Next i
  286.     If cboNetworkProtocol.ListCount Then
  287.         'We were successful in finding at least one protocol available on this machine
  288.         Exit Sub
  289.     End If
  290.     'None of the protocols specified in SETUP.LST are available on this machine.  We need
  291.     'to let the user know what's wrong, including which protocol(s) were expected.
  292.     MsgError ResolveResString(resNOPROTOCOLSSUPPORTED1), vbExclamation Or vbOKOnly, gstrTitle
  293.     Dim strMsg As String
  294.     strMsg = ResolveResString(resNOPROTOCOLSSUPPORTED2) & LF$
  295.     For i = 1 To gcProtocols
  296.         strMsg = strMsg & LF$ & Chr$(9) & gProtocol(i).strFriendlyName
  297.     Next i
  298.     MsgError strMsg, vbExclamation Or vbOKOnly, gstrTitle
  299.     ExitSetup frmRemoteServerDetails, gintRET_FATAL
  300. End Sub
  301. '-----------------------------------------------------------
  302. ' SUB: strGetServerName
  303. ' Given a remote server registration file, retrieves the
  304. '   friendly name of the server
  305. '-----------------------------------------------------------
  306. Private Function strGetServerName(ByVal strRegFilename As String) As String
  307.     Const strKey = "AppDescription="
  308.     Dim strLine As String
  309.     Dim iFile As Integer
  310.     On Error GoTo DoErr
  311.     'This will have to do if we can't find the friendly name
  312.     strGetServerName = GetFileName(strRegFilename)
  313.     iFile = FreeFile
  314.     Open strRegFilename For Input Access Read Lock Read Write As #iFile
  315.     While Not EOF(iFile)
  316.         Line Input #iFile, strLine
  317.         If Left$(strLine, Len(strKey)) = strKey Then
  318.             'We've found the line with the friendly server name
  319.             Dim strName As String
  320.             strName = Mid$(strLine, Len(strKey) + 1)
  321.             If strName <> "" Then
  322.                 strGetServerName = strName
  323.             End If
  324.             Close iFile
  325.             Exit Function
  326.         End If
  327.     Wend
  328.     Close iFile
  329.     Exit Function
  330. DoErr:
  331.     strGetServerName = ""
  332. End Function
  333. Private Sub txtNetworkAddress_Change()
  334.     cmdOK.Enabled = fValid()
  335. End Sub
  336. 'Returns True iff the inputs are valid
  337. Private Function fValid() As Boolean
  338.     fValid = True
  339.     If Not fNetworkProtocolSpecified And (cboNetworkProtocol.ListIndex < 0) Then
  340.         fValid = False
  341.     End If
  342.     If Not fNetworkAddressSpecified And (txtNetworkAddress = "") Then
  343.         fValid = False
  344.     End If
  345. End Function
  346. Private Sub CheckSpecifiedProtocolSequence(ByVal strNetworkProtocol As String, ByVal strFriendlyServerName As String)
  347.     #If Win32 Then
  348.         'Attempt to find the friendly name of this protocol from the list in SETUP.LST
  349.         Dim fSuccessReading As Boolean
  350.         Dim strFriendlyName As String
  351.         Dim i As Integer
  352.         
  353.         strFriendlyName = strNetworkProtocol 'This will have to do if we can't find anything better
  354.         
  355.         fSuccessReading = ReadProtocols(gstrSetupInfoFile, gstrINI_SETUP)
  356.         If fSuccessReading And gcProtocols > 0 Then
  357.             For i = 1 To gcProtocols
  358.                 If gProtocol(i).strName = strNetworkProtocol Then
  359.                     strFriendlyName = gProtocol(i).strFriendlyName
  360.                     Exit For
  361.                 End If
  362.             Next i
  363.         End If
  364.         
  365.         'Now check to see if this protocol is available
  366.         If fIsProtocolSeqSupported(strNetworkProtocol, strFriendlyName) Then
  367.             'OK
  368.             Exit Sub
  369.         Else
  370.             'Nope, not supported.  Give an informational message about what to do, then continue with setup.
  371. Retry:
  372.             If MsgError( _
  373.                 ResolveResString(resSELECTEDPROTONOTSUPPORTED, "|1", strFriendlyServerName, "|2", strFriendlyName), _
  374.                 vbInformation Or vbOKCancel, _
  375.                 gstrTitle) _
  376.               = vbCancel Then
  377.                 'The user chose cancel.  Give them a chance to exit.
  378.                 ExitSetup frmRemoteServerDetails, gintRET_EXIT
  379.                 GoTo Retry
  380.             Else
  381.                 'The user chose OK.  Continue with setup.
  382.                 Exit Sub
  383.             End If
  384.         End If
  385.     #Else
  386.         Exit Sub
  387.     #End If
  388. End Sub
  389.