Public Function GetImage(ByVal RequestCode As String, Optional ByVal SubCode As String) As Object
Select Case RequestCode
 
        Case "Toolbar"
            Select Case SubCode
                Case "Normal"
                        Set GetImage = ToolbarNormal ' ImageList
                Case "Hot"
                        Set GetImage = ToolbarHot ' ImageList
                Case "Disabled"
                        Set GetImage = ToolbarDisabled ' ImageList
            End Select
 
        Case "BackgroundImage"
            Set GetImage = BackgroundImage ' Picture
 
        Case "TreeImages"
            Set GetImage = TreeImages ' ImageList
 
        Case "GridImages"
            Set GetImage = GridImages ' ImageList
 
        Case "Report"
            Select Case SubCode
                Case "Header"
                        Set GetImage = ReportHeader ' Picture
            End Select
 
End Select
End Function

SERVER_LOCATION ---> |http://200.41.229.187| (del tipo 8)
SERVEROBJ_CLASS ---> |GrialData.Server| (del tipo 8)
USUARIO ---> |LTATO| (del tipo 8)
CONEXION ---> |LTATO:PROD;WMMNFpnwqtFmvwn| (del tipo 8)
DB_INSTANCE ---> |PROD| (del tipo 8)
RELA_SOCUSUA15 ---> |1| (del tipo 8)
ID_SOCUSUA01 ---> |1| (del tipo 8)
SOCUSUA01_NOMBRE ---> |LTATO| (del tipo 8)
SOCUSUA15_ENTIDAD ---> |TATO, LUCIO| (del tipo 8)
SOCUSUA15_NRODOC ---> |20-21796978-7| (del tipo 8)
SOCUSUA01_FBAJA ---> || (del tipo 8)
SOCUSUA01_TIPO ---> |2| (del tipo 8)
SOCUSUA01_TIENEUSERDB ---> |1| (del tipo 8)
RELA_PREFORM02_BASE ---> |105| (del tipo 8)
ENTIDAD ---> |Tato, Lucio| (del tipo 8)
SU02_1 ---> |objeto| (del tipo 9)
SU02_2 ---> |objeto| (del tipo 9)
SU02_3 ---> |objeto| (del tipo 9)
SU02_4 ---> |objeto| (del tipo 9)
SU02_5 ---> |objeto| (del tipo 9)
SU02_6 ---> |objeto| (del tipo 9)
SU02_7 ---> |objeto| (del tipo 9)
SU02_ACTIVA ---> |1| (del tipo 2)
DISKSESSION_CONNINDEX ---> |1| (del tipo 3)
INSTALACIONES_ROOT ---> |http://200.41.229.187| (del tipo 8)
CONNECTION_INDEX ---> |0| (del tipo 8)
ID_SYSFUNC03 ---> |3784| (del tipo 3)
ID_FUNC ---> |3784| (del tipo 3)
FUNC_URL ---> |/instalaciones| (del tipo 8)
FUNC_DESCRI ---> |Proceso Respuesta Banco Lotes Transferencias| (del tipo 8)
FUNC_DESCRI_ROT ---> |Proceso Respuesta Banco Lotes Transferencias| (del tipo 8)
FUNC_CODDUPL ---> || (del tipo 8)
SOCUSUA21 ---> |153| (del tipo 3)
SYSFUNC03 ---> |3784| (del tipo 3)
PUEDEEJECUTAR ---> |0| (del tipo 3)
MENU_ALTA ---> |-1| (del tipo 3)
MENU_BAJA ---> |-1| (del tipo 3)
MENU_MODI ---> |-1| (del tipo 3)
MENU_CONSULTA ---> |-1| (del tipo 3)
MENU_REPORTE ---> |-1| (del tipo 3)
MENU_INFORME ---> |-1| (del tipo 3)
MENU_FRM1 ---> -1 si el usuario esta habilitado, 0 en otro caso
MENU_FRM2 ---> -1 si el usuario esta habilitado, 0 en otro caso
MENU_FRM3 ---> -1 si el usuario esta habilitado, 0 en otro caso
MENU_ACEPTAR ---> |-1|  si el usuario tiene el boton aceptar

? SU02Activa.Contenido
 
ID_SOCUSUA02 ---> |3666| (del tipo 8)
RELA_SOCUSUA01 ---> |261| (del tipo 8)
RELA_SOCUSUA21 ---> |161| (del tipo 8)
RELA_PREFORM02 ---> |1825| (del tipo 8)
RELA_PREFORM11 ---> |2301| (del tipo 8)
RELA_PREFORM12 ---> |1681| (del tipo 8)
SOCUSUA02_FBAJA ---> || (del tipo 8)
PREFORM02_CODIGO ---> |1| (del tipo 8)
PREFORM02_DESCRI ---> |Administración Central| (del tipo 8)
PREFORM11_CODIGO ---> |GN.02| (del tipo 8)
PREFORM11_DESCRI ---> |Organo Rector Presupuesto| (del tipo 8)
PREFORM12_CODIGO ---> |AB| (del tipo 8)
PREFORM12_DESCRI ---> |Administrador de la Base| (del tipo 8)
RELA_PREFORM01 ---> |688| (del tipo 8)
ID_PREFORM03 ---> |1931| (del tipo 8)
PERI_DESCRI ---> |Período 2006| (del tipo 8)
PERI_ANO ---> |2006| (del tipo 8)
SYSFORM02_COD ---> |FOR| (del tipo 8)
PREFORM02_CODRECTOR ---> |1| (del tipo 8)
EJE_RELA_PREFORM01 ---> |686| (del tipo 8)
EJE_ID_PREFORM03 ---> |1853| (del tipo 8)
EJE_PERI_DESCRI ---> |Período 2005| (del tipo 8)
EJE_PERI_ANO ---> |2005| (del tipo 8)
EJE_SYSFORM02_COD ---> |EJE| (del tipo 8)

Public Function VBErrorText() As String
    Dim Source As String
    Source = Err.Source
    If Source Like App.EXEName & "*" Then
        Source = ""
    Else
        Source = Source & ": "
    End If
    VBErrorText = "Ha ocurrido un error." & vbCrLf & vbCrLf & _
                     Source & Err.Description
End Function
 
Sub MsgError(GrialCont As Object)
    Dim s As String, AppVersion As String
    s = VBErrorText()
    On Error Resume Next
        AppVersion = " v" & App.Major & "." & App.Minor & "." & App.Revision
        MsgBox s, vbCritical, App.Title & AppVersion
        GrialCont.AddErrLog App.EXEName & AppVersion & ": " & s
    Err.Clear
End Sub

Option Explicit
Option Compare Text
 
Sub ascii(a As String)
Dim n As Integer
For n = 1 To Len(a)
    Debug.Print Asc(Mid(a, n, 1)); ",";
    If n Mod 10 = 0 Then Debug.Print
Next
Debug.Print
End Sub
 
Sub cutprint(ByVal s As String)
Do While Len(s)
    If Len(s) > 40 Then
        Dim cutp As Integer
        cutp = InStr(30, s, ",")
        If cutp = 0 Then cutp = InStr(30, s, ";")
        If cutp = 0 Then cutp = Max(InStr(20, s, " "), 80)
        Debug.Print Left$(s, cutp - 1)
        'Add Left$(s, cutp - 1)
        s = Mid$(s, cutp)
    Else
        Debug.Print s
'        Add s
        Exit Do
    End If
 
Loop
 
End Sub
 
Sub sql(ComandoSQL)
sqlprint ComandoSQL
'Clipboard.SetText MsgText
End Sub
 
Sub sqlprint(ByVal s As String)
Dim cutp As Integer
'Msg ""
Do
    cutp = InStr(10, s, "FROM")
    If cutp = 0 Then cutp = InStr(10, s, "WHERE")
    If cutp = 0 Then cutp = InStr(10, s, "and")
    If cutp = 0 Then cutp = InStr(10, s, "GROUP")
    If cutp = 0 Then cutp = InStr(10, s, "ORDER")
    If cutp = 0 Then cutp = Len(s) + 1
    cutprint Left$(s, cutp - 1)
    s = Mid$(s, cutp)
Loop While Len(s)
 
End Sub
 
Sub ShowRec(r As Recordset)
On Error Resume Next
Dim F As Field
For Each F In r.Fields
    Debug.Print F.Name; ": ", , F.Value;
    If Err Then Debug.Print "("; Err.Description; ")";
    Debug.Print
Next
Err.Clear
End Sub
 
Sub Show(r)
On Error Resume Next
 
Dim SaveFilter, SaveBmk
SaveFilter = r.Filter
If Err Then
    Debug.Print Err.Description
    Exit Sub
End If
 
If Not (r.EOF Or r.BOF Or (r.Status And adRecDeleted) <> 0) Then
    SaveBmk = r.Bookmark
End If
 
'R.Filter = adFilterPendingRecords
If r.RecordCount = 0 Then
    Debug.Print " RecordCount = 0"
    GoTo Salida
End If
 
Dim F As Field
r.MoveFirst
Do While Not r.EOF
    Debug.Print "REC:"; r.AbsolutePosition; " "; ' " ["; R.Status; "]:";
     For Each F In r.Fields
        Debug.Print F.Name; ":"; 'F.OriginalValue;
        Debug.Print "|"; F.Value; "| ";
        If Err Then
            Debug.Print "("; Left$(Err.Description, 15); "...) ";
            Err.Clear
        End If
    Next
    Debug.Print
    r.MoveNext
Loop
 
Salida:
r.Filter = SaveFilter
if not IsEmpty(SaveBmk) then r.Bookmark = SaveBmk
Err.Clear
End Sub
 
Sub Pend(r)
 
On Error Resume Next
 
Dim SaveFilter, SaveBmk
SaveFilter = r.Filter
If Err Then
    Debug.Print Err.Description
    Exit Sub
End If
 
If Not (r.EOF Or r.BOF Or (r.Status And adRecDeleted) <> 0) Then
    SaveBmk = r.Bookmark
End If
r.Filter = ""
r.Filter = adFilterPendingRecords
If r.RecordCount = 0 Then
    Debug.Print Err.Description
    Debug.Print " adFilterPendingRecords, RecordCount = 0"
    GoTo Salida
End If
 
 
Dim F As Field
r.MoveFirst
Do While Not r.EOF
    Debug.Print "REC:"; r.AbsolutePosition; "["; r.Status; ":";
    If r.Status And adRecDeleted Then Debug.Print "Del ";
    If r.Status And adRecModified Then Debug.Print "Mod ";
    If r.Status And adRecNew Then Debug.Print "New ";
    Debug.Print "] ";
     For Each F In r.Fields
        Debug.Print LCase$(F.Name); ":|"; F.OriginalValue;
        If r.Status And adRecDeleted Then
            Debug.Print "| ";
        Else
            Debug.Print "|"; F.Value; "| ";
            If Err Then
                Debug.Print "("; Left$(Err.Description, 5); "...) ";
                Err.Clear
            End If
        End If
    Next
    Debug.Print
    Err.Clear
    r.MoveNext
    If Err Then
            Debug.Print "Movenext: ("; Err.Description & ")"
            Exit Do
    End If
Loop
Err.Clear
 
Salida:
r.Filter = SaveFilter
If Not IsEmpty(SaveBmk) Then r.Bookmark = SaveBmk
Err.Clear
 
End Sub