home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR7 / FOXTAILS.ZIP / DBFIXED.PRG < prev    next >
Text File  |  1992-02-29  |  4KB  |  147 lines
  1. *    Written by R.L. Coppedge
  2. *    Copyright 1992 dbF Software Productions
  3. *    By the way, dbF also has:
  4. *    SysTrak        A Computer Hardware/Software Inventory System
  5. *    Flags        A Flatfile Application Gen. for db3,4 and Fox
  6. *    ClasAdz        A Classified/Notice system for Networks
  7. *    FerretPro    A collection of FoxPro tools (like this one)
  8. *    Contact dbF for more information.
  9. *    dbF Software Productions
  10. *    P.O. Box 37194
  11. *    Cleve., Ohio 44137-0194
  12. *    CIS: 72117,165
  13. *    (216)491-4581
  14. *
  15. *
  16. SET TALK OFF
  17. SET SAFETY OFF
  18. DEFINE WINDOW Dbfixed FROM 1,0 TO 22,79 TITLE "DbFixed"
  19. ACTIVATE WINDOW DbFixed
  20. @3,15 SAY "Copyright 1992, dbF Software Productions"
  21. @4,2 TO 13,70 DOUBLE
  22. @5,4 SAY "This program will help you import data files into a dbF"
  23. @6,4 SAY "format.  Files that have some kind of fixed record length"
  24. @7,4 SAY "but with a header (ie, a Cobol data file) length.  You"
  25. @8,4 SAY "try finding (or already know) combinations of record and"
  26. @9,4 SAY "header lengths until you find one that fits..."
  27. @10,4 SAY "Sounds like something you wanna do?"
  28. @11,5 GET choice PICTURE '@*H \!\<Ok;\?\<Cancel' DEFAULT "Ok"
  29. READ
  30. IF Choice = "Cancel"
  31.     RELEASE WINDOW DbFixed
  32.     WAIT "Be that way!" WINDOW
  33.     RETURN
  34. ENDIF
  35. DEFINE WINDOW Keepr FROM 16,5 TO 22,65 DOUBLE TITLE "Now what?"
  36. Fl = GETFILE()
  37. IF EMPTY(Fl)
  38.     RELEASE WINDOW DbFixed, Keepr
  39.     RETURN
  40. ENDIF
  41. Opn = FOPEN(Fl,0)
  42. =ADIR(Fstuff,Fl)
  43. Fsz = Fstuff(2)
  44. Hdsz = 20
  45. Rsz = 80
  46. DO WHILE .T.
  47.     CLEAR
  48.     @0,3 SAY "Tap <Esc> to Exit"
  49.     @1,5 SAY "File size is " + ALLTRIM(STR(Fsz))+ " Bytes Long"
  50.     @2,5 SAY "What header size do you want? " GET Hdsz PICTURE "99999" ;
  51.     VALID BETWEEN(Hdsz,1,Fsz) ERROR "Umm...keep the file's size in mind, ok?"
  52.     @3,5 SAY "What record Size? " GET Rsz PICTURE "99999" ;
  53.     VALID BETWEEN(Rsz,1,Fsz) ERROR "Umm...keep the file's size in mind, ok?"
  54.     @18,5 SAY "Copyright 1992, dbF Software Productions..."
  55.     READ
  56.     IF LASTKEY() = 27
  57.         EXIT
  58.     ENDIF
  59.     Nmrecs = INT((Fsz-Hdsz)/ Rsz)
  60.     IF Nmrecs > 0
  61.         @6,5 SAY "There would be " + ALLTRIM(STR(Nmrecs)) + " Records created by"
  62.         @7,5 SAY "importing this file..."
  63.     ELSE
  64.         @6,5 SAY "Hey, waitaminnit!  The file is only " + ALLTRIM(STR(Fstuff(2))) + " bytes long"
  65.         @7,5 SAY "That's not big enough for this..."
  66.         WAIT WINDOW
  67.         LOOP
  68.     ENDIF
  69.     Rmdr = Fsz - (Nmrecs*Rsz) - Hdsz
  70.     IF Rmdr <> 0
  71.         @8,5 SAY "There would be " + ALLTRIM(STR(Rmdr)) + " bytes left over..."
  72.         @9,5 SAY "That's usually an indicator that you're a bit (or byte) off"
  73.     ENDIF
  74.     @10,5 SAY "Do you want to see what 2 records would look like?"
  75.     @11,2 GET choice PICTURE '@* \!\<Ok;\?\<Cancel' DEFAULT "Ok"
  76.     READ
  77.     IF Choice = "Ok"
  78.         N = FSEEK(Opn, Hdsz, 0)
  79.         R1 = FREAD(Opn, Rsz)
  80.         R2 = FREAD(Opn, Rsz)
  81.         Nlines = INT(Rsz/77) + 1
  82.         @3,2 SAY "Ok, with that positioning, the 1st two records look like this:"
  83.         D = "1>>"
  84.         @4,0 GET D
  85.         CLEAR GETS
  86.         FOR X = 1 TO Nlines
  87.             Slen = IIF(Rsz-77*(X-1)>77,77,Rsz-77*(X-1))
  88.             @3 + X, 3 SAY SUBSTR(R1,77*(X-1)+1,Slen)
  89.         ENDFOR
  90.         D = "2>>" 
  91.         @5+Nlines,0 GET D
  92.         CLEAR GETS
  93.         Offset = Nlines
  94.         FOR X = 1 TO Nlines
  95.             Slen = IIF(Rsz-77*(X-1)>77,77,Rsz-77*(X-1))
  96.             @4 + X+Offset, 3 SAY SUBSTR(R2,77*(X-1)+1,Slen)
  97.         ENDFOR
  98.     ENDIF
  99.     ACTIVATE WINDOW Keepr
  100.     @0,1 SAY "Now, do you want to export the entire"
  101.     @1,1 SAY "file to a database?"
  102.     @2,2 GET choice PICTURE '@* \!\<Ok;\?\<Cancel' DEFAULT "Ok"
  103.     READ
  104.     IF Choice = "Ok"
  105.         Newfile = PUTFILE("Enter a File Name" , "Export", "Dbf")
  106.         IF EMPTY(Newfile)
  107.             WAIT "Import aborted...tap any key" WINDOW
  108.             DEACTIVATE WINDOW Keepr
  109.             LOOP
  110.         ENDIF
  111.         USE Dummy
  112.         ZAP
  113.         NFlds = INT(Rsz/254) + 1
  114.         FOR X = 1 TO NFlds
  115.             APPEND BLANK
  116.             Fn = "Field" + ALLTRIM(STR(X))
  117.             REPLACE Field_Name WITH Fn, Field_Type WITH "C", Field_Len WITH IIF(X=Nflds,Rsz-254*(X-1) ,254)
  118.         ENDFOR
  119.         CREATE (Newfile) FROM Dummy
  120.         USE (Newfile) ALIAS Newfile
  121.         N = FSEEK(Opn, Hdsz, 0)
  122.         DO WHILE !FEOF(Opn)
  123.             R1 = FREAD(Opn, Rsz)
  124.             APPEND BLANK
  125.             FOR X = 1 TO NFlds
  126.                 Fn = "Field" + ALLTRIM(STR(X))
  127.                 Slen = IIF(Rsz-254*(X-1)>254,254,Rsz-254*(X-1))
  128.                 REPLACE (Fn) WITH SUBSTR(R1,254*(X-1)+1,Slen)
  129.             ENDFOR
  130.         ENDDO
  131.         CLEAR
  132.         @0,1 SAY "Boy that was fun! Your new database now has"
  133.         @1,1 SAY ALLTRIM(STR(RECCOUNT())) + " Records"
  134.         @2,1 SAY "Do it again?"
  135.         @3,2 GET choice PICTURE '@* \!\<Ok;\?\<Cancel' DEFAULT "Ok"
  136.         READ
  137.         IF Choice = "Cancel"
  138.             EXIT
  139.         ENDIF
  140.     ENDIF
  141.     DEACTIVATE WINDOW Keepr
  142. ENDDO
  143. =FCLOSE(Opn)
  144. CLOSE DATA
  145. RELEASE WINDOW DbFixed, Keepr
  146. RETURN
  147.