home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / remote / rembase.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-12  |  38.4 KB  |  1,255 lines
  1. {$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  2. {$M 16384,0,655360}
  3. (*========================================================*)
  4. (*                    REMBASE.PAS v. 1.1                  *)
  5. (*                Slave-Programm für REMOTE               *)
  6. (*          (C) 1993 Ralf Hensmann & DMV-Verlag           *)
  7. (*  Compiler: Turbo/Borland Pascal 7.0, Real Mode Target  *)
  8. (* ====================================================== *)
  9. {$DEFINE LapLink}    (* wird auch in den Units benötigt!  *)
  10.                      (* Unbedingt zusätzlich im Compiler- *)
  11.                      (* menü [O]ptions | [C]ompiler       *)
  12.                      (* | [C]ond. defines setzen !!!      *)
  13. {$DEFINE NoKeyBreak} (* kein Tastatur-Abbruch während     *)
  14.                      (* das Remotesystem aktiv ist        *)
  15. PROGRAM RemoteSlave;
  16. USES
  17.   Dos, Crt, Graph, Crc, ParData, ParCRC, Strings, Rem_Type;
  18.  
  19. CONST
  20.   File_Max              = 17;
  21.   DoProtocol            = FALSE;
  22.   (* Falls protokolliert werden soll, die Grafik-         *)
  23.   (* initialisierung auskommentieren!                     *)
  24.   NoContact: STRING[23] = 'Kontakt abgebrochen ...';
  25.   ExitMsg  :
  26. {$IFNDEF NoKeyBreak}
  27.    STRING[58] = ' »Taste« zum Abbruch (dann sofort' +
  28.                 ' Remotelaufwerk unloaden)';
  29. {$ELSE}
  30.    STRING[41] = ' Abbruch nur per Unload vom Master-System';
  31. {$ENDIF}
  32.  
  33. TYPE
  34.   tBufArray = ARRAY [0..65534] OF BYTE;
  35.  
  36. VAR
  37.   st, lw,                 (* Hilfsstrings für Eingaben    *)
  38.   Path,                   (* Pfad des Befehls             *)
  39.   FileName,               (* Dateiname                    *)
  40.   CurDir     : STRING;    (* aktuelles Verzeichnis        *)
  41.   nr, Error,              (* für Val()                    *)
  42.   i, j       : WORD;      (* Laufvariablen                *)
  43.   Head       : fx_Command_head; (* Kommandobefehl         *)
  44.   NoDrive    : BOOLEAN;   (* Laufwerk nicht echt ...      *)
  45.   Buf        : ARRAY [0..255] OF BYTE;
  46.                           (* allgemeiner Puffer           *)
  47.   NetPath    : ASCIIZ;    (* Pfad als ASCIIZ              *)
  48.   FileNr     : BYTE;      (* Hilfsvariable aktuelle Datei *)
  49.   f          : ARRAY [0..File_Max] OF File;
  50.                           (* Puffer für offene Datei      *)
  51.   Free       : ARRAY [0..File_Max] OF BOOLEAN;
  52.                           (* Welche sind frei ?           *)
  53.   f_PSP      : ARRAY [0..File_Max] OF WORD;
  54.                           (* PSP des offenen Files        *)
  55.   t          : SearchRec; (* für FindFirst/Next           *)
  56.   DataBuf    : ^tBufArray;(* Datenübertragung             *)
  57.   DataBuf2   : ^WORD;     (* Sicherheit wegen 64 kByte    *)
  58.   fn2        : ASCIIZ;    (* für Rename                   *)
  59.   LwTbl      : ARRAY [1..27] OF CHAR;
  60.                           (* Tabelle der mögl. Laufwerke  *)
  61.   ch         : CHAR;      (* für Tastendruck abwarten ... *)
  62.   grResult,               (* Ergebnis der Grafik-Initial. *)
  63.   GraphDriver,            (* verwendeter Grafiktreiber    *)
  64.   GraphMode  ,            (* verwendeter Grafikmodus      *)
  65.   XOld, YOld : INTEGER;   (* alte X/Y-Koord. des Logo     *)
  66.   OldExitProc: POINTER;   (* Zeiger auf die Exit-Prozedur *)
  67.   MaxX, MaxY : INTEGER;   (* Grafik MaxX/MaxY             *)
  68.   p1, p2     : POINTER;   (* Zeiger auf die Bitmaps       *)
  69.   PicSize,                (* Größe der »toolbox«-Bitmap   *)
  70.   BarColor,               (* Farbe des »toolbox«-Balken   *)
  71.   FrameColor,             (* Farbe des Bitmap-Rahmen      *)
  72.   BackColor,              (* Hintergrundfarbe d. Bitmap   *)
  73.   ShadeColor,             (* Schattenfarbe d. Schriftzugs *)
  74.   BarStyle,               (* Style des Balken i.d. Bitmap *)
  75.   BkStyle,                (* Hintergrund-Style            *)
  76.   txColor    : WORD;      (* Farbe des Schriftzugs        *)
  77.  
  78. (* die notwendigen BGI-Treiber einbinden:                 *)
  79. PROCEDURE HercDriverProc;    EXTERNAL;       {$L HERC.OBJ  }
  80. PROCEDURE EGAVGADriverProc;  EXTERNAL;       {$L EGAVGA.OBJ}
  81. PROCEDURE CGADriverProc;     EXTERNAL;       {$L CGA.OBJ   }
  82. PROCEDURE ATT400DriverProc;  EXTERNAL;       {$L ATT.OBJ   }
  83. PROCEDURE PC3270DriverProc;  EXTERNAL;       {$L PC3270.OBJ}
  84.  
  85. (* die verwendeten Schriften einbinden:                   *)
  86. PROCEDURE SmallFontProc;     EXTERNAL;       {$L LITT.OBJ  }
  87. PROCEDURE TriplexFontProc;   EXTERNAL;       {$L TRIP.OBJ  }
  88.  
  89. PROCEDURE DisplayLogo;
  90. (* DisplayLogo löscht das alte Display und zeigt das neue *)
  91. (* Logo auf einer Random-Bildschirmposition an            *)
  92. VAR
  93.   x, y : WORD;
  94.   p    : ShortInt;
  95. BEGIN
  96.   Randomize;                  (* Zufallszähler initialis. *)
  97.   x := Random(MaxX - 191);    (* x-Position und           *)
  98.   y := Random(MaxY - 100);    (* y-Position = Zufallswert *)
  99.   IF x = 0 THEN x := 190;     (* ... aber > 0             *)
  100.   IF y = 0 THEN y :=  60;
  101.   PutImage(XOld, YOld, p2^, CopyPut);      (* Löschen alt *)
  102.   PutImage(x, y, p1^, CopyPut);            (* Setzen neu  *)
  103.   IF GraphDriver IN [EGA, EGA64, VGA] THEN BEGIN
  104.     Randomize;
  105.     p := Random(64);                  (* Zufallspalette   *)
  106.     IF p MOD 8 = 0 THEN p := 63;      (* Rahmenfarbe per  *)
  107.     SetPalette(FrameColor, p);        (* Palette steuern  *)
  108.   END;
  109.   XOld := x; YOld := y;               (* Position merken  *)
  110. END;
  111.  
  112. PROCEDURE BuildLogo;
  113. (* Aufbau der Grafik. Zeichnen und Abspeichern des Logo   *)
  114. CONST
  115.   txName: STRING[ 7] = 'toolbox';
  116.   STitle: STRING[33] = 'Die Programmierer-Fachzeitschrift';
  117. {$IFDEF SaveBMP}
  118. VAR
  119.   f     : File;
  120. {$ENDIF}
  121. BEGIN
  122.   XOld := 1;         (* Voreinstellungen für alte Werte   *)
  123.   YOld := 1;
  124.   MaxX := GetMaxX;   (* grafikkartenunabhängige Auflösung *)
  125.   MaxY := GetMaxY;   (* in X- und Y-Richtung              *)
  126.  
  127.   CASE GraphDriver OF
  128.     CGA, MCGA, ATT400:       (* zwei-Farben / Colorkarten *)
  129.     BEGIN
  130.       FrameColor := White;            (* Rahmenfarbe      *)
  131.       BarColor   := Black;            (* Balkenfarbe      *)
  132.       BackColor  := Black;            (* Logo-Hintergrund *)
  133.       BarStyle   := CloseDotFill;     (* Balken-Muster    *)
  134.       txColor    := White;            (* Textfarbe        *)
  135.       ShadeColor := Black;            (* Schattenfarbe    *)
  136.       BkStyle    := SolidFill;        (* Hgr.-Füllmuster  *)
  137.     END;
  138.     EGAMono, HercMono, PC3270: (* zwei Farben / Monochrom *)
  139.     BEGIN
  140.       FrameColor := Blue;             (* Rahmenfarbe      *)
  141.       BarColor   := LightGray;        (* Balkenfarbe      *)
  142.       BackColor  := Black;            (* Logo-Hintergrund *)
  143.       BarStyle   := CloseDotFill;     (* Balken-Muster    *)
  144.       txColor    := White;            (* Textfarbe        *)
  145.       ShadeColor := Black;            (* Schattenfarbe    *)
  146.       BkStyle    := SolidFill;        (* Hgr.-Füllmuster  *)
  147.     END
  148.   ELSE (* EGA, EGA64, VGA *)          (* 16 Farben        *)
  149.     SetPalette(Green, 127);           (* grün <<-->> weiß *)
  150.     FrameColor   := LightBlue;        (* Rahmenfarbe      *)
  151.     SetPalette(FrameColor, 63);       (* hellblau -> weiß *)
  152.     BarColor     := LightRed;         (* Balkenfarbe      *)
  153.     BackColor    := Blue;             (* Logo-Hintergrund *)
  154.     BarStyle     := SolidFill;        (* Balken-Muster    *)
  155.     ShadeColor   := Black;            (* Schattenfarbe    *)
  156.     txColor      := White;            (* Schriftfarbe     *)
  157.     BkStyle      := SolidFill;        (* Hgr.-Füllmuster  *)
  158.   END;
  159.  
  160.   SetBkColor(Black); (* BS-Hintergrundfarbe schwarz       *)
  161.   ClearDevice;       (* Bildschirm löschen                *)
  162.  
  163.   SetLineStyle(SolidLn, $3C, ThickWidth);
  164.   SetFillStyle(BkStyle, BackColor);
  165.   Bar(101, 91, 289, 149);        (* Logo-Hintergrund      *)
  166.  
  167.   SetColor(FrameColor);          (* Rahmenfarbe setzen    *)
  168.   Rectangle(102, 92, 288, 148);  (* Rahmen um Bild ziehen *)
  169.  
  170.   SetFillStyle(BarStyle, BarColor); (* Balken-Design      *)
  171.   Bar(103, 115, 287, 131);       (* Logo-Balken zeichnen  *)
  172.  
  173.   SetTextStyle(TriplexFont, HorizDir, 5);
  174.   SetColor(ShadeColor);          (* Schattenfarbe         *)
  175.   OutTextXY(120,  90, txName);   (* Schriftzug 'toolbox'  *)
  176.   OutTextXY(121,  90, txName);   (* Schatten  ...         *)
  177.   OutTextXY(120,  91, txName);   (* vierfach dick         *)
  178.   OutTextXY(121,  91, txName);
  179.  
  180.   SetColor(txColor);
  181.   OutTextXY(116,  92, txName);   (* Vordergrundschrift    *)
  182.   OutTextXY(116,  91, txName);   (* ... vierfach dick     *)
  183.   OutTextXY(117,  92, txName);
  184.   OutTextXY(117,  91, txName);
  185.  
  186.   SetTextStyle(SmallFont, HorizDir, 2);   (* Kleinschrift *)
  187.   SetLineStyle(SolidLn, $3C, NormWidth);  (* Linentyp     *)
  188.   OutTextXY(136, 136, STitle);            (* Unterzeile   *)
  189.   Line(136, 145, 260, 145);         (* ... unterstreichen *)
  190.  
  191.   PicSize := ImageSize(100, 90, 290, 150);(* Bitmapgröße  *)
  192.   GetMem(p1, PicSize);              (* Speicher anfordern *)
  193.   GetImage(100, 90, 290, 150, p1^);      (* 1.BMP sichern *)
  194.   SetFillStyle(SolidFill, GetBkColor);   (* Bild ...      *)
  195.   Bar(100, 90, 290, 150);                (* schwärzen ... *)
  196.   GetMem(p2, PicSize);                   (* und 2. Bitmap *)
  197.   GetImage(100, 90, 290, 150, p2^);      (* abspeichern   *)
  198. {$IFDEF SaveBMP}
  199.   Assign(f, 'TXLOGO.PIC');               (* die beiden    *)
  200.   Rewrite(f, 1);                         (* Bilder für    *)
  201.   BlockWrite(f, p1^, PicSize);           (* Wiederverwen- *)
  202.   Close(f);                              (* dung in Da-   *)
  203.   Assign(f, 'EMPTY.PIC');                (* teien spei-   *)
  204.   Rewrite(f, 1);                         (* chern         *)
  205.   BlockWrite(f, p2^, PicSize);
  206.   Close(f);
  207. {$ENDIF}
  208.  
  209.   SetTextStyle(SmallFont, HorizDir, 4);  (* Infotext ...  *)
  210.   SetTextJustify(CenterText, CenterText);(* formatieren...*)
  211.   SetColor(txColor);                     (*... und zeigen *)
  212.   OutTextXY(GetMaxX DIV 2, GetMaxY - 10, ExitMsg);
  213.  
  214.   DisplayLogo;                           (* Logo anzeigen *)
  215. END;
  216.  
  217. FUNCTION HexW(w : WORD) : STRING;
  218. CONST
  219.   h : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  220. BEGIN
  221.   HexW[0] := #4;
  222.   HexW[1] := h[Hi(w) SHR 4];
  223.   HexW[2] := h[Hi(w) AND $F];
  224.   HexW[3] := h[Lo(w) SHR 4];
  225.   HexW[4] := h[Lo(w) AND $F];
  226. END;
  227.  
  228. TYPE
  229.   tOut_String = STRING[16];
  230. CONST
  231.    Cmd_String: ARRAY [_RemDir.._ExtendOpen] OF tOut_String =
  232.          ('01h RemDir     :', '03h MakeDir    :',
  233.           '05h ChangeDir  :', '06h CloseFile  :',
  234.           '07h CommitFile :', '08h ReadFile   :',
  235.           '09h WriteFile  :', '0Ch GetSpace   :',
  236.           '0Eh SetAttr    :', '0Fh GetAttr    :',
  237.           '11h Rename     :', '13h Delete     :',
  238.           '16h Open       :', '17h Create     :',
  239.           '1Bh FindFirst  :', '1Ch FindNext   :',
  240.           '21h SeekEnd    :', '22h Close all  :',
  241.           '2Eh ExtendOpen :');
  242.  
  243. PROCEDURE MyExitProc;
  244. (* Exitprozedur, die bei »Halt()« in den Textmodus (falls *)
  245. (* notwendig) schaltet und die Meldung ausgibt. Sie wech- *)
  246. (* selt außerdem ins Ursprungsverzeichnis zurück.         *)
  247. BEGIN
  248.   IF grResult = grOk THEN CloseGraph;
  249.   ClrScr;
  250.   WriteLn(NoContact);
  251.   ChDir(CurDir);
  252.   ExitProc := OldExitProc;          (* weiter hangeln ... *)
  253. END;
  254.  
  255. PROCEDURE ProtocolCommand;
  256. (* ProtocolCommand dient zur Ausgabe eines Protokolls für *)
  257. (* Debuggingzwecke. Es gibt die Kommandonummer, den       *)
  258. (* Befehl und den Dateinamen aus.                         *)
  259. VAR
  260.   Buf : ASCIIZ;
  261. BEGIN
  262.   Write(Cmd_String[Head.Command]);
  263.   Write(' ', HexW(Head.Current_PSP), ' ');
  264.   IF ((Head.Command >= _Close) AND (Head.Command <= _Write))
  265.   OR (Head.Command=_SeekEnd) THEN
  266.     WriteLn(StrLCopy(Buf, Head.SFT.FCB_fn, 11), ' ',
  267.                      HexW(Head.Param1), 'h')
  268.   ELSE
  269.     IF Head.Command = _FindNext THEN
  270.       WriteLn(Head.SDB.Srch_Attr, ' ',
  271.               StrLCopy(Buf, Head.SDB.Srch_Tmpl, 11))
  272.     ELSE
  273.       WriteLn(Head.fn1, ' ', HexW(Head.Param0), 'h');
  274. END;
  275.  
  276. FUNCTION ProcessFN1 : BOOLEAN;
  277. (* ProcessFN1 trennt den Pfad in zwei Teile: den File-    *)
  278. (* namen und das Verzeichnis. Wenn das Verzeichnis nicht  *)
  279. (* vorhanden ist, weil der Laufwerksname fehlt, setzt     *)
  280. (* ProcessFN1 die Variable nodrive. Die Prozeduren müssen *)
  281. (* dann entsprechend reagieren.                           *)
  282. VAR
  283.   Len : BYTE;
  284. BEGIN
  285.   Len := StrLen(Head.fn1);        (* Dateinamen abtrennen *)
  286.   REPEAT
  287.     Dec(Len)
  288.   UNTIL (Len < id_max) OR (Head.fn1[Len] = '\');
  289.   (* kein '\' gefunden ... --> unglaublicher Fehler!      *)
  290.   IF (Head.fn1[Len] <> '\') THEN BEGIN
  291.     NoDrive    := TRUE;
  292.     ProcessFN1 := FALSE;
  293.     Exit;
  294.   END;
  295.   ProcessFN1 := TRUE;
  296.   (* Dateinamen abspeichern *)
  297.   FileName := StrPas(@Head.fn1[Len + 1]);
  298.   IF (Len < id_max) THEN BEGIN
  299.     (* kein Laufwerk ausgewählt *)
  300.     NoDrive := TRUE;
  301.     IF FileName[1] = '?' THEN Path := ''
  302.     ELSE BEGIN
  303.       Path := FileName[1] + ':\';
  304.       FileName := '';
  305.     END;
  306.   END ELSE BEGIN
  307.     NoDrive           := FALSE;
  308.     Head.fn1[Len + 1] := #0;
  309.     Path              := StrPas(@Head.fn1[id_max - 1]);
  310.     Path[1]           := Path[2];
  311.     Path[2]           := ':';
  312.   END;
  313. END;
  314.  
  315. FUNCTION ProcessFN2 : STRING;
  316. (* ProcessFN2 macht aus dem Pfad den korrekten DOS-Pfad...*)
  317. VAR
  318.   Len : BYTE;
  319. BEGIN
  320.   Len := StrLen(fn2);             (* Dateinamen ermitteln *)
  321.   REPEAT
  322.     Dec(Len)
  323.   UNTIL (Len < id_max) OR (fn2[Len] = '\');
  324.   (* kein '\' gefunden ... --> unglaublicher Fehler!      *)
  325.   IF (fn2[Len] <> '\') THEN BEGIN
  326.     NoDrive := TRUE;
  327.     Exit;
  328.   END;
  329.   IF (Len < id_max) THEN BEGIN (* kein Laufwerk ausgewählt*)
  330.     NoDrive    := TRUE;
  331.     ProcessFN2 := '';
  332.   END ELSE BEGIN
  333.     ProcessFN2    := StrPas(@fn2[id_max - 1]);
  334.     ProcessFN2[1] := fn2[id_max];
  335.     ProcessFN2[2] := ':';
  336.   END;
  337. END;
  338.  
  339. PROCEDURE NameToFCB(VAR st : STRING; VAR FCB : FCBArray);
  340. VAR
  341.   h, e : INTEGER;
  342. BEGIN
  343.   FillChar(FCB, SizeOf(FCB), ' ');
  344.   IF (st = '.') OR (st = '..') THEN BEGIN
  345.     FCB[0] := '.';
  346.     IF Length(st) = 2 THEN FCB[1] := '.';
  347.     Exit;
  348.   END;
  349.   h := Pos('.', st) - 1;
  350.   IF h= -1 THEN h := Length(st);
  351.   e := Length(st) - h - 1;
  352.   IF e > 3    THEN e := 3;
  353.   IF (e >= 0) THEN Move(st[h + 2], FCB[8], e);
  354.   IF h > 8    THEN h := 8;
  355.   IF h > 0    THEN Move(st[1], FCB, h);
  356. END;
  357.  
  358. FUNCTION MakeCanonical(VAR pc1, pc2) : BOOLEAN; ASSEMBLER;
  359. (* MakeCanonical wandelt den ersten Dateinamen in einen   *)
  360. (* absoluten Dateinamen um.                               *)
  361. ASM
  362.   PUSH DS
  363.   MOV  AH, 60H
  364.   LDS  SI, pc1
  365.   LES  DI, pc2
  366.   INT  21H
  367.   POP  DS
  368.   MOV  AL, 1
  369.   JNC  @Ok
  370.   SUB  AL, AL
  371.  @Ok:
  372. END;
  373.  
  374. (* ServerCall ruft Int21h Routinen über die Funktion      *)
  375. (* $5D00 auf. Diese erlaubt das Setzen von Wildcards für  *)
  376. (* Delete und Rename                                      *)
  377. PROCEDURE ServerCall(VAR r : Registers);
  378.  
  379. TYPE
  380.   tDPL = RECORD
  381.      AX, BX, CX, DX, SI, DI, DS, ES    : WORD;
  382.      Reserved, computer_id, Process_ID : WORD;
  383.   END;
  384.  
  385. VAR
  386.   dpl : tDPL;
  387.   pt  : ^tDPL;
  388.  
  389. BEGIN
  390.   pt              := @dpl;
  391.   dpl.AX          := r.AX;
  392.   dpl.BX          := r.BX;
  393.   dpl.CX          := r.CX;
  394.   dpl.DX          := r.DX;
  395.   dpl.SI          := r.SI;
  396.   dpl.DI          := r.DI;
  397.   dpl.DS          := r.DS;
  398.   dpl.ES          := r.ES;
  399.   dpl.Reserved    := 0;
  400.   dpl.computer_id := 0;
  401.   dpl.Process_ID  := 0;
  402.   ASM
  403.     MOV   AX, 5D00H
  404.     PUSH  DS
  405.     LDS   DI, pt
  406.     MOV   DX, DI
  407.     INT   21H
  408.     PUSH  DS
  409.     PUSH  SI
  410.     PUSHF
  411.     LDS   SI, r
  412.     POP   Registers([SI]).&Flags
  413.     MOV   Registers([SI]).&AX, AX
  414.     MOV   Registers([SI]).&BX, BX
  415.     MOV   Registers([SI]).&CX, CX
  416.     MOV   Registers([SI]).&DX, DX
  417.     POP   AX
  418.     MOV   Registers([SI]).&si, AX
  419.     MOV   Registers([SI]).&DI, DI
  420.     POP   AX
  421.     MOV   Registers([SI]).&DS, AX
  422.     MOV   AX, ES
  423.     MOV   Registers([SI]).&ES, AX
  424.     POP   DS
  425.   END;
  426. END;
  427.  
  428. FUNCTION Multi_Rename(st1, st2 : STRING) : WORD;
  429. VAR
  430.   p1, p2, a1, a2 : ARRAY [0..127] OF CHAR;
  431.   r              : Registers;
  432. BEGIN
  433.   StrPCopy(p1, st1);
  434.   StrPCopy(p2, st2);
  435.   MakeCanonical(p1, a1);
  436.   MakeCanonical(p2, a2);
  437.   r.AX := $5600;
  438.   r.DS := Seg(a1);
  439.   r.DX := Ofs(a1);
  440.   r.ES := Seg(a2);
  441.   r.DI := Ofs(a2);
  442.   r.BX := 0;
  443.   r.CX := 0;
  444.   r.SI := 0;
  445.   ServerCall(r);
  446.   IF (r.Flags AND FCarry = 0) OR (r.AX = $12) THEN
  447.     Multi_Rename := 0
  448.   ELSE
  449.     Multi_Rename := r.AX;
  450. END;
  451.  
  452. FUNCTION Multi_Delete(st1 : STRING; Mask : BYTE) : WORD;
  453. VAR
  454.   p1, a1 : ARRAY [0..127] OF CHAR;
  455.   r      : Registers;
  456. BEGIN
  457.   StrPCopy(p1, st1);
  458.   MakeCanonical(p1, a1);
  459.   r.AX := $4100;
  460.   r.DS := Seg(a1);
  461.   r.DX := Ofs(a1);
  462.   r.ES := 0;
  463.   r.DI := 0;
  464.   r.BX := 0;
  465.   r.CX := Mask;
  466.   r.si := 0;
  467.   ServerCall(r);
  468.   IF (r.Flags AND FCarry = 0) THEN Multi_Delete := 0
  469.                               ELSE Multi_Delete := r.AX;
  470. END;
  471.  
  472. PROCEDURE RemakePath;
  473. (* RemakePath konstruiert aus dem echten Pfad und Datei-  *)
  474. (* namen wieder den für das Netzlaufwerk gewünschten      *)
  475. (* Namen.                                                 *)
  476.  
  477. BEGIN
  478.   StrCopy(NetPath, id_Drv);       (* ID des Netzlaufwerks *)
  479.   IF NoDrive THEN BEGIN
  480.     NetPath[id_max]     := FileName[1];
  481.     NetPath[id_max + 1] := #0;
  482.   END ELSE BEGIN
  483.     NetPath[id_max] := Path[1];
  484.     (* Pfad anhängen *)
  485.     Move(Path[3], NetPath[id_max + 1], Length(Path) - 2);
  486.     (* Filename anhängen *)
  487.     Move(FileName[1], NetPath[id_max + Length(Path) - 1],
  488.          Length(FileName));
  489.     NetPath[id_max + Length(Path) +
  490.             Length(FileName) - 1] := #0;
  491.   END;
  492. END;
  493.  
  494. PROCEDURE SendReply(Size : WORD);
  495. VAR
  496.   ans : Ans_RemDir ABSOLUTE Buf;
  497.   i   : INTEGER;
  498. BEGIN
  499.   i := IOResult;
  500.   IF i = 103 THEN i := 2;
  501.   IF i <> 0 THEN
  502.     ans.Flags := ans.Flags OR FCarry      (* Carry setzen *)
  503.   ELSE
  504.     ans.Flags := ans.Flags AND NOT FCarry;(* Carry löschen*)
  505.   ans.AX := i;                            (* Fehlercode   *)
  506.   IF DoProtocol THEN
  507.     WriteLn('--> ', HexW(ans.Flags), ' ', HexW(ans.AX));
  508.   SendCRCBuf(ans, Size);
  509. END;
  510.  
  511. PROCEDURE Fail(Size : WORD);
  512. VAR
  513.   a : Ans_RemDir ABSOLUTE Buf;
  514. BEGIN
  515.   a.Flags := a.Flags OR FCarry;
  516.   a.AX    := 5;
  517.   IF DoProtocol THEN
  518.     WriteLn('--> ', HexW(a.Flags), ' ', HexW(a.AX));
  519.   SendCRCBuf(a, Size);
  520. END;
  521.  
  522. PROCEDURE P_RemDir;
  523. (* Remove Directory - Subfunktion 01h                     *)
  524. VAR
  525.   ans : Ans_RemDir ABSOLUTE Buf;
  526.   b   : BOOLEAN;
  527.   io  : WORD;
  528. BEGIN
  529.   IF grResult = grOk THEN DisplayLogo;
  530.   ProcessFN1;                     (* Pfad ermitteln       *)
  531.   IF NoDrive THEN BEGIN
  532.     Fail(SizeOf(ans));            (* Pseudopfad...        *)
  533.     Exit;
  534.   END;
  535.   ChDir(Copy(Path, 1, 3));
  536.   RmDir(Path + FileName);         (* Verzeichnis löschen  *)
  537.   SendReply(SizeOf(ans));
  538. END;
  539.  
  540. PROCEDURE P_MakeDir;
  541. (* Make Directory - Subfunktion 03h                       *)
  542. VAR
  543.   ans : ans_MakeDir ABSOLUTE Buf;
  544.   b   : BOOLEAN;
  545. BEGIN
  546.   IF grResult = grOk THEN DisplayLogo;
  547.   ProcessFN1;                      (* Pfad ermitteln      *)
  548.   IF NoDrive THEN BEGIN
  549.     Fail(SizeOf(ans));             (* Pseudopfad...       *)
  550.     Exit;
  551.   END;
  552.   MkDir(Path + FileName);         (* Verzeichnis erzeugen *)
  553.   SendReply(SizeOf(ans));
  554. END;
  555.  
  556. PROCEDURE P_ChDir;
  557. (* Change Directory - Subfunktion 05h                     *)
  558. VAR
  559.   ans : ans_ChDir ABSOLUTE Buf;
  560.   b   : BOOLEAN;
  561. BEGIN
  562.   IF grResult = grOk THEN DisplayLogo;
  563.   IF StrComp(Head.fn1, id_Drv) <> 0 THEN BEGIN
  564.     ProcessFN1;                   (* Pfad ermitteln       *)
  565.     ChDir(Path + FileName);       (* Verzeichnis erzeugen *)
  566.     RemakePath;                   (* neuer Pfad           *)
  567.     IF InOutRes <> 0 THEN
  568.       StrCopy(ans.curr_path, NetPath);
  569.   END ELSE
  570.     StrCopy(ans.curr_path, Head.fn1);
  571.   SendReply(SizeOf(ans));
  572. END;
  573.  
  574. PROCEDURE P_Close;
  575. (* Close File - Subfunktion 06h                           *)
  576. VAR
  577.   ans : ans_Close ABSOLUTE Buf;
  578.   l   : LongInt;
  579. BEGIN
  580.   IF grResult = grOk THEN DisplayLogo;
  581.   Dec(Head.SFT.Handle_Cnt);
  582.                         (* DOS scheint es nicht zu machen *)
  583.   FileNr := os(Head.SFT.DevDrv_Ptr).o;
  584.                                 (* für Redirector frei... *)
  585.   os(l).o := Head.SFT.F_Time;   (*       File updaten ... *)
  586.   os(l).s := Head.SFT.F_Date;
  587.   SetFTime(f[FileNr], l);
  588.   Close(f[FileNr]);             (*      ... und schließen *)
  589.   SetFAttr(f[FileNr], Head.SFT.Attr_Byte);
  590.   ans.SFT := Head.SFT;          (*     Felder zurückgeben *)
  591.   SendReply(SizeOf(ans));
  592.   Free[FileNr] := TRUE;
  593. END;
  594.  
  595.  
  596. PROCEDURE P_Commit;
  597. (* Commit File - Subfunktion 07h                          *)
  598. BEGIN
  599.   (* Dummy-Funktion, alle Buffer werden ohnehin geflusht  *)
  600. END;
  601.  
  602. PROCEDURE P_Read;
  603. (* Read from File - Subfunktion 08h                       *)
  604. VAR
  605.   ans : Ans_Read ABSOLUTE Buf;
  606.   sp  : Sft_Ptr;
  607. BEGIN
  608.   IF grResult = grOk THEN DisplayLogo;
  609.   FileNr := os(Head.SFT.DevDrv_Ptr).o;
  610.                                (* --> für Redirector frei *)
  611.   Seek(f[FileNr], Head.SFT.F_Pos);  (* Adresse suchen ... *)
  612.   BlockRead(f[FileNr], DataBuf^, Head.Param1, ans.Size);
  613.                                     (* Daten lesen        *)
  614.   ans.SFT := Head.SFT;
  615.   ans.SFT.F_Pos := ans.SFT.F_Pos + ans.Size;
  616.   SendReply(SizeOf(ans));  (* Status und Größe übertragen *)
  617.   IF ((ans.Flags AND FCarry) = 0) AND (ans.Size > 0) THEN
  618.     SendCRCBuf(DataBuf^, ans.Size);
  619. END;
  620.  
  621. PROCEDURE P_Write;
  622. (* Write to File - Subfunktion 09h                        *)
  623. VAR
  624.   ans : Ans_Write ABSOLUTE Buf;
  625.   sp  : Sft_Ptr;
  626. BEGIN
  627.   IF grResult = grOk THEN DisplayLogo;
  628.   IF Head.Param1 > 0 THEN
  629.     ReceiveCRCBuf(DataBuf^, Head.Param1);
  630.   FileNr := os(Head.SFT.DevDrv_Ptr).o;
  631.                                    (* für Redirector frei *)
  632.   Seek(f[FileNr], Head.SFT.F_Pos);  (* Adresse suchen ... *)
  633.   BlockWrite(f[FileNr], DataBuf^, Head.Param1, ans.Size);
  634.   ans.SFT          := Head.SFT;
  635.   ans.SFT.F_Pos    := ans.SFT.F_Pos + ans.Size;
  636.   ans.SFT.F_Size   := FileSize(f[FileNr]);
  637.   ans.SFT.Dev_Info := ans.SFT.Dev_Info AND NOT $40;
  638.   SendReply(SizeOf(ans));
  639. END;
  640.  
  641. PROCEDURE P_GetSpace;
  642. (* Get Disk Space - Subfunktion 0Ch                       *)
  643. VAR
  644.   ans : Ans_GetSpace ABSOLUTE Buf;
  645. BEGIN
  646.   IF StrComp(Head.fn1, id_Drv) = 0 THEN
  647.     Path[1]  := 'C'
  648.   ELSE
  649.     ProcessFN1;
  650.     ASM
  651.       MOV AH, 36H
  652.       MOV DL, Byte(Path[1])
  653.       SUB DL, Byte('@')
  654.       INT 21H
  655.       MOV ans.spc,   AX
  656.       MOV ans.totc,  DX
  657.       MOV ans.bps,   CX
  658.       MOV ans.freec, BX
  659.     END;
  660.   IF DoProtocol THEN WriteLn;
  661.   SendCRCBuf(ans, SizeOf(ans));
  662. END;
  663.  
  664. PROCEDURE P_SetAttr;
  665. (* Set File Attributes - Subfunktion 0Eh                  *)
  666. VAR
  667.   ans    : Ans_SetAttr ABSOLUTE Buf;
  668.   hp, lp : ARRAY [0..127] OF CHAR;
  669.   lPtr   : POINTER;
  670. BEGIN
  671.   ProcessFN1;
  672.   IF NoDrive THEN BEGIN
  673.     Fail(SizeOf(ans));                   (* Pseudopfad... *)
  674.     Exit;
  675.   END;
  676.   StrPCopy(hp, Path);
  677.   StrPCopy(StrECopy(lp, hp), FileName);
  678.   lPtr := @lp;
  679.   ASM
  680.     PUSH DS
  681.     MOV  AX, $4301
  682.     MOV  CX, Head.Param0
  683.     LDS  si, lPtr
  684.     MOV  DX, SI
  685.     INT  21H
  686.     PUSHF
  687.     MOV  ans.&AX,   AX
  688.     POP  AX
  689.     MOV  ans.Flags, AX
  690.     POP  DS
  691.   END;
  692.   IF DoProtocol THEN
  693.     WriteLn('--> ', HexW(ans.Flags), ' ', HexW(ans.AX));
  694.   SendCRCBuf(ans, SizeOf(ans));
  695. END;
  696.  
  697. PROCEDURE P_GetAttr;
  698. (* Get File Attributes - Subfunktion 0Fh                  *)
  699. VAR
  700.   ans    : ans_GetAttr ABSOLUTE Buf;
  701.   hp, lp : ARRAY [0..127] OF CHAR;
  702.   lPtr   : POINTER;
  703.   f      : File;
  704.   long   : LongInt;
  705. BEGIN
  706.   ProcessFN1;
  707.   IF NoDrive THEN BEGIN
  708.     Fail(SizeOf(ans));                   (* Pseudopfad... *)
  709.     Exit;
  710.   END;
  711.   StrPCopy(hp, Path);
  712.   StrPCopy(StrECopy(lp, hp), FileName);
  713.   lPtr := @lp;
  714.   ASM
  715.     PUSH  DS
  716.     MOV   AX, $4300
  717.     LDS   SI, lPtr
  718.     MOV   DX, SI
  719.     INT   21H
  720.     POP   DS
  721.     PUSHF
  722.     POP   ans.Flags
  723.     MOV   ans.&AX, AX
  724.     JC    @weiter
  725.     MOV   ans.&AX, CX
  726.   @weiter:
  727.   END;
  728.   IF (ans.Flags AND FCarry = 0) THEN BEGIN
  729.     Assign(f, Path + FileName);
  730.     Reset(f, 1);
  731.     long := FileSize(f);
  732.     ans.BX := os(long).s;
  733.     ans.DI := os(long).o;
  734.     Close(f);
  735.     ans.AX := IOResult;
  736.     IF ans.AX <> 0 THEN ans.Flags := FCarry
  737.                    ELSE ans.Flags:= 0;
  738.   END;
  739.   IF DoProtocol THEN
  740.     WriteLn('--> ', HexW(ans.Flags), ' ', HexW(ans.AX));
  741.   SendCRCBuf(ans, SizeOf(ans));
  742. END;
  743.  
  744. PROCEDURE P_Rename;
  745. (* Rename File - Subfunktion 11h                          *)
  746. VAR
  747.   ans   : Ans_Rename ABSOLUTE Buf;
  748.   f2    : STRING;
  749. BEGIN
  750.   IF grResult = grOk THEN DisplayLogo;
  751.   ProcessFN1;
  752.   ReceiveCRCBuf(fn2, SizeOf(fn2));
  753.   f2 := ProcessFN2;
  754.   IF NoDrive THEN BEGIN
  755.     Fail(SizeOf(ans));                   (* Pseudopfad... *)
  756.     Exit;
  757.   END;
  758.   ans.AX := Multi_Rename(Path + FileName, f2);
  759.   IF ans.AX <> 0 THEN ans.Flags := FCarry;
  760.   SendReply(SizeOf(ans));
  761. END;
  762.  
  763.  
  764. PROCEDURE P_Delete;
  765. (* Delete File - Subfunktion 13h                          *)
  766. VAR
  767.   ans : Ans_Delete ABSOLUTE Buf;
  768. BEGIN
  769.   IF grResult = grOk THEN DisplayLogo;
  770.   ProcessFN1;
  771.   IF NoDrive THEN BEGIN
  772.     Fail(SizeOf(ans));                   (* Pseudopfad... *)
  773.     Exit;
  774.   END;
  775.   ans.AX := Multi_Delete(Path + FileName, $27) ;
  776.   IF ans.AX <> 0 THEN ans.Flags := FCarry;
  777.   SendReply(SizeOf(ans));
  778. END;
  779.  
  780. PROCEDURE P_Open;
  781. (* Open Existing File - Subfunktion 16h                   *)
  782. VAR
  783.   ans   : Ans_Open ABSOLUTE Buf;
  784.   fm, i : BYTE;
  785.   Attr  : WORD;
  786.   long  : LongInt;
  787. BEGIN
  788.   IF grResult = grOk THEN DisplayLogo;
  789.   ProcessFN1;
  790.   i := 1;
  791.   WHILE (i <= File_Max) AND NOT Free[i] DO Inc(i);
  792.   IF (i > File_Max) THEN BEGIN
  793.     ans.AX    := 4;
  794.     ans.Flags := FCarry;
  795.     IF DoProtocol THEN
  796.       WriteLn('--> ', HexW(ans.Flags), ' ', HexW(ans.AX));
  797.     SendCRCBuf(ans, SizeOf(ans));
  798.     Exit;
  799.   END;
  800.   IF NoDrive OR (i > File_Max) OR (FileName='') THEN BEGIN
  801.     Fail(SizeOf(ans));                   (* Pseudopfad... *)
  802.     Exit;
  803.   END;
  804.   fm       := FileMode;
  805.   FileMode := Lo(Head.Param0);
  806.   Attr     := Hi(Head.Param0);
  807.   Assign(f[i], Path + FileName);
  808.   Reset(f[i], 1);
  809.   IF InOutRes = 0 THEN BEGIN
  810.     Free[i]  := FALSE;
  811.     f_PSP[i] := Head.Current_PSP;
  812.   END;
  813.   GetFTime(f[i], long);
  814.   FileMode := fm;
  815.   (* SFT updaten *)
  816.   ans.SFT.F_Size           := FileSize(f[i]);
  817.   ans.SFT.F_Date           := os(long).s;
  818.   ans.SFT.F_Time           := os(long).o;
  819.   NameToFCB(FileName, ans.SFT.FCB_fn);
  820.   ans.SFT.Attr_Byte        := Attr AND Anyfile;
  821.   ans.SFT.Open_Mode        := Lo(Head.Param0) AND $7F;
  822.   ans.SFT.Dir_Sector       := 0;
  823.   ans.SFT.Dir_EntryNo      := 0;
  824.   ans.SFT.DevDrv_Ptr       := NIL;
  825.   ans.SFT.F_Pos            := 0;
  826.   (* eigene Nummer abspeichern *)
  827.   os(ans.SFT.DevDrv_Ptr).o := i;
  828.   SendReply(SizeOf(ans));
  829. END;
  830.  
  831. PROCEDURE P_Create;
  832. (* Truncate/Create File - Subfunktion 17h                 *)
  833. VAR
  834.   ans   : Ans_Create ABSOLUTE Buf;
  835.   i     : BYTE;
  836.   Attr  : WORD;
  837.   long  : LongInt;
  838. BEGIN
  839.   IF grResult = grOk THEN DisplayLogo;
  840.   ProcessFN1;
  841.   i := 1;
  842.   WHILE (i <= File_Max) AND NOT Free[i] DO Inc(i);
  843.   IF (i > File_Max) THEN BEGIN
  844.     ans.AX    := 4;
  845.     ans.Flags := FCarry;
  846.     IF DoProtocol THEN
  847.       WriteLn('--> ', HexW(ans.Flags), ' ', HexW(ans.AX));
  848.     SendCRCBuf(ans, SizeOf(ans));
  849.     Exit;
  850.   END;
  851.   IF NoDrive OR (FileName = '') THEN BEGIN
  852.     Fail(SizeOf(ans));                   (* Pseudopfad... *)
  853.     Exit;
  854.   END;
  855.   Assign(f[i], Path + FileName);
  856.   Rewrite(f[i], 1);
  857.   IF InOutRes = 0 THEN BEGIN
  858.     Free[i]  := FALSE;
  859.     f_PSP[i] := Head.Current_PSP;
  860.   END;
  861.   Attr := Lo(Head.Param0);
  862.   GetFTime(f[i], long);
  863.   (* SFT updaten *)
  864.   ans.SFT.F_Size           := FileSize(f[i]);
  865.   ans.SFT.F_Date           := os(long).s;
  866.   ans.SFT.F_Time           := os(long).o;
  867.   NameToFCB(FileName, ans.SFT.FCB_fn);
  868.   ans.SFT.Attr_Byte        := Attr;
  869.   ans.SFT.Open_Mode        := FileMode;
  870.   ans.SFT.Dir_Sector       := 0;
  871.   ans.SFT.Dir_EntryNo      := 0;
  872.   ans.SFT.DevDrv_Ptr       := NIL;
  873.   ans.SFT.F_Pos            := 0;
  874.   os(ans.SFT.DevDrv_Ptr).o := i;
  875.   SendReply(SizeOf(ans));
  876. END;
  877.  
  878. PROCEDURE P_FindFirst;
  879. (* FindFirst - Subfunktion 1Bh                            *)
  880. VAR
  881.   ans : Ans_FindFirst ABSOLUTE Buf;
  882.  
  883.   FUNCTION Found(ch : CHAR) : BOOLEAN;
  884.   VAR
  885.     i : BYTE;
  886.   BEGIN
  887.     i := 1;
  888.     Found := TRUE;
  889.     WHILE LwTbl[i] <> #0 DO BEGIN
  890.       IF UpCase(ch) = UpCase(LwTbl[i]) THEN Exit;
  891.       Inc(i);
  892.     END;
  893.     Found := FALSE;
  894.   END;
  895.  
  896. BEGIN
  897.   IF grResult = grOk THEN DisplayLogo;
  898.   ProcessFN1;
  899.   IF NoDrive THEN BEGIN         (* Verzeichnis simulieren *)
  900.     IF Lo(Head.Param0) = $08 THEN BEGIN
  901.       NameToFCB(FileName, ans.SDB.Srch_Tmpl);
  902.       StrPCopy(ans.DIB.FName, 'toolbox olé');
  903.       ans.DIB.FAttr     := VolumeID;
  904.       ans.SDB.Par_ClStr := 0;
  905.     END ELSE BEGIN
  906.       FillChar(ans.DIB.FName[1], 10, ' ');
  907.       IF Head.fn1[id_max] = '?' THEN BEGIN
  908.         ans.DIB.FName[0]  := LwTbl[1];
  909.         ans.DIB.FAttr     := Directory;
  910.         ans.SDB.Par_ClStr := 1;
  911.         ans.AX            := 0;
  912.         ans.Flags         := 0;
  913.       END ELSE BEGIN
  914.         IF (Head.fn1[id_max+1] = #0) AND
  915.             Found(Head.fn1[id_max]) THEN BEGIN
  916.           ans.DIB.FName[0]  := Head.fn1[id_max];
  917.           ans.DIB.FAttr     := Directory;
  918.           ans.SDB.Par_ClStr := 26;
  919.           ans.AX            := 0;
  920.           ans.Flags         := 0;
  921.         END ELSE BEGIN
  922.           ans.DIB.FName[0]  := Head.fn1[id_max];
  923.           ans.DIB.FAttr     := Directory;
  924.           ans.SDB.Par_ClStr := 26;
  925.           ans.AX            := 18;
  926.           ans.Flags         := FCarry;
  927.         END;
  928.       END;
  929.     END;
  930.     ans.SDB.Srch_Attr   := Lo(Head.Param0);
  931.     ans.SDB.Dir_Entry   := 0;
  932.     ans.DIB.Time_LStupd := 0;
  933.     ans.DIB.Date_LStupd := 0;
  934.     ans.DIB.FSiz        := 0;
  935.     ans.SDB.f1[1]       := 255;
  936.     SendCRCBuf(ans, SizeOf(ans));
  937.     Exit;
  938.   END;
  939.   FindFirst(Path + FileName, Head.Param0, t);
  940.   InOutRes := DosError;
  941.   Move(t.Fill, ans.SDB, 21);   (* SDB und DIR_REC updaten *)
  942.   ans.SDB.f1[1]       := ans.SDB.Drv_Lett;
  943.   NameToFCB(t.Name, ans.DIB.FName);
  944.   ans.DIB.FAttr       := t.Attr AND Anyfile;
  945.   ans.DIB.Time_LStupd := os(t.Time).o;
  946.   ans.DIB.Date_LStupd := os(t.Time).s;
  947.   ans.DIB.FSiz        := t.Size;
  948.   ans.SDB.Drv_Lett    := ans.SDB.Drv_Lett OR $80;
  949.   SendReply(SizeOf(ans));
  950. END;
  951.  
  952. PROCEDURE P_FindNext;
  953. (* FindNext - Subfunktion 1Ch                             *)
  954. VAR
  955.   ans : Ans_FindNext ABSOLUTE Buf;
  956.   pc  : WORD;
  957. BEGIN
  958.   IF Head.SDB.f1[1] = 255 THEN BEGIN
  959.     pc := Head.SDB.Par_ClStr + 1;
  960.     ans.SDB.Par_ClStr   := pc;
  961.     ans.SDB.f1[1]       := 255;
  962.     FillChar(ans.DIB.FName[1], 10, ' ');
  963.     ans.DIB.FName[0]    := LwTbl[pc];
  964.     ans.DIB.FAttr       := Directory OR ReadOnly;
  965.     ans.DIB.Time_LStupd := 0;         (* wow, welch Werte *)
  966.     ans.DIB.Date_LStupd := 0;
  967.     ans.DIB.FSiz        := 0;
  968.     IF LwTbl[pc] = #0 THEN BEGIN
  969.       ans.AX    := 18;
  970.       ans.Flags := FCarry;
  971.     END ELSE BEGIN
  972.       ans.AX    := 0;
  973.       ans.Flags := 0;
  974.     END;
  975.     IF DoProtocol THEN
  976.       WriteLn('--> ', HexW(ans.Flags), ' ', HexW(ans.AX));
  977.     SendCRCBuf(ans, SizeOf(ans));
  978.     Exit;
  979.   END;
  980.   Head.SDB.Drv_Lett := Head.SDB.f1[1];
  981.   Move(Head.SDB, t.Fill, 21);
  982.   FindNext(t);
  983.   InOutRes            := DosError;
  984.   Move(t.Fill, ans.SDB, 21);   (* SDB und DIR_REC updaten *)
  985.   ans.SDB.f1[1]       := ans.SDB.Drv_Lett;
  986.   NameToFCB(t.Name, ans.DIB.FName);
  987.   ans.DIB.FAttr       := t.Attr;
  988.   ans.DIB.Time_LStupd := os(t.Time).o;
  989.   ans.DIB.Date_LStupd := os(t.Time).s;
  990.   ans.DIB.FSiz        := t.Size;
  991.   SendReply(SizeOf(ans));
  992. END;
  993.  
  994. PROCEDURE P_SeekEnd;
  995. (* Seek From End Of File - Subfunktion 21h                *)
  996. BEGIN
  997.   (* Dummy *)
  998. END;
  999.  
  1000. PROCEDURE P_Hook;
  1001. (* Process termination hook - Subfunktion 22h             *)
  1002. VAR
  1003.   i : BYTE;
  1004. BEGIN
  1005.   FOR i := 0 TO File_Max DO BEGIN
  1006.     IF (NOT Free[i]) AND
  1007.        (f_PSP[i] = Head.Current_PSP) THEN BEGIN
  1008.       Close(f[i]);
  1009.       Free[i] := TRUE;
  1010.     END;
  1011.   END;
  1012.   IF DoProtocol THEN WriteLn;
  1013. END;
  1014.  
  1015. PROCEDURE P_ExtendOpen;
  1016. (* Special Multi-Purpose Open File - Subfunktion 2Eh      *)
  1017. VAR
  1018.   ans   : Ans_ExtendOpen ABSOLUTE Buf;
  1019.   SPop  : tSpecPop;
  1020.   i, fm : BYTE;
  1021.   Attr  : WORD;
  1022.   long  : LongInt;
  1023. BEGIN
  1024.   IF grResult = grOk THEN DisplayLogo;
  1025.   ReceiveCRCBuf(SPop, SizeOf(tSpecPop));
  1026.   ProcessFN1;
  1027.   i := 1;
  1028.   WHILE (i <= File_Max) AND NOT Free[i] DO
  1029.    Inc(i);
  1030.   IF (i > File_Max) THEN BEGIN
  1031.     ans.AX    := 4;
  1032.     ans.Flags := FCarry;
  1033.     IF DoProtocol THEN
  1034.       WriteLn('--> ', HexW(ans.Flags), ' ', HexW(ans.AX));
  1035.     SendCRCBuf(ans, SizeOf(ans));
  1036.     Exit;
  1037.   END;
  1038.   IF NoDrive OR (FileName = '') THEN BEGIN
  1039.     Fail(SizeOf(ans));                   (* Pseudopfad... *)
  1040.     Exit;
  1041.   END;
  1042.   Assign(f[i], Path + FileName);
  1043.   GetFAttr(f[i], Attr);
  1044.   IF (DosError = 0) AND (Attr AND $10 <> 0) THEN
  1045.     DosError := 5;
  1046.   IF ((SPop.SPop_Act AND $F = 0) AND (DosError = 0)) OR
  1047.      ((SPop.SPop_Act AND $F0 = 0) AND (DosError <> 0)) THEN
  1048.   BEGIN
  1049.     (* von Aktionscode so gewünscht *)
  1050.     Fail(SizeOf(ans));
  1051.     Exit;
  1052.   END;
  1053.   fm       := FileMode;
  1054.   FileMode := SPop.SPop_Mode;
  1055.   IF (SPop.SPop_Act = 2) OR (DosError <> 0) THEN BEGIN
  1056.     (* neuen Dateieintrag erzeugen *)
  1057.     IF DosError = 0 THEN ans.CX := 3 ELSE ans.CX := 2;
  1058.     Rewrite(f[i], 1);
  1059.     Attr := SPop.SPop_Attr;
  1060.   END ELSE BEGIN
  1061.     Reset(f[i], 1);
  1062.     ans.CX := 1;
  1063.   END;
  1064.   IF InOutRes = 0 THEN BEGIN
  1065.     Free[i]  := FALSE;
  1066.     f_PSP[i] := Head.Current_PSP;
  1067.   END;
  1068.   FileMode := fm;
  1069.   GetFTime(f[i], long);
  1070.   (* SFT updaten *)
  1071.   ans.SFT.F_Size           := FileSize(f[i]);
  1072.   ans.SFT.F_Date           := os(long).s;
  1073.   ans.SFT.F_Time           := os(long).o;
  1074.   NameToFCB(FileName, ans.SFT.FCB_fn);
  1075.   ans.SFT.Attr_Byte        := Attr;
  1076.   ans.SFT.Open_Mode        := SPop.SPop_Mode;
  1077.   ans.SFT.Dir_Sector       := 0;
  1078.   ans.SFT.Dir_EntryNo      := 0;
  1079.   ans.SFT.DevDrv_Ptr       := NIL;
  1080.   ans.SFT.F_Pos            := 0;
  1081.   (* eigene Nummer abspeichern *)
  1082.   os(ans.SFT.DevDrv_Ptr).o := i;
  1083.   SendReply(SizeOf(ans));
  1084. END;
  1085.  
  1086. FUNCTION GetHex(VAR s : STRING; VAR Val : WORD) : WORD;
  1087. VAR
  1088.   hw, w : WORD;
  1089.   i     : BYTE;
  1090. BEGIN
  1091.   IF Length(s) > 4 THEN BEGIN
  1092.     GetHex := 5;
  1093.     Exit;
  1094.   END;
  1095.   w := 0;
  1096.   FOR i := 1 TO Length(s) DO BEGIN
  1097.     hw   := 0;
  1098.     s[i] := UpCase(s[i]);
  1099.     IF (s[i] >= '0') AND (s[i] <= '9') THEN
  1100.       hw := Ord(s[i]) - BYTE('0')
  1101.     ELSE IF (s[i] >= 'A') AND (s[i] <= 'F') THEN
  1102.       hw := Ord(s[i]) - BYTE('A') + 10
  1103.     ELSE BEGIN
  1104.       GetHex := i;
  1105.       Exit;
  1106.     END;
  1107.     w := w SHL 4 + hw;
  1108.   END;
  1109.   Val    := w;
  1110.   GetHex := 0;
  1111. END;
  1112.  
  1113. TYPE
  1114.   tSubFunc = PROCEDURE;
  1115.   Proc_Tbl = ARRAY [_RemDir.._ExtendOpen] OF tSubFunc;
  1116.  
  1117. CONST
  1118.   FuncTbl : Proc_Tbl =
  1119.     (P_RemDir,   P_MakeDir, P_ChDir,     P_Close,
  1120.      P_Commit,   P_Read,    P_Write,     P_GetSpace,
  1121.      P_SetAttr,  P_GetAttr, P_Rename,    P_Delete,
  1122.      P_Open,     P_Create,  P_FindFirst, P_FindNext,
  1123.      P_SeekEnd,  P_Hook,    P_ExtendOpen);
  1124.  
  1125. PROCEDURE ReDirector;
  1126. BEGIN
  1127.   REPEAT
  1128.     ReceiveCRCBuf(Head, SizeOf(Head));
  1129.     IF Head.Command = _KillContact THEN Exit;
  1130.     IF LastResult <> ReadyToTransfer THEN Exit;
  1131.     IF DoProtocol THEN ProtocolCommand;
  1132.     FuncTbl[Head.Command];
  1133.   UNTIL (LastResult <> ReadyToTransfer);
  1134. END;
  1135.  
  1136. PROCEDURE InfoText;
  1137. BEGIN
  1138.   WriteLn('Aufruf: REMBASE [Laufwerke] [LptNr] oder '^M^J,
  1139.           '        REMBASE [Laufwerke] $[LPT-Adresse]');
  1140.   WriteLn('Beispiele: »REMBASE ac 1« oder »REMBASE acde ',
  1141.           '$378«'^J);
  1142.   Halt(1);
  1143. END;
  1144.  
  1145. PROCEDURE DisplayText;
  1146. CONST
  1147.   InfoMsg : STRING[40] =
  1148.                  '        toolbox-Remote-Laufwerk         ';
  1149.   CopyrMsg: STRING[40] =
  1150.                  ' Copyright (c) R. Hensmann & DMV-Verlag ';
  1151. VAR
  1152.   i : INTEGER;
  1153. BEGIN
  1154.   ClrScr;
  1155.   FOR i := 1 TO 25 * 80 - 1 DO Write('*');
  1156.   GotoXY(40 - Length(InfoMsg) DIV 2, 13);
  1157.   Write(InfoMsg);
  1158.   GotoXY(40 - Length(CopyrMsg) DIV 2, 14);
  1159.   Write(CopyrMsg);
  1160.   GotoXY(80 - Length(ExitMsg), 25);
  1161.   Write(ExitMsg);
  1162. END;
  1163.  
  1164. BEGIN
  1165.   grResult   := -1;
  1166.   CheckBreak := FALSE;
  1167.   (* Grafiktreiber und Fonts anmelden: *)
  1168.   RegisterBGIFont(@SmallFontProc);
  1169.   RegisterBGIFont(@TriplexFontProc);
  1170.   RegisterBGIDriver(@HercDriverProc);
  1171.   RegisterBGIDriver(@EGAVGADriverProc);
  1172.   RegisterBGIDriver(@CGADriverProc);
  1173.   RegisterBGIDriver(@ATT400DriverProc);
  1174.   RegisterBGIDriver(@PC3270DriverProc);
  1175.  
  1176.   (* aktuelles Laufwerk, um anschließend wieder hierher   *)
  1177.   (* zu wechseln:                                         *)
  1178.   GetDir(0, CurDir);
  1179.   IF ParamCount = 0 THEN BEGIN
  1180.     WriteLn('Remote-Drive Basis v1.1'^M^J +
  1181.             'Copyright (C) 1993 R. Hensmann & DMV'^M^J +
  1182.             'Starten Sie dieses Programm auf dem Rechner');
  1183.     WriteLn('den sie als Laufwerk einsetzen wollen.'^J);
  1184.     Write('Alle Laufwerke, die verwendet werden sollen: ' +
  1185.           '(z. B. ac) ');
  1186.     ReadLn(lw);
  1187.     Write('Adresse der Schnittstelle (1, 2, 3 oder in Hex ',
  1188.           '(z. B. $378) : ');
  1189.     ReadLn(st);
  1190.     Delay(500);
  1191.   END ELSE IF ParamCount = 2 THEN BEGIN
  1192.     lw := ParamStr(1);
  1193.     st := ParamStr(2);
  1194.   END ELSE InfoText;
  1195.   IF st[1] = '$' THEN BEGIN
  1196.     Delete(st, 1, 1);
  1197.     Error := GetHex(st, nr)
  1198.   END ELSE
  1199.     Val(st, nr, Error);
  1200.   IF Error <> 0 THEN
  1201.     InfoText
  1202.   ELSE IF nr <= 3 THEN
  1203.     nr := GetLPTAdress(nr);
  1204.   FillChar(LwTbl, SizeOf(LwTbl), #0);
  1205.   FOR i := 1 TO Length(lw) DO BEGIN
  1206.     lw[i] := UpCase(lw[i]);
  1207.     IF (lw[i] >= 'A') AND (lw[i] <= 'Z') THEN BEGIN
  1208.       j := 1;
  1209.       WHILE (LwTbl[j] <> lw[i]) AND (LwTbl[j] <> #0) DO
  1210.         Inc(j);
  1211.       IF LwTbl[j] = #0 THEN LwTbl[j] := lw[i];
  1212.     END;
  1213.   END;
  1214.   IF LwTbl[1] = #0 THEN BEGIN
  1215.     WriteLn('Nicht allzuviele Laufwerke...');
  1216.     Halt(1);
  1217.   END;
  1218.   OldExitProc := ExitProc;
  1219.   ExitProc    := @MyExitProc;
  1220.   (* alle frei... *)
  1221.   FillChar(Free, SizeOf(Free), #1);
  1222.   New(DataBuf);
  1223.   New(DataBuf2);
  1224.   UnitInit(nr);
  1225.   WriteLn('Warten auf Hauptprogramm ... ' +
  1226.           '(Abbruch mit beliebiger Taste)');
  1227.   WHILE KeyPressed DO ch := ReadKey;
  1228.   SetKbdWatchdog; (* Abbruch mit beliebiger Taste möglich *)
  1229.   StartReceive;
  1230.   IF ParaResult <> ReadyToTransfer THEN BEGIN
  1231.    NoContact := '... abgebrochen';      (* String patchen *)
  1232.    Halt(1);
  1233.   END;
  1234.   (* Erst jetzt die Grafik initialisieren: *)
  1235.   DetectGraph(GraphDriver, GraphMode);
  1236.   InitGraph(GraphDriver, GraphMode, '');
  1237.   grResult := GraphResult;
  1238.   IF grResult = grOk THEN BuildLogo ELSE DisplayText;
  1239.   ReceiveCRCBuf(id_Drv, SizeOf(id_Drv));
  1240. {$IFDEF NoKeyBreak}  (* kein Abbruch mehr per Tastendruck *)
  1241.   ClrKbdWatchDog;    (* möglich! Falls der Master-PC aus- *)
  1242. {$ENDIF}             (* geschaltet wird, muß der Slave-PC *)
  1243.                      (* warmgestartet werden!             *)
  1244.   ReDirector;                   (* Programm-Hauptschleife *)
  1245.   IF grResult = grOk THEN BEGIN (* es war Grafikmodus     *)
  1246.     FreeMem(p1, PicSize);       (* Speicher wieder frei-  *)
  1247.     FreeMem(p2, PicSize);       (* geben.                 *)
  1248.   END;
  1249.   (* die restliche Restaurierungen und Ausgaben werden in *)
  1250.   (* der Exit-Prozedur »MyExitProc« vorgenommen.          *)
  1251. END.
  1252.  
  1253. (*========================================================*)
  1254. (*                 Ende von REMBASE.PAS                   *)
  1255.