MAKEDBF.LST 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. Listing:
  2. 1 IMPLEMENTATION MODULE MakeDBF;
  3. 2 (*
  4. 3 * ModBase
  5. 4 * Release 3.0
  6. 5 * (c) Copyright 1986 - 1991 PMI
  7. 6 Copyright 1988 - 1991 John McMonagle
  8. 7 * P.O. Box 8402
  9. 8 * Green Bay Wi 53308
  10. 9 * All Rights Reserved
  11. 10 * by Ed Ross
  12. 11 *)
  13. 12
  14. 13
  15. 14 FROM DataTypes IMPORT DataElmtRec,IndexElmtRec,TableName,FldList,IdxList,
  16. 15 DBFName;
  17. 16 FROM NumTypes IMPORT Real8;
  18. 17 FROM StrConv IMPORT RealToStr,CardinalToStr;
  19. 18 FROM GenLists IMPORT GenList,ListLength,GetElmt;
  20. 19 FROM HandleIO IMPORT BlockRead,BlockWrite,FileExists,
  21. 20 OpenFile,CloseHandle,CreateFile,FileLength;
  22. 21 FROM StringIO IMPORT ErrorMessage;
  23. 22 FROM PosUtils IMPORT Equal,Present,Pos;
  24. 23 FROM Prompts IMPORT PromptStr,PromptYN;
  25. 24 FROM Strings IMPORT Length,CompareStr;
  26. 25 FROM StrEdit IMPORT CAPstr,CrunchBlanks,Append,SetLength,AssignStr,LowerStr;
  27. 26 FROM LowLevel IMPORT Fill;
  28. 27 FROM ModBase3 IMPORT DBFile, DBFieldDescriptor,AppendBlank,GetField,
  29. 28 BuildDBF,CloseDBF,WriteDBRec,DefaultFixUp,InitDBF;
  30. 29 FROM DBIndxes IMPORT DBIndex,InitIndex,CloseIndex,BuildIndex,AddRecord,
  31. 30 InitCompIndex,BuildCompIndex;
  32. 31 FROM SYSTEM IMPORT TSIZE,ADR,ADDRESS;
  33. 32 IMPORT VWindows;
  34. 33 FROM VStorage IMPORT DosAlloc,DosDealloc;
  35. 34 FROM Str IMPORT Copy;
  36. 35
  37. 36
  38. 37
  39. 38
  40. 39 PROCEDURE MakeDataBaseFile(TheList : GenList);
  41. 40 VAR
  42. 41 DBDesc : ARRAY[1..128] OF DBFieldDescriptor;
  43. ***** ^ not supported yet
  44. ***** ^ not supported yet
  45. 42 ByteCnt : CARDINAL;
  46. 43 ElmtCnt : CARDINAL;
  47. 44 J : CARDINAL;
  48. 45 Code : CARDINAL;
  49. 46 Elmt : DataElmtRec;
  50. 47 FileName : ARRAY[0..20] OF CHAR;
  51. ***** ^ not supported yet
  52. ***** ^ not supported yet
  53. 48 DBFFile : DBFile;
  54. 49 BEGIN
  55. 50 ElmtCnt := ListLength(TheList);
  56. ***** ^ not supported yet
  57. ***** ^ not supported yet
  58. 51 ByteCnt := (ElmtCnt+1) * TSIZE(DBFieldDescriptor) ;
  59. ***** ^ not supported yet
  60. ***** ^ not supported yet
  61. 52 (*DosAlloc(DBDesc,ByteCnt);*)
  62. 53 Fill(ADR(DBDesc),ByteCnt,0);
  63. ***** ^ not supported yet
  64. ***** ^ not supported yet
  65. ***** ^ not supported yet
  66. ***** ^ not supported yet
  67. 54 FOR J := 1 TO ElmtCnt DO
  68. 55 GetElmt(TheList,J,Elmt,Code);
  69. ***** ^ not supported yet
  70. ***** ^ not supported yet
  71. ***** ^ not supported yet
  72. ***** ^ not supported yet
  73. 56 Copy(DBDesc[J].name , Elmt.Name);
  74. ***** ^ not supported yet
  75. ***** ^ not supported yet
  76. ***** ^ not supported yet
  77. ***** ^ not supported yet
  78. ***** ^ not supported yet
  79. ***** ^ not supported yet
  80. 57 DBDesc[J].size := Elmt.Len;
  81. ***** ^ not supported yet
  82. ***** ^ not supported yet
  83. ***** ^ not supported yet
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. 58 DBDesc[J].decplaces := Elmt.Dec;
  87. ***** ^ not supported yet
  88. ***** ^ not supported yet
  89. ***** ^ not supported yet
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. 59 DBDesc[J].fldtype := Elmt.Type;
  93. ***** ^ not supported yet
  94. ***** ^ not supported yet
  95. ***** ^ not supported yet
  96. ***** ^ not supported yet
  97. ***** ^ not supported yet
  98. 60 END; (* end for j *)
  99. 61 Copy(FileName , TableName);
  100. ***** ^ not supported yet
  101. ***** ^ not supported yet
  102. ***** ^ not supported yet
  103. 62 Append(FileName,'.DBF');
  104. ***** ^ not supported yet
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. 63 InitDBF(FileName,DBFFile,0,FALSE,TRUE,FALSE,DefaultFixUp);
  108. ***** ^ not supported yet
  109. ***** ^ not supported yet
  110. ***** ^ not supported yet
  111. ***** ^ not supported yet
  112. 64 J := BuildDBF(DBDesc,ElmtCnt,DBFFile);
  113. ***** ^ not supported yet
  114. ***** ^ not supported yet
  115. ***** ^ not supported yet
  116. 65 AppendBlank( DBFFile );
  117. ***** ^ not supported yet
  118. ***** ^ not supported yet
  119. 66 CloseDBF(DBFFile);
  120. ***** ^ not supported yet
  121. ***** ^ not supported yet
  122. 67 (* DosDealloc(DBDesc,ByteCnt); *)
  123. 68
  124. 69 END MakeDataBaseFile;
  125. ***** ^ not supported yet
  126. 70 END MakeDBF.
  127. ***** ^ not supported yet
  128. 56 errors