home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 2: Collection B / 17Bit_Collection_B.iso / files / 1545.dms / in.adf / KwikBackUp / Source / BackUp.mod < prev    next >
Encoding:
Modula Implementation  |  1990-03-25  |  28.2 KB  |  959 lines
  1. IMPLEMENTATION MODULE BackUp;
  2.  
  3. FROM SYSTEM           IMPORT ADR, ADDRESS, LONGSET;
  4.  
  5. FROM Arts             IMPORT Assert;
  6.  
  7. FROM Dos              IMPORT FileLockPtr, UnLock, Lock, Examine, ExNext,
  8.                              FileInfoBlockPtr, sharedLock, IoErr, CurrentDir,
  9.                              noMoreEntries, DateStamp, DatePtr, Read,
  10.                              FileHandlePtr, Open, Close, oldFile, archive,
  11.                              SetProtection, CreateDir, newFile, Write,
  12.                              SetComment, DeleteFile;
  13.  
  14. FROM Exec             IMPORT Byte, CopyMem, GetMsg, ReplyMsg;
  15.  
  16. FROM Graphics         IMPORT SetAPen, SetBPen, SetDrMd, jam1, jam2, RectFill;
  17.  
  18. FROM Heap             IMPORT AllocMem, Deallocate;
  19.  
  20. FROM Intuition        IMPORT GadgetFlags, GadgetFlagSet, IntuiMessagePtr,
  21.                              IDCMPFlags, IDCMPFlagSet, RefreshGadgets;
  22.  
  23. FROM Strings          IMPORT first, last, Insert, Length, Copy;
  24.  
  25. FROM TrackDisk        IMPORT notSpecified, noSecHdr, badSecPreamble,
  26.                              badSecId, badHdrSum, badSecSum, tooFewSecs,
  27.                              badSecHdr, writeProt, diskChanged, seekError,
  28.                              noMem, badUnitNum, badDriveType, driveInUse,
  29.                              postReset;
  30.  
  31. FROM TrackDiskSupport IMPORT OpenTrackDisk, FormatTrack, ReadBlock, Motor,
  32.                              GetNumTracks, CloseTrackDisk, GetDiskChange,
  33.                              ChangeState, ReadCycSec;
  34.  
  35. FROM HDDisplay        IMPORT gadgets, ReqResults, Gadgets, RP, HDName, Type,
  36.                              HDRequest, Window;
  37.  
  38.  
  39. (*------  CONTs:  ------*)
  40.  
  41. CONST
  42.   TrackSize = 512*22;
  43.   Gorks = "Gorks!?!";
  44.   EndeID = "BkUpEnde";
  45.  
  46. (*------  TYPEs:  ------*)
  47.  
  48. TYPE
  49.   Res = (ok,continue,cancel);
  50.   String = ARRAY[0..255] OF CHAR;
  51.   MyFileType = RECORD
  52.     gorks: ARRAY[0..7] OF CHAR;    (*   0 =   0 *)
  53.     byte:  LONGCARD;               (*   8 =   8 *)
  54.     prot:  LONGSET;                (*  12 =   C *)
  55.     name:  ARRAY[0..107] OF CHAR;  (*  16 =  10 *)
  56.     comm:  ARRAY[0..115] OF CHAR;  (* 124 =  7C *)
  57.     Size:  LONGCARD;               (* 240 =  F0 *)
  58.     path:  String;                 (* 244 =  F4 *)
  59.   END;                             (* 500 = 1F4 *)
  60.   (* Danach MyFileType.size Bytes data und bis zu 3 pad-Bytes *)
  61.   EndeType = RECORD
  62.     endeID: ARRAY[0..7] OF CHAR;
  63.     byte: LONGCARD;
  64.   END;
  65.   (* hinter letztem File *)
  66.  
  67. (* BackUp - Format:
  68.      Am Anfang jeder Diskkette :
  69.      Byte 0..3 : "BkUp"
  70.           4..5 : Identifier der BackUp-Reihe
  71.           6    : Disketten Nummer
  72.           7    : Version (0)
  73.      Der Rest aller Disketten wird als ein großer Block angesehen.
  74.      Er enthält für jedes File einen `MyFileType' gefolgt von dem
  75.      Fileinhalt und  bis zu 3 Pad-Bytes. Hinter dem letzen File ist ein
  76.      `EndeID'.  *)
  77.  
  78.  
  79. (*------  VARs:  ------*)
  80.  
  81. VAR
  82.   TrackBuffer: POINTER TO ARRAY[0..TrackSize-1] OF CHAR;
  83.   ActTrack: CARDINAL;
  84.   TrackBufferCnt: CARDINAL;
  85.   DiskChange: LONGCARD;
  86.   DiskNum: CARDINAL;
  87.   Datum: DatePtr;
  88.   ReqStr: ARRAY[0..39] OF CHAR;
  89.   bool: BOOLEAN;
  90.   MyFileInfo: MyFileType;
  91.   MyLock: FileLockPtr;
  92.   File: FileHandlePtr;
  93.  
  94. (*------  Fast Val to String:  ------*)
  95.  
  96. PROCEDURE Make2Digits(x: INTEGER; at: CARDINAL);
  97. (* macht aus x eine 2 - Ziffer Zahl an der Stelle at in ReqStr *)
  98. BEGIN
  99.   ReqStr[at  ] := CHAR(ORD("0") + x DIV 10);
  100.   ReqStr[at+1] := CHAR(ORD("0") + x - (x DIV 10) * 10);
  101. END Make2Digits;
  102.  
  103. (*------  Type Pathname:  ------*)
  104.  
  105. PROCEDURE TypePath(Path: ARRAY OF CHAR);
  106.  
  107. BEGIN
  108.   SetAPen(RP,0); SetBPen(RP,0); SetDrMd(RP,jam2);
  109.   RectFill(RP,100,144,612,151);
  110.   SetAPen(RP,1);
  111.   IF Length(Path)<64 THEN
  112.     Type(100,150,Path);
  113.   ELSE
  114.     Path[64] := 0C;
  115.     Type(100,150,Path);
  116.   END;
  117. END TypePath;
  118.  
  119. PROCEDURE TypeName(Name: ARRAY OF CHAR);
  120.  
  121. BEGIN
  122.   SetAPen(RP,0); SetBPen(RP,0); SetDrMd(RP,jam2);
  123.   RectFill(RP,100,164,612,171);
  124.   SetAPen(RP,1);
  125.   IF Length(Name)<64 THEN
  126.     Type(100,170,Name);
  127.   ELSE
  128.     Name[64] := 0C;
  129.     Type(100,150,Name);
  130.   END;
  131. END TypeName;
  132.  
  133. (*------  Error Request:  ------*)
  134.  
  135. PROCEDURE Error(Drive: CARDINAL; err: Byte; Read: BOOLEAN): ReqResults;
  136.  
  137. VAR
  138.   res: ReqResults;
  139.  
  140. BEGIN
  141.   CASE err OF
  142.   notSpecified:  ReqStr := "???";                     |
  143.   noSecHdr:      ReqStr := "No Sector Header";        |
  144.   badSecPreamble:ReqStr := "Bad Sector Preamble";     |
  145.   badSecId:      ReqStr := "Bad Sector Identifier";   |
  146.   badHdrSum:     ReqStr := "Header-Checksum Error";   |
  147.   badSecSum:     ReqStr := "Sector-Checksum Error";   |
  148.   tooFewSecs:    ReqStr := "Too few Sectors";         |
  149.   badSecHdr:     ReqStr := "Bad Sector Header";       |
  150.   writeProt:     ReqStr := "Disk is Write-Protected"; |
  151.   diskChanged:   ReqStr := "Disk Changed";            |
  152.   seekError:     ReqStr := "Seek Error";              |
  153.   noMem:         ReqStr := "Not enough Memory";       |
  154.   badUnitNum:    ReqStr := "Drive not connected";     |
  155.   badDriveType:  ReqStr := "Bad Drive-Type";          |
  156.   driveInUse:    ReqStr := "Drive in Use";            |
  157.   postReset:     ReqStr := "User Reset";              |
  158.   ELSE
  159.     ReqStr := "00"; Make2Digits(ORD(err),0);
  160.   END;
  161.   IF Read THEN
  162.     Insert(ReqStr,first,"Read-Error: ");
  163.   ELSE
  164.     Insert(ReqStr,first,"Write-Error: ");
  165.   END;
  166.   res := HDRequest(ADR(ReqStr),3,2,TRUE);
  167.   DiskChange := GetDiskChange(Drive);
  168.   RETURN res;
  169. END Error;
  170.  
  171. (*-----------------------  Create BackUp:  --------------------------------*)
  172.  
  173. PROCEDURE BackUp(Drive: CARDINAL);
  174.  
  175. VAR
  176.   ID1,ID2: CHAR;
  177.   NumTracks: LONGCARD;
  178.   Count: LONGCARD;
  179.   err: BOOLEAN;
  180.  
  181. (*------  Move to next Track:  ------*)
  182.  
  183.   PROCEDURE NextTrack(): Res;
  184.   (* Res can be ok or cancel *)
  185.  
  186.   BEGIN
  187.     IF ActTrack>=(NumTracks-1) THEN
  188.       INC(DiskNum);
  189.       IF Motor(Drive,FALSE) THEN END;
  190.       ReqStr := "Insert Disk Number 00 !";
  191.       Make2Digits(DiskNum,19);
  192.       IF HDRequest(ADR(ReqStr),0,1,FALSE)=Cancel THEN RETURN cancel END;
  193.       LOOP
  194.         WHILE NOT(ChangeState(Drive)) DO
  195.           IF HDRequest(ADR("No Disk in Drive !"),0,1,TRUE)=Cancel THEN
  196.             RETURN cancel;
  197.           END;
  198.         END;
  199.         IF DiskNum=1 THEN EXIT END;
  200.         IF ReadBlock(Drive,0,TrackBuffer,1,GetDiskChange(Drive))#0 THEN EXIT END;
  201.         IF (TrackBuffer^[0]="B") AND (TrackBuffer^[1]="k") AND
  202.            (TrackBuffer^[2]="U") AND (TrackBuffer^[3]="p") AND
  203.            (TrackBuffer^[4]=ID1) AND (TrackBuffer^[5]=ID2) AND
  204.            (TrackBuffer^[6]<CHAR(DiskNum)) THEN
  205.           IF Motor(Drive,FALSE) THEN END;
  206.           ReqStr := "This is Disk # 00! Insert # 00!";
  207.           Make2Digits(ORD(TrackBuffer^[6]),15);
  208.           Make2Digits(DiskNum,28);
  209.           CASE HDRequest(ADR(ReqStr),3,2,TRUE) OF
  210.           Continue: EXIT; |
  211.           Cancel: RETURN cancel;
  212.           ELSE
  213.           END;
  214.         ELSE
  215.           EXIT;
  216.         END;
  217.       END;
  218.       ActTrack := 0;
  219.       TrackBuffer^ := "BkUp";                         (* Disk ID        *)
  220.       TrackBuffer^[4] := ID1; TrackBuffer^[5] := ID2; (* Backup ID      *)
  221.       TrackBuffer^[6] := CHAR(DiskNum);               (* Disk #         *)
  222.       TrackBuffer^[7] := 0C;                          (* BackUp Version *)
  223.       TrackBufferCnt  := 8; (* 8 Bytes in Buffer *)
  224.       ReqStr := "00"; Make2Digits(DiskNum,0);
  225.       Type(560,45,ReqStr);
  226.       DiskChange := GetDiskChange(Drive);
  227.     ELSE
  228.       INC(ActTrack);
  229.     END;
  230.     ReqStr := "00"; Make2Digits(ActTrack,0);
  231.     Type(560,61,ReqStr);
  232.     RETURN ok;
  233.   END NextTrack;
  234.  
  235. (*------  Write to TrackDisk:  ------*)
  236.  
  237.   PROCEDURE WriteTrack(Buffer: ADDRESS; Size: LONGCARD): Res;
  238.  
  239.   VAR
  240.     err: Byte;
  241.  
  242.   BEGIN
  243.     WHILE Size>=(TrackSize-TrackBufferCnt) DO
  244.       CopyMem(Buffer,ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),
  245.               TrackSize-TrackBufferCnt);
  246.       INC(Buffer,TrackSize-TrackBufferCnt);
  247.       DEC(Size,TrackSize-TrackBufferCnt);
  248.       TrackBufferCnt := 0;
  249.       LOOP
  250.         Type(500,77," writing ");
  251.         err := FormatTrack(Drive,ActTrack,TrackBuffer,1,DiskChange);
  252.         IF err=0 THEN
  253.           Type(500,77,"verifying");
  254.           err := ReadCycSec(Drive,ActTrack,0,0,TrackBuffer,22,DiskChange);
  255.           IF err=0 THEN EXIT END;
  256.         END;
  257.         CASE Error(Drive,err,FALSE) OF
  258.         Retry:
  259.           DiskChange := GetDiskChange(Drive); |
  260.         Continue:
  261.           IF NextTrack()=cancel THEN RETURN cancel END;
  262.           RETURN continue; |
  263.         Cancel:
  264.           RETURN cancel; |
  265.         ELSE
  266.         END;
  267.       END;
  268.       IF NextTrack()=cancel THEN RETURN cancel END;
  269.     END;
  270.     IF Size#0 THEN
  271.       CopyMem(Buffer,ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),Size);
  272.       INC(TrackBufferCnt,Size);
  273.     END;
  274.     RETURN ok;
  275.   END WriteTrack;
  276.  
  277. (*------  Write last Track:  ------*)
  278.  
  279.   PROCEDURE WriteLast(): Res;
  280.  
  281.   VAR err: Byte;
  282.     Ende: EndeType;
  283.  
  284.   BEGIN
  285.     LOOP
  286.       Ende.endeID := EndeID;
  287.       Ende.byte := TrackBufferCnt + 11264 * LONGCARD(ActTrack);
  288.       IF WriteTrack(ADR(Ende),SIZE(Ende))=cancel THEN RETURN cancel END;
  289.       IF (TrackBufferCnt#0) OR (ActTrack#0) THEN
  290.         err := FormatTrack(Drive,ActTrack,TrackBuffer,1,DiskChange);
  291.         IF err=0 THEN EXIT END;
  292.         CASE Error(Drive,err,FALSE) OF
  293.           Continue: RETURN continue; |
  294.           Cancel:   RETURN cancel;   |
  295.         ELSE
  296.         END;
  297.       ELSE
  298.         EXIT;
  299.       END;
  300.     END;
  301.     IF Motor(Drive,FALSE) THEN END;
  302.     RETURN ok;
  303.   END WriteLast;
  304.  
  305. (*------  Write File to Tracks:  ------*)
  306.  
  307.   PROCEDURE WriteFile(File: FileHandlePtr; Size: LONGCARD): Res;
  308.  
  309.   VAR
  310.     err: Byte;
  311.     len: LONGINT;
  312.  
  313.   BEGIN
  314.     Size := ((Size+3) DIV 4) * 4;                        (* add Pad bytes *)
  315.     WHILE Size>=(TrackSize-TrackBufferCnt) DO
  316.       len := Read(File,ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),
  317.                   TrackSize-TrackBufferCnt);
  318.       DEC(Size,TrackSize-TrackBufferCnt);
  319.       TrackBufferCnt := 0;
  320.       LOOP
  321.         Type(500,77," writing ");
  322.         err := FormatTrack(Drive,ActTrack,TrackBuffer,1,DiskChange);
  323.         IF err=0 THEN
  324.           Type(500,77,"verifying");
  325.           err := ReadCycSec(Drive,ActTrack,0,0,TrackBuffer,22,DiskChange);
  326.           IF err=0 THEN EXIT END;
  327.         END;
  328.         CASE Error(Drive,err,FALSE) OF
  329.         Retry:
  330.           DiskChange := GetDiskChange(Drive); |
  331.         Continue:
  332.           IF NextTrack()=cancel THEN RETURN cancel END;
  333.           RETURN continue; |
  334.         Cancel:
  335.           RETURN cancel; |
  336.         ELSE
  337.         END;
  338.       END;
  339.       IF NextTrack()=cancel THEN RETURN cancel END;
  340.     END;
  341.     IF Size#0 THEN
  342.       len := Read(File,ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),Size);
  343.       INC(TrackBufferCnt,Size);
  344.     END;
  345.     RETURN ok;
  346.   END WriteFile;
  347.  
  348. (*------  Rekursiv backup procedure:  ------*)
  349.  
  350.   PROCEDURE DoBackUp(lock: FileLockPtr): Res;
  351.  
  352.   VAR
  353.     FileInfo: FileInfoBlockPtr;
  354.     DosErr: LONGINT;
  355.     res: Res;
  356.     Lock2,old: FileLockPtr;
  357.     l: INTEGER;
  358.     c: CHAR;
  359.     MyMsgPtr: IntuiMessagePtr;
  360.  
  361.   BEGIN
  362.     res := ok;
  363.     TypePath(MyFileInfo.path);
  364.     LOOP
  365.       AllocMem(FileInfo,SIZE(FileInfo^),FALSE);
  366.       IF FileInfo#NIL THEN EXIT END;
  367.       IF HDRequest(ADR("Out of memory"),3,2,TRUE)#Retry THEN EXIT END;
  368.     END;
  369.     IF Examine(lock,FileInfo)#0 THEN
  370.       IF FileInfo^.dirEntryType>0 THEN
  371.         old := CurrentDir(lock);
  372.         WITH FileInfo^ DO
  373.           WITH MyFileInfo DO
  374.             WHILE (ExNext(lock,FileInfo)#0) AND (res#cancel) DO
  375.               IF dirEntryType>0 THEN
  376. (*------  Directory:  ------*)
  377.                 LOOP
  378.                   Lock2 := Lock(ADR(fileName),sharedLock);
  379.                   IF Lock2#NIL THEN EXIT END;
  380.                   ReqStr := "Can't Lock ";
  381.                   Insert(ReqStr,last,fileName);
  382.                   IF HDRequest(ADR(ReqStr),3,2,TRUE)=Cancel THEN
  383.                     res:= cancel;
  384.                     EXIT;
  385.                   END;
  386.                 END;
  387.                 IF Lock2#0 THEN
  388.                   l := Length(path);
  389.                   IF l>253 THEN
  390.                     WHILE HDRequest(ADR("Path tooo looong!!!"),3,2,TRUE)#Cancel DO END;
  391.                     res := cancel;
  392.                   ELSE
  393.                     IF l#0 THEN path[l] := "/"; path[l+1] := 0C END;
  394.                     Insert(path,last,fileName);
  395.                     res := DoBackUp(Lock2);
  396.                     path[l] := 0C;
  397.                     TypePath(path);
  398.                   END;
  399.                   UnLock(Lock2);
  400.                 END;
  401.               ELSE
  402. (*------  File:  ------*)
  403.                 IF NOT(archive  IN protection) OR
  404.                    NOT(selected IN Gadgets[RegardArchivedGadg].flags) THEN
  405.                   TypeName(fileName);
  406.                   byte := TrackBufferCnt + 11264*LONGCARD(ActTrack);
  407.                   prot := protection;
  408.                   Copy(name,fileName,first,Length(fileName));
  409.                   Copy(comm,comment ,first,Length(comment));
  410.                   Size := size;
  411.                   LOOP
  412.                     File := Open(ADR(fileName),oldFile);
  413.                     IF File#NIL THEN EXIT END;
  414.                     Copy(ReqStr,"Can't Open ",first,11);
  415.                     Insert(ReqStr,last,fileName);
  416.                     Insert(ReqStr,last,"!");
  417.                     CASE HDRequest(ADR(ReqStr),3,2,TRUE) OF
  418.                     Cancel: res := cancel; EXIT; |
  419.                     Continue: EXIT; |
  420.                     ELSE
  421.                     END;
  422.                   END;
  423.                   IF File#NIL THEN
  424.                     CASE WriteTrack(ADR(MyFileInfo),SIZE(MyFileType)) OF
  425.                     ok: res := WriteFile(File,size);
  426.                         Close(File);
  427.                         IF (res=ok) AND (selected IN Gadgets[SetArchivedGadg].flags) THEN
  428.                           IF SetProtection(ADR(fileName),protection +
  429.                                LONGSET{archive})=0 THEN END;
  430.                         END; |
  431.                     cancel: Close(File); res := cancel; |
  432.                     ELSE
  433.                       Close(File);
  434.                     END;
  435.                   END;
  436.                 END;   (* IF archived IN protection AND RegardArchived THEN *)
  437.               END;   (* IF direntryType>0 THEN ELSE *)
  438.               MyMsgPtr := GetMsg(Window^.userPort);
  439.               IF MyMsgPtr#NIL THEN
  440.                 IF MyMsgPtr^.class=IDCMPFlagSet{gadgetDown} THEN
  441.                   ReplyMsg(MyMsgPtr);
  442.                   IF HDRequest(ADR("Do you wish to abort BackUp?"),0,1,FALSE)=Cancel THEN
  443.                     res := ok;
  444.                   ELSE
  445.                     res := cancel;
  446.                   END;
  447.                 ELSE
  448.                   ReplyMsg(MyMsgPtr);
  449.                 END;
  450.               END;
  451.             END;   (* WHILE ExNext()#0 DO *)
  452.           END;   (* WITH MyFileInfo DO *)
  453.         END;   (* WITH FileInfo^ DO *)
  454.         old := CurrentDir(old);
  455.       END;   (* IF FileInfo^.dirEntryType>0 THEN *)
  456.     END;   (* IF Examine()=0 THEN *)
  457.     Deallocate(FileInfo);
  458.     RETURN res;
  459.   END DoBackUp;
  460.  
  461. (*------  Start:  ------*)
  462.  
  463. BEGIN
  464.  
  465. (*------  Init:  ------*)
  466.  
  467.   MyFileInfo.gorks := Gorks;
  468.  
  469.   LOOP   (* this loop is just to be able to jump to the end easily *)
  470.     SetAPen(RP,1); SetBPen(RP,0); SetDrMd(RP,jam2);
  471.     LOOP
  472.       err := OpenTrackDisk(Drive,TRUE)#0;
  473.       IF NOT(err) THEN EXIT END;
  474.       IF HDRequest(ADR("Can't open TrackDisk"),3,2,TRUE)=Cancel THEN EXIT END;
  475.     END;
  476.     IF err THEN EXIT END;
  477.     NumTracks := GetNumTracks(Drive) DIV 2;
  478.     DiskNum := 0;                        (* start disk #0                    *)
  479.     ActTrack := NumTracks;
  480.     DateStamp(Datum);                    (* take ticks as ID for this BackUp *)
  481.     WITH Datum^ DO
  482.       ID1 := CHAR(tick - (tick DIV 256) * 256);
  483.       ID2 := CHAR((tick - (tick DIV 65536) * 65536) DIV 256);
  484.     END;
  485.  
  486.     LOOP
  487.       MyLock := Lock(ADR(HDName),sharedLock);
  488.       IF MyLock#NIL THEN EXIT END;
  489.       ReqStr := "Can't Lock ";
  490.       Insert(ReqStr,last,HDName);
  491.       IF HDRequest(ADR(ReqStr),3,2,TRUE)=Cancel THEN EXIT END;
  492.     END;
  493.  
  494. (*------  Start:  ------*)
  495.  
  496.     IF MyLock#NIL THEN
  497.       IF NextTrack()#cancel THEN             (* insert first Disk          *)
  498.         MyFileInfo.path := "";
  499.         IF DoBackUp(MyLock)#cancel THEN      (* Back it up                 *)
  500.           IF WriteLast()=cancel THEN END;    (* Write last track           *)
  501.         END;
  502.       END;
  503.       UnLock(MyLock);
  504.     END;
  505.  
  506. (*------  Done:  ------*)
  507.  
  508.     EXIT;
  509.  
  510.   END;
  511.  
  512.   IF NOT(err) THEN
  513.     IF Motor(Drive,FALSE) THEN END;
  514.     CloseTrackDisk(Drive);
  515.   END;
  516.  
  517.   TypeName("                --------  Done  --------");
  518.  
  519. END BackUp;
  520.  
  521. (*----------------------------  Restore:  ---------------------------------*)
  522.  
  523. PROCEDURE Restore(Drive: CARDINAL);
  524.  
  525. VAR
  526.   DiskID: ARRAY[0..7] OF CHAR;
  527.   ID1,ID2: CHAR;
  528.   res: Res;
  529.   err: BOOLEAN;
  530.   NumTracks: LONGCARD;
  531.   old: FileLockPtr;
  532.   MyMsgPtr: IntuiMessagePtr;
  533.  
  534. (*------  Move to next Track:  ------*)
  535.  
  536.   PROCEDURE NextReadTrack(): Res;
  537.   (* Res can be ok or cancel *)
  538.  
  539.   VAR
  540.     err: Byte;
  541.  
  542.   BEGIN
  543.     Type(500,77," reading ");
  544.     MyMsgPtr := GetMsg(Window^.userPort);
  545.     IF MyMsgPtr#NIL THEN
  546.       IF MyMsgPtr^.class=IDCMPFlagSet{gadgetDown} THEN
  547.         ReplyMsg(MyMsgPtr);
  548.         IF HDRequest(ADR("Do you wish to abort BackUp?"),0,1,FALSE)=Retry THEN
  549.           RETURN cancel;
  550.         END;
  551.       ELSE
  552.         ReplyMsg(MyMsgPtr);
  553.       END;
  554.     END;
  555.     IF ActTrack>=(NumTracks-1) THEN
  556.       ActTrack := 0;
  557.       INC(DiskNum);
  558.       IF Motor(Drive,FALSE) THEN END;
  559.       ReqStr := "Insert Disk Number 00 !";
  560.       Make2Digits(DiskNum,19);
  561.       IF HDRequest(ADR(ReqStr),0,1,FALSE)=Cancel THEN RETURN cancel END;
  562.       LOOP
  563.         WHILE NOT(ChangeState(Drive)) DO
  564.           IF HDRequest(ADR("No Disk in Drive !"),0,1,TRUE)=Cancel THEN
  565.             RETURN cancel;
  566.           END;
  567.         END;
  568.         err := ReadBlock(Drive,0,TrackBuffer,22,GetDiskChange(Drive));
  569.         IF err#0 THEN
  570.           CASE Error(Drive,err,TRUE) OF
  571.           Cancel: RETURN cancel; |
  572.           Continue: RETURN continue; |
  573.           ELSE
  574.           END;
  575.         ELSIF (TrackBuffer^[0]#"B") OR (TrackBuffer^[1]#"k") OR
  576.               (TrackBuffer^[2]#"U") OR (TrackBuffer^[3]#"p") THEN
  577.           CASE HDRequest(ADR("That's no Backup-Disk"),3,2,TRUE) OF
  578.           Cancel: RETURN cancel; |
  579.           Continue: RETURN continue; |
  580.           ELSE
  581.           END;
  582.         ELSIF TrackBuffer^[6]#CHAR(DiskNum) THEN
  583.           IF Motor(Drive,FALSE) THEN END;
  584.           ReqStr := "This is Disk # 00! Insert # 00!";
  585.           Make2Digits(ORD(TrackBuffer^[6]),15);
  586.           Make2Digits(DiskNum,28);
  587.           CASE HDRequest(ADR(ReqStr),3,2,TRUE) OF
  588.           Continue: RETURN continue; |
  589.           Cancel: RETURN cancel;
  590.           ELSE
  591.           END;
  592.         ELSIF TrackBuffer^[7]#0C THEN
  593.           IF Motor(Drive,FALSE) THEN END;
  594.           ReqStr := "Wrong Backup Version!";
  595.           CASE HDRequest(ADR(ReqStr),3,2,TRUE) OF
  596.           Continue: RETURN continue; |
  597.           Cancel: RETURN cancel;
  598.           ELSE
  599.           END;
  600.         ELSIF DiskNum=1 THEN
  601.           ID1 := TrackBuffer^[4]; ID2 := TrackBuffer^[5]; EXIT;
  602.         ELSIF (TrackBuffer^[4]#ID1) OR (TrackBuffer^[5]#ID2) THEN
  603.           IF Motor(Drive,FALSE) THEN END;
  604.           ReqStr := "Wrong BackUp-Identifier!";
  605.           CASE HDRequest(ADR(ReqStr),3,2,TRUE) OF
  606.           Continue: RETURN continue; |
  607.           Cancel: RETURN cancel;
  608.           ELSE
  609.           END;
  610.         ELSE
  611.           EXIT;
  612.         END;
  613.       END;   (* LOOP *)
  614.       ReqStr := "00"; Make2Digits(DiskNum,0);
  615.       Type(560,45,ReqStr);
  616.       DiskChange := GetDiskChange(Drive);
  617.       TrackBufferCnt := 8;
  618.     ELSE
  619.       INC(ActTrack);
  620.       err := ReadBlock(Drive,22*ActTrack,TrackBuffer,22,DiskChange);
  621.       IF err#0 THEN
  622.         CASE Error(Drive,err,FALSE) OF
  623.         Cancel: RETURN cancel; |
  624.         Continue: RETURN continue; |
  625.         ELSE
  626.         END;
  627.       END;
  628.       TrackBufferCnt := 0;
  629.     END;
  630.     ReqStr := "00"; Make2Digits(ActTrack,0);
  631.     Type(560,61,ReqStr);
  632.     RETURN ok;
  633.   END NextReadTrack;
  634.  
  635. (*------  Read Bytes from TrackDisk:  ------*)
  636.  
  637.   PROCEDURE ReadTrack(Buffer: ADDRESS; Size: LONGCARD): Res;
  638.  
  639.   BEGIN
  640.     WHILE Size>0 DO
  641.       IF Size>=TrackSize-TrackBufferCnt THEN
  642.         CopyMem(ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),Buffer,
  643.                 TrackSize-TrackBufferCnt);
  644.         DEC(Size,TrackSize-TrackBufferCnt);
  645.         INC(Buffer,TrackSize-TrackBufferCnt);
  646.         CASE NextReadTrack() OF
  647.         cancel: RETURN cancel; |
  648.         continue: RETURN continue; |
  649.         ELSE
  650.         END;
  651.       ELSE
  652.         CopyMem(ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),Buffer,
  653.                 Size);
  654.         INC(TrackBufferCnt,Size);
  655.         Size := 0;
  656.       END;
  657.     END;
  658.     RETURN ok;
  659.   END ReadTrack;
  660.  
  661. (*------  Make Directory:  ------*)
  662.  
  663.   PROCEDURE GetDir(VAR name: ARRAY OF CHAR; VAR lock: FileLockPtr): BOOLEAN;
  664.   (* Returns TRUE if error occured *)
  665.  
  666.   VAR
  667.     lck: FileLockPtr;
  668.     len: INTEGER;
  669.     c: CHAR;
  670.  
  671.   BEGIN
  672.     lock := Lock(ADR(name),sharedLock);
  673.     IF lock#NIL THEN
  674.       RETURN FALSE;
  675.     ELSE
  676.       lock := CreateDir(ADR(name));
  677.       IF lock#NIL THEN
  678.         RETURN FALSE;
  679.       ELSE
  680.         len := Length(name) - 1;
  681.         WHILE (len>0) AND (name[len]#"/") DO DEC(len) END;
  682.         IF len=0 THEN RETURN TRUE END;
  683.         c := name[len];
  684.         name[len] := 0C;
  685.         IF GetDir(name,lck) THEN
  686.           name[len] := c;
  687.           RETURN TRUE; (* Error *)
  688.         ELSE
  689.           UnLock(lck);
  690.           name[len] := c;
  691.           lock := Lock(ADR(name),sharedLock);
  692.           IF lock#NIL THEN
  693.             RETURN FALSE;
  694.           ELSE
  695.             lock := CreateDir(ADR(name));
  696.             RETURN lock=NIL;
  697.           END;
  698.         END;
  699.       END;
  700.     END;
  701.   END GetDir;
  702.  
  703. (*------  Read File from TrackDisk:  ------*)
  704.  
  705.   PROCEDURE ReadFile(seek: BOOLEAN): Res;
  706.  
  707.   VAR
  708.     err: Byte;
  709.     adr: LONGCARD;
  710.     len: LONGINT;
  711.     lock,old: FileLockPtr;
  712.     file: FileHandlePtr;
  713.     res: Res;
  714.  
  715.   BEGIN
  716.     res := ok;
  717.     adr := TrackBufferCnt + LONGCARD(ActTrack) * 11264;
  718.     IF seek THEN
  719.       CASE ReadTrack(ADR(MyFileInfo.prot),SIZE(MyFileInfo)-12) OF
  720.       cancel: RETURN cancel; |
  721.       continue: RETURN continue; |
  722.       ELSE
  723.       END;
  724.       MyFileInfo.gorks := Gorks;
  725.       MyFileInfo.byte := adr;
  726.     ELSE
  727.       CASE ReadTrack(ADR(MyFileInfo),SIZE(MyFileInfo)) OF
  728.       cancel: RETURN cancel; |
  729.       continue: RETURN continue; |
  730.       ELSE
  731.       END;
  732.     END;
  733.     WITH MyFileInfo DO
  734.       IF (gorks[0]="G") AND (gorks[1]="o") AND (gorks[2]="r") AND
  735.          (gorks[3]="k") AND (gorks[4]="s") AND (gorks[5]="!") AND
  736.          (gorks[6]="?") AND (gorks[7]="!") AND (byte=adr) THEN
  737.         TypeName(name);
  738.         IF Length(path)=0 THEN
  739.           lock := NIL;
  740.         ELSE
  741.           TypePath(path);
  742.           LOOP
  743.             IF GetDir(path,lock) THEN
  744.               CASE HDRequest(ADR("Can't create Directory!"),3,2,TRUE) OF
  745.               Cancel: res := cancel; EXIT; |
  746.               Continue: res := continue; EXIT; |
  747.               ELSE
  748.               END;
  749.             ELSE
  750.               EXIT;
  751.             END;
  752.           END;
  753.         END;
  754.         IF res=ok THEN
  755.           IF lock#NIL THEN old := CurrentDir(lock) END;
  756.           LOOP
  757.             file := Open(ADR(name),newFile);
  758.             IF file#NIL THEN EXIT END;
  759.             ReqStr := "Can't open ";
  760.             Insert(ReqStr,last,name);
  761.             CASE HDRequest(ADR(ReqStr),3,2,TRUE) OF
  762.             Cancel: res := cancel; EXIT; |
  763.             Continue: res := continue; EXIT; |
  764.             ELSE
  765.             END;
  766.           END;
  767.           IF file#NIL THEN
  768.             WHILE (Size#0) AND (res=ok) DO
  769.               IF Size>=TrackSize-TrackBufferCnt THEN
  770.                 len := Write(file,ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),
  771.                              TrackSize-TrackBufferCnt);
  772.                 DEC(Size,TrackSize-TrackBufferCnt);
  773.                 CASE NextReadTrack() OF
  774.                 cancel: res := cancel; |
  775.                 continue: res := continue; |
  776.                 ELSE
  777.                 END;
  778.               ELSE
  779.                 len := Write(file,ADDRESS(LONGCARD(TrackBuffer)+TrackBufferCnt),
  780.                              Size);
  781.                 INC(TrackBufferCnt,Size);
  782.                 Size := 0;
  783.               END;
  784.             END;
  785.             TrackBufferCnt := ((TrackBufferCnt + 3) DIV 4) * 4;
  786.             IF TrackBufferCnt>TrackSize THEN
  787.               CASE NextReadTrack() OF
  788.               cancel: res := cancel; |
  789.               continue: res := continue; |
  790.               ELSE
  791.               END;
  792.             END;
  793.             Close(file);
  794.             IF res#ok THEN
  795.               IF DeleteFile(ADR(name))=0 THEN END;
  796.             ELSE
  797.               IF SetProtection(ADR(name),prot)=0 THEN END;
  798.               IF SetComment(ADR(name),ADR(comm))=0 THEN END;
  799.             END;
  800.           END;
  801.           IF lock#NIL THEN
  802.             old := CurrentDir(old);
  803.             UnLock(lock);
  804.           END;
  805.           RETURN res;
  806.         END;
  807.       ELSIF (gorks[0]="B") AND (gorks[1]="k") AND
  808.             (gorks[2]="U") AND (gorks[3]="p") AND
  809.             (gorks[4]="E") AND (gorks[5]="n") AND
  810.             (gorks[6]="d") AND (gorks[7]="e") AND
  811.             (byte=adr) THEN
  812.         RETURN cancel;
  813.       ELSE
  814.         IF HDRequest(ADR("Wrong data found! Continue?"),3,2,FALSE)=Cancel THEN
  815.           RETURN cancel;
  816.         ELSE
  817.           RETURN continue;
  818.         END;
  819.       END;
  820.     END;
  821.     RETURN res;
  822.   END ReadFile;
  823.  
  824. (*------  Seek:  ------*)
  825.  
  826.   PROCEDURE Seek(): Res;
  827.  
  828.   VAR ID: RECORD
  829.            go: ARRAY[0..7] OF CHAR;
  830.            by: LONGCARD;
  831.           END;
  832.       adr: LONGCARD;
  833.       err: Byte;
  834.  
  835.   BEGIN
  836.     TypeName("              ------  Searching  ------");
  837.     LOOP
  838.       DiskChange := GetDiskChange(Drive);
  839.       err := ReadBlock(Drive,0,TrackBuffer,22,DiskChange);
  840.       IF err#0 THEN
  841.         CASE Error(Drive,err,TRUE) OF
  842.         Cancel: RETURN cancel; |
  843.         Continue: EXIT; |
  844.         ELSE END;
  845.       ELSE
  846.         ID1 := TrackBuffer^[4];
  847.         ID2 := TrackBuffer^[5];
  848.         DiskNum := ORD(TrackBuffer^[6]);
  849.         ReqStr := "00"; Make2Digits(DiskNum,0);
  850.         Type(560,45,ReqStr);
  851.         EXIT;
  852.       END;
  853.     END;
  854.     IF TrackBufferCnt>TrackSize THEN TrackBufferCnt := TrackSize END;
  855.     IF ActTrack>NumTracks THEN ActTrack := NumTracks END;
  856.     adr := TrackBufferCnt + LONGCARD(ActTrack) * 11264;
  857.     LOOP
  858.       IF TrackBufferCnt>=TrackSize THEN
  859.         LOOP
  860.           CASE NextReadTrack() OF
  861.           cancel: RETURN cancel; |
  862.           ok: EXIT; |
  863.           ELSE END;
  864.         END;
  865.         IF ActTrack=0 THEN
  866.           ID1 := TrackBuffer^[4];
  867.           ID2 := TrackBuffer^[5];
  868.           DiskNum := ORD(TrackBuffer^[6]);
  869.           ReqStr := "00"; Make2Digits(DiskNum,0);
  870.           Type(560,45,ReqStr);
  871.         END;
  872.         adr := TrackBufferCnt + LONGCARD(ActTrack) * 11264;
  873.       END;
  874.       IF (TrackBuffer^[TrackBufferCnt]="G") THEN
  875.         IF (TrackBuffer^[TrackBufferCnt+1]="o") AND
  876.            (TrackBuffer^[TrackBufferCnt+2]="r") AND
  877.            (TrackBuffer^[TrackBufferCnt+3]="k") THEN
  878.           CASE ReadTrack(ADR(ID),12) OF
  879.           cancel: RETURN cancel; |
  880.           ELSE
  881.             IF (ID.go[4]="s") AND (ID.go[5]="!") AND
  882.                (ID.go[6]="?") AND (ID.go[7]="!") AND
  883.                (ID.by = adr) THEN
  884.               RETURN ReadFile(TRUE);
  885.             END;
  886.           END;
  887.         END;
  888.       END;
  889.       INC(TrackBufferCnt,4);
  890.       INC(adr,4);
  891.     END;
  892.   END Seek;
  893.  
  894. BEGIN
  895.  
  896. (*------  Init:  ------*)
  897.  
  898.   LOOP   (* this loop is just to be able to jump to the end easily *)
  899.     SetAPen(RP,1); SetBPen(RP,0); SetDrMd(RP,jam2);
  900.     LOOP
  901.       err := OpenTrackDisk(Drive,TRUE)#0;
  902.       IF NOT(err) THEN EXIT END;
  903.       IF HDRequest(ADR("Can't open TrackDisk"),3,2,TRUE)=Cancel THEN EXIT END;
  904.     END;
  905.     IF err THEN EXIT END;
  906.     NumTracks := GetNumTracks(Drive) DIV 2;
  907.     DiskNum := 0;                      (* start disk #0                    *)
  908.     ActTrack := NumTracks;
  909.  
  910.     LOOP
  911.       MyLock := Lock(ADR(HDName),sharedLock);
  912.       IF MyLock#NIL THEN EXIT END;
  913.       ReqStr := "Can't Lock ";
  914.       Insert(ReqStr,last,HDName);
  915.       IF HDRequest(ADR(ReqStr),3,2,TRUE)=Cancel THEN EXIT END;
  916.     END;
  917.  
  918. (*------  Start:  ------*)
  919.  
  920.     IF MyLock#NIL THEN
  921.       old := CurrentDir(MyLock);
  922.       res := NextReadTrack();              (* insert first Disk          *)
  923.       IF res=continue THEN res := Seek() END;
  924.       IF res=ok THEN
  925.         LOOP
  926.           CASE ReadFile(FALSE) OF
  927.           continue: IF Seek()=cancel THEN EXIT END; |
  928.           cancel: EXIT; |
  929.           ELSE
  930.           END;
  931.         END;
  932.       END;
  933.       old := CurrentDir(old);
  934.       UnLock(MyLock);
  935.     END;
  936.  
  937. (*------  Done:  ------*)
  938.  
  939.     EXIT;
  940.  
  941.   END;
  942.  
  943.   IF NOT(err) THEN
  944.     IF Motor(Drive,FALSE) THEN END;
  945.     CloseTrackDisk(Drive);
  946.   END;
  947.  
  948.   TypeName("                --------  Done  --------");
  949.  
  950. END Restore;
  951.  
  952. (*------  Initialization:  ------*)
  953.  
  954. BEGIN
  955.   AllocMem(TrackBuffer,SIZE(TrackBuffer^),TRUE);
  956.   AllocMem(Datum,SIZE(Datum^),FALSE);
  957.   Assert((TrackBuffer#NIL) AND (Datum#NIL),ADR("Not enough memory!!!"));
  958. END BackUp.
  959.