home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / codebsic / cb5_demo.bas < prev    next >
BASIC Source File  |  1995-02-01  |  35KB  |  864 lines
  1. ' Data Types Used by CodeBasic
  2.  
  3. Type FIELD4INFOCB
  4.     fname As Long        ' C string (which is different than a Basic String)
  5.     ftype As Integer
  6.     flength As Integer
  7.     fdecimals As Integer
  8. End Type
  9.  
  10. Type FIELD4INFO          ' Corresponding Basic structure
  11.     fname As String
  12.     ftype As String * 1
  13.     flength As Integer
  14.     fdecimals As Integer
  15. End Type
  16.  
  17. Type TAG4INFOCB
  18.     name As Long         ' C string
  19.     expression As Long   ' C string
  20.     filter As Long       ' C string
  21.     unique As Integer
  22.     descending As Integer
  23. End Type
  24.  
  25. Type TAG4INFO
  26.     name As String
  27.     expression As String
  28.     filter As String
  29.     unique As Integer
  30.     descending As Integer
  31. End Type
  32.  
  33.  
  34. '===================================================================================
  35. '
  36. '     CODE4 Access  function prototypes
  37. '
  38. '===================================================================================
  39.  
  40. Declare Function code4autoOpen% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  41. Declare Function code4createError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  42. Declare Function code4dateFormatCB& Lib "v4demo.dll" Alias "code4dateFormat" (ByVal c4&, ByVal pic$)
  43. Declare Function code4defaultUniqueError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  44. Declare Function code4errorCode% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  45. Declare Function code4exclusive% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  46. Declare Function code4exprError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  47. Declare Function code4fieldNameError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  48. Declare Function code4goError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  49. Declare Function code4hWnd% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  50. Declare Function code4lockAttempts% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  51. Declare Function code4memExpandBlock% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  52. Declare Function code4memExpandData% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  53. Declare Function code4memExpandIndex% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  54. Declare Function code4memExpandTag% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  55. Declare Function code4memSizeBlock& Lib "v4demo.dll" (ByVal c4&, ByVal value&)
  56. Declare Function code4memSizeBuffer& Lib "v4demo.dll" (ByVal c4&, ByVal value&)
  57. Declare Function code4memSizeMemo% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  58. Declare Function code4memSizeMemoExpr& Lib "v4demo.dll" (ByVal c4&, ByVal value&)
  59. Declare Function code4memSizeSortBuffer& Lib "v4demo.dll" (ByVal c4&, ByVal value&)
  60. Declare Function code4memSizeSortPool& Lib "v4demo.dll" (ByVal c4&, ByVal value&)
  61. Declare Function code4memStartBlock% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  62. Declare Function code4memStartData% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  63. Declare Function code4memStartIndex% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  64. Declare Function code4memstartmax& Lib "v4demo.dll" (ByVal c4&, ByVal value&)
  65. Declare Function code4memStartTag% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  66. Declare Function code4offError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  67. Declare Function code4openError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  68. Declare Function code4optimize% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  69. Declare Function code4optimizeWrite% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  70. Declare Function code4readLock% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  71. Declare Function code4readOnly% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  72. Declare Function code4relateError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  73. Declare Function code4safety% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  74. Declare Function code4skipError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  75. Declare Function code4tagNameError% Lib "v4demo.dll" (ByVal c4&, ByVal value%)
  76.  
  77.  
  78. '===============================================================================================
  79. '
  80. '                                 Data File Functions' Prototypes
  81. '
  82. '-----------------------------------------------------------------------------------------------
  83. Declare Function d4aliasCB& Lib "v4demo.dll" Alias "d4alias" (ByVal d4&)
  84. Declare Sub d4AliasSet Lib "v4demo.dll" Alias "d4alias_set" (ByVal d4&, ByVal AliasValue$)
  85. Declare Function d4append% Lib "v4demo.dll" (ByVal d4&)
  86. Declare Function d4appendBlank% Lib "v4demo.dll" Alias "d4append_blank" (ByVal d4&)
  87. Declare Function d4appendStart% Lib "v4demo.dll" Alias "d4append_start" (ByVal d4&, ByVal UseMemoEntries%)
  88. Declare Sub d4blank Lib "v4demo.dll" (ByVal d4&)
  89. Declare Function d4bof% Lib "v4demo.dll" (ByVal d4&)
  90. Declare Function d4bottom% Lib "v4demo.dll" (ByVal d4&)
  91. Declare Function d4changed% Lib "v4demo.dll" (ByVal d4&, ByVal intFlag%)
  92. Declare Function d4check% Lib "v4demo.dll" (ByVal d4&)
  93. Declare Function d4close% Lib "v4demo.dll" (ByVal d4&)
  94. Declare Function d4closeAll% Lib "v4demo.dll" Alias "d4close_all" (ByVal c4&)
  95. Declare Function d4createCB& Lib "v4demo.dll" Alias "d4create" (ByVal c4&, ByVal DbfName$, fieldinfo As Any, tagInfo As Any)
  96. Declare Function d4data& Lib "v4demo.dll" (ByVal c4&, ByVal AliasName$)
  97. Declare Sub d4delete Lib "v4demo.dll" (ByVal d4&)
  98. Declare Function d4deleted% Lib "v4demo.dll" (ByVal d4&)
  99. Declare Function d4eof% Lib "v4demo.dll" (ByVal d4&)
  100. Declare Function d4field& Lib "v4demo.dll" (ByVal d4&, ByVal FieldName$)
  101. Declare Function d4fieldInfo& Lib "v4demo.dll" Alias "d4field_info" (ByVal d4&)
  102. Declare Function d4fieldJ& Lib "v4demo.dll" Alias "d4field_j" (ByVal d4&, ByVal JField%)
  103. Declare Function d4fieldNumber% Lib "v4demo.dll" Alias "d4field_number" (ByVal d4&, ByVal FieldName$)
  104. Declare Function d4fileNameCB& Lib "v4demo.dll" Alias "d4fileName" (ByVal d4&)
  105. Declare Function d4flush% Lib "v4demo.dll" (ByVal d4&)
  106. Declare Function d4flushData% Lib "v4demo.dll" Alias "d4flush_data" (ByVal d4&)
  107. Declare Function d4flushFiles% Lib "v4demo.dll" Alias "d4flush_files" (ByVal c4&)
  108. Declare Function d4freeBlocks% Lib "v4demo.dll" Alias "d4free_blocks" (ByVal d4&)
  109. Declare Function d4go% Lib "v4demo.dll" (ByVal d4&, ByVal RecNum&)
  110. Declare Function d4goData% Lib "v4demo.dll" Alias "d4go_data" (ByVal d4&, ByVal RecNum&)
  111. Declare Function d4goEof% Lib "v4demo.dll" Alias "d4go_eof" (ByVal d4&)
  112. Declare Function d4index& Lib "v4demo.dll" (ByVal d4&, ByVal IndexName$)
  113. Declare Function d4init& Lib "v4demo.dll" Alias "d4init_v" ()
  114. Declare Function d4initUndo% Lib "v4demo.dll" Alias "d4initUndo" (ByVal c4&)
  115. Declare Function d4lock% Lib "v4demo.dll" (ByVal d4&, ByVal RecordNum&)
  116. Declare Function d4lockAll% Lib "v4demo.dll" Alias "d4lock_all" (ByVal d4&)
  117. Declare Function d4lockAppend% Lib "v4demo.dll" Alias "d4lock_append" (ByVal d4&)
  118. Declare Function d4lockFile% Lib "v4demo.dll" Alias "d4lock_file" (ByVal d4&)
  119. Declare Function d4lockGroup% Lib "v4demo.dll" Alias "d4lock_group" (ByVal d4&, RecordsArray&, ByVal NumRecords%)
  120. Declare Function d4lockIndex% Lib "v4demo.dll" Alias "d4lock_index" (ByVal d4&)
  121. Declare Function d4lockTest% Lib "v4demo.dll" Alias "d4lock_test" (ByVal d4&, ByVal RecNum&)
  122. Declare Function d4lockTestAppend% Lib "v4demo.dll" Alias "d4lock_test_append" (ByVal d4&)
  123. Declare Function d4lockTestFile% Lib "v4demo.dll" Alias "d4lock_test_file" (ByVal d4&)
  124. Declare Function d4lockTestIndex% Lib "v4demo.dll" Alias "d4lock_test_index" (ByVal d4&)
  125. Declare Function d4memoCompress% Lib "v4demo.dll" Alias "d4memo_compress" (ByVal d4&)
  126. Declare Function d4numFields% Lib "v4demo.dll" Alias "d4num_fields" (ByVal d4&)
  127. Declare Function d4open& Lib "v4demo.dll" (ByVal c4&, ByVal DbfName$)
  128. Declare Function d4optStart% Lib "v4demo.dll" Alias "d4opt_start" (ByVal c4&)
  129. Declare Function d4optSuspend& Lib "v4demo.dll" Alias "d4opt_suspend" (ByVal c4&)
  130. Declare Function d4optimize% Lib "v4demo.dll" (ByVal d4&, ByVal OptFlag%)
  131. Declare Function d4optimizeWrite% Lib "v4demo.dll" Alias "d4optimize_write" (ByVal d4&, ByVal OptFlag%)
  132. Declare Function d4pack% Lib "v4demo.dll" (ByVal d4&)
  133. Declare Function d4packData% Lib "v4demo.dll" Alias "d4pack_data" (ByVal d4&)
  134. Declare Function d4position# Lib "v4demo.dll" (ByVal d4&)
  135. Declare Function d4positionSet% Lib "v4demo.dll" Alias "d4position_set" (ByVal d4&, ByVal Percentage#)
  136. Declare Sub d4recall Lib "v4demo.dll" (ByVal d4&)
  137. Declare Function d4reccount& Lib "v4demo.dll" (ByVal d4&)
  138. Declare Function d4recno& Lib "v4demo.dll" (ByVal d4&)
  139. Declare Function d4record& Lib "v4demo.dll" (ByVal d4&)
  140. Declare Function d4recordWidth& Lib "v4demo.dll" Alias "d4record_width" (ByVal d4&)
  141. Declare Function d4refresh% Lib "v4demo.dll" (ByVal d4&)
  142. Declare Function d4refreshRecord% Lib "v4demo.dll" Alias "d4refresh_record" (ByVal d4&)
  143. Declare Function d4reindex% Lib "v4demo.dll" (ByVal d4&)
  144. Declare Function d4seek% Lib "v4demo.dll" (ByVal d4&, ByVal seekValue$)
  145. Declare Function d4seekDouble% Lib "v4demo.dll" Alias "d4seek_double" (ByVal d4&, ByVal value#)
  146. Declare Function d4skip% Lib "v4demo.dll" (ByVal d4&, ByVal NumberRecords&)
  147. Declare Function d4tag& Lib "v4demo.dll" (ByVal d4&, ByVal TagName$)
  148. Declare Function d4tagDefault& Lib "v4demo.dll" Alias "d4tag_default" (ByVal d4&)
  149. Declare Function d4tagNext& Lib "v4demo.dll" Alias "d4tag_next" (ByVal d4&, ByVal TagOn As Any)
  150. Declare Function d4tagPrev& Lib "v4demo.dll" Alias "d4tag_prev" (ByVal d4&, ByVal TagOn As Any)
  151. Declare Sub d4tagSelect Lib "v4demo.dll" Alias "d4tag_select" (ByVal d4&, ByVal tPtr As Any)
  152. Declare Function d4tagSelected& Lib "v4demo.dll" Alias "d4tag_selected" (ByVal d4&)
  153. Declare Function d4top% Lib "v4demo.dll" (ByVal d4&)
  154. Declare Function d4unlock% Lib "v4demo.dll" (ByVal d4&)
  155. Declare Function d4unlockFiles% Lib "v4demo.dll" Alias "d4unlock_files" (ByVal d4&)
  156. Declare Function d4write% Lib "v4demo.dll" (ByVal d4&, ByVal RecNum&)
  157. Declare Function d4zap% Lib "v4demo.dll" (ByVal d4&, ByVal StartRecord&, ByVal EndRecord&)
  158.  
  159. '===============================================================================================
  160. '
  161. '                                   Date Functions' Prototypes
  162. '
  163. '-----------------------------------------------------------------------------------------------
  164. Declare Sub date4assign Lib "v4demo.dll" (ByVal DateForm$, ByVal JulianDay&)
  165. Declare Function date4cdowCB& Lib "v4demo.dll" Alias "date4cdow" (ByVal DateForm$)
  166. Declare Function date4cmonthCB& Lib "v4demo.dll" Alias "date4cmonth" (ByVal DateForm$)
  167. Declare Function date4day% Lib "v4demo.dll" (ByVal DateForm$)
  168. Declare Function date4dow% Lib "v4demo.dll" (ByVal DateForm$)
  169. Declare Sub date4formatCB Lib "v4demo.dll" Alias "date4format" (ByVal DateForm$, ByVal Result$, ByVal pic$)
  170. Declare Sub date4initCB Lib "v4demo.dll" Alias "date4init" (ByVal DateForm$, ByVal value$, ByVal pic$)
  171. Declare Function date4long& Lib "v4demo.dll" (ByVal DateForm$)
  172. Declare Function date4month% Lib "v4demo.dll" (ByVal DateForm$)
  173. Declare Sub date4timeNow Lib "v4demo.dll" Alias "date4time_now" (ByVal TimeForm$)
  174. Declare Sub date4todayCB Lib "v4demo.dll" Alias "date4today" (ByVal DateForm$)
  175. Declare Function date4year% Lib "v4demo.dll" (ByVal DateForm$)
  176.  
  177.  
  178. '===============================================================================================
  179. '
  180. '                          Expression Evaluation Functions' Prototypes
  181. '
  182. '-----------------------------------------------------------------------------------------------
  183. Declare Function expr4double# Lib "v4demo.dll" (ByVal ExprPtr&)
  184. Declare Sub expr4free Lib "v4demo.dll" (ByVal ExprPtr&)
  185. Declare Function expr4Len% Lib "v4demo.dll" (ByVal ExprPtr&)
  186. Declare Function expr4parse& Lib "v4demo.dll" (ByVal d4&, ByVal expression$)
  187. Declare Function expr4true% Lib "v4demo.dll" (ByVal ExprPtr&)
  188.  
  189. '===============================================================================================
  190. '
  191. '                            Field Functions' Prototypes
  192. '
  193. '-----------------------------------------------------------------------------------------------
  194. Declare Sub f4assign Lib "v4demo.dll" (ByVal fPtr&, ByVal value$)
  195. Declare Sub f4assignChar Lib "v4demo.dll" Alias "f4assign_char" (ByVal fPtr&, ByVal Char%)
  196. Declare Sub f4assignDouble Lib "v4demo.dll" Alias "f4assign_double" (ByVal fPtr&, ByVal value#)
  197. Declare Sub f4assignField Lib "v4demo.dll" Alias "f4assign_field" (ByVal fPtrTo&, ByVal fPtrFrom&)
  198. Declare Sub f4assignInt Lib "v4demo.dll" Alias "f4assign_int" (ByVal fPtr&, ByVal value%)
  199. Declare Sub f4assignLong Lib "v4demo.dll" Alias "f4assign_long" (ByVal fPtr&, ByVal value&)
  200. Declare Sub f4assignN Lib "v4demo.dll" Alias "f4assign_n" (ByVal fPtr&, ByVal value$, ByVal Length%)
  201. Declare Sub f4blank Lib "v4demo.dll" (ByVal fPtr&)
  202. Declare Function f4char% Lib "v4demo.dll" (ByVal fPtr&)
  203. Declare Function f4data& Lib "v4demo.dll" (ByVal fPtr&)
  204. Declare Function f4decimals% Lib "v4demo.dll" (ByVal fPtr&)
  205. Declare Function f4double# Lib "v4demo.dll" (ByVal fPtr&)
  206. Declare Function f4int% Lib "v4demo.dll" (ByVal fPtr&)
  207. Declare Function f4len& Lib "v4demo.dll" Alias "f4len_v" (ByVal fPtr&)
  208. Declare Function f4long& Lib "v4demo.dll" (ByVal fPtr&)
  209. Declare Function f4memoAssign% Lib "v4demo.dll" Alias "f4memo_assign" (ByVal fPtr&, ByVal value$)
  210. Declare Function f4memoAssignN% Lib "v4demo.dll" Alias "f4memo_assign_n" (ByVal fPtr&, ByVal value$, ByVal Length%)
  211. Declare Sub f4memoFree Lib "v4demo.dll" Alias "f4memo_free" (ByVal fPtr&)
  212. Declare Function f4memoLen& Lib "v4demo.dll" Alias "f4memoLen" (ByVal fPtr&)
  213. Declare Function f4memoPtr& Lib "v4demo.dll" Alias "f4memo_ptr" (ByVal fPtr&)
  214. Declare Function f4memoStrCB& Lib "v4demo.dll" Alias "f4memo_str" (ByVal fPtr&)
  215. Declare Function f4nameCB& Lib "v4demo.dll" Alias "f4name" (ByVal fPtr&)
  216. Declare Function f4ncpy% Lib "v4demo.dll" (ByVal fPtr&, ByVal memPtr$, ByVal memLength%)
  217. Declare Function f4ptr& Lib "v4demo.dll" (ByVal fPtr&)
  218. Declare Function f4strCB& Lib "v4demo.dll" Alias "f4str" (ByVal fPtr&)
  219. Declare Function f4true% Lib "v4demo.dll" (ByVal fPtr&)
  220. Declare Function f4type% Lib "v4demo.dll" (ByVal fPtr&)
  221.  
  222. '===============================================================================================
  223. '
  224. '                             Index Functions' Prototypes
  225. '
  226. '-----------------------------------------------------------------------------------------------
  227. Declare Function i4close% Lib "v4demo.dll" (ByVal i4&)
  228. Declare Function i4createCB& Lib "v4demo.dll" Alias "i4create" (ByVal d4&, ByVal FileName As Any, tagInfo As TAG4INFOCB)
  229. Declare Function i4lock% Lib "v4demo.dll" (ByVal i4&)
  230. Declare Function i4openCB& Lib "v4demo.dll" Alias "i4open" (ByVal d4&, ByVal FileName As Any)
  231. Declare Function i4reindex% Lib "v4demo.dll" (ByVal i4&)
  232. Declare Function i4tag& Lib "v4demo.dll" (ByVal i4&, ByVal FileName$)
  233. Declare Function i4tagInfo& Lib "v4demo.dll" Alias "i4tag_info" (ByVal i4&)
  234. Declare Function i4unlock% Lib "v4demo.dll" (ByVal i4&)
  235.  
  236. '===============================================================================================
  237. '
  238. '                            Relate Functions' Prototypes
  239. '
  240. '-----------------------------------------------------------------------------------------------
  241. Declare Function relate4bottom% Lib "v4demo.dll" (ByVal r4&)
  242. Declare Sub relate4changed Lib "v4demo.dll" (ByVal r4&)
  243. Declare Function relate4createSlave& Lib "v4demo.dll" Alias "relate4create_slave" (ByVal r4&, ByVal d4&, ByVal mExpr$, ByVal t4 As Any)
  244. Declare Function relate4data& Lib "v4demo.dll" (ByVal r4&)
  245. Declare Function relate4dataTag& Lib "v4demo.dll" (ByVal r4&)
  246. Declare Function relate4do% Lib "v4demo.dll" (ByVal r4&)
  247. Declare Function relate4doOne% Lib "v4demo.dll" Alias "relate4do_one" (ByVal r4&)
  248. Declare Function relate4errorAction% Lib "v4demo.dll" Alias "relate4error_action" (ByVal r4&, ByVal ErrAction%)
  249. Declare Function relate4free% Lib "v4demo.dll" (ByVal r4&, ByVal CloseFlag%)
  250. Declare Function relate4init& Lib "v4demo.dll" (ByVal d4&)
  251. Declare Function relate4lock% Lib "v4demo.dll" (ByVal r4&)
  252. Declare Function relate4matchLen% Lib "v4demo.dll" Alias "relate4match_len" (ByVal r4&, ByVal Length%)
  253. Declare Function relate4master& Lib "v4demo.dll" (ByVal r4&)
  254. Declare Function relate4next% Lib "v4demo.dll" (r4&)
  255. Declare Function relate4querySet% Lib "v4demo.dll" Alias "relate4query_set" (ByVal r4&, ByVal expr As String)
  256. Declare Function relate4skip% Lib "v4demo.dll" (ByVal r4&, ByVal NumRecs&)
  257. Declare Function relate4skipEnable% Lib "v4demo.dll" Alias "relate4skip_enable" (ByVal r4&, ByVal DoEnable%)
  258. Declare Function relate4sortSet% Lib "v4demo.dll" Alias "relate4sort_set" (ByVal r4&, ByVal expr As String)
  259. Declare Function relate4top% Lib "v4demo.dll" (ByVal r4&)
  260. Declare Function relate4type% Lib "v4demo.dll" (ByVal r4&, ByVal rType%)
  261. Declare Function relate4unlock% Lib "v4demo.dll" (ByVal r4&)
  262.  
  263. '===============================================================================================
  264. '
  265. '  Report function prototypes
  266. '
  267. '================================================================================================
  268.  
  269. Declare Function report4currency% Lib "v4demo.dll" (ByVal r4&, ByVal symbol%)
  270. Declare Function report4do% Lib "v4demo.dll" (ByVal r4&)
  271. Declare Sub report4free Lib "v4demo.dll" (ByVal r4&, ByVal free_r%, ByVal close_f%)
  272. Declare Sub report4output Lib "v4demo.dll" (ByVal r4&, ByVal o_code%, ByVal o_dev As Any, ByVal styles%)
  273. Declare Sub report4pageSize Lib "v4demo.dll" Alias "report4page_size" (ByVal r4&, ByVal pWidth%, ByVal pHeight%)
  274. Declare Function report4relate& Lib "v4demo.dll" (ByVal r4&)
  275. Declare Function report4retrieve& Lib "v4demo.dll" (ByVal c4&, ByVal f_name$, ByVal open_f%)
  276. Declare Function report4save% Lib "v4demo.dll" (ByVal r4&, ByVal fname$)
  277. Declare Function report4symbolsNumeric% Lib "v4demo.dll" Alias "report4symbols_numeric" (ByVal r4&, ByVal thous%, ByVal decimal%)
  278.  
  279. '===============================================================================================
  280. '
  281. '  TAG4 Access function prototypes
  282. '
  283. '================================================================================================
  284.  
  285. Declare Function tag4aliasCB& Lib "v4demo.dll" Alias "tag4alias" (ByVal t4&)
  286. Declare Function tag4Descending% Lib "v4demo.dll" (ByVal t4&)
  287. Declare Function tag4exprCB& Lib "v4demo.dll" Alias "tag4expr" (ByVal t4&)
  288. Declare Function tag4filterCB& Lib "v4demo.dll" Alias "tag4filter" (ByVal t4&)
  289. Declare Function tag4KeyLen% Lib "v4demo.dll" (ByVal t4&)
  290. Declare Function tag4Unique% Lib "v4demo.dll" (ByVal t4&)
  291. Declare Function tag4UniqueError% Lib "v4demo.dll" (ByVal t4&, ByVal value%)
  292.  
  293. '===============================================================================================
  294. '
  295. '                            Tag Functions' Prototypes
  296. '
  297. '-----------------------------------------------------------------------------------------------
  298. Declare Function t4bottom% Lib "v4demo.dll" (ByVal t4&)
  299. Declare Function t4eof% Lib "v4demo.dll" (ByVal t4&)
  300. Declare Function t4go% Lib "v4demo.dll" (ByVal t4&, ByVal key$, ByVal RecNum&)
  301. Declare Function t4keyCB& Lib "v4demo.dll" Alias "t4key" (ByVal t4&)
  302. Declare Function t4open& Lib "v4demo.dll" Alias "t4open_v" (ByVal dbPtr&, ByVal IndexName$)
  303. Declare Function t4position# Lib "v4demo.dll" (ByVal t4&)
  304. Declare Function t4positionSet% Lib "v4demo.dll" Alias "t4position_set" (ByVal t4&, ByVal Position#)
  305. Declare Function t4recno& Lib "v4demo.dll" (ByVal t4&)
  306. Declare Function t4seek% Lib "v4demo.dll" (ByVal t4&, ByVal key As Any, ByVal keyLength%)
  307. Declare Function t4skip& Lib "v4demo.dll" (ByVal t4&, ByVal NumRecs&)
  308. Declare Function t4top% Lib "v4demo.dll" (ByVal t4&)
  309.  
  310. '=======================================================================================
  311. '
  312. '                Utility function prototypes
  313. '
  314. '========================================================================================
  315.  
  316. Declare Function u4alloc& Lib "v4demo.dll" (ByVal amt&)
  317. Declare Function u4allocFree& Lib "v4demo.dll" Alias "u4alloc_free" (ByVal c4&, ByVal amt&)
  318. Declare Sub u4free Lib "v4demo.dll" (ByVal memPtr&)
  319. Declare Function u4ncpy% Lib "v4demo.dll" (ByVal MemPtr1$, ByVal memptr2&, ByVal memLength%)
  320. Declare Function u4ncpy2% Lib "v4demo.dll" Alias "u4ncpy" (ByVal MemPtr1&, ByVal memptr2$, ByVal memLength%)
  321.  
  322. '=======================================================================================
  323. '
  324. '                Misc. function prototypes
  325. '
  326. '========================================================================================
  327.  
  328. Declare Function v4Cstring& Lib "v4demo.dll" (ByVal s$)
  329. Declare Sub v4Cstringfree Lib "v4demo.dll" (ByVal s&)
  330.  
  331.  
  332. 'CodeBase Return Code Constants
  333.  
  334. Global Const r4success% = 0
  335. Global Const r4found% = 1
  336. Global Const r4after = 2
  337. Global Const r4eof = 3
  338. Global Const r4bof = 4
  339. Global Const r4entry = 5
  340. Global Const r4descending = 10
  341. Global Const r4unique = 20
  342. Global Const r4uniqueContinue = 25
  343. Global Const r4ignore = 40
  344. Global Const r4keep = 45
  345. Global Const r4locked = 50
  346. Global Const r4noCreate = 60
  347. Global Const r4noOpen = 70
  348. Global Const r4notag = 80
  349.  
  350. Global Const relate4filterRecord = 101
  351. Global Const relate4doRemove = 102
  352. Global Const relate4skipped = 104
  353. Global Const relate4blank = 105
  354. Global Const relate4skipRec = 106
  355. Global Const relate4terminate = 107
  356. Global Const relate4exact = 108
  357. Global Const relate4scan = 109
  358. Global Const relate4approx = 110
  359. Global Const relate4sortSkip = 120
  360. Global Const relate4sortDone = 121
  361.  
  362. 'CodeBasic Field Definition Constants
  363. Global Const r4logLen = 1
  364. Global Const r4dateLen = 8
  365. Global Const r4memoLen = 10
  366. Global Const r4str$ = "C"
  367. Global Const r4float$ = "F"
  368. Global Const r4num$ = "N"
  369. Global Const r4date$ = "D"
  370. Global Const r4log$ = "L"
  371. Global Const r4memo$ = "M"
  372.  
  373. 'Other CodeBasic Constants
  374. Global Const r4check = -5
  375.  
  376. 'CodeBasic Error Code Constants
  377. Global Const e4close = -10
  378. Global Const e4create = -20
  379. Global Const e4len = -30
  380. Global Const e4lenSet = -40
  381. Global Const e4lock = -50
  382. Global Const e4open = -60
  383. Global Const e4read = -70
  384. Global Const e4remove = -80
  385. Global Const e4rename = -90
  386. Global Const e4seek = -100
  387. Global Const e4unlock = -110
  388. Global Const e4write = -120
  389. Global Const e4data = -200
  390. Global Const e4fieldName = -210
  391. Global Const e4fieldType = -220
  392. Global Const e4recordLen = -230
  393. Global Const e4entry = -300
  394. Global Const e4index = -310
  395. Global Const e4tagName = -330
  396. Global Const e4unique = -340
  397. Global Const e4commaExpected = -400
  398. Global Const e4complete = -410
  399. Global Const e4dataName = -420
  400. Global Const e4numParms = -430
  401. Global Const e4overflow = -440
  402. Global Const e4rightMissing = -450
  403. Global Const e4typeSub = -460
  404. Global Const e4unrecFunction = -470
  405. Global Const e4unrecOperator = -480
  406. Global Const e4unrecValue = -490
  407. Global Const e4undetermined = -500
  408. Global Const e4info = -910
  409. Global Const e4memory = -920
  410. Global Const e4parm = -930
  411. Global Const e4result = -950
  412.  
  413. Function b4$ (p&)
  414.  
  415. 'This is a utility function for copying a DLL string pointer to a VB string.
  416.  
  417.     Dim rc%
  418.     Dim s As String * 256
  419.     s$ = ""
  420.     rc% = u4ncpy(s$, (p&), 255)
  421.     b4$ = Left$(s$, rc)
  422.  
  423. End Function
  424.  
  425. Function code4dateFormat$ (c4codePtr&, Fmt$)
  426.  
  427. 'This function returns and optionally modifies the
  428. 'CODE4.dateFormat member
  429.  
  430.     Dim in As String * 19
  431.     Dim DatePtr&, rc%
  432.  
  433.     'If Fmt$ = "" then return present date format,
  434.     'otherwise change date format to Fmt$
  435.     DatePtr = code4dateFormatCB(c4codePtr&, Fmt$)
  436.  
  437.     'Copy to VB string and trim any null characters
  438.     rc% = u4ncpy(in$, DatePtr, 19)
  439.     code4dateFormat$ = Left$(in$, rc%)
  440.  
  441. End Function
  442.  
  443. Function d4alias$ (dbPtr&)
  444.  
  445. 'This function returns the data file alias
  446.  
  447.     Dim AliasPtr&
  448.     Dim AliasName As String * 11
  449.  
  450.     'Get pointer to alias string
  451.     AliasPtr& = d4aliasCB(dbPtr)
  452.  
  453.     'Copy to VB string and trim null character(s)
  454.     rc% = u4ncpy(AliasName$, AliasPtr&, 11)
  455.     d4alias$ = Left$(AliasName$, rc%)
  456.  
  457. End Function
  458.  
  459. Function d4create& (ByVal cb&, dbname$, d() As FIELD4INFO, n() As TAG4INFO)
  460.  
  461.     ' d4create calls d4createCB() to create a new database.
  462.     ' This function is the same as d4createData() except that
  463.     ' it requires an additional parameter which it uses to
  464.     ' create tag information for a database.
  465.     '
  466.     ' Variable n is an array of type TAG4INFO which corresponds
  467.     ' to TAG4INFOCB, a structure that can be used by d4create.
  468.     ' The difference once again is merely the difference in the
  469.     ' representation of strings between C and Basic.
  470.     ' d4create takes the contents from the TAG4INFO structure
  471.     ' and builds a TAG4INFOCB structure which it passes to d4createCB().
  472.     ' Note: the TAG4INFOCB array is one size larger than the TAG4INFO
  473.     ' array.  The extra empty (zero filled) array element is the
  474.     ' way that d4createCB() detects the end of the array.
  475.     
  476.    
  477.     Dim i%
  478.     
  479.     Dim flb%
  480.     Dim fub%
  481.     Dim fs%
  482.     
  483.     Dim tlb%
  484.     Dim tub%
  485.     Dim ts%
  486.  
  487.  
  488.     flb = LBound(d)
  489.     fub = UBound(d)
  490.     fs = fub - flb + 1
  491.  
  492.  
  493.     ReDim f(1 To (fs + 1)) As FIELD4INFOCB
  494.     For i = 1 To fs
  495.         f(i).fname = v4Cstring(d((flb - 1) + i).fname)    ' note: this function allocates memory
  496.         f(i).ftype = Asc(d((flb - 1) + i).ftype)
  497.         f(i).flength = d((flb - 1) + i).flength
  498.         f(i).fdecimals = d((flb - 1) + i).fdecimals
  499.     Next i
  500.  
  501.     tlb = LBound(n)
  502.     tub = UBound(n)
  503.     ts = tub - tlb + 1
  504.     ReDim t(1 To (ts + 1)) As TAG4INFOCB
  505.     For i = 1 To ts
  506.         t(i).name = v4Cstring(n((tlb - 1) + i).name)
  507.         t(i).expression = v4Cstring(n((tlb - 1) + i).expression)
  508.         t(i).filter = v4Cstring(n((tlb - 1) + i).filter)
  509.         t(i).unique = n((tlb - 1) + i).unique
  510.         t(i).descending = n((tlb - 1) + i).descending
  511.     Next i
  512.     d4create = d4createCB(cb&, ByVal (dbname$), f(1), t(1))
  513.     
  514.     ' Since v4Cstring allocates memory for the storage of
  515.     ' C strings, we must free the memory after it has been
  516.     ' used.
  517.     For i = 1 To fs
  518.          Call v4Cstringfree(f(i).fname)
  519.     Next i
  520.  
  521.     For i = 1 To ts
  522.         Call v4Cstringfree(t(i).name)
  523.         Call v4Cstringfree(t(i).expression)
  524.         Call v4Cstringfree(t(i).filter)
  525.     Next i
  526.  
  527.  
  528. End Function
  529.  
  530. Function d4createData& (ByVal cb&, dbname$, d() As FIELD4INFO)
  531.  
  532.     ' d4createData() calls d4createCB() to create a new database.
  533.     ' d4create() builds the FIELD4INFOCB array which is
  534.     ' the one recognized by d4create (note that the only difference
  535.     ' is that the fname field is a string in type FIELD4INFO
  536.     ' and type long in FIELD4INFOCB which is how strings are represented
  537.     ' in C).  Furthermore, the size of f (our FIELD4INFOCB array) is one
  538.     ' larger than the size s of FIELD4INFO d.  This is because
  539.     ' d4create doesn't know the size of the array f and therefore it stops
  540.     ' when it reaches an array element that is filled with zeros which
  541.     ' the extra (s+1)'th element of f provides.
  542.  
  543.     Dim i%
  544.     Dim lb%
  545.     Dim ub%
  546.     Dim s%
  547.  
  548.     lb = LBound(d)
  549.     ub = UBound(d)
  550.     s = ub - lb + 1
  551.  
  552.  
  553.     ReDim f(1 To (s + 1)) As FIELD4INFOCB
  554.     For i = 1 To s
  555.         f(i).fname = v4Cstring(d((lb - 1) + i).fname)' note: this function allocates memory
  556.         f(i).ftype = Asc(d((lb - 1) + i).ftype)
  557.         f(i).flength = d((lb - 1) + i).flength
  558.         f(i).fdecimals = d((lb - 1) + i).fdecimals
  559.     
  560.     Next i
  561.  
  562.     d4createData = d4createCB(cb&, ByVal (dbname$), f(1), ByVal (0&))
  563.     
  564.     ' Since v4Cstring allocates memory for the storage of
  565.     ' C strings, we must free the memory after it has been
  566.     ' used.
  567.     For i = 1 To s
  568.       Call v4Cstringfree(f(i).fname)
  569.     Next i
  570.  
  571. End Function
  572.  
  573. Function d4fileName$ (dbfPtr&)
  574.  
  575.    d4fileName$ = b4(d4fileNameCB(dbfPtr))
  576.  
  577. End Function
  578.  
  579. Function date4cdow$ (dateString$)
  580.     
  581. 'This function returns the day of the week in a character
  582. 'string based on the value in 'DateString'
  583.  
  584.     'Validate "dateString"
  585.     If dateString = "" Or Len(dateString) < 8 Then Exit Function
  586.  
  587.     Dim DatePtr&
  588.     DatePtr& = date4cdowCB(dateString)    'Get pointer to day
  589.     If DatePtr = 0 Then Exit Function     'Illegal date
  590.  
  591.     Dim rc%
  592.     Dim inDay As String * 10
  593.     rc% = u4ncpy(inDay$, DatePtr&, 10)    'Copy it to inDay
  594.     date4cdow$ = Left$(inDay$, rc%)       'Trim null characters
  595.  
  596. End Function
  597.  
  598. Function date4cmonth$ (dateString$)
  599.     
  600. 'This function returns the month in 'DateString' as a
  601. 'character string
  602.  
  603.     'Validate "DateString"
  604.     If dateString = "" Or Len(dateString) < 8 Then Exit Function
  605.  
  606.     Dim DatePtr&
  607.     DatePtr& = date4cmonthCB(dateString)    'Get pointer to month
  608.     If DatePtr = 0 Then Exit Function       'Illegal date
  609.  
  610.     Dim rc%
  611.     Dim inMonth As String * 10
  612.     rc% = u4ncpy(inMonth$, DatePtr&, 10)    'Copy it to inMonth
  613.  
  614.     date4cmonth$ = Left$(inMonth$, rc%)      'Return month
  615.    
  616. End Function
  617.  
  618. Sub date4format (dateString$, Result$, pic$)
  619.  
  620. 'This functions formats Result$ using the date value
  621. ' in 'dateString$' and the format info. in 'Pic$'
  622.  
  623.     'Size Result$
  624.     Result$ = Space$(Len(pic$) + 1)
  625.  
  626.     Call date4formatCB(dateString$, Result$, pic$)
  627.     Result$ = Left$(Result$, Len(pic$))
  628.     
  629. End Sub
  630.  
  631. Sub date4init (Result$, dateString$, pic$)
  632.  
  633. 'This functions formats Result$ using the date value
  634. ' in 'dateString$' and the format info. in 'Pic$'
  635.  
  636.     'Size Result$
  637.     Result$ = Space$(Len(pic$) + 1)
  638.  
  639.     Call date4initCB(Result$, dateString$, pic$)
  640.     Result$ = Left$(Result$, Len(pic$))
  641.  
  642. End Sub
  643.  
  644. Sub date4today (dateS As String)
  645.  
  646.    If Len(dateS) < 8 Then dateS = Space$(8)
  647.    Call date4todayCB(dateS)
  648.  
  649. End Sub
  650.  
  651. Function f4memoStr$ (fPtr&)
  652. 'This function returns a string corresponding to the memo
  653. 'field pointer argument.
  654.  
  655.     Dim MemoLen&, MemoPtr&, rc%
  656.  
  657.     MemoLen& = f4memoLen(fPtr) + 1         'Get memo length
  658.     MemoPtr& = f4memoPtr(fPtr)
  659.     If MemoPtr& = 0 Then Exit Function
  660.  
  661.     Dim MemoString$
  662.     MemoString = String$(MemoLen&, " ")
  663.  
  664.     'Copy 'MemoPtr' to VB string 'MemoString'
  665.     rc% = u4ncpy(MemoString$, MemoPtr&, MemoLen&)
  666.     
  667.     'Remove null character and return memo contents
  668.     f4memoStr$ = Left$(MemoString$, rc%)
  669.                
  670. End Function
  671.  
  672. Function f4name$ (fPtr&)
  673.  
  674. 'This function returns the name of a field
  675.  
  676.     Dim FldNamePtr&                     'Pointer to field name
  677.     Dim FldName As String * 11          'String to hold info
  678.     Dim rc%
  679.     FldNamePtr& = f4nameCB(fPtr)        'Get pointer
  680.  
  681.     'Copy to string 'FldName' and remove null character(s)
  682.     rc% = u4ncpy(FldName$, FldNamePtr&, 11)
  683.     f4name$ = Left$(FldName$, rc%)
  684.                               
  685. End Function
  686.  
  687. Function f4str$ (Field&)
  688.                                    
  689. 'This function returns the contents of a field
  690.  
  691.    Dim s$, fPtr&
  692.    Dim rc%, flen%
  693.  
  694.    flen = f4len(Field)                 'Get field length
  695.    s$ = Space$(flen + 1)               'Make s$ one byte longer for null character that u4ncpy adds
  696.    fPtr& = f4ptr(Field)
  697.  
  698.    If fPtr& = 0 Then Exit Function
  699.    
  700.    rc% = u4ncpy(s$, fPtr&, flen + 1)   'Copy field contents
  701.    
  702.    f4str$ = Left$(s$, flen%)           'Remove null character
  703.  
  704. End Function
  705.  
  706. Function i4create& (ByVal dbPtr&, IndexName$, n() As TAG4INFO)
  707.  
  708.     ' i4create() calls i4createCB() to create a new
  709.     ' index file. Variable n is an array of type TAG4INFO
  710.     ' which corresponds to TAG4INFOCB, a structure that
  711.     ' can be used by i4createCB(). The difference once
  712.     ' again is merely the difference in the representation
  713.     ' of strings between C and Basic.
  714.     '
  715.     ' i4create() takes the contents from the TAG4INFO
  716.     ' structure and builds a TAG4INFOCB structure which
  717.     ' it passes to i4createCB(). Note: the TAG4INFOCB
  718.     ' arrary is one size larger than the TAG4INFO array.
  719.     ' The extra empty (zero filled) array element is the
  720.     ' way that d4create detects the end of the array.
  721.     '
  722.     ' Note also, that if 'IndexName' is an empty string,
  723.     ' the index file that is created will become a
  724.     ' "production" index file. i.e. it will be opened every
  725.     ' time the corresponding data file is opened.
  726.     
  727.     Dim i%
  728.     
  729.     Dim tlb%
  730.     Dim tub%
  731.     Dim ts%
  732.  
  733.     
  734.     tlb = LBound(n)
  735.     tub = UBound(n)
  736.     ts = tub - tlb + 1
  737.     ReDim t(1 To (ts + 1)) As TAG4INFOCB
  738.     For i = 1 To ts
  739.         t(i).name = v4Cstring(n((tlb - 1) + i).name)
  740.         t(i).expression = v4Cstring(n((tlb - 1) + i).expression)
  741.         t(i).filter = v4Cstring(n((tlb - 1) + i).filter)
  742.         t(i).unique = n((tlb - 1) + i).unique
  743.         t(i).descending = n((tlb - 1) + i).descending
  744.     Next i
  745.  
  746.     If IndexName$ = "" Then    'User wants production index file
  747.         i4create = i4createCB(dbPtr&, ByVal 0&, t(1))
  748.     Else
  749.         i4create = i4createCB(dbPtr&, IndexName$, t(1))
  750.     End If
  751.     
  752.     ' Since v4Cstring allocates memory for the storage of
  753.     ' C strings, we must free the memory after it has been
  754.     ' used.
  755.  
  756.     For i = 1 To ts
  757.          Call v4Cstringfree(t(i).name)
  758.          Call v4Cstringfree(t(i).expression)
  759.          Call v4Cstringfree(t(i).filter)
  760.     Next i
  761.  
  762.  
  763. End Function
  764.  
  765. Function i4open& (d4&, fname$)
  766.  
  767.    If fname = "" Then
  768.       i4open = i4openCB(d4&, ByVal 0&)   'Use data file name
  769.    Else
  770.       i4open = i4openCB(d4&, fname$)     'Use supplied name
  771.    End If
  772.  
  773. End Function
  774.  
  775. Function t4key$ (tPtr&)
  776.  
  777. 'This function returns the value of the current key
  778.    
  779.    Dim KeyPtr&, KeyLen%, KeyBuf$
  780.  
  781.    KeyLen% = tag4KeyLen(tPtr&) + 1
  782.    KeyBuf$ = Space(KeyLen%)
  783.  
  784.    'Get pointer to key info
  785.    KeyPtr& = t4keyCB(tPtr&)
  786.  
  787.    If KeyPtr& = 0 Then Exit Function
  788.  
  789.    'Copy to VB string
  790.    rc% = u4ncpy(KeyBuf$, KeyPtr&, KeyLen%)
  791.  
  792.    'Trim null character(s)
  793.    t4key$ = Left$(KeyBuf$, rc%)
  794.  
  795. End Function
  796.  
  797. Function tag4alias$ (tPtr&)
  798.     
  799. 'This function returns the alias of an index tag
  800.  
  801.     Dim AliasPtr&
  802.     Dim AliasName As String * 11
  803.  
  804.     'Get pointer to alias string
  805.     AliasPtr& = tag4aliasCB(tPtr&)
  806.  
  807.     'Copy to VB string
  808.     rc% = u4ncpy(AliasName$, AliasPtr&, 11)
  809.  
  810.     'Trim null character(s)
  811.     tag4alias$ = Left$(AliasName$, rc%)
  812.  
  813. End Function
  814.  
  815. Function tag4expr$ (tPtr&)
  816.  
  817. 'This function returns the original tag expression
  818.  
  819.     Dim ExprPtr&
  820.     Dim expr As String * 255
  821.  
  822.     'Get pointer to parsed dBASE expression
  823.     ExprPtr& = tag4exprCB(tPtr&)
  824.  
  825.     'Copy to VB string and trim null character(s)
  826.     rc% = u4ncpy(expr$, ExprPtr&, 255)
  827.     tag4expr$ = Left$(expr$, rc%)
  828.  
  829. End Function
  830.  
  831. Function tag4Filter$ (tPtr&)
  832.  
  833. 'This function returns the tag filter expression
  834.     
  835.     Dim FilterPtr&
  836.     Dim filter As String * 255
  837.  
  838.     'Get pointer to parsed filter expression
  839.     FilterPtr& = tag4filterCB(tPtr&)
  840.  
  841.     If FilterPtr& = 0 Then          'No filter
  842.         tag4Filter$ = ""
  843.         Exit Function
  844.     End If
  845.  
  846.     'Copy to VB string and trim null character(s)
  847.     rc% = u4ncpy(filter$, FilterPtr&, 255)
  848.     tag4Filter$ = Left$(filter$, rc%)
  849.  
  850. End Function
  851.  
  852. Function u4descend$ (charString$)
  853.  
  854.    Dim Result$, i%
  855.  
  856.    For i = 1 To Len(charString)
  857.     Result = Result + Chr$(128 And Asc(Mid$(charString, i, 1)))
  858.    Next
  859.  
  860.    u4descend = Result
  861.  
  862. End Function
  863.  
  864.