home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / remote / remote.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-10  |  42.1 KB  |  1,156 lines
  1. (* ====================================================== *)
  2. (*                      REMOTE.PAS                        *)
  3. (*    TSR-Master-Programm zur paralellen Übertragung      *)
  4. (*         (c) 1993 Ralf Hensmann & DMV-Verlag            *)
  5. (* ====================================================== *)
  6. {$A-,B-,D+,L+,E-,F-,I-,N-,O-,R-,S-,V-}
  7. {$M 2048,128,1000}
  8.  
  9. {$DEFINE LapLink}    (* wird auch in den Units benötigt ! *)
  10.                      (* unter [O]ptions im [C]ompilermenü *)
  11.                      (* bei [C]onditional defines auch    *)
  12.                      (* setzen. Sonst tut's nicht !       *)
  13.  
  14. PROGRAM Remote_Drive;
  15.  
  16. USES Dos, Crt, CRC, ParData, ParCRC, Strings, Rem_Type;
  17.  
  18. (* ====================================================== *)
  19. (*                 Der Interrupt-Handler                  *)
  20. (*
  21.  Der Interrupt-Handler besteht aus zwei Teilen. Die eigent-
  22.  liche ISR ist in einem Byte-Array abgespeichert und über-
  23.  nimmt das Sichern der Stack-Register, von CS:IP und den
  24.  Flags -- eine Aufgabe, die in Turbo Pascal nicht gelöst
  25.  werden kann. Der Redirector ist in Turbo-Pascal geschrieben
  26.  und verteilt die Aufgaben je nach Funktionsnummer. Die
  27.  ISR ist ohne Veränderung aus dem Buch "undocumented DOS"
  28.  übernommen.
  29.  Die folgenden Adressen müssen während der Laufzeit
  30.  eingetragen werden:                                      *)
  31. (* ====================================================== *)
  32.  
  33. CONST
  34.   Prev_Hndlr   = 99;        { Alter Interrupt-Einsrung $2F }
  35.   Redir_Entry  = 49;        { Einsprung des Redirectors    }
  36.   Our_SP_Ofs   = 45;        { Turbo-Pascal Stack-Segment   }
  37.   Our_SS_Ofs   = 40;
  38.  
  39. (* weitere Werte können beim Compilieren eingetragen      *)
  40. (* werden. Sie hängen vom Codeende ab.                    *)
  41.   ISR_Code_Max = 102;           { Nummer des letzten Bytes }
  42.   Save_SS_Ofs  = ISR_Code_Max+1;{ Stack-Segment des Callers}
  43.   Save_SP_Ofs  = ISR_Code_Max+3;{ Stack-Offset des Callers }
  44.   Save_Rf_Ofs  = ISR_Code_Max+5; { Flags bei ISR-Einsprung }
  45.   Save_Fl_Ofs  = ISR_Code_Max+7; { Flags auf dem Stack     }
  46.   Save_CS_Ofs  = ISR_Code_Max+9; { CS auf dem Stack        }
  47.   Save_IP_Ofs  = ISR_Code_Max+11;{ IP auf dem Stack        }
  48.   Our_Drv_Ofs  = ISR_Code_Max+13;{ Hilfsvariable           }
  49.  
  50. TYPE  { Array für ISR-Routine }
  51.   ISR_Code_Buffer = ARRAY [0..ISR_Code_Max] OF BYTE;
  52.   { ISR-Struktur enthält zusätzlich auch die }
  53.   { Sicherungs-Variablen                     }
  54.   ISRptr  = ^ISR_Rec;
  55.   ISR_Rec = RECORD
  56.     ic : ISR_Code_Buffer;{ Der eigentliche ISR-Code        }
  57.     Save_SS,             { Altes Stack-Segment beim Aufruf }
  58.     Save_SP,             { Alter Stack-Offset beim Aufruf  }
  59.     Real_Fl,             { Flags bei Aufruf der ISR-Routine}
  60.     Save_Fl,             { Auf dem Stack
  61.                            zwischengespeicherte Flags      }
  62.     Save_CS,             { Auf dem Stack abgelegtes CS     }
  63.     Save_IP   : WORD;    { Auf dem Stack abgelegter IP     }
  64.     Our_Drive : BOOLEAN; { Durchreichen des Interrupts
  65.                            bzw. Rückkehr                   }
  66.   END;
  67.  
  68. { Der ISR-Code hat zwei Aufgaben. 1. reicht er unbekannte  }
  69. { Funktionen ohne weitere Probleme weiter und 2. erledigt  }
  70. { er das für Turbo Pascal dringend notwendige              }
  71. { Stack-Switching. Außerdem erlaubt er die Veränderung     }
  72. { aller Variablen, die auf dem Stack liegen.               }
  73.  
  74. CONST
  75.   ISR_Code : ISR_Code_Buffer = { entry: }
  76.     (       $90,
  77.       { nop OR int 3          ; for debugging }
  78.             $9C,
  79.       { pushf                 ; save flags    }
  80.         $80,$FC,$11,
  81.       { cmp   ah,11h          ; our fxn?      }
  82.         $75,$5A,
  83.       { jne   not_ours        ; bypass        }
  84.     $2E,$8F,$06, Save_Rf_Ofs, 0,
  85.       { pop   cs:real_fl      ; store act flgs}
  86.     $2E,$8F,$06, Save_IP_Ofs, 0,
  87.       { pop   cs:save_ip      ; store cs:ip   }
  88.     $2E,$8F,$06, Save_CS_Ofs, 0,
  89.       { pop   cs:save_cs      ; and flags     }
  90.     $2E,$8F,$06, Save_Fl_Ofs, 0,
  91.       { pop   cs:save_fl      ; from stack    }
  92.     $2E,$89,$26, Save_SP_Ofs, 0,
  93.       { mov   cs:save_sp,sp   ; save stack    }
  94.         $8C,$D4,
  95.       { mov   sp,ss                           }
  96.     $2E,$89,$26, Save_SS_Ofs, 0,
  97.       { mov   cs:save_ss,sp                   }
  98.  
  99.     $BC,     0,0,
  100.       { mov   sp,SSEG         ; set our stack }
  101.     $8E,$D4,
  102.       { mov   ss,sp                           }
  103.     $BC,     0,0,
  104.       { mov   sp,SPTR                         }
  105.     $9C,
  106.       { pushf                 ; call our      }
  107.     $9A,     0,0,0,0,
  108.       { call  redir           ; intr proc.    }
  109.     $2E,$8B,$26, Save_SS_Ofs, 0,
  110.       { mov   sp,cs:save_ss   ; put back      }
  111.         $8E,$D4,
  112.       { mov   ss,sp           ; caller's stack}
  113.     $2E,$8B,$26, Save_SP_Ofs, 0,
  114.       { mov   sp,cs:save_sp                   }
  115.     $2E,$FF,$36, Save_Fl_Ofs, 0,
  116.       { push  cs:save_fl      ; restore       }
  117.     $2E,$FF,$36, Save_CS_Ofs, 0,
  118.       { push  cs:save_cs      ; restore       }
  119.     $2E,$FF,$36, Save_IP_Ofs, 0,
  120.       { push  cs:save_ip      ; return addr.  }
  121.     $2E,$FF,$36, Save_Rf_Ofs, 0,
  122.       { push  cs:real_fl      ; save act flgs }
  123.     $2E,$80,$3E, Our_Drv_Ofs,0,0,
  124.       { cmp cs:our_drive,0; not our drive?}
  125.     $74,$04,
  126.       { je    not_ours        ; no, jump      }
  127.     $9D,
  128.       { popf                  ; yes, restore  }
  129.     $CA,$02,$00,
  130.       { retf  2               ; & return flags}
  131.       { not_ours: }
  132.     $9D,
  133.       { popf                  ; restore flags }
  134.     $EA,    0,0,0,0
  135.       { jmp   far prev_hndlr  ; pass the buck }
  136.   );
  137.  
  138. VAR
  139.   ISR    : ISRptr;  { Der Zeiger auf die ISR-Routine       }
  140.   Our_SP : WORD;    { Wert der Stackpointers               }
  141.  
  142.   PROCEDURE Redirector(_flags,_cs,_ip,_ax,_bx,_cx,_dx,
  143.                      _si,_di,_ds,_es,_bp : WORD);
  144.             INTERRUPT;  FORWARD;
  145.  
  146.   PROCEDURE Init_ISR_Code;
  147.    (* init_isr_code richtet den ISR-Handler ein und nimmt *)
  148.    (* die notwendigen Änderungen vor. Wichtig ist, daß    *)
  149.    (* die Routine an einer Paragraphengrenze beginnt, so  *)
  150.    (* daß die Offsets innerhalb der ISR-Routine stimmig   *)
  151.    (* sind. Der Redirector ist als forward deklariert, da *)
  152.    (* er so etwa die Hälfte des Programms aufruft und     *)
  153.    (* deshalb am Ende steht.                              *)
  154.   TYPE
  155.     OS = RECORD
  156.            o, s : WORD;
  157.          END;
  158.   VAR
  159.     P  : POINTER;
  160.     i  : POINTER ABSOLUTE ISR;
  161.   BEGIN
  162.     { Speicher reservieren und an
  163.       Paragraphengrenze ausrichten }
  164.     GetMem(ISR, SizeOf(ISR_Rec)+15);
  165.     Inc(os(ISR).s, (os(ISR).o+15) SHR 4);
  166.     { Code eintragen und modifizieren }
  167.     ISR^.ic := ISR_Code;
  168.     GetIntVec($2F, P);
  169.     os(ISR).o   := Redir_Entry;
  170.     Pointer(i^) := @Redirector;
  171.     os(ISR).o := Our_SS_Ofs;  Word(i^)    := SSeg;
  172.     os(ISR).o := Our_Sp_Ofs;  Word(i^)    := Our_SP;
  173.     os(ISR).o := Prev_Hndlr;  Pointer(i^) := P;
  174.     { Speicher beginnt an Paragraphengrenze }
  175.     os(ISR).o := 0;
  176.   END;
  177.  
  178. (* ====================================================== *)
  179. (*   Prozeduren für Redirector                            *)
  180.  
  181. VAR
  182.   Head         : fx_Command_Head; { Variable für Befehl    }
  183.   Drive_No     : BYTE;   { Nummer des Laufwerks (F: --> 5) }
  184.   Sda_fn1      : ^ASCIIZ; { Zeiger auf ersten ASCIIZ-Par.  }
  185.   Sda_fn2      : ^ASCIIZ; { Zgr. auf 2. Parameter (Rename) }
  186.   Sda_SrchAttr : ^BYTE;   { gewünschtes Suchattribut       }
  187.   Sda_Sdb      : Sdb_Ptr; { Zeiger auf Suchdatenblock      }
  188.   Sda_Dib      : Dir_Ptr; { Zeiger auf Directory-Info      }
  189.   Sda_CurrDta  : ^POINTER;{ Zeiger auf aktuelle DTA        }
  190.   Sda_CurrPsp  : ^WORD;   { Zeiger auf aktuelen PSP        }
  191.   Sda_SpecPop  : ^tSpecPop; { Zeiger für extended open     }
  192.   Sda_OpenMode : ^BYTE;  { Zeiger auf gewünschten Openmode }
  193.   Cds_CurrPath : ^PathPtr; { Zeiger auf akt. Pfad im Lw.   }
  194.   Buf          : ASCIIZ;   { Puffer (128 Byte)             }
  195.   R            : RegSet;   { Register beim Aufruf d. Prog. }
  196.  
  197. {$F+}
  198.  
  199.   PROCEDURE p_RemDir;
  200.   (* Remove Directory - subfunction 01h                   *)
  201.   (* Eingabeparameter:                                    *)
  202.   (*   SDA.fn1 : vollständiger Directory-Name             *)
  203.   (* Ausgabeparameter:                                    *)
  204.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  205.   (*   3 : Suchweg nicht gefunden - Verzeichnis nicht     *)
  206.   (*       lokalisierbar                                  *)
  207.   (*   5 : Zugriff verweigert (Verz. z.B. nicht löschbar) *)
  208.   VAR
  209.     Ans : Ans_RemDir ABSOLUTE Buf;
  210.   BEGIN
  211.     Head.Command := _RemDir;
  212.     Head.Fn1     := Sda_fn1^;
  213.     SendCRCBuf(Head, SizeOf(Head));
  214.     ReceiveCRCBuf(Buf, SizeOf(Ans_RemDir));
  215.     R.Flags := Ans.Flags;
  216.     R.AX    := Ans.AX;
  217.   END;
  218.  
  219.   PROCEDURE p_MakeDir;
  220.   (* Make Directory - subfunction 03h                     *)
  221.   (* Eingabeparameter:                                    *)
  222.   (*   SDA.fn1 : vollständiger Directory-Name             *)
  223.   (* Ausgabeparameter:                                    *)
  224.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  225.   (*   3 : Suchweg nicht gefunden - Verzeichnis nicht     *)
  226.   (*       lokalisierbar                                  *)
  227.   (*   5 : Zugriff verweigert (Verz. z.B. nicht löschbar) *)
  228.   VAR
  229.     Ans : Ans_MakeDir ABSOLUTE Buf;
  230.   BEGIN
  231.     Head.Command := _MakeDir;
  232.     Head.Fn1     := Sda_fn1^;
  233.     SendCRCBuf(Head, SizeOf(Head));
  234.     ReceiveCRCBuf(Buf, SizeOf(Ans_MakeDir));
  235.     R.Flags := Ans.Flags;
  236.     R.AX    := Ans.AX;
  237.   END;
  238.  
  239.   PROCEDURE p_ChDir;
  240.   (* Change Directory - subfunction 05h                   *)
  241.   (* Eingabeparameter:                                    *)
  242.   (*   SDA.fn1 : vollständiger Directory-Name             *)
  243.   (* Ausgabeparameter:                                    *)
  244.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  245.   (*   3 : Suchweg nicht gefunden - Verzeichnis nicht     *)
  246.   (*       lokalisierbar                                  *)
  247.   (* CDS.curr_path muß auf den aktuellen Wert gesetzt     *)
  248.   (* werden. Außer beim Root-Verzeichnis darf kein '\'    *)
  249.   (* am Ende stehen.                                      *)
  250.   VAR
  251.     Ans : Ans_ChDir ABSOLUTE Buf;
  252.   BEGIN
  253.     Head.Command := _ChDir;
  254.     Head.Fn1     := Sda_fn1^;
  255.     SendCRCBuf(Head, SizeOf(Head));
  256.     ReceiveCRCBuf(Buf, SizeOf(Ans_ChDir));
  257.     R.Flags        := Ans.Flags;
  258.     R.AX           := Ans.AX;
  259.     IF (R.Flags AND FCarry) = 0 THEN
  260.       Cds_CurrPath^^ := Ans.Curr_Path;
  261.   END;
  262.  
  263.   PROCEDURE p_Close;
  264.   (* Close File - subfunction 06h                         *)
  265.   (* Eingabeparameter:                                    *)
  266.   (*   es:di zeigen auf SFT des Files, das geschlossen    *)
  267.   (*         werden soll.                                 *)
  268.   (* Ausgabeparameter:                                    *)
  269.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  270.   (*  -Fehler entsprechen DOS-Fehlern Schäpers S. 692 ff. *)
  271.   (*   SFT muß ausgewertet werden                         *)
  272.   (*   (handle_cnt nicht (?) ändern):                     *)
  273.   (*   z.B. f_date und f_time korrekt eintragen           *)
  274.   VAR
  275.     Ans : Ans_Close ABSOLUTE Buf;
  276.     Sp  : SFT_Ptr;
  277.   BEGIN
  278.     Sp           := Ptr(R.ES, R.DI);
  279.     Head.Command := _Close;
  280.     Head.SFT     := Sp^;
  281.     SendCRCBuf(Head, SizeOf(Head));
  282.     ReceiveCRCBuf(Buf, SizeOf(Ans_Close));
  283.     R.Flags := Ans.Flags;
  284.     R.AX    := Ans.AX;
  285.     Sp^     := Ans.SFT;
  286.   END;
  287.  
  288.   PROCEDURE p_Commit;
  289.   (* Commit File - subfunction 07h                        *)
  290.   (* Eingabeparameter:                                    *)
  291.   (*   es:di zeigen auf SFT des Files, das geflusht       *)
  292.   (*         werden soll.                                 *)
  293.   (* Ausgabeparameter:                                    *)
  294.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  295.   (*  _Fehler entsprechen DOS-Fehlern Schäpers S. 692 ff. *)
  296.   (*   Puffer müssen geleert werden.                      *)
  297.   BEGIN
  298.   END;
  299.  
  300.   PROCEDURE p_Read;
  301.   (* Read from File - subfunction 08h                     *)
  302.   (* Eingabeparameter:                                    *)
  303.   (*   es:di zeigen auf SFT des Files, das gelesen werden *)
  304.   (*         soll.                                        *)
  305.   (*   cx    Anzahl der Bytes, die aus dem File gelesen   *)
  306.   (*         werden sollen                                *)
  307.   (*   SDA.curr_dta zeigt auf Datenpuffer                 *)
  308.   (* Ausgabeparameter:                                    *)
  309.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  310.   (* Fehler entsprechen DOS-Fehlern Schäpers S. 692 ff.   *)
  311.   (*   CX : wirklich gelesene Bytes                       *)
  312.   (*   Die SFT muß entsprechend upgedated werden.         *)
  313.   (*     (f_pos)                                          *)
  314.   VAR
  315.     Ans : Ans_Read ABSOLUTE Buf;
  316.     Sp  : SFT_Ptr;
  317.   BEGIN
  318.     Sp           := Ptr(R.ES,R.DI);
  319.     Head.Command := _Read;           { Befehl }
  320.     Head.SFT     := Sp^;             { SFT    }
  321.     Head.Param1  := R.CX;            { Größe  }
  322.     SendCRCBuf(Head, SizeOf(Head));
  323.     ReceiveCRCBuf(Buf, SizeOf(Ans_Read));
  324.     R.Flags := Ans.Flags;
  325.     R.AX    := Ans.AX;
  326.     Sp^     := Ans.SFT;
  327.     R.CX    := Ans.Size;
  328.     { Block lesen }
  329.     IF ((R.Flags AND FCarry) = 0) AND (Ans.Size <> 0) THEN
  330.       ReceiveCRCBuf(Sda_CurrDta^^, R.CX);
  331.   END;
  332.  
  333.   PROCEDURE p_Write;
  334.   (* Write to File - subfunction 09h                      *)
  335.   (* Eingabeparameter:                                    *)
  336.   (*   es:di zeigen auf SFT des Files, in das geschrieben *)
  337.   (*         werden soll.                                 *)
  338.   (*   cx    Anzahl der Bytes, die in das File            *)
  339.   (*         geschrieben werden sollen                    *)
  340.   (*   SDA.curr_dta zeigt auf Datenpuffer                 *)
  341.   (* Ausgabeparameter:                                    *)
  342.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  343.   (* Fehler entsprechen DOS-Fehlern Schäpers S. 692 ff.   *)
  344.   (*   CX : wirklich gelesene Bytes                       *)
  345.   (*   Die SFT muß entsprechend upgedated werden.         *)
  346.   (*     (f_pos, f_size, dev_info Bit 6 löschen)          *)
  347.   VAR
  348.     Ans : Ans_Write ABSOLUTE Buf;
  349.     Sp  : SFT_Ptr;
  350.   BEGIN
  351.     Sp           := Ptr(R.ES,R.DI);
  352.     Head.Command := _Write;           { Befehl }
  353.     Head.SFT     := Sp^;              { SFT    }
  354.     Head.Param1  := R.CX;             { Größe  }
  355.     SendCRCBuf(Head, SizeOf(Head));   { Header senden }
  356.     IF R.CX > 0 THEN
  357.       SendCRCBuf(Sda_CurrDta^^, R.CX);{ Daten senden  }
  358.     ReceiveCRCBuf(Buf, SizeOf(Ans_Write));
  359.     R.Flags := Ans.Flags;
  360.     R.AX    := Ans.AX;
  361.     Sp^     := Ans.SFT;
  362.     R.CX    := Ans.Size;
  363.   END;
  364.  
  365.   PROCEDURE p_GetSpace;
  366.   (* Get Disk Space - subfunction 0Ch                     *)
  367.   (* Eingabeparameter:                                    *)
  368.   (*  es:di : Zeiger auf CDS-Struktur                     *)
  369.   (* Ausgabeparameter:                                    *)
  370.   (*  al : Sektoren pro Cluster                           *)
  371.   (*  bx : Gesamtzahl der Cluster                         *)
  372.   (*  cx : Bytes pro Sektor                               *)
  373.   (*  dx : Verfügbare Cluster                             *)
  374.   (*  Benutzt werden al*bx*cx und al*cx*dx                *)
  375.   VAR
  376.     P   : ^PathArray;
  377.     Ans : Ans_GetSpace ABSOLUTE Buf;
  378.   BEGIN
  379.     P := Ptr(R.ES, R.DI);
  380.     Head.Command := _GetSpace;
  381.     Move(P^, Head.Fn1, 67);
  382.     SendCRCBuf(Head, SizeOf(Head));
  383.     ReceiveCRCBuf(Buf, SizeOf(Ans_GetSpace));
  384.     R.AX := Ans.SPC;
  385.     R.BX := Ans.Totc;
  386.     R.CX := Ans.Bps;
  387.     R.DX := Ans.Freec;
  388.   END;
  389.  
  390.   PROCEDURE p_SetAttr;
  391.   (* Set File Attributes - subfunction 0Eh                *)
  392.   (* Eingabeparameter:                                    *)
  393.   (*   SDA.fn1 : Vollständiger Dateiname                  *)
  394.   (*   word auf dem TopOfStack: Neue File-Attribute       *)
  395.   (*                            byte(ptr(r.ss,r.sp)^)     *)
  396.   (* Ausgabeparameter:                                    *)
  397.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  398.   (*   Fehler entsprechen DOS-Fehlern Schäpers S. 692 ff. *)
  399.   (*   2 : Datei nicht gefunden                           *)
  400.   (*   5 : Zugriff verweigert                             *)
  401.   VAR
  402.     Ans : Ans_SetAttr ABSOLUTE Buf;
  403.   BEGIN
  404.     Head.Command := _SetAttr;              { Kommando    }
  405.     Head.Fn1     := Sda_fn1^;              { File        }
  406.     Head.Param0  := BYTE(Ptr(R.SS,R.Sp)^); { neues Attr. }
  407.     SendCRCBuf(Head, SizeOf(Head));
  408.     ReceiveCRCBuf(Buf, SizeOf(Ans_SetAttr));
  409.     R.AX    := Ans.AX;
  410.     R.Flags := Ans.Flags;
  411.   END;
  412.  
  413.   PROCEDURE p_GetAttr;
  414.   (* Get File Attributes - subfunction 0Fh                *)
  415.   (* Eingabeparameter:                                    *)
  416.   (*   SDA.fn1 : Vollständiger Dateiname                  *)
  417.   (*   word auf dem TopOfStack: Neue File-Attribute       *)
  418.   (*                            byte(ptr(r.ss,r.sp)^)     *)
  419.   (* Ausgabeparameter:                                    *)
  420.   (*   AX ohne Carry: File Attribut                       *)
  421.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  422.   (*   Fehler entsprechen DOS-Fehlern Schäpers S. 692 ff. *)
  423.   (*   2 : Datei nicht gefunden                           *)
  424.   (*   5 : Zugriff verweigert                             *)
  425.   VAR
  426.     Ans : Ans_GetAttr ABSOLUTE Buf;
  427.   BEGIN
  428.     Head.Command := _GetAttr;              { Kommando    }
  429.     Head.Fn1     := Sda_fn1^;              { File        }
  430.     SendCRCBuf(Head, SizeOf(Head));
  431.     ReceiveCRCBuf(Buf, SizeOf(Ans_GetAttr));
  432.     R.AX    := Ans.AX;
  433.     R.Flags := Ans.Flags;
  434.     R.BX    := Ans.BX;
  435.     R.DI    := Ans.DI;
  436.   END;
  437.  
  438.   PROCEDURE p_Rename;
  439.   (* Rename File - subfunction 11h                        *)
  440.   (* Eingabeparameter:                                    *)
  441.   (*   SDA.fn1 : Vollständiger Dateiname (mit Wildcards!) *)
  442.   (*   SDA.fn2 : Neuer vollständiger Dateiname            *)
  443.   (*             (Zugriff über ss:fn2_csofs)              *)
  444.   (* Ausgabeparameter:                                    *)
  445.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  446.   VAR
  447.     Ans : Ans_Rename ABSOLUTE Buf;
  448.   BEGIN
  449.     Head.Command := _Rename;
  450.     Head.Fn1     := Sda_fn1^;
  451.     SendCRCBuf(Head, SizeOf(Head));
  452.     Buf          := Sda_fn2^;
  453.     SendCRCBuf(Buf, SizeOf(Buf));
  454.     ReceiveCRCBuf(Buf, SizeOf(Ans_Rename));
  455.     R.AX    := Ans.AX;
  456.     R.Flags := Ans.Flags;
  457.   END;
  458.  
  459.   PROCEDURE p_Delete;
  460.   (* Delete File - subfunction 13h                        *)
  461.   (* Eingabeparameter:                                    *)
  462.   (*   SDA.fn1 : Vollständiger Dateiname (mit Wildcards!) *)
  463.   (* Ausgabeparameter:                                    *)
  464.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  465.   VAR
  466.     Ans : Ans_Delete ABSOLUTE Buf;
  467.   BEGIN
  468.     Head.Command := _Delete;
  469.     Head.Fn1     := Sda_fn1^;
  470.     SendCRCBuf(Head, SizeOf(Head));
  471.     ReceiveCRCBuf(Buf, SizeOf(Ans_Delete));
  472.     R.AX    := Ans.AX;
  473.     R.Flags := Ans.Flags;
  474.   END;
  475.  
  476.   PROCEDURE p_Open;
  477.   (* Open Existing File - subfunction 16h                 *)
  478.   (* Eingabeparameter:                                    *)
  479.   (*   SDA.fn1        : vollständiger Dateiname           *)
  480.   (*   es:di          : Zeiger auf uninitialisierten SFT  *)
  481.   (*   SDA.open_mode  : gewünschter OpenMode für File     *)
  482.   (*                    (0: Lesen, 1:Schreiben,           *)
  483.   (*                     2: Lesen/Schreiben               *)
  484.   (* Ausgabeparameter:                                    *)
  485.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  486.   (*   SFT komplettiert                                   *)
  487.   (*    aus File übernehmen: f_size, f_date, f_time,      *)
  488.   (*                         fcb_fn, attr_byte            *)
  489.   (*    ändern: open_mode Bit 7 löschen                   *)
  490.   (*    setzen: dev_info ($8040 or drive_no),             *)
  491.   (*            dir_sector (0), dir_entryno (0),          *)
  492.   (*            dev_drvptr (nil), f_pos (0)               *)
  493.   VAR
  494.     Ans : Ans_Open ABSOLUTE Buf;
  495.     Sp  : ^SFT_Rec;
  496.     BP  : ^BYTE;
  497.   BEGIN
  498.     BP := Ptr(R.SS, R.Sp);
  499.     Sp := Ptr(R.ES, R.DI);
  500.     Head.Command := _Open;
  501.     Head.Fn1     := Sda_fn1^;
  502.     Head.Param0  := Sda_OpenMode^ + BP^ SHL 8;
  503.     SendCRCBuf(Head, SizeOf(Head));
  504.     ReceiveCRCBuf(Buf, SizeOf(Ans_Open));
  505.     Ans.SFT.Dev_Info := $8040 OR Drive_No;
  506.     Sp^     := Ans.SFT;
  507.     R.AX    := Ans.AX;
  508.     R.Flags := Ans.Flags;
  509.   END;
  510.  
  511.   PROCEDURE p_Create;
  512.   (* Truncate/Create File - subfunction 17h               *)
  513.   (* Eingabeparameter:                                    *)
  514.   (*   SDA.fn1        : vollständiger Dateiname           *)
  515.   (*   es:di          : Zeiger auf uninitialisierten SFT  *)
  516.   (*   word auf TOS   : Fileattribut + 'openwish'         *)
  517.   (*                    (0:normal 1:create new)           *)
  518.   (* Ausgabeparameter:                                    *)
  519.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  520.   (*   SFT komplettiert                                   *)
  521.   (*    aus File übernehmen: f_size, f_date, f_time,      *)
  522.   (*                         fcb_fn, attr_byte (?)        *)
  523.   (*    ändern: open_mode Bit 7 löschen                   *)
  524.   (*    setzen: dev_info ($8040 or drive_no),             *)
  525.   (*            dir_sector (0), dir_entryno (0),          *)
  526.   (*            dev_drvptr (nil), f_pos (0)               *)
  527.   (* !!! keine Lösung für DOS Funktion $5B !!!            *)
  528.   VAR
  529.     Ans : Ans_Create ABSOLUTE Buf;
  530.     Sp  : SFT_Ptr;
  531.   BEGIN
  532.     Sp           := Ptr(R.ES, R.DI);
  533.     Head.Command := _Create;
  534.     Head.Fn1     := Sda_fn1^;
  535.     Head.Param0  := WORD(Ptr(R.SS, R.Sp)^);
  536.     SendCRCBuf(Head, SizeOf(Head));
  537.     ReceiveCRCBuf(Buf, SizeOf(Ans_Create));
  538.     Ans.SFT.Dev_Info := $8040 OR Drive_No;
  539.     Sp^     := Ans.SFT;
  540.     R.AX    := Ans.AX;
  541.     R.Flags := Ans.Flags;
  542.   END;
  543.  
  544.   PROCEDURE p_FindFirst;
  545.   (* FindFirst - subfunction 1Bh                          *)
  546.   (* Eingabeparameter:                                    *)
  547.   (*   SDA.fn1      : vollständige Spezifikation der Datei*)
  548.   (*   SDA.sdb      : Suchdatenblock (uninitialisiert)    *)
  549.   (*   SDA.curr_dta : zeigt auf Directory-Info-Buffer     *)
  550.   (*   SDA.srch_attr: Such-Attributmaske                  *)
  551.   (* Ausgabeparameter:                                    *)
  552.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  553.   (*   zusätzlich: 18 : kein File gefunden                *)
  554.   (*   initialisierter SDB und Directory-Info-Buffer      *)
  555.   VAR
  556.     Ans : Ans_FindFirst ABSOLUTE Buf;
  557.   BEGIN
  558.     Head.Command := _FindFirst;
  559.     Head.Fn1     := Sda_fn1^;
  560.     Head.Param0  := Sda_SrchAttr^;
  561.     SendCRCBuf(Head, SizeOf(Head));
  562.     ReceiveCRCBuf(Buf, SizeOf(Ans_FindFirst));
  563.     Ans.Sdb.Drv_Lett := Drive_No OR $80;
  564.     Sda_Sdb^  := Ans.Sdb;
  565.     Sda_Dib^  := Ans.Dib;
  566.     R.AX      := Ans.AX;
  567.     R.Flags   := Ans.Flags;
  568.   END;
  569.  
  570.   PROCEDURE p_FindNext;
  571.   (* FindNext - subfunction 1Ch                           *)
  572.   (* Eingabeparameter:                                    *)
  573.   (*   SDA.sdb      : Suchdatenblock (initialisiert)      *)
  574.   (*   SDA.curr_dta : zeigt auf Directory-Info-Buffer     *)
  575.   (* Ausgabeparameter:                                    *)
  576.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  577.   (*   zusätzlich: 18 : kein File gefunden                *)
  578.   (*   initialisierter SDB und Directory-Info-Buffer      *)
  579.   VAR
  580.     Ans : Ans_FindNext ABSOLUTE Buf;
  581.   BEGIN
  582.     Head.Command := _FindNext;
  583.     Head.Sdb     := Sda_Sdb^;
  584.     Head.Dir     := Sda_Dib^;
  585.     SendCRCBuf(Head, SizeOf(Head));
  586.     ReceiveCRCBuf(Buf, SizeOf(Ans_FindNext));
  587.     Ans.Sdb.Drv_Lett := $80 OR Drive_No;
  588.     R.AX      := Ans.AX;
  589.     R.Flags   := Ans.Flags;
  590.     Sda_Sdb^  := Ans.Sdb;
  591.     Sda_Dib^  := Ans.Dib;
  592.   END;
  593.  
  594.   PROCEDURE p_SeekEnd;
  595.   (* Seek From End Of File - subfunction 21h              *)
  596.   (* Eingabeparameter:                                    *)
  597.   (*   es:di : Zeiger auf SFT des Files                   *)
  598.   (*   cx:dx : Offset, auf das positioniert werden soll.  *)
  599.   (* Ausgabeparameter:                                    *)
  600.   (*   AX+Carry, falls Fehler aufgetreten                 *)
  601.   VAR
  602.     Sp   : SFT_Ptr;
  603.     Long : LongInt;
  604.   BEGIN
  605.     Sp         := Ptr(R.ES, R.DI);
  606.     os(Long).s := R.CX;
  607.     os(Long).o := R.DX;
  608.     Sp^.f_Pos  := Sp^.f_Size-Long;
  609.     R.DX       := os(Long).s;
  610.     R.AX       := os(Long).o;
  611.   END;
  612.  
  613.   PROCEDURE p_Hook;
  614.   (* Process Termination Hook - subfunction 22h           *)
  615.   (* Der Process Termination Hook wird immer aufgerufen,  *)
  616.   (* wenn ein Programm beendet wird. Dies ist notwendig,  *)
  617.   (* da viele Programm (z.B. Windows) gar nicht daran     *)
  618.   (* denken, ihre eigenen Dateien zu schließen...         *)
  619.   BEGIN
  620.     Head.Command := _Hook;
  621.     SendCRCBuf(Head,SizeOf(Head));
  622.   END;
  623.  
  624.   PROCEDURE p_ExtendOpen;
  625.   (* Special Multi-Purpose Open File - subfunction 2Eh    *)
  626.   (* Diese Funktion wird u.a. von Windows aufgerufen. Sie *)
  627.   (* hat wie die Funktion 17h das Problem der nicht       *)
  628.   (* bekannten Mitteilung des Fehlerfalles.               *)
  629.   (* Eingabeparameter:                                    *)
  630.   (*    SDA.fn1 : vollständiger Dateiname                 *)
  631.   (*    es:di   : uninitialisierte SFT für File           *)
  632.   (*    SDA.spop_act  : Action-Code (siehe Schäpers)      *)
  633.   (*    SDA.spop_attr : Fileattribut                      *)
  634.   (*    SDA.spop_mode : Modus                             *)
  635.   (* Ausgabeparameter:                                    *)
  636.   (*    Carry und AX im Fehlerfall                        *)
  637.   (*    initialisierte SFT                                *)
  638.   VAR
  639.     Ans : Ans_ExtendOpen ABSOLUTE Buf;
  640.     Sp  : ^SFT_Rec;
  641.   BEGIN
  642.     Sp            := Ptr(R.ES, R.DI);
  643.     Head.Command  := _ExtendOpen;
  644.     Head.Fn1      := Sda_fn1^;
  645.     SendCRCBuf(Head, SizeOf(Head));
  646.     SendCRCBuf(Sda_SpecPop^, SizeOf(tSpecPop));
  647.     ReceiveCRCBuf(Buf, SizeOf(Ans_ExtendOpen));
  648.     Ans.SFT.Dev_Info := $8040 OR Drive_No;
  649.     Sp^     := Ans.SFT;
  650.     R.AX    := Ans.AX;
  651.     R.Flags := Ans.Flags;
  652.     R.CX    := Ans.CX;
  653.   END;
  654.  
  655.   PROCEDURE p_Inquiry;
  656.   BEGIN
  657.     R.AX := $00FF;
  658.   END;
  659.  
  660. {$F-}
  661.  
  662. (* Der Redirector *)
  663.  
  664. CONST
  665.   Fxn_Map_Max = $2E;
  666.  
  667. TYPE
  668.   SubFunction = PROCEDURE;
  669.   Proc_Tbl    = ARRAY [0..Fxn_Map_Max] OF SubFunction;
  670.  
  671. CONST
  672.   FuncTbl : Proc_Tbl =
  673.    (p_Inquiry,  p_RemDir,  NIL,       p_MakeDir,   { 00-03 }
  674.     NIL,        p_ChDir,   p_Close,   p_Commit,    { 04-07 }
  675.     p_Read,     p_Write,   NIL,       NIL,         { 08-0B }
  676.     p_GetSpace, NIL,       p_SetAttr, p_GetAttr,   { 0C-0F }
  677.     NIL,        p_Rename,  NIL,       p_Delete,    { 10-13 }
  678.     NIL,        NIL,       p_Open,    p_Create,    { 14-17 }
  679.     NIL,        NIL,       NIL,       p_FindFirst, { 18-1B }
  680.     p_FindNext, p_Hook,    NIL,       NIL,         { 1C-1F }
  681.     NIL,        p_SeekEnd, p_Hook,    NIL,         { 20-23 }
  682.     NIL,        NIL,       NIL,       NIL,         { 24-27 }
  683.     NIL,        NIL,       NIL,       NIL,         { 28-2B }
  684.     NIL,        NIL,       p_ExtendOpen);          { 2C-2E }
  685.  
  686. VAR
  687.   Func          : SubFunction;
  688.                                 { gewünschte Unterfunktion }
  689.   fPtr          : POINTER ABSOLUTE Func;
  690.                                 { Zeiger auf dieselbe      }
  691.   TransferBreak : WaitResult;   { Flag (Kanalüberwachung)  }
  692.  
  693.   { Der Redirector ist der zweite Teil des ISR-Handlers,   }
  694.   { diesmal in Turbo Pascal. Die Routine ist als           }
  695.   { "interrupt" deklariert und sichert daher automatisch   }
  696.   { fast alle Register. Die restlichen Register wurden     }
  697.   { schon durch die ISR-Routine gesichert. Wird der        }
  698.   { Redirector benötigt, speichert er alle Register in der }
  699.   { Variablen "r" ab, die im Gegensatz zum Typ "Registers" }
  700.   { wirklich alle Register enthält. Die werden bei Ver-    }
  701.   { lassen wieder restauriert, so daß jedes Register       }
  702.   { geändert werden kann.                                  }
  703.  
  704.   PROCEDURE Redirector(_flags,_cs,_ip,_ax,_bx,_cx,_dx,
  705.                        _si,_di,_ds,_es,_bp : WORD);
  706.   BEGIN
  707.     WITH R DO BEGIN
  708.         { our_drive = false --> call wird durchgereicht }
  709.       ISR^.Our_Drive:=FALSE;
  710.         { wenn wir den Call nicht unterstützen,
  711.           wird er durchgereicht }
  712.       IF Lo(_ax) > Fxn_Map_Max THEN
  713.         Exit
  714.       ELSE
  715.         Func := FuncTbl[Lo(_ax)];
  716.       IF fPtr = NIL THEN Exit;
  717.  
  718.         { wenn der call nicht für uns ist,
  719.           wird er ebenfalls durchgereicht }
  720.       IF ((Lo(_ax) >= $6) AND (Lo(_ax) <= $B)) OR
  721.           (Lo(_ax) = $21) THEN BEGIN
  722.           { SFT-Funktionen }
  723.         IF (SFT_Rec(Ptr(_es,_di)^).Dev_Info AND
  724.                      $1F) <> Drive_No THEN BEGIN
  725.           Exit;
  726.         END;
  727.       END ELSE
  728.           { Funktionen, in denen currpath auf die
  729.             korrekte cds zeigt }
  730.         IF (Lo(_ax) > 0) AND (Lo(_ax) <> $1C) AND
  731.            (Lo(_ax) <> $1D) AND (Lo(_ax) <> $22) THEN BEGIN
  732.           IF StrLComp(Cds_CurrPath^^,
  733.                       ID_Drv, ID_Max-1) <> 0 THEN Exit;
  734.         END;
  735.  
  736.       ISR^.Our_Drive := TRUE;
  737.         { Speichern der Register }
  738.       Move(_bp, BP, 18);
  739.       SS    := ISR^.Save_SS;
  740.       Sp    := ISR^.Save_SP;
  741.       CS    := ISR^.Save_CS;
  742.       IP    := ISR^.Save_IP;
  743.       Flags := ISR^.Real_FL;
  744.         { alles ok ... }
  745.         { Überprüfung des Übertragungskanals ... }
  746.       AX    := 0;
  747.       Flags := Flags AND NOT FCarry;
  748.         { lokale Verarbeitung }
  749.       Head.Current_PSP := Sda_CurrPsp^;
  750.       Func;
  751.         { Register wiederherstellen }
  752.       Move(BP, _bp, 18);
  753.       ISR^.Save_SS := SS;
  754.       ISR^.Save_SP := Sp;
  755.       ISR^.Save_CS := CS;
  756.       ISR^.Save_IP := IP;
  757.       ISR^.Real_FL := Flags;
  758.     END;
  759.   END;
  760.  
  761.   (* TSR-Routinen *)
  762.  
  763. TYPE
  764.   Sig_Rec = RECORD
  765.     Signature : STRING[7];
  766.                 { Signatur zum Wiederfinden des Interrupts }
  767.     PSP       : WORD;     { Segment des PSPs zum Löschen   }
  768.     Drive_No  : BYTE;     { Laufwerksnummer                }
  769.     LptAdr    : WORD;     { Adresse der Schnittstelle      }
  770.     tMode     : TransMode;{ 4- oder 8-Bit Transfer         }
  771.     tLast     : ^BYTE;    { senden oder empfangen...       }
  772.     OldLpt    : ARRAY [1..4] OF WORD;
  773.   END;
  774.   SigPtr = ^Sig_Rec;
  775.   OS = RECORD             { Zur Bearbeitung von Zeigern    }
  776.          o, s : WORD;
  777.        END;
  778.  
  779. CONST
  780.   Our : Sig_Rec = (Signature : 'TOOLBOX';
  781.                    PSP       : 0;
  782.                    Drive_No  : 0;
  783.                    LptAdr    : 0;
  784.                    tMode     : Transfer4;
  785.                    tLast     : NIL);
  786.  
  787. VAR
  788.   LoL   : ^LoL_Rec;   (* List of Lists *)
  789.   Drive : STRING[3];
  790.  
  791.   PROCEDURE FailProg(st : STRING);
  792.   BEGIN
  793.     WriteLn(st);
  794.     Halt(1);
  795.   END;
  796.  
  797.   FUNCTION Get_Dos_Vars : BYTE;
  798.   (* get_dos_vars holt die DOS-Version, die Adresse der  *)
  799.   (* SDA und der LoL. Da das Programm nur DOS-Versionen  *)
  800.   (* ab 3.10 unterstützt, wird ggf. abgebrochen. Als     *)
  801.   (* Funktionsergebnis wird die Hauptversion von DOS     *)
  802.   (* zurückgegeben.                                      *)
  803.   VAR
  804.     R   : Registers;
  805.     Ver : WORD;
  806.     SDA : POINTER;
  807.   BEGIN
  808.       { DOS-Version ermitteln }
  809.     Ver := Swap(DosVersion);
  810.     IF (Ver < $30A) OR (Ver > $0A00 { OS/2 }) THEN
  811.       FailProg('DOS Version must be 3.10 or greater');
  812.     WITH R DO BEGIN
  813.       AX  := $5D06;
  814.       MsDos(R);
  815.       SDA := Ptr(DS, SI);   { Get SDA pointer }
  816.       AX  := $5200;
  817.       MsDos(R);
  818.       LoL := Ptr(ES, BX);   { Get LoL pointer }
  819.     END;
  820.       { Variablen initialisieren }
  821.     IF Ver >= $400 THEN BEGIN
  822.       Sda_fn1      := @Sda4_Rec(SDA^).Fn1;
  823.       Sda_fn2      := @Sda4_Rec(SDA^).Fn2;
  824.       Sda_SrchAttr := @Sda4_Rec(SDA^).Srch_Attr;
  825.       Sda_Sdb      := @Sda4_Rec(SDA^).Sdb;
  826.       Sda_Dib      := @Sda4_Rec(SDA^).Found_File;
  827.       Sda_CurrDta  := @Sda4_Rec(SDA^).Curr_DTA;
  828.       Sda_CurrPsp  := @Sda4_Rec(SDA^).Curr_PSP;
  829.       Sda_SpecPop  := @Sda4_Rec(SDA^).sPop;
  830.       Sda_OpenMode := @Sda4_Rec(SDA^).Open_Mode;
  831.       Cds_CurrPath := @Sda4_Rec(SDA^).Drive_CdsPtr;
  832.     END ELSE BEGIN
  833.       Sda_fn1      := @Sda3_Rec(SDA^).Fn1;
  834.       Sda_fn2      := @Sda3_Rec(SDA^).Fn2;
  835.       Sda_SrchAttr := @Sda3_Rec(SDA^).Srch_Attr;
  836.       Sda_Sdb      := @Sda3_Rec(SDA^).Sdb;
  837.       Sda_Dib      := @Sda3_Rec(SDA^).Drive_CdsPtr;
  838.       Sda_CurrDta  := @Sda3_Rec(SDA^).Curr_DTA;
  839.       Sda_CurrPsp  := @Sda3_Rec(SDA^).Curr_PSP;
  840.       Sda_OpenMode := @Sda3_Rec(SDA^).Open_Mode;
  841.       Cds_CurrPath := @Sda3_Rec(SDA^).Drive_CdsPtr;
  842.     END;
  843.     Get_Dos_Vars := Hi(Ver);
  844.   END;
  845.  
  846.   FUNCTION Installed_2f:BYTE; ASSEMBLER;
  847.    (* installed_2f überprüft, ob überhaupt ein
  848.       Redirector gesetzt werden kann *)
  849.   ASM
  850.     MOV AX,1100H
  851.     INT 2FH
  852.   END;
  853.  
  854.   PROCEDURE Set_Path_Entry(Dos_Major : BYTE);
  855.   (* set_path_entry trägt das Laufwerk in die CDS-Tabelle *)
  856.   (* ein. Es überprüft in der LoL, ob der Eintrag möglich *)
  857.   (* ist und das Laufwerk nicht schon benutzt. Die Flags, *)
  858.   (* der current_path und der root_ofs müssen gesetzt     *)
  859.   (* werden. Außerdem initialisiert set_path_entry den    *)
  860.   (* Int-2F-Hook                                          *)
  861.   VAR
  862.     Our_Cds : ^Cds3_Rec;
  863.   BEGIN
  864.     { Installieren des $2F-Handlers }
  865.     IF Installed_2f=1 THEN
  866.       FailProg('Not OK to install a redirector...');
  867.  
  868.     (* !!! Achtung: Es wird angenommen, daß auf dem Stack *)
  869.     (* !!!          256 Bytes belegt sind. Sollte das     *)
  870.     (* !!!          Programm nicht klappen, könnte es     *)
  871.     (* !!!          daran liegen.                         *)
  872.     Our_SP := sPtr + $100;
  873.  
  874.     { Initialisierung des ISR-Codes: }
  875.     Init_ISR_Code;
  876.  
  877.     { A = 1, B = 2, C = 3, ... }
  878.     Drive_No := BYTE(Drive[1]) - BYTE('@');
  879.  
  880.     { Laufwerk überhaupt in CDS enthalten ? }
  881.     IF Drive_No > LoL^.Last_Drive THEN
  882.       FailProg('in CONFIG.SYS »LASTDRIVE=' + Drive[1] +
  883.                '« eintragen');
  884.  
  885.     { CDS-Eintrag bestimmen ... }
  886.     IF Dos_Major = 3 THEN
  887.       Our_Cds := @LoL^.Cds^.Cds3[Drive_No]
  888.     ELSE
  889.       Our_Cds := @LoL^.Cds^.Cds4[Drive_No];
  890.  
  891.     { CDS-Eintrag für Programm modifizieren ... }
  892.     WITH Our_Cds^ DO BEGIN
  893.       IF (Flags AND $C000)<>0 THEN  { Laufwerk unbenutzt ? }
  894.         FailProg('Drive already assigned.');
  895.       Flags := Flags OR $C000;
  896.                              { Network und Physical Bit an }
  897.         { Laufwerksname sei "RMT.F:\" }
  898.       ID_Drv[ID_Max-3] := CHAR(BYTE('@') + Drive_No);
  899.         { Laufwerk in CDS eintragen }
  900.       StrCopy(Curr_Path, ID_Drv);
  901.       Root_Ofs := ID_Max-1;
  902.     END;
  903.   END;
  904.  
  905.   PROCEDURE Kill_SFT;
  906.   (* kill_sft löscht alle Einträge in der SFT, die von    *)
  907.   (* unserem Installationsprogramm benutzt werden.        *)
  908.   VAR
  909.     jPtr    : ^BYTE;
  910.     jftSize : WORD;
  911.   BEGIN
  912.     jPtr    := Pointer(Ptr(PrefixSeg,$34)^);
  913.     jftSize := Mem[PrefixSeg:$32];
  914.     ASM
  915.       MOV CX,jftSize
  916.       LES DI,jPtr
  917.       ADD DI,CX
  918.     @LOOP:
  919.       Dec DI
  920.       MOV BL,ES:[DI]
  921.       CMP BL,0FFH
  922.       JZ  @NoHndl
  923.       MOV BX,CX
  924.       DEC BX
  925.       MOV AH,3EH
  926.       INT 21H
  927.     @NoHndl:
  928.       LOOP @LOOP
  929.     END;
  930.   END;
  931.  
  932.   PROCEDURE TSR;
  933.   (* tsr ersetzt die Keep-Routine. Sie gibt das           *)
  934.   (* Environment frei und reserviert lediglich den        *)
  935.   (* Speicherbereich zwischen aktuellem HeapPtr und       *)
  936.   (* Präfix. Absolute Vorsicht also bei new während des   *)
  937.   (* residenten Zustands!                                 *)
  938.   VAR
  939.     R : Registers;
  940.   BEGIN
  941.     SwapVectors;
  942.   { Tauscht SYSTEM-Interrupt-Vektoren mit DOS-Vektoren aus }
  943.     R.AX := $4900;
  944.     { folgenden Speicherblock freigeben :                  }
  945.     R.ES := MemW[PrefixSeg:$2C];  { Environment-Segment    }
  946.     MsDos(R);
  947.     R.AX := $3100;
  948.     { Terminate & Stay Resident für folg. Block:           }
  949.     R.DX := os(HeapPtr).s - PrefixSeg + 1;
  950.     { Bereich von Präfix - akt. HeapPtr  }
  951.     MsDos(R);
  952.   END;
  953.  
  954.   PROCEDURE Settle_Down;
  955.   (* settle_down hängt das Programm in den Interrupt $2F  *)
  956.   (* und speichert an der erstbesten Stelle im Bereich    *)
  957.   (* $60 bis $67 einen Verweis auf das TSR-Programm ab.   *)
  958.   (* Dieser kann später zum Löschen eingesetzt werden.    *)
  959.   VAR
  960.     i : INTEGER;
  961.   BEGIN
  962.     SetIntVec($2F,ISR);
  963.     { Einhängen der ISR in Int $2F                         }
  964.     { Suchen eines freien Interrupt im Bereich $60 bis $67 }
  965.     { zum Abspeichern der TSR-Daten, die zum Unload        }
  966.     { benötigt werden.                                     }
  967.     i := $60;
  968.     WHILE (i <= $67) AND
  969.           (Pointer(Ptr(0, i SHL 2)^) <> NIL) DO Inc(i);
  970.     IF i = $68 THEN BEGIN
  971.         { Kein Interrupt zum Unloaden gefunden ... }
  972.       WriteLn('No user interrupt available. ',
  973.               'REMOTE not unloadable...');
  974.       Kill_SFT;
  975.       TSR;
  976.     END;
  977.     { Abspeichern des Signatur-Records in der Kommandozeile}
  978.     { des PSP (Offset $80). Der Zeiger auf die Signatur    }
  979.     { wird im Int-i abgelegt. Anschließend wird das        }
  980.     { Programm resident gemacht.                           }
  981.     SetIntVec(i, Ptr(PrefixSeg, $80));
  982.     Our.PSP      := PrefixSeg;
  983.     Our.Drive_No := Drive_No;
  984.     Sig_Rec(Ptr(PrefixSeg, $80)^) := Our;
  985.     Kill_SFT;
  986.     TSR;
  987.   END;
  988.  
  989.   PROCEDURE Do_Unload(Dos_Major : BYTE);
  990.   (* do_unload sucht das letzte installierte Laufwerk und *)
  991.   (* hängt es aus der INT-2F-Kette aus. Anschließend wird *)
  992.   (* der Speicher freigegeben und in der CDS das Laufwerk *)
  993.   (* als nicht vorhanden markiert.                        *)
  994.   VAR
  995.     i      : INTEGER;
  996.     P, Cds : POINTER;
  997.     R      : Registers;
  998.   BEGIN
  999.     { Signatur-Record von hinten her suchen }
  1000.     i := $67;
  1001.     WHILE (i >= $60) AND
  1002.       (SigPtr(Ptr(0, i SHL 2)^)^.Signature <> Our.Signature)
  1003.       DO Dec(i);
  1004.     { Signatur-Record nicht gefunden ... }
  1005.     IF i = $5F THEN
  1006.       FailProg(Our.Signature + ' nicht gefunden...');
  1007.     GetIntVec($2F, P);
  1008.     { nicht unser 2F-Handler... }
  1009.     IF os(P).o <> 0 THEN
  1010.       FailProg('2F überschrieben...');
  1011.     { alten Handler eintragen ... }
  1012.     os(P).o := Prev_Hndlr;
  1013.     SetIntVec($2F, Pointer(P^));
  1014.     GetIntVec(i, P);
  1015.     Drive_No := Sig_Rec(P^).Drive_No;
  1016.     { Speicher freigeben ... }
  1017.     WITH R DO BEGIN
  1018.         { Funktion $49 gibt Speicherblock "ES" frei }
  1019.       AX := $4900;
  1020.       ES := Sig_Rec(P^).PSP;
  1021.       MsDos(R);
  1022.       IF Boolean(Flags AND FCarry) THEN
  1023.         WriteLn('Freigabe des Hauptspeichers nicht ',
  1024.                 'möglich...');
  1025.     END;
  1026.     { User-Interrupt freigeben ... }
  1027.     SetIntVec(i,NIL);
  1028.     { Selbstmordbefehl an den Remote-Rechner }
  1029.     UnitInit(Sig_Rec(P^).LptAdr);
  1030.     TransferMode := Sig_Rec(P^).tMode;
  1031.     LastMode     := Sig_Rec(P^).tLast^;
  1032.     { BIOS wieder reparieren ... }
  1033.     Move(Sig_Rec(P^).OldLpt, Mem[$40:$08],
  1034.          SizeOf(Our.OldLpt));
  1035.     Write('«Taste»');
  1036.     SetKbdWatchdog;
  1037.     Head.Command := _KillContact;
  1038.     SendCRCBuf(Head,SizeOf(Head));
  1039.     ClrKbdWatchdog;
  1040.     WriteLn(^H^H^H^H^H^H^H^H, '       ');
  1041.     WHILE KeyPressed AND (ReadKey = #0) DO (* nothing *) ;
  1042.     { CDS-Struktur aus der LoL bestimmen }
  1043.     Cds := LoL_Rec(LoL^).Cds;
  1044.     IF Dos_Major = 3 THEN
  1045.       Inc(os(Cds).o, SizeOf(Cds3_Rec) * Pred(Drive_No))
  1046.     ELSE
  1047.       Inc(os(Cds).o, SizeOf(Cds4_rec) * Pred(Drive_No));
  1048.     { Laufwerk als gelöscht markieren ... }
  1049.     WITH Cds3_Rec(Cds^) DO
  1050.       Flags := Flags AND $3FFF;
  1051.                  { oberste 5 Bit geben Typ des Lw an... }
  1052.     WriteLn('Laufwerk ', CHAR(BYTE('@') + Drive_No),
  1053.             ': nicht mehr vorhanden.');
  1054.   END;
  1055.  
  1056.   FUNCTION GetHex(VAR s : STRING; VAR Val : WORD) : WORD;
  1057.   VAR
  1058.     hw, w : WORD;
  1059.     i     : BYTE;
  1060.   BEGIN
  1061.     IF Length(s) > 4 THEN BEGIN
  1062.       GetHex := 5;
  1063.       Exit;
  1064.     END;
  1065.     w := 0;
  1066.     FOR i := 1 TO Length(s) DO BEGIN
  1067.       hw := 0; s[i] := UpCase(s[i]);
  1068.       IF (s[i] >= '0') AND (s[i] <= '9') THEN
  1069.         hw := Ord(s[i]) - Byte('0')
  1070.       ELSE IF (s[i] >= 'A') AND (s[i] <= 'F') THEN
  1071.         hw := Ord(s[i]) - Byte('A') + 10
  1072.       ELSE BEGIN
  1073.         GetHex := i;
  1074.         Exit;
  1075.       END;
  1076.       w := w SHL 4 + hw;
  1077.     END;
  1078.     Val    := w;
  1079.     GetHex := 0;
  1080.   END;
  1081.  
  1082. VAR
  1083.   Error, Nr, Dos_Major : WORD;
  1084.   st                   : STRING[6];
  1085.   i, j                 : WORD;
  1086. BEGIN
  1087.   IF (ParamCount <> 1) AND (ParamCount <> 2) THEN
  1088.     FailProg('Benutzung: REMOTE drive-letter: '+
  1089.              'lptnr oder REMOTE -u zum deinstallieren');
  1090.   Drive     := ParamStr(1);
  1091.   Drive[1]  := UpCase(Drive[1]);
  1092.   Dos_Major := Get_Dos_Vars;
  1093.   { Aufforderung zum Unloaden }
  1094.   IF (Drive = '-u') OR (Drive = '-U') THEN
  1095.     { Entfernen der residenten Version }
  1096.     Do_Unload(Dos_Major)
  1097.   ELSE BEGIN
  1098.     { Überprüfung auf 'korrektes' Verzeichnis }
  1099.     IF (Length(Drive) > 2) OR
  1100.        (Drive[1] < 'A') OR (Drive[1] > 'Z') OR
  1101.        ((Length(Drive) = 2) AND (Drive[2] <> ':')) THEN
  1102.       FailProg('Benutzung: REMOTE drive-letter: lptnr oder'+
  1103.                ' REMOTE -u zum Deinstallieren')
  1104.     ELSE BEGIN
  1105.       st := ParamStr(2);
  1106.       IF st[1] = '$' THEN BEGIN
  1107.         Delete(st, 1, 1);
  1108.         Error := GetHex(st, Nr);
  1109.       END ELSE BEGIN
  1110.         Val(st, Nr, Error);
  1111.         IF Error = 0 THEN Nr := GetLPTAdress(Nr);
  1112.       END;
  1113.       IF Error <> 0 THEN BEGIN
  1114.         FailProg('Benutzung: REMOTE drive-letter: '+
  1115.                  'lptnr oder REMOTE -u zum Deinstallieren');
  1116.       END;
  1117.       UnitInit(Nr);
  1118.       Our.LptAdr := Nr;
  1119.         { Nun klauen wir die Adresse... }
  1120.       Move(Mem[Seg0040:$08], Our.OldLpt, SizeOf(Our.OldLpt));
  1121.       i := 0;
  1122.       j := 0;
  1123.       WHILE i <= 3 DO BEGIN
  1124.         IF MemW[Seg0040:$08+2*i] <> Nr THEN BEGIN
  1125.           MemW[Seg0040:$08+2*j] := MemW[Seg0040:$08+2*i];
  1126.           Inc(j);
  1127.         END;
  1128.         Inc(i);
  1129.       END;
  1130.       WHILE j <= 3 DO BEGIN
  1131.         MemW[Seg0040:$08+2*j] := 0;
  1132.         Inc(j);
  1133.       END;
  1134.       WriteLn('Warten auf Verbindung ',
  1135.               '(Tastendruck zum Abbruch) ...');
  1136.       SetKbdWatchdog;
  1137.       StartSend;
  1138.       Our.tMode := TransferMode;
  1139.       Our.tLast := @LastMode;
  1140.       IF ParaResult = UserBreak THEN BEGIN
  1141.         WriteLn('...abgebrochen');
  1142.         Halt(1);
  1143.       END;
  1144.       ClrKbdWatchdog;
  1145.       TransferBreak := LastResult;
  1146.       Set_Path_Entry(Dos_Major);
  1147.       SendCRCBuf(ID_Drv, SizeOf(ID_Drv));
  1148.       WriteLn('Remote-Laufwerk installiert als ',
  1149.               Drive[1], ':');
  1150.       Settle_Down;
  1151.     END;
  1152.   END;
  1153. END.
  1154. (* ====================================================== *)
  1155. (*                 Ende von REMOTE.PAS                    *)
  1156.