home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l406 / 4.ddi / VISDATA.BA_ / VISDATA.bin
Encoding:
Text File  |  1992-10-21  |  18.0 KB  |  689 lines
  1. '------------------------------------------------------------
  2. ' VISDATA.BAS
  3. ' support functions for the Visual Data sample application
  4. '
  5. ' General Information: This app is intended to demonstrate
  6. '   and exercise all of the functionality available in the
  7. '   VT (Virtual Table) Object layer in VB 2.0 Pro. It has
  8. '   the following limitations (not imposed by VB):
  9. '       1. Only one DataBase may be open at a time
  10. '       2. Only one Dynaset may be open at a time
  11. '       3. Only one record is displayed at a time
  12. '
  13. '   Any valid SQL statement may be sent via the Utility SQL
  14. '   function excluding "select" statements which may be
  15. '   executed from the Dynaset Create function. With these
  16. '   two features, this simple app becomes a powerful data
  17. '   definition and query tool accessing any ODBC driver
  18. '   available at the time.
  19. '
  20. '   The app has the capability to perform all DDL (data
  21. '   definition language) functions. These are accessed
  22. '   from the "Tables" form. This form accesses the
  23. '   "NewTable", "AddField" and "IndexAdd" forms to do
  24. '   the actual table, field and index definition.
  25. '   Tables and Indexes may be deleted when the corresponding
  26. '   "Delete" button is enabled. It is not possible to
  27. '   delete fields.
  28. '
  29. ' Naming Conventions:
  30. '   "f..."   = Form
  31. '   "c..."   = Form control
  32. '   "F..."   = Form level variable
  33. '   "gst..." = Global String
  34. '   "gf..."  = Global flag (true/false)
  35. '   "gw..."  = Global 2 byte integer value
  36. '
  37. '------------------------------------------------------------
  38.  
  39. Option Explicit
  40.  
  41. 'api declarations
  42. Declare Function OSGetPrivateProfileString% Lib "Kernel" Alias "GetPrivateProfileString" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal ReturnString$, ByVal NumBytes As Integer, ByVal FileName$)
  43. Declare Function OSWritePrivateProfileString% Lib "Kernel" Alias "WritePrivateProfileString" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal FileName$)
  44.  
  45. 'global object variables
  46. Global gCurrentDB As Database
  47. Global gfDBOpenFlag As Integer
  48. Global gCurrentDS As Dynaset
  49.  
  50. 'global database variables
  51. Global gstDBName As String
  52. Global gstUserName As String
  53. Global gstPassword As String
  54. Global gstDataBase As String
  55. Global gstDynaString As String
  56. Global gstTblName As String
  57. Global gfUpdatable As Integer
  58.  
  59. 'other global vars
  60. Global gstZoomData As String
  61. Global gstTableFilter As String
  62. Global gwMaxGridRows As Long
  63.  
  64. 'new field properties
  65. Global gwFldType As Integer
  66. Global gwFldSize As Integer
  67.  
  68. 'global find values
  69. Global gfFindFailed As Integer
  70. Global gstFindExpr As String
  71. Global gstFindOp As String
  72. Global gstFindField As String
  73. Global gfFindMatch As Integer
  74. Global gfFromTableView As Integer
  75.  
  76. 'global flags
  77. Global gfDBChanged As Integer
  78. Global gfFromSQL As Integer
  79. Global gfTransPending As Integer
  80. Global gfAddTableFlag As Integer
  81.  
  82. 'global constants
  83. Global Const DEFAULTDRIVER = "SQL Server"
  84. Global Const MODAL = 1
  85. Global Const HOURGLASS = 11
  86. Global Const DEFAULT_MOUSE = 0
  87. Global Const YES = 6
  88. Global Const MSGBOX_TYPE = 4 + 48 + 256
  89. Global Const TRUE_ST = "True"
  90. Global Const FALSE_ST = "False"
  91. Global Const EOF_ERR = 626
  92. Global Const FTBLS = 0
  93. Global Const FFLDS = 1
  94. Global Const FINDX = 2
  95. Global Const MAX_GRID_ROWS = 1999
  96. Global Const MAX_MEMO_SIZE = 20000
  97. Global Const GETCHUNK_CUTOFF = 50
  98.  
  99. 'field type constants
  100. Global Const FT_TRUEFALSE = 1
  101. Global Const FT_BYTE = 2
  102. Global Const FT_INTEGER = 3
  103. Global Const FT_LONG = 4
  104. Global Const FT_CURRENCY = 5
  105. Global Const FT_SINGLE = 6
  106. Global Const FT_DOUBLE = 7
  107. Global Const FT_DATETIME = 8
  108. Global Const FT_STRING = 10
  109. Global Const FT_MEMO = 12
  110.  
  111. Function CheckTransPending (msg As String) As Integer
  112.  
  113.   If gfTransPending = True Then
  114.     MsgBox msg + Chr(13) + Chr(10) + "Execute Commit or Rollback First.", 48
  115.     CheckTransPending = True
  116.   Else
  117.     CheckTransPending = False
  118.   End If
  119.  
  120. End Function
  121.  
  122. Sub CloseAllDynasets ()
  123.   Dim i As Integer
  124.  
  125.   MsgBar "Closing Dynasets", True
  126.   While i < forms.Count
  127.     If forms(i).Tag = "Dynaset" Then
  128.       Unload forms(i)
  129.     Else
  130.       i = i + 1
  131.     End If
  132.   Wend
  133.   MsgBar "", False
  134.  
  135. End Sub
  136.  
  137. Function CopyStruct (from_db As Database, to_db As Database, from_nm As String, to_nm As String, create_ind As Integer) As Integer
  138.   On Error GoTo CSErr
  139.  
  140.   Dim i As Integer
  141.   Dim tbl As New tabledef    'table object
  142.   Dim fld As Field           'field object
  143.   Dim ind As Index           'index object
  144.  
  145.   'search to see if table exists
  146.   For i = 0 To to_db.TableDefs.Count - 1
  147.     If UCase(to_db.TableDefs(i).Name) = UCase(to_nm) Then
  148.       If MsgBox(to_nm + " already exists, delete it?", 4) = YES Then
  149.          to_db.TableDefs.Delete to_db.TableDefs(to_nm)
  150.       Else
  151.          CopyStruct = False
  152.          Exit Function
  153.       End If
  154.       Exit For
  155.     End If
  156.   Next
  157.  
  158.   tbl.Name = to_nm
  159.  
  160.   'get the needed data from the source database
  161.   from_db.TableDefs(from_nm).Fields.Refresh
  162.   from_db.TableDefs(from_nm).Indexes.Refresh
  163.  
  164.   'create the fields
  165.   For i = 0 To from_db.TableDefs(from_nm).Fields.Count - 1
  166.     Set fld = New Field
  167.     fld.Name = from_db.TableDefs(from_nm).Fields(i).Name
  168.     fld.Type = from_db.TableDefs(from_nm).Fields(i).Type
  169.     fld.Size = from_db.TableDefs(from_nm).Fields(i).Size
  170.     tbl.Fields.Append fld
  171.   Next
  172.  
  173.   'create the indexes
  174.   If create_ind <> False Then
  175.     For i = 0 To from_db.TableDefs(from_nm).Indexes.Count - 1
  176.       Set ind = New Index
  177.       ind.Name = from_db.TableDefs(from_nm).Indexes(i).Name
  178.       ind.Fields = from_db.TableDefs(from_nm).Indexes(i).Fields
  179.       ind.Unique = from_db.TableDefs(from_nm).Indexes(i).Unique
  180.       tbl.Indexes.Append ind
  181.     Next
  182.   End If
  183.  
  184.   'append the new table
  185.   to_db.TableDefs.Append tbl
  186.  
  187.   CopyStruct = True
  188.   GoTo CSEnd
  189.  
  190. CSErr:
  191.   ShowError
  192.   CopyStruct = False
  193.   Resume CSEnd
  194.  
  195. CSEnd:
  196.  
  197. End Function
  198.  
  199. 'sub used to create a sample table and fill it
  200. 'with NumbRecs number of rows
  201. 'can only be called from the debug window
  202. 'for example:
  203. 'CreateSampleTable("mytbl",100)
  204. Sub CreateSampleTable (TblName As String, NumbRecs As Long)
  205.   Dim ds As Dynaset
  206.   Dim ii As Long
  207.   Dim t1 As New tabledef
  208.   Dim f1 As New Field
  209.   Dim f2 As New Field
  210.   Dim f3 As New Field
  211.   Dim f4 As New Field
  212.   Dim i1 As New Index
  213.   Dim i2 As New Index
  214.  
  215.   'create the data holding table
  216.   t1.Name = TblName
  217.   
  218.   f1.Name = "name"
  219.   f1.Type = FT_STRING
  220.   f1.Size = 25
  221.   t1.Fields.Append f1
  222.  
  223.   f2.Name = "address"
  224.   f2.Type = FT_STRING
  225.   f2.Size = 25
  226.   t1.Fields.Append f2
  227.  
  228.   f3.Name = "record"
  229.   f3.Type = FT_STRING
  230.   f3.Size = 10
  231.   t1.Fields.Append f3
  232.  
  233.   f4.Name = "id"
  234.   f4.Type = FT_LONG
  235.   f4.Size = 4
  236.   t1.Fields.Append f4
  237.  
  238.   gCurrentDB.TableDefs.Append t1
  239.  
  240.   'add the indexes
  241.   i1.Name = TblName + "1"
  242.   i1.Fields = "name"
  243.   i1.Unique = False
  244.   gCurrentDB.TableDefs(TblName).Indexes.Append i1
  245.  
  246.   i2.Name = TblName + "2"
  247.   i2.Fields = "id"
  248.   i2.Unique = True
  249.   gCurrentDB.TableDefs(TblName).Indexes.Append i2
  250.  
  251.   'add records to the table in reverse order
  252.   'so indexes have some work to do
  253.   Set ds = gCurrentDB.CreateDynaset(TblName)
  254.   For ii = NumbRecs To 1 Step -1
  255.     ds.AddNew
  256.     ds(0) = "name" + CStr(ii)
  257.     ds(1) = "addr" + CStr(ii)
  258.     ds(2) = "rec" + CStr(ii)
  259.     ds(3) = ii
  260.     ds.Update
  261.   Next
  262.  
  263. End Sub
  264.  
  265. Function GetFieldType (ft As String) As Integer
  266.   'return field length
  267.   If ft = "String" Then
  268.     GetFieldType = FT_STRING
  269.   Else
  270.     Select Case ft
  271.       Case "True/False"
  272.         GetFieldType = FT_TRUEFALSE
  273.       Case "Byte"
  274.         GetFieldType = FT_BYTE
  275.       Case "Integer"
  276.         GetFieldType = FT_INTEGER
  277.       Case "Long"
  278.         GetFieldType = FT_LONG
  279.       Case "Currency"
  280.         GetFieldType = FT_CURRENCY
  281.       Case "Single"
  282.         GetFieldType = FT_SINGLE
  283.       Case "Double"
  284.         GetFieldType = FT_DOUBLE
  285.       Case "Date/Time"
  286.         GetFieldType = FT_DATETIME
  287.       Case "Memo"
  288.         GetFieldType = FT_MEMO
  289.     End Select
  290.   End If
  291.  
  292. End Function
  293.  
  294. Function GetFieldWidth (t As Integer)
  295.   'determines the form control width
  296.   'based on the field type
  297.   Select Case t
  298.     Case FT_TRUEFALSE
  299.       GetFieldWidth = 850
  300.     Case FT_BYTE
  301.       GetFieldWidth = 650
  302.     Case FT_INTEGER
  303.       GetFieldWidth = 900
  304.     Case FT_LONG
  305.       GetFieldWidth = 1100
  306.     Case FT_CURRENCY
  307.       GetFieldWidth = 1800
  308.     Case FT_SINGLE
  309.       GetFieldWidth = 1800
  310.     Case FT_DOUBLE
  311.       GetFieldWidth = 2200
  312.     Case FT_DATETIME
  313.       GetFieldWidth = 2000
  314.     Case FT_STRING
  315.       GetFieldWidth = 3250
  316.     Case FT_MEMO
  317.       GetFieldWidth = 3250
  318.     Case Else
  319.       GetFieldWidth = 3250
  320.   End Select
  321.  
  322. End Function
  323.  
  324. Function GetINIString$ (ByVal szItem$, ByVal szDefault$)
  325.   Dim tmp As String
  326.   Dim x As Integer
  327.  
  328.   tmp = String$(255, 32)
  329.   x = OSGetPrivateProfileString("VISDATA", szItem$, szDefault$, tmp, Len(tmp), "VISDATA.INI")
  330.  
  331.   GetINIString = Mid$(tmp, 1, x)
  332. End Function
  333.  
  334. Function GetNumbRecs (fds As Dynaset, wh As String) As Long
  335.   Dim ds As Dynaset
  336.  
  337.   On Error GoTo GNRErr
  338.  
  339.   'this is a quick way to get the number of
  340.   'records in a dynaset
  341.   If fds.Updatable = True Then
  342.     Set ds = gCurrentDB.CreateDynaset("select count(*) from " + fds.Name)
  343.     gfUpdatable = True
  344.     GetNumbRecs = ds(0)
  345.     ds.Close
  346.   Else
  347.     gfUpdatable = False
  348.     'use the where clause only if "group by" not found
  349.     If InStr(1, wh, "group by") = 0 Then
  350.       Set ds = gCurrentDB.CreateDynaset("select count(*) from " + wh)
  351.       GetNumbRecs = ds(0)
  352.       ds.Close
  353.     End If
  354.   End If
  355.  
  356.   GoTo GNREnd
  357.  
  358. GNRErr:
  359.   If InStr(1, Error$, "Timeout") > 0 Then
  360.     MsgBox "Timeout Occurred Getting Record Count, try Increasing QueryTimeout!", 48
  361.     GetNumbRecs = -1
  362.     Resume GNREnd
  363.   End If
  364.   Resume Next
  365.   GetNumbRecs = 0
  366.   Resume GNREnd
  367.  
  368. GNREnd:
  369.  
  370. End Function
  371.  
  372. '----------------------------------------------------------------------------
  373. 'to use this function in any app,
  374. '1. create a form with a grid
  375. '2. create a dynaset
  376. '3. call this function from the form with
  377. '   grd    = your grid control name
  378. '   dynst$ = your dynaset open string (table name or SQL select statement)
  379. '   numb&  = the max number of rows to load (grid is limited to 2000)
  380. '   start& = starting row (needed to display the record number in the
  381. '            left column when loading blocks of records as the
  382. '            DynaGrid form in this app does with the "More" button)
  383. '----------------------------------------------------------------------------
  384. Function LoadGrid (grd As Control, fds As Dynaset, dynst$, numb&, start&) As Integer
  385.    Dim ft As Integer               'field type
  386.    Dim i As Integer, j As Integer  'for loop indexes
  387.    Dim fn As String                'field name
  388.    Dim rc As Integer               'record count
  389.    Dim gs As String                'grid string
  390.  
  391.    On Error GoTo LGErr
  392.  
  393.    MsgBar "Loading Grid for Table View", True
  394.    'setup the grid
  395.    grd.Rows = 2       'reduce the grid
  396.    grd.FixedRows = 0  'allow next step
  397.    grd.Rows = 1       'clears the grid completely
  398.    grd.Cols = fds.Fields.Count + 1
  399.  
  400.    If start& = 0 Then        'only do it on first call
  401.      'set the column widths
  402.      For i = 0 To fds.Fields.Count - 1
  403.        ft = fds(i).Type
  404.        If ft = FT_STRING Then
  405.          If fds(i).Size > Len(fds(i).Name) Then
  406.            If fds(i).Size <= 10 Then
  407.              grd.ColWidth(i + 1) = fds(i).Size * fTables.TextWidth("A")
  408.            Else
  409.              grd.ColWidth(i + 1) = 10 * fTables.TextWidth("A")
  410.            End If
  411.          Else
  412.            If Len(fds(i).Name) <= 10 Then
  413.              grd.ColWidth(i + 1) = Len(fds(i).Name) * fTables.TextWidth("A")
  414.            Else
  415.              grd.ColWidth(i + 1) = 10 * fTables.TextWidth("A")
  416.            End If
  417.          End If
  418.        ElseIf ft = FT_MEMO Then
  419.          grd.ColWidth(i + 1) = 1200
  420.        Else
  421.          grd.ColWidth(i + 1) = GetFieldWidth(ft)
  422.        End If
  423.      Next
  424.  
  425.      'load the field names
  426.      grd.Row = 0
  427.      If gfFromSQL = False Or InStr(1, dynst, "*") > 1 Then
  428.        For i = 0 To fds.Fields.Count - 1
  429.          grd.Col = i + 1
  430.          grd.Text = UCase(fds(i).Name)
  431.        Next
  432.  
  433.      Else
  434.       'parse off field names in select statement
  435.        j = 8
  436.        For i = 0 To fds.Fields.Count - 1
  437.          fn = ""
  438.          While Mid(dynst, j, 1) <> "," And Mid(dynst, j, 1) <> " "
  439.            fn = fn + Mid(dynst, j, 1)
  440.            j = j + 1
  441.          Wend
  442.          While Mid(dynst, j, 1) = "," Or Mid(dynst, j, 1) = " "
  443.            j = j + 1
  444.          Wend
  445.          grd.Col = i + 1
  446.          grd.Text = UCase(fn)
  447.        Next
  448.      End If
  449.    End If
  450.  
  451.    rc = 1
  452.  
  453.    'fill method 1
  454.    'add the rows with the additem method
  455.    While fds.EOF = False And rc <= numb
  456.      gs = CStr(rc + start) + Chr$(9)
  457.      For i = 0 To fds.Fields.Count - 1
  458.        If fds(i).Type = FT_MEMO Then
  459.          If fds(i).FieldSize() < 255 Then
  460.            gs = gs + StripNonAscii(vFieldVal(fds(i))) + Chr$(9)
  461.          Else
  462.            'can only get the 1st 255 chars
  463.            gs = gs + StripNonAscii(vFieldVal(fds(i).GetChunk(0, 255))) + Chr$(9)
  464.          End If
  465.        ElseIf fds(i).Type = FT_STRING Then
  466.          gs = gs + StripNonAscii(vFieldVal(fds(i))) + Chr$(9)
  467.        Else
  468.          gs = gs + vFieldVal(fds(i)) + Chr$(9)
  469.        End If
  470.      Next
  471.      gs = Mid(gs, 1, Len(gs) - 1)
  472.      grd.AddItem gs
  473.      fds.MoveNext
  474.      rc = rc + 1
  475.    Wend
  476.  
  477.    'fill method 2
  478.    'add the cells individually
  479. '   While fds.EOF = False And rc <= numb
  480. '     grd.Rows = rc + 1
  481. '     grd.Row = rc
  482. '     grd.Col = 0
  483. '     grd.Text = CStr(rc + start)
  484. '     For i = 0 To fds.Fields.Count - 1
  485. '       grd.Col = i + 1
  486. '       If fds(i).Type = FT_MEMO Then
  487. '         'can only get the 1st 255 chars
  488. '         grd.Text = StripNonAscii(vFieldVal((fds(i).GetChunk(0, 255))))
  489. '       ElseIf fds(i).Type = FT_STRING Then
  490. '         grd.Text = StripNonAscii(vFieldVal((fds(i))))
  491. '       Else
  492. '         grd.Text = CStr(vFieldVal(fds(i)))
  493. '       End If
  494. '     Next
  495. '     fds.MoveNext
  496. '     rc = rc + 1
  497. '   Wend
  498.  
  499.    grd.FixedRows = 1   'freeze the field names
  500.    grd.FixedCols = 1   'freeze the row numbers
  501.    grd.Row = 1         'set current position
  502.    grd.Col = 1
  503.  
  504.    LoadGrid = rc       'return number added
  505.    GoTo LGEnd
  506.  
  507. LGErr:
  508.    ShowError
  509.    LoadGrid = False    'return 0
  510.    Resume LGEnd
  511.  
  512. LGEnd:
  513.    MsgBar "", False
  514.  
  515. End Function
  516.  
  517. Sub MsgBar (msg As String, pw As Integer)
  518.   If msg = "" Then
  519.     VDMDI.cMsg = "Ready"
  520.   Else
  521.     If pw = True Then
  522.       VDMDI.cMsg = msg + ", please wait..."
  523.     Else
  524.       VDMDI.cMsg = msg
  525.     End If
  526.   End If
  527.   VDMDI.cMsg.Refresh
  528. End Sub
  529.  
  530. Sub RefreshTables (tbl_list As Control)
  531.    Dim i As Integer, j As Integer, h As Integer
  532.    Dim st As String
  533.    ReDim fltrs(1) As String
  534.    Dim OkayToAdd As Integer
  535.  
  536.    On Error GoTo TRefErr
  537.  
  538.    MsgBar "Refreshing Table List", True
  539.    SetHourGlass VDMDI
  540.  
  541.    i = 1
  542.    While i <= Len(gstTableFilter) + 1
  543.      If Mid(gstTableFilter, i, 1) = "," Or i = Len(gstTableFilter) + 1 Then
  544.        ReDim Preserve fltrs(UBound(fltrs) + 1)
  545.        fltrs(j) = st
  546.        st = ""
  547.        j = j + 1
  548.      Else
  549.        st = st + Mid(gstTableFilter, i, 1)
  550.      End If
  551.      i = i + 1
  552.    Wend
  553.  
  554.    gCurrentDB.TableDefs.Refresh
  555.    tbl_list.Clear
  556.    For i = 0 To gCurrentDB.TableDefs.Count - 1
  557.      st = gCurrentDB.TableDefs(i).Name
  558.      If gstTableFilter = "" Then
  559.        tbl_list.AddItem st
  560.      Else
  561.        OkayToAdd = True
  562.        For h = 0 To j - 1
  563.          If Mid(fltrs(h), 1, 1) = "-" Then
  564.            If UCase(st) Like UCase(Mid(fltrs(h), 2, Len(fltrs(h)) - 1)) Then
  565.              OkayToAdd = False
  566.            End If
  567.          Else
  568.            If Not UCase(st) Like UCase(fltrs(h)) Then
  569.              OkayToAdd = False
  570.            End If
  571.          End If
  572.        Next
  573.        If OkayToAdd = True Then
  574.          tbl_list.AddItem st
  575.        End If
  576.      End If
  577.    Next
  578.    
  579.    GoTo TRefEnd
  580.  
  581. TRefErr:
  582.    ShowError
  583.    gfDBOpenFlag = False
  584.    Resume TRefEnd
  585.  
  586. TRefEnd:
  587.    ResetMouse VDMDI
  588.    MsgBar "", False
  589.  
  590. End Sub
  591.  
  592. Sub ResetMouse (f As Form)
  593.   VDMDI.MousePointer = DEFAULT_MOUSE
  594.   f.MousePointer = DEFAULT_MOUSE
  595. End Sub
  596.  
  597. Function SetFldProperties (ft As String) As String
  598.   'return field length
  599.   If ft = "String" Then
  600.     gwFldType = FT_STRING
  601.   Else
  602.     Select Case ft
  603.       Case "True/False"
  604.         SetFldProperties = "1"
  605.         gwFldType = FT_TRUEFALSE
  606.         gwFldSize = 1
  607.       Case "Byte"
  608.         SetFldProperties = "1"
  609.         gwFldType = FT_BYTE
  610.         gwFldSize = 1
  611.       Case "Integer"
  612.         SetFldProperties = "2"
  613.         gwFldType = FT_INTEGER
  614.         gwFldSize = 2
  615.       Case "Long"
  616.         SetFldProperties = "4"
  617.         gwFldType = FT_LONG
  618.         gwFldSize = 4
  619.       Case "Currency"
  620.         SetFldProperties = "8"
  621.         gwFldType = FT_CURRENCY
  622.         gwFldSize = 8
  623.       Case "Single"
  624.         SetFldProperties = "4"
  625.         gwFldType = FT_SINGLE
  626.         gwFldSize = 4
  627.       Case "Double"
  628.         SetFldProperties = "8"
  629.         gwFldType = FT_DOUBLE
  630.         gwFldSize = 8
  631.       Case "Date/Time"
  632.         SetFldProperties = "8"
  633.         gwFldType = FT_DATETIME
  634.         gwFldSize = 8
  635.       Case "Memo"
  636.         SetFldProperties = "0"
  637.         gwFldType = FT_MEMO
  638.         gwFldSize = 0
  639.     End Select
  640.   End If
  641. End Function
  642.  
  643. Sub SetHourGlass (f As Form)
  644.   DoEvents  'cause forms to repaint before going on
  645.   VDMDI.MousePointer = HOURGLASS
  646.   f.MousePointer = HOURGLASS
  647. End Sub
  648.  
  649. Sub ShowError ()
  650.   Dim s As String
  651.   Dim crlf As String
  652.  
  653.   crlf = Chr(13) + Chr(10)
  654.   s = "The following Error occurred:" + crlf + crlf
  655.   'add the error string
  656.   s = s + Error$ + crlf
  657.   'add the error number
  658.   s = s + "Number: " + CStr(Err)
  659.   'beep and show the error
  660.   Beep
  661.   MsgBox (s)
  662.  
  663. End Sub
  664.  
  665. Function StripNonAscii (vs As Variant) As String
  666.   Dim i As Integer
  667.   Dim ts As String
  668.  
  669.   For i = 1 To Len(vs)
  670.     If Asc(Mid(vs, i, 1)) < 32 Or Asc(Mid(vs, i, 1)) > 126 Then
  671.       ts = ts + " "
  672.     Else
  673.       ts = ts + Mid(vs, i, 1)
  674.     End If
  675.   Next
  676.  
  677.   StripNonAscii = ts
  678.  
  679. End Function
  680.  
  681. Function vFieldVal (fv As Variant) As Variant
  682.   If IsNull(fv) Then
  683.     vFieldVal = ""
  684.   Else
  685.     vFieldVal = CStr(fv)
  686.   End If
  687. End Function
  688.  
  689.