Listing: 1 IMPLEMENTATION MODULE MakeDBF; 2 (* 3 * ModBase 4 * Release 3.0 5 * (c) Copyright 1986 - 1991 PMI 6 Copyright 1988 - 1991 John McMonagle 7 * P.O. Box 8402 8 * Green Bay Wi 53308 9 * All Rights Reserved 10 * by Ed Ross 11 *) 12 13 14 FROM DataTypes IMPORT DataElmtRec,IndexElmtRec,TableName,FldList,IdxList, 15 DBFName; 16 FROM NumTypes IMPORT Real8; 17 FROM StrConv IMPORT RealToStr,CardinalToStr; 18 FROM GenLists IMPORT GenList,ListLength,GetElmt; 19 FROM HandleIO IMPORT BlockRead,BlockWrite,FileExists, 20 OpenFile,CloseHandle,CreateFile,FileLength; 21 FROM StringIO IMPORT ErrorMessage; 22 FROM PosUtils IMPORT Equal,Present,Pos; 23 FROM Prompts IMPORT PromptStr,PromptYN; 24 FROM Strings IMPORT Length,CompareStr; 25 FROM StrEdit IMPORT CAPstr,CrunchBlanks,Append,SetLength,AssignStr,LowerStr; 26 FROM LowLevel IMPORT Fill; 27 FROM ModBase3 IMPORT DBFile, DBFieldDescriptor,AppendBlank,GetField, 28 BuildDBF,CloseDBF,WriteDBRec,DefaultFixUp,InitDBF; 29 FROM DBIndxes IMPORT DBIndex,InitIndex,CloseIndex,BuildIndex,AddRecord, 30 InitCompIndex,BuildCompIndex; 31 FROM SYSTEM IMPORT TSIZE,ADR,ADDRESS; 32 IMPORT VWindows; 33 FROM VStorage IMPORT DosAlloc,DosDealloc; 34 FROM Str IMPORT Copy; 35 36 37 38 39 PROCEDURE MakeDataBaseFile(TheList : GenList); 40 VAR 41 DBDesc : ARRAY[1..128] OF DBFieldDescriptor; ***** ^ not supported yet ***** ^ not supported yet 42 ByteCnt : CARDINAL; 43 ElmtCnt : CARDINAL; 44 J : CARDINAL; 45 Code : CARDINAL; 46 Elmt : DataElmtRec; 47 FileName : ARRAY[0..20] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 48 DBFFile : DBFile; 49 BEGIN 50 ElmtCnt := ListLength(TheList); ***** ^ not supported yet ***** ^ not supported yet 51 ByteCnt := (ElmtCnt+1) * TSIZE(DBFieldDescriptor) ; ***** ^ not supported yet ***** ^ not supported yet 52 (*DosAlloc(DBDesc,ByteCnt);*) 53 Fill(ADR(DBDesc),ByteCnt,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 54 FOR J := 1 TO ElmtCnt DO 55 GetElmt(TheList,J,Elmt,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 56 Copy(DBDesc[J].name , Elmt.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 57 DBDesc[J].size := Elmt.Len; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 58 DBDesc[J].decplaces := Elmt.Dec; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 DBDesc[J].fldtype := Elmt.Type; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 END; (* end for j *) 61 Copy(FileName , TableName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 62 Append(FileName,'.DBF'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 63 InitDBF(FileName,DBFFile,0,FALSE,TRUE,FALSE,DefaultFixUp); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 J := BuildDBF(DBDesc,ElmtCnt,DBFFile); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 AppendBlank( DBFFile ); ***** ^ not supported yet ***** ^ not supported yet 66 CloseDBF(DBFFile); ***** ^ not supported yet ***** ^ not supported yet 67 (* DosDealloc(DBDesc,ByteCnt); *) 68 69 END MakeDataBaseFile; ***** ^ not supported yet 70 END MakeDBF. ***** ^ not supported yet 56 errors