| 
SPLAF4.FRM __________ Dim datatosend As String * 5 Dim FIN As String Dim nblignes As Integer Dim largecol As String Dim f3use As String ________________________________________ Sub Form_Load () 'FONCTION CHARGEE A L'APPEL DU PGM chargegrille End Sub __________________________________________ Sub chargegrille () Screen.MousePointer = 11 msg.Caption = "chargement en cours ....." initgrille Show splaf4.Refresh ' par defaut "liste vide" grille.Row = 1 grille.Col = 0 grille.Text = "(Liste vide)" Do nblignes = nblignes + 1 uneligne datatosend = "SUITE" Loop Until FIN = "O" grille.Row = 1 grille.Col = 0 msg.Caption = " " Screen.MousePointer = 0 End Sub ________________________________________ Sub refresh_click () 'BOUTON REFRESH chargegrille End Sub ________________________________________ Sub refreshm_Click () 'OPTION DU MENU OU F5 refresh_click End Sub ____________________________________________ Sub initgrille () |
|
' Declare les variables locales. Dim col2 ' Efface le contenu de la grille. grille.Rows = 2 nblignes = 0 datatosend = "DEBUT" ' Reinitialise l'image dans la cellule 0, 0 grille.Row = 0 grille.Col = 0 ' Place les en-tetes de col dans la 1ere ligne. grille.Text = "Nom" grille.Col = 1 grille.Text = "Pages" grille.Col = 2 grille.Text = "Usrdta" grille.Col = 3 grille.Text = "Etat" grille.Col = 4 grille.Text = "Outq" 'Centre le texte dans la 1ere col. For col2 = 0 To 4 grille.FixedAlignment(col2) = 2 If largecol <> "O" Then grille.ColWidth(col2) = grille.ColWidth(col2) * 2 End IfSPLAF4.FRM - 3 Next col2 ' ne pas retailler les colonnes largecol = "O" ' msg liste en cours ... grille.Row = 1 grille.Col = 0 grille.Text = "En cours..." grille.Col = 1 grille.Text = "" grille.Col = 2 grille.Text = "" grille.Col = 3 grille.Text = "" grille.Col = 4 grille.Text = "" End Sub __________________________________________ Sub uneligne () 'RECUPERE UN SPOOL (DIALOGUE APPC) |
|
' If there is no conversation active, it will be allocated at this time. Dim Header As String * 4 ' String to receive formatted header Dim record As String * 46 ' String to receive record from the AS/400 ' String to hold data to be sent If ConvId = 0 Then ' If conversation is not active rc% = Allocate() ' Allocate a conversation End If Call AsciiToEbcdic(datatosend) ' Convert data to EBCDICSPLAF4.FRM - 4 If Send(datatosend) = 0 Then ' Send data to the AS/400 If RecvW(4, Header) = 0 Then ' Receive 4 byte header If RecvW(46, record) = 0 Then ' Receive 46 byte record Call EbcdicToAscii(record) ' Convert record to ASCII FIN = Left$(record, 1) If FIN <> "O" Then If nblignes > 1 Then grille.Rows = (nblignes + 1) End If grille.Row = nblignes grille.Col = 0 grille.Text = Mid$(record, 2, 10) ' nom grille.Col = 1 grille.Text = Mid$(record, 12, 5) ' pages grille.Col = 2 grille.Text = Mid$(record, 17, 10) ' usrdta grille.Col = 3 grille.Text = Mid$(record, 27, 10) ' etat grille.Col = 4 grille.Text = Mid$(record, 37, 10) ' outq End If rc% = RecvW(0, GetSend$) ' Do one more receive to get change ' direction indicator (WhatReceived = Send) End If End If End If End Sub ________________________________________ Sub exit_click () 'BOUTON EXIT deallocate f3use = "O" End End Sub ________________________________________ |
|
Sub exitm_Click () 'OPTION DU MENU OU F3
exit_click
End Sub
________________________________________
' SORTIE DU PGM DEMANDEE
Sub Form_QueryUnload (cancel As Integer, UnloadMode As Integer)
If f3use <> "O" Then
MsgBox "Conversations en cours, Utilisez Exit.", 16, "Attention"
cancel = 1
End If
End Sub
' FONCTION COPIÉES PARTIR DES OUTILS PCS (QIWSTOOL)
______________________________________________________
Function Allocate () As Integer
' This function allocates a conversation with AS/400 program
' splaf4CL in library AF4tool
' The conversation has the following characteristics:
' Mapped conversation
' 271 byte router buffer (minimum required)
' Sync Level - none
' No pip data
' If successful, the conversation ID is returned
PipData$ = Chr$(0) ' This routine sends no pip data
' systeme par defaut
getdefsys
rc% = EHNAPPC_Allocate(hWnd, 271, EHNAPPC_MAPPED, EHNAPPC_SYNCLEVELNONE, sysna
me, "SPLAF4CL.AF4TOOL", 0, PipData$, ConvId)
If rc% <> 0 Then
FIN = "O"
MsgBox ("Allocate impossible /code retour : " + Str$(rc%))
End If
Allocate = rc%
End Function
___________________________________________
Sub deallocate ()
' This subroutine deallocates the active conversation
' specified in the ConvID global variableSPLAF4.FRM - 2
rc% = EHNAPPC_Deallocate(hWnd, ConvId, EHNAPPC_DEALLOCATESYNCLEVEL)
End Sub
Sub EbcdicToAscii (StrName As String)
' This routine converts a String from EBCDIC to ASCII
|
|
Dim tlen As Integer
Target$ = Space$(Len(StrName)) ' Initialize target string
tlen = Len(Target$) ' Set target string length
rc% = EHNDT_EBCDICToASCII(hWnd, StrName, Target$, Len(StrName), tlen)
StrName = Left$(Target$, tlen) ' Move target to original string
End Sub
_________________________________________
Sub getdefsys ()
' This routine gets the default system into variable DefSys$
sysname = Space$(10)
rc% = EHNAPPC_GetDefaultSystem(hWnd, sysname)
End Sub
__________________________________________
Sub AsciiToEbcdic (StrName As String)
' This routine converts a String from ASCII to EBCDIC
Dim tlen As Integer
Target$ = Space$(Len(StrName)) ' Initialize target string
tlen = Len(Target$) ' Set target string length
rc% = EHNDT_ASCIIToEBCDIC(hWnd, StrName, Target$, Len(StrName), tlen)
StrName = Left$(Target$, tlen) ' Move target to original string
End Sub
_______________________________________
Function RecvW (Rlen As Integer, buff As String) As Integer
' This function Receives data from the Router for the length specified
' and returns it in the string specified.
IntBuff$ = Space$(Rlen) ' Set up an intermediate buffer to receive data
rc% = EHNAPPC_ReceiveAndWait(hWnd, ConvId, EHNAPPC_BUFFER, Rlen, IntBuff$, Wha
tRec%, Rts%, ActLen%)
If rc% <> 0 Then
FIN = "O"
MsgBox ("Reception en erreur / code retour : " + Str$(rc%))
Else
buff = Left$(IntBuff$, ActLen%) ' Move received data to output string
Rlen = ActLen% ' Return actual length
End If
RecvW = rc% ' Return return code
End Function
_______________________________________
Function Send (Sdata As String) As Integer
' This function sends the specified data to the AS/400
' It does not wait for a reply
' The data sent will be preceeded by the proper GDS header (llID)
Dim GDSHdr As String * 4 ' GDS Header
Dim FData As String ' Formatted Data (header + data)
|
|
Call flip(Len(Sdata) + 4, Dlen$) ' Get length into proper format
GDSHdr = Dlen$ + Chr$(&H12) + Chr$(&HFF) ' Format of GDS header is llID wh
ere ID=x'12FF'
FData = GDSHdr + Sdata ' Put together formatted data
rc% = EHNAPPC_SendData(hWnd, ConvId, Len(FData), FData, rqs%)
If rc% <> 0 Then
FIN = "O"
MsgBox ("Envoi en erreur / code retour : " + Str$(rc%))
End If
Send = rc% ' Return return code
End Function
|
