This function returns the associated error message text
from a failed operation in UniVerse Objects. It was
necessary to build the text file, UVOAIF.TXT,
from the eponymously named include file in UniVerse Objects.
'**********************************************************
Function fncFindErr(ByRef errno As Long) As String
'**********************************************************
' ray 01/2000 -- find uvobject error text '
On Error GoTo Err_Handler
Dim intFN As Integer, Code As Long
Dim blnFoundErr As Boolean, txtpath$
blnFoundErr = False
txtpath = strDrive & "UV_OBJECTS\PARAMS\UVOAIF.TXT"
intFN = FreeFile ' get unused file first '
Open txtpath For Input As #intFN
Do Until EOF(intFN) Or blnFoundErr = True
Input #1, Code, fncFindErr
If Code = errno Then
' found the error '
fncFindErr = " - " & fncFindErr & "!"
blnFoundErr = True
End If
Loop
Close #intFN
If blnFoundErr = False Then fncFindErr = " FindErr --Unknown uvObject Error Occurred!"
Exit Function
Err_Handler:
' cannot open the error file itself! '
fncFindErr = " FindErr -- Unable to open " & txtpath & "!"
End Function
Introduces the LOCATE functionality to Visual Basic & UniVerse
Objects. Could use another argument for ascending/descending
but external subroutines in UvObjects don't support variable
numbers of arguments. Don't feel like modifying a whole bunch
of code to address the ascendancy issue.
SUBROUTINE PICK.LOCATE (STRING,TXT,DELM,POS,FOUND)
* to be called from uv_objects
* search for txt in string according to delm
* return in pos
* found = whether we found it
* delm:
* 0 = am
* 1 = vm
* 2 = svm
*
* ray 01/2000
*
IF DELM = 2 THEN VAL = 1 ELSE VAL = 0
*
IF DELM THEN
* vm/svm
LOCATE(TXT,STRING,1,VAL;POS) THEN FOUND = 1 ELSE FOUND = 0
*
END ELSE
* am
LOCATE(TXT,STRING;POS) THEN FOUND = 1 ELSE FOUND =
*
END ; * of locate
*
RETURN
A concise snippet of code written by Alex Vlassis to read
and lock a record. There is a need in UniVerse Objects to
specify a lock strategy. The default locking strategy releases
the lock whenever the 'recordid' value changes. This results
in the loss of a lock whenever the programmer reads another
record from the same file as the locked record. If I am under
a misconception on this, please advise me.
With obj_file_var
.recordid = this_id
.lockstrategy 1
.releasestrategy 1
.read
' test results here:
end with
Also from Alex Vlassis, the Pick FIELD statement adapted to VB:
Option Explicit
Public Function pickfield(str_string As String, str_delimeter As String, int_occur)
As String
' av @ 02/23/2000
' function to re-produce the pick function field
' coming in str_string as the string to be searched
' str_delimeter as the delimeter separator
' int_occur is the first or second or ... n occurance of the delimeter
' within the string..
Dim i As Integer
Dim int_len As Integer
Dim int_count As Integer
Dim s As String
Dim temp As String
Dim bln_found As Boolean
bln_found = False
temp = vbNullString
'
int_len = Len(str_string)
If int_occur <= 0 Then
int_occur = 1
End If
Dim s_items() As String
If str_delimeter = vbNullString Or Len(str_string) <= 0 Then
pickfield = vbNullString ' return null
Else
ReDim s_items(0) As String
For i = 1 To int_len
' extract each character
s = Mid$(str_string, i, 1)
' keep on adding to temp
If s = str_delimeter Then
'
int_count = int_count + 1
ReDim Preserve s_items(UBound(s_items) + 1)
'
s_items(int_count) = temp
temp = vbNullString
If int_count = int_occur Then
pickfield = s_items(int_count)
bln_found = True
Exit For
End If
'
Else
' loop and keep on forming the temp string
temp = temp & s
End If
Next i
If Len(temp) > 0 Then
ReDim Preserve s_items(UBound(s_items) + 1)
s_items(UBound(s_items)) = temp
ReDim Preserve s_items(int_occur)
End If
If bln_found = False Then
pickfield = s_items(int_occur)
End If
End If
End Function