home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pc3270sa.zip / vbdde / fgsystpc.frm < prev    next >
Text File  |  2002-02-28  |  5KB  |  170 lines
  1. VERSION 4.00
  2. Begin VB.Form FormGetSysTopics 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Get System Topics"
  5.    ClientHeight    =   2040
  6.    ClientLeft      =   4488
  7.    ClientTop       =   4344
  8.    ClientWidth     =   2544
  9.    BeginProperty Font 
  10.       name            =   "MS Sans Serif"
  11.       charset         =   0
  12.       weight          =   700
  13.       size            =   7.8
  14.       underline       =   0   'False
  15.       italic          =   0   'False
  16.       strikethrough   =   0   'False
  17.    EndProperty
  18.    ForeColor       =   &H80000008&
  19.    Height          =   2364
  20.    Left            =   4440
  21.    LinkMode        =   1  'Source
  22.    LinkTopic       =   "Form2"
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   2040
  26.    ScaleWidth      =   2544
  27.    ShowInTaskbar   =   0   'False
  28.    Top             =   4068
  29.    Width           =   2640
  30.    Begin VB.TextBox TopicsDataText 
  31.       BackColor       =   &H00C0FFFF&
  32.       ForeColor       =   &H00FF0000&
  33.       Height          =   372
  34.       Left            =   0
  35.       MultiLine       =   -1  'True
  36.       TabIndex        =   2
  37.       TabStop         =   0   'False
  38.       Top             =   360
  39.       Visible         =   0   'False
  40.       Width           =   372
  41.    End
  42.    Begin VB.CommandButton Execute 
  43.       Caption         =   "&Update"
  44.       Default         =   -1  'True
  45.       Height          =   372
  46.       Left            =   240
  47.       TabIndex        =   0
  48.       Top             =   1560
  49.       Width           =   876
  50.    End
  51.    Begin VB.CommandButton ExitDlg 
  52.       Cancel          =   -1  'True
  53.       Caption         =   "E&xit"
  54.       Height          =   372
  55.       Left            =   1320
  56.       TabIndex        =   1
  57.       Top             =   1560
  58.       Width           =   972
  59.    End
  60.    Begin VB.Frame Frame1 
  61.       Caption         =   "Topics"
  62.       Height          =   1332
  63.       Left            =   480
  64.       TabIndex        =   3
  65.       Top             =   120
  66.       Width           =   1572
  67.       Begin VB.ListBox SystemTopicsList 
  68.          BackColor       =   &H00C0FFFF&
  69.          Height          =   1008
  70.          Left            =   120
  71.          TabIndex        =   4
  72.          TabStop         =   0   'False
  73.          Top             =   240
  74.          Width           =   1332
  75.       End
  76.    End
  77. End
  78. Attribute VB_Name = "FormGetSysTopics"
  79. Attribute VB_Creatable = False
  80. Attribute VB_Exposed = False
  81. Private Sub Execute_Click()
  82.    
  83.   OldMousePointer = MousePointer
  84.   MousePointer = 11 ' Hour Glass Mouse Pointer
  85.   
  86.   UpdateSystemTopics
  87.       
  88.   MousePointer = OldMousePointer
  89. End Sub
  90.  
  91. Private Sub ExitDlg_Click()
  92.     Hide
  93. End Sub
  94.  
  95. Private Sub UpdateLogPointer()
  96.     LogEnd = LogEnd + 1
  97.     If LogEnd = MAXLOGNUM + 1 Then
  98.        LogEnd = 0
  99.     End If
  100.  
  101.     If LogTop = LogEnd Then
  102.        LogTop = LogTop + 1
  103.        If LogTop = MAXLOGNUM + 1 Then
  104.           LogTop = 0
  105.        End If
  106.     End If
  107. End Sub
  108.  
  109.  
  110. Private Sub UpdateSystemTopics()
  111. On Error GoTo ErrHandler
  112.    FunctionComp = True
  113.    
  114.    rc = DoEvents()              'If you use VisualBasic V2.0, call
  115.                                 'DoEvents function each time before
  116.                                 'starting DDE conversation.
  117.    TopicsDataText.LinkTimeout = -1
  118.    TopicsDataText.LinkTopic = "IBM327032|System"
  119.    TopicsDataText.LinkMode = COLD
  120.    TopicsDataText.LinkItem = "Topics"
  121.    TopicsDataText.LinkRequest
  122.    TopicsDataText.LinkMode = NONE
  123.    If FunctionComp = True Then
  124.       EndStatus$ = MSG_OK
  125.    Else
  126.       MsgBox MSG_DDE_ERROR, 48, MSG_SAMPLE_PROG
  127.       EndStatus$ = MSG_NG
  128.    End If
  129.    TempLogData$ = Time$ + ":Get System Topics : " + EndStatus$ + Chr$(13) + Chr$(10) + Chr$(9)
  130.    TempLogData$ = TempLogData$ + MSG_APPLICATION + APPLICATION_NAME + """" + Chr$(13) + Chr$(10) + Chr$(9)
  131.    TempLogData$ = TempLogData$ + MSG_TOPIC + """System""" + Chr$(13) + Chr$(10) + Chr$(9)
  132.    TempLogData$ = TempLogData$ + MSG_ITEM + """Topics""" + Chr$(13) + Chr$(10) + Chr$(9)
  133.    TempLogData$ = TempLogData$ + "Data =" + """" + TopicsDataText.Text + """" + Chr$(13) + Chr$(10)
  134.    LogData$(LogEnd) = TempLogData$
  135.    UpdateLogPointer
  136.    Loged = True
  137.    Exit Sub
  138.  
  139. ErrHandler:
  140.    FunctionComp = False
  141.    Resume Next
  142.  
  143. End Sub
  144.  
  145. Private Sub Form_Load()
  146.   UpdateSystemTopics
  147. End Sub
  148.  
  149.  
  150. Private Sub TopicsDataText_Change()
  151.    SystemTopicsList.Clear
  152.  
  153.    StartPos& = 1
  154.    Do While True
  155.       EndPos& = InStr(StartPos&, TopicsDataText.Text, Chr$(9))
  156.       If EndPos& = 0 Then
  157.         temp$ = LTrim$(RTrim$(Mid$(TopicsDataText.Text, StartPos&)))
  158.         SystemTopicsList.AddItem temp$
  159.         Exit Do
  160.       Else
  161.         temp$ = LTrim$(RTrim$(Mid$(TopicsDataText.Text, StartPos&, EndPos& - StartPos&)))
  162.         SystemTopicsList.AddItem temp$
  163.       End If
  164.       StartPos& = EndPos& + 1
  165.    Loop
  166.  
  167. End Sub
  168.  
  169.  
  170.