Listing: 1 MODULE DBF2DES; 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 (* given a dbase3 file - create a descriptor for it *) 14 15 FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec, 16 AppendBlank,DBFile,InitDBF,OpenDBF,DefaultFixUp,FieldList,NumberOfFields, 17 DBFieldPtr; 18 FROM ScrnTypes IMPORT InitDisplayFrame,DisplayFrame,AFrameName,ImageElement; 19 FROM DataTypes IMPORT DataElmtRec; 20 FROM PosUtils IMPORT Present,Pos; 21 FROM Prompts IMPORT PromptStr; 22 FROM HandleIO IMPORT FileExists,BlockRead,BlockWrite,CreateFile,CloseHandle; 23 IMPORT InitCompilerMods; 24 FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,CAPstr,Append,SetLength; 25 FROM M2Strings IMPORT Length,Assign; 26 FROM LowLevel IMPORT Fill; 27 FROM EnvironUtils IMPORT ReadEnvironment,ParsedParam; 28 FROM SYSTEM IMPORT ADR,SIZE; 29 IMPORT VWindows; 30 31 VAR 32 FileName : ARRAY[0..30] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 33 FileName2 : ARRAY[0..20] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 34 Environ : ARRAY[0..30] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 35 DF : DisplayFrame; 36 Elmt : DataElmtRec; 37 DBF : DBFile; 38 J : CARDINAL; 39 H : CARDINAL; 40 FldList : DBFieldPtr; 41 NbrFlds : CARDINAL; 42 B : BOOLEAN; 43 EM : CARDINAL; 44 PROCEDURE OpenFile(); 45 BEGIN 46 B := ParsedParam(1,FileName); ***** ^ not supported yet ***** ^ not supported yet 47 IF NOT B 48 THEN 49 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 50 Fill(ADR(FileName),SIZE(FileName),0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 PromptStr('Enter name of Database File ',FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 52 END; 53 CrunchBlanks(FileName); ***** ^ not supported yet ***** ^ not supported yet 54 IF Present('.',FileName) ***** ^ not supported yet ***** ^ not supported yet 55 THEN SetLength(FileName,Pos('.',FileName)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 56 END; 57 Assign(FileName, FileName2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 58 Append(FileName2,'.DBF'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 InitDBF(FileName2,DBF,2,FALSE,FALSE,FALSE,DefaultFixUp); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 IF NOT OpenDBF(DBF) ***** ^ not supported yet ***** ^ not supported yet 61 THEN 62 HALT; ***** ^ undeclared identifier 63 END; 64 CrunchBlanks(FileName); ***** ^ not supported yet ***** ^ not supported yet 65 Append(FileName,'.DDF'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 66 EM := CreateFile(H,FileName); ***** ^ not supported yet ***** ^ not supported yet 67 END OpenFile; ***** ^ not supported yet 68 69 BEGIN 70 71 OpenFile(); ***** ^ not supported yet ***** ^ not supported yet 72 FldList := FieldList(DBF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 73 NbrFlds := NumberOfFields(DBF); ***** ^ not supported yet ***** ^ not supported yet 74 FOR J := 1 TO NbrFlds DO 75 Assign( FldList^[J].name,Elmt.Name ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 76 Elmt.Type := FldList^[J].fldtype; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 77 Elmt.Len := FldList^[J].size; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 Elmt.Dec := FldList^[J].decplaces; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 79 Elmt.Idx := ' '; ***** ^ not supported yet ***** ^ not supported yet 80 Elmt.Desc := ''; ***** ^ not supported yet ***** ^ not supported yet 81 EM := BlockWrite(H,ADR(Elmt),SIZE(Elmt)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 END; 83 EM := CloseHandle(H); ***** ^ not supported yet ***** ^ not supported yet 84 85 END DBF2DES. 89 errors