AS400,AS/400,iSeries,i5,VB,接続サンプルWindowsXPサーバー）　　　　　　 　

前提条件

　OLE DB接続（IBMDA400)
　　　OLE DBを使用するためには、「IBM AS/400 クライアント・アクセス」
　　　同じCD-ROM内にある「IBM AS/400 SDK for ActiveX and OLE DB」を導入する必要があります。

-----------------------------------------------------------------------------------------
CLPプログラム
　　*******************************************************
　　** オブジェクト：ＱＧＰＬ／ＶＢＴＥＳＴＣ
    *******************************************************
    PGM PARM(&IN1 &IN2 &OUT1)
           DCL VAR(&IN1) TYPE(*CHAR) LEN(4)
           DCL VAR(&IN2) TYPE(*DEC ) LEN(8 0)
           DCL VAR(&IN2C) TYPE(*CHAR) LEN(8)
           DCL VAR(&OUT1) TYPE(*CHAR) LEN(1)
           CHGVAR &IN2C &IN2
           SNDPGMMSG MSG(&IN2C) TOUSR(DSP01)
           CHGVAR VAR(&OUT1) VALUE('OK')
    ENDPGM
-----------------------------------------------------------------------------------------
ＶＢソース
　　Private Sub Command1_Click()

      Dim STS1 As String
      Dim STS2 As String
      Dim STS3 As String

      Set cn    = New ADODB.Connection
      Set cmd  = New ADODB.Command

      ' AS400のオープン
      cn.Open "Provider=IBMDA400;Data Source=ＡＳ４００システム名;", "ユーザー", "パスワード"

      Set cmd.ActiveConnection = cn

      With cmd
           .CommandText = "{{CALL /QSYS.LIB/QGPL.LIB/VBTESTC.PGM (?,?,?)}}"
           '.CommandType = adCmdText
           .Prepared = True
           .Parameters.Append cmd.CreateParameter("Parm1", adChar, adParamInput, 2)
           .Parameters.Append cmd.CreateParameter("Parm2", adDecimal, adParamInput, 8)
             .Parameters(1).Precision = 8          '<--最大の総桁数
             .Parameters(1).NumericScale = 0    '<--小数部の最大桁数
          .Parameters.Append cmd.CreateParameter("Parm3", adChar, adParamInputOutput, 2)
       End With
       With cmd
         .Parameters(0).Value = "01"
         .Parameters(1).Value = "20030303"
         .Parameters(2).Value = ""
         .Parameters(3).Value = ""
         .Parameters(4).Value = ""
       End With
      cmd.Execute Rcds, Parms, adCmdText        ' AS400　コマンド実行
      STS1 = cmdAS400.Parameters(2).Value
       cmd.ActiveConnection.Close
       Set cn = Nothing
　　End Sub

　

HOME