home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pc3270sa.zip / vbdde / fputdaps.frm < prev    next >
Text File  |  2002-02-28  |  7KB  |  229 lines
  1. VERSION 4.00
  2. Begin VB.Form FormPutDataToPS 
  3.    Caption         =   "Put Data to PS"
  4.    ClientHeight    =   3024
  5.    ClientLeft      =   3768
  6.    ClientTop       =   2880
  7.    ClientWidth     =   4692
  8.    BeginProperty Font 
  9.       name            =   "MS Sans Serif"
  10.       charset         =   0
  11.       weight          =   700
  12.       size            =   7.8
  13.       underline       =   0   'False
  14.       italic          =   0   'False
  15.       strikethrough   =   0   'False
  16.    EndProperty
  17.    ForeColor       =   &H80000008&
  18.    Height          =   3348
  19.    Left            =   3720
  20.    LinkMode        =   1  'Source
  21.    LinkTopic       =   "Form1"
  22.    ScaleHeight     =   3024
  23.    ScaleWidth      =   4692
  24.    Top             =   2604
  25.    Width           =   4788
  26.    Begin VB.CheckBox EOFCheck 
  27.       Caption         =   "EOF &Flag Enable"
  28.       ForeColor       =   &H80000008&
  29.       Height          =   375
  30.       Left            =   240
  31.       TabIndex        =   7
  32.       Top             =   1920
  33.       Width           =   1935
  34.    End
  35.    Begin VB.ComboBox SessionIdList 
  36.       BackColor       =   &H00FFFFC0&
  37.       ForeColor       =   &H00000000&
  38.       Height          =   288
  39.       ItemData        =   "FPUTDAPS.frx":0000
  40.       Left            =   1320
  41.       List            =   "FPUTDAPS.frx":0052
  42.       Sorted          =   -1  'True
  43.       Style           =   2  'Dropdown List
  44.       TabIndex        =   2
  45.       Top             =   480
  46.       Width           =   492
  47.    End
  48.    Begin VB.CommandButton ExitDlg 
  49.       Cancel          =   -1  'True
  50.       Caption         =   "E&xit"
  51.       Height          =   372
  52.       Left            =   2880
  53.       TabIndex        =   9
  54.       Top             =   2520
  55.       Width           =   972
  56.    End
  57.    Begin VB.CommandButton Execute 
  58.       Caption         =   "&Execute"
  59.       Default         =   -1  'True
  60.       Height          =   375
  61.       Left            =   840
  62.       TabIndex        =   8
  63.       Top             =   2520
  64.       Width           =   975
  65.    End
  66.    Begin VB.TextBox PutDataText 
  67.       BackColor       =   &H00FFFFC0&
  68.       BeginProperty Font 
  69.          name            =   "System"
  70.          charset         =   0
  71.          weight          =   700
  72.          size            =   9.6
  73.          underline       =   0   'False
  74.          italic          =   0   'False
  75.          strikethrough   =   0   'False
  76.       EndProperty
  77.       ForeColor       =   &H00000000&
  78.       Height          =   492
  79.       Left            =   360
  80.       MultiLine       =   -1  'True
  81.       ScrollBars      =   1  'Horizontal
  82.       TabIndex        =   6
  83.       Top             =   1200
  84.       Width           =   3972
  85.    End
  86.    Begin VB.TextBox PSStartOffsetText 
  87.       BackColor       =   &H00FFFFC0&
  88.       ForeColor       =   &H00000000&
  89.       Height          =   288
  90.       Left            =   3600
  91.       TabIndex        =   4
  92.       Text            =   "0000"
  93.       Top             =   480
  94.       Width           =   492
  95.    End
  96.    Begin VB.Frame Frame2 
  97.       Caption         =   "Input Parameters"
  98.       Height          =   2292
  99.       Left            =   120
  100.       TabIndex        =   0
  101.       Top             =   120
  102.       Width           =   4452
  103.       Begin VB.Frame Frame3 
  104.          Caption         =   "PS &Data"
  105.          Height          =   852
  106.          Left            =   120
  107.          TabIndex        =   5
  108.          Top             =   840
  109.          Width           =   4212
  110.       End
  111.       Begin VB.Label Label2 
  112.          Caption         =   "PS &Position"
  113.          Height          =   252
  114.          Left            =   2400
  115.          TabIndex        =   3
  116.          Top             =   360
  117.          Width           =   1092
  118.       End
  119.       Begin VB.Label Label1 
  120.          Caption         =   "Session &Id"
  121.          Height          =   252
  122.          Left            =   240
  123.          TabIndex        =   1
  124.          Top             =   360
  125.          Width           =   972
  126.       End
  127.    End
  128. End
  129. Attribute VB_Name = "FormPutDataToPS"
  130. Attribute VB_Creatable = False
  131. Attribute VB_Exposed = False
  132.  
  133. Private Sub Execute_Click()
  134. On Error GoTo ErrHandler
  135.    FunctionComp = True
  136.    
  137.    OldMousePointer = MousePointer
  138.    MousePointer = 11 ' Hour Glass Mouse Pointer
  139.    
  140.    DisplayType$ = GetDisplayType$(SessionIdList.Text)
  141.    
  142.    If DisplayType$ = "NONE" Then
  143.       MousePointer = OldMousePointer
  144.       MsgBox MSG_INVALID_PSID + SessionIdList.Text, 48, MSG_SAMPLE_PROG
  145.       Exit Sub
  146.    End If
  147.    
  148.    temp$ = LTrim$(RTrim$(SessionIdList.Text))
  149.    If Len(temp$) > 0 Then
  150.       Topic$ = "Session" + SessionIdList.Text
  151.    Else
  152.       MousePointer = OldMousePointer
  153.       MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
  154.       Exit Sub
  155.    End If
  156.  
  157.    Item$ = GetItemName()
  158.    rc = DoEvents()              'If you use VisualBasic V2.0, call
  159.                                 'DoEvents function each time before
  160.                                 'starting DDE conversation.
  161.    PutDataText.LinkTimeout = -1
  162.    PutDataText.LinkTopic = APPLICATION_NAME + "|" + Topic$
  163.    PutDataText.LinkMode = COLD
  164.    PutDataText.LinkItem = Item$
  165.    PutDataText.LinkPoke
  166.    PutDataText.LinkMode = NONE
  167.       
  168.    MousePointer = OldMousePointer
  169.    If FunctionComp = True Then
  170.       MsgBox MSG_FUNCTION_COMP, 64, MSG_SAMPLE_PROG
  171.       EndStatus$ = MSG_OK
  172.    Else
  173.       MsgBox MSG_DDE_ERROR, 48, MSG_SAMPLE_PROG
  174.       EndStatus$ = MSG_NG
  175.    End If
  176.  
  177.    TempLogData$ = Time$ + ":Put Data to PS : " + EndStatus$ + Chr$(13) + Chr$(10) + Chr$(9)
  178.    TempLogData$ = TempLogData$ + MSG_APPLICATION + APPLICATION_NAME + """" + Chr$(13) + Chr$(10) + Chr$(9)
  179.    TempLogData$ = TempLogData$ + MSG_TOPIC + """" + Topic$ + """" + Chr$(13) + Chr$(10) + Chr$(9)
  180.    TempLogData$ = TempLogData$ + MSG_ITEM + """" + Item$ + """" + Chr$(13) + Chr$(10)
  181.    LogData$(LogEnd) = TempLogData$
  182.    UpdateLogPointer
  183.    Loged = True
  184.    Exit Sub
  185.  
  186. ErrHandler:
  187.    FunctionComp = False
  188.    Resume Next
  189. End Sub
  190.  
  191. Private Sub ExitDlg_Click()
  192.     Hide
  193. End Sub
  194.  
  195. Private Function GetItemName() As String
  196.  
  197.   temp$ = RTrim$(LTrim$(PSStartOffsetText.Text))
  198.  
  199.   If EOFcheck.Value = CHECKED Then
  200.      Temp2$ = "1"
  201.   Else
  202.      Temp2$ = "0"
  203.   End If
  204.   GetItemName = "EPS(" + temp$ + "," + Temp2$ + ")"
  205. End Function
  206.  
  207. Private Sub UpdateLogPointer()
  208.     LogEnd = LogEnd + 1
  209.     If LogEnd = MAXLOGNUM + 1 Then
  210.        LogEnd = 0
  211.     End If
  212.  
  213.     If LogTop = LogEnd Then
  214.        LogTop = LogTop + 1
  215.        If LogTop = MAXLOGNUM + 1 Then
  216.           LogTop = 0
  217.        End If
  218.     End If
  219. End Sub
  220.  
  221. Private Sub Form_Load()
  222.   SessionIdList.ListIndex = 0
  223.   AdjustForNT351 FormPutDataToPS
  224. End Sub
  225.  
  226.  
  227.  
  228.  
  229.