MAKECUST.MOD 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263
  1. MODULE MakeCustomerDBF;
  2. (* this program will create the file for Customer *)
  3. FROM LowLevel IMPORT Fill;
  4. FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,
  5. GetField,DBFieldDescriptor,DBFile;
  6. FROM DBCreate IMPORT BuildDBF;
  7. FROM SYSTEM IMPORT SIZE,ADR;
  8. FROM Storage IMPORT ALLOCATE,DEALLOCATE;
  9. VAR
  10. CustomerDBF : DBFile;
  11. PROCEDURE MakeDatabase();
  12. VAR
  13. Error : CARDINAL;
  14. Desc : POINTER TO ARRAY [1..200] OF DBFieldDescriptor;
  15. BEGIN
  16. ALLOCATE(Desc, 31 * SIZE(DBFieldDescriptor));
  17. Fill(Desc, 31 * SIZE(DBFieldDescriptor),0);
  18. MakeDescriptor( Desc^[ 1], 'CIN', 10, 0, 'C');
  19. MakeDescriptor( Desc^[ 2], 'NAMEIDX', 40, 0, 'C');
  20. MakeDescriptor( Desc^[ 3], 'NAME', 40, 0, 'C');
  21. MakeDescriptor( Desc^[ 4], 'NOTES1', 40, 0, 'C');
  22. MakeDescriptor( Desc^[ 5], 'NOTES2', 40, 0, 'C');
  23. MakeDescriptor( Desc^[ 6], 'NOTES3', 40, 0, 'C');
  24. MakeDescriptor( Desc^[ 7], 'AMTOUT', 10, 2, 'N');
  25. MakeDescriptor( Desc^[ 8], 'LASTINV', 8, 0, 'D');
  26. MakeDescriptor( Desc^[ 9], 'YTDPURCH', 10, 2, 'N');
  27. MakeDescriptor( Desc^[ 10], 'SALESREP', 10, 0, 'C');
  28. MakeDescriptor( Desc^[ 11], 'CONTACT', 20, 0, 'C');
  29. MakeDescriptor( Desc^[ 12], 'PHONENBR', 18, 0, 'C');
  30. MakeDescriptor( Desc^[ 13], 'FAXNBR', 15, 0, 'C');
  31. MakeDescriptor( Desc^[ 14], 'DATENTER', 8, 0, 'D');
  32. MakeDescriptor( Desc^[ 15], 'SHIPTOA1', 30, 0, 'C');
  33. MakeDescriptor( Desc^[ 16], 'SHIPTOA2', 30, 0, 'C');
  34. MakeDescriptor( Desc^[ 17], 'SHIPTOA3', 30, 0, 'C');
  35. MakeDescriptor( Desc^[ 18], 'SHIPTOZP', 9, 0, 'C');
  36. MakeDescriptor( Desc^[ 19], 'BILLTOA1', 30, 0, 'C');
  37. MakeDescriptor( Desc^[ 20], 'BILLTOA2', 30, 0, 'C');
  38. MakeDescriptor( Desc^[ 21], 'BILLTOA3', 30, 0, 'C');
  39. MakeDescriptor( Desc^[ 22], 'BILLTOZP', 9, 0, 'C');
  40. MakeDescriptor( Desc^[ 23], 'DISCLEVEL', 1, 0, 'N');
  41. MakeDescriptor( Desc^[ 24], 'DISCAMOUNT', 4, 2, 'N');
  42. MakeDescriptor( Desc^[ 25], 'SHIPVIA', 20, 0, 'C');
  43. MakeDescriptor( Desc^[ 26], 'TERMS', 20, 0, 'C');
  44. MakeDescriptor( Desc^[ 27], 'LIMIT', 10, 2, 'N');
  45. MakeDescriptor( Desc^[ 28], 'RESALENBR', 15, 0, 'C');
  46. MakeDescriptor( Desc^[ 29], 'TAXABLE', 1, 0, 'C');
  47. MakeDescriptor( Desc^[ 30], 'FREEFRGHT', 1, 0, 'C');
  48. MakeDescriptor( Desc^[ 31], 'SALEREPCOM', 4, 2, 'N');
  49. InitDBF('Customer.DBF',CustomerDBF,0,FALSE,TRUE,FALSE,DefaultFixUp);
  50. (* It would be a good to test error.*)
  51. Error:=BuildDBF(Desc^, 31,CustomerDBF);
  52. CloseDBF(CustomerDBF);
  53. DEALLOCATE(Desc, 31 * SIZE(DBFieldDescriptor));
  54. END MakeDatabase;
  55. BEGIN
  56. MakeDatabase();
  57. END MakeCustomerDBF.