home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / tricks / fileteil.bas < prev    next >
Encoding:
BASIC Source File  |  1989-03-21  |  3.8 KB  |  146 lines
  1. '* ------------------------------------------------------- *
  2. '*                     FILETEIL.BAS                        *
  3. '*  Utility zum Aufteilen und Zusammenfügen großer Dateien *
  4. '*          (c)  1989  W.Steininger  &  TOOLBOX            *
  5. '* ------------------------------------------------------- *
  6. ON ERROR GOTO fehler
  7. ON KEY(10) GOSUB ende
  8.  
  9. DO
  10.   CLS
  11.   CLOSE
  12.   KEY(10) ON
  13.   LOCATE 3,25
  14.   PRINT "********** Fileteiler *********" : PRINT
  15.   LOCATE 25,1 : PRINT "F10-Programmende"; : LOCATE 5,1
  16.  
  17.   DO
  18.     PRINT "File aufteilen (A) oder zusammenfügen (Z) ?";
  19.     INPUT art$ : art$ = UCASE$(art$)
  20.   LOOP UNTIL (art$ = "A") OR (art$ = "Z")
  21.  
  22.   IF art$ = "Z" THEN
  23.     CALL zufuegen
  24.   ELSE
  25.     CALL teilen
  26.   END IF
  27. LOOP UNTIL 1 = 1     '* Endlosschleife, Abbruch über ON..KEY
  28.  
  29. SUB zufuegen
  30.   PRINT
  31.   PRINT "Pfad\Filename der zusammengesetzten Datei  ? ";
  32.   INPUT filename$
  33.   PRINT "Pfad\Filename der geteilten Dateien        ? ";
  34.   INPUT outfile$
  35.   DO
  36.     PRINT "Anzahl der Dateien  (0..99)                ? ";
  37.     INPUT fileanz%
  38.   LOOP UNTIL (fileanz% > 0) AND (fileanz% < 100)
  39.  
  40.   OPEN filename$ FOR BINARY AS #1
  41.   filegroesse% = 0
  42.  
  43.   KEY(10) OFF                      '* Abbruch nicht zulassen
  44.   FOR i% = 0 TO fileanz% - 1
  45.     a$ = STR$(i%)
  46.     a$ = RIGHT$(a$, LEN(a$) - 1)
  47.     outfile$ = LEFT$(outfile$, LEN(outfile$) - LEN(a$)) + a$
  48.  
  49. filepruef:                      '* Rückkehr Fehlerbehandlung
  50.     OPEN outfile$ FOR INPUT AS #2
  51.     CLOSE 2
  52.     OPEN outfile$ FOR BINARY AS #2
  53.     PRINT outfile$
  54.     SEEK 1, filegroesse
  55.     DO
  56.       GET$ #2, 10000, temp$
  57.       PUT$ #1, temp$
  58.     LOOP UNTIL EOF(2)
  59.     filegroesse = filegroesse + LOF(2)
  60.     CLOSE 2
  61.   NEXT i%
  62.   PRINT "File fertig rekonstruiert"
  63.   DELAY 1
  64. END SUB
  65.  
  66. SUB teilen
  67.   PRINT
  68.   PRINT "Pfad\Filename der aufzuteilenden Datei ? ";
  69.   INPUT filename$
  70.   PRINT "Pfad\Filename der geteilten Dateien    ? ";
  71.   INPUT outfile$
  72.   ok = 0
  73.   DO
  74.     DO
  75.       PRINT "Filegröße   (größer 10000)             ? "
  76.       INPUT filegroesse
  77.     LOOP UNTIL filegroesse > 9999
  78.     filegroesse = INT(filegroesse/10000) * 10000
  79.     OPEN filename$ FOR BINARY AS #1
  80.     filelaenge = LOF(1)
  81.     fileanz = INT(filelaenge/filegroesse)
  82.     IF filelaenge < filegroesse THEN
  83.       PRINT "Keine Aufteilung nötig !"
  84.       ok = 0                            '* FALSCH
  85.     ELSE
  86.       ok = -1                           '* WAHR
  87.     END IF
  88.     IF fileanz > 99 THEN
  89.       PRINT "Zu viele Teile nötig !!"
  90.       ok = 0
  91.     ELSE
  92.       ok = -1
  93.     END IF
  94.   LOOP UNTIL ok
  95.   KEY(10) OFF
  96.   FOR i% = 0 TO fileanz
  97.  
  98. teilweiter:                 '* Rückkehr aus Fehlerbehandlung
  99.     a$ = STR$(i%)
  100.     a$ = RIGHT$(a$, LEN(a$) - 1)
  101.     outfile$ = LEFT$(outfile$, LEN(outfile$) - len(a$)) + a$
  102.     OPEN outfile$ FOR BINARY AS #2
  103.     PRINT outfile$
  104.     SEEK 1, i% * filegroesse
  105.     IF i% = fileanz THEN
  106.       DO
  107.         GET$ #1, 10000, temp$
  108.         PUT$ #2, temp$
  109.       LOOP UNTIL EOF(1)
  110.     ELSE        
  111.       FOR j% = 1 TO filegroesse/10000
  112.         GET$ #1, 10000, temp$
  113.         PUT$ #2, temp$
  114.       NEXT j%
  115.     END IF
  116.     CLOSE 2
  117.   NEXT i%
  118.   PRINT "Aufteilung beendet. Anzahl der Files: "; fileanz+1
  119.   DELAY 1    
  120. END SUB
  121.  
  122. fehler:                           '* eigene Fehlerbehandlung
  123.   SELECT CASE err
  124.     CASE 61
  125.       IF art$ = "a" THEN
  126.         CLOSE 2
  127.         KILL outfile$
  128.         PRINT "Diskette voll. ";
  129.         INPUT "Neue Diskette einlegen <RETURN>", a$
  130.         RESUME teilweiter
  131.       END IF
  132.     case 53
  133.       IF art$ = "z" THEN
  134.       CLOSE 2
  135.       PRINT "Diskette mit File "; outfile$;
  136.       INPUT " einlegen und <RETURN>"; ip$
  137.       RESUME filepruef
  138.     END IF
  139.   END SELECT
  140.   PRINT "Fehler "; err
  141.  
  142. ende:
  143.   CLOSE : END
  144.  
  145. '* ------------------------------------------------------- *
  146. '*                Ende von FILETEIL.BAS                    *