Announcement

Collapse
No announcement yet.

PB/DOS - Network Redirection Functions

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PB/DOS - Network Redirection Functions

    Code:
    '-------------------------------------------------------------------------------
    '      Unit: redir4.pbl
    '     Zweck: Funktionen für Geräte-Umleitung (Netzwerk) und zum Auslesen
    '            von Infos zu umgeleiteten Geräten, Implementation von TRUENAME.
    '   Version: 1.03
    '     Stand: 15.01.1999
    '   Sprache: PowerBASIC 3.5
    '     Autor: (C) M.Hoffmann, Wedeler Landstr.139, 22559 Hamburg.
    '  Benötigt:
    '  Historie:
    '      1.00: Erste Version aus Unit redir3 weiterentwickelt:
    '            Implementation der ursprünglich in MS-DOS enthaltenen, undokumen-
    '            tierten TRUENAME Funktion (INT 21h, Subfunktion 60h), die in einer
    '            WfW-Dosbox nur teilweise und unter Win95 so gar nicht funktioniert.
    '            Alle Programme und Libraries, die TRUENAME-Funktionen verwenden,
    '            müssen diese Funktionen verwenden, um fehlerfrei unter WfW bzw.
    '            Win95 zu laufen. Dokumentation zu TRUENAME siehe DOS7FS1-Unit.
    '      1.01: Bugfixing für RedirTruename (PFAD-Komponente fehlte); nur
    '            KURZE DATEINAMEN zurückliefern (CL=01).
    '      1.02: Anpassungen für PB 3.5; ASM; Bugfixes; Optimierungen; IsDriveRemote
    '            und Truename-Codierung von DOS7FS1 übernommen (modifiziert);
    '            ACHTUNG: RedirGetItem(Parm1) jetzt BYVAL übergeben!
    '            Bei RedirAdd(LM) wird das Passwort unter LM/WfW/W95 ignoriert,
    '            man muß bereits angemeldet sein (29.6.98).
    '      1.03: Bei allen Fehlern aus 21/7160 danach 21/60 probieren (FullFile-
    '            name). Grund: Bei Angabe nicht existierender Dateien liefert
    '            21/7160 einen Fehlercode zurück.
    '  Hinweise: Außer bei RedirAddLM werden die Netzwerkaufrufe des DOS-Kernels
    '            (5F0x) benutzt, anstelle der undokumentierten LAN Manager-Calls
    '            (5F3x/4x/5x). Weitere Calls in DOS7FS1.
    '-------------------------------------------------------------------------------
    ' c: redir4  .pbu      5720  23.09.97  13:18   1.00
    ' c: redir4  .pbu      5740  24.09.97   9:59   1.01
    ' c: redir4  .pbu      4274  29.06.98  13:31   1.02
    ' c: redir4  .pbu      4258  15.01.99  11:37   1.03
    
    '---Compiler--------------------------------------------------------------------
    
    $compile  unit
    $cpu      80386
    $debug    map-,pbdebug-,path-,unit-
    $dim      all
    $error    all-
    $event    off
    $float    emulate
    $lib      all-
    $optimize size
    $static
    $option   gosub-,signed-
    
    defint a-z
    
    '---Deklarationen---------------------------------------------------------------
    
    %lenlocal   = 16
    %lenremote  = 128
    %lenbuf     = 261
    
    ' LAN-Manager use_info_1-Struktur
    
    type UseInfo1Type
       Locl    as asciiz*9
       Padding as string*1
       pRmot   as dword
       pPswd   as dword
       lnksta  as word ' Linkstate (nicht benutzt)=
       UseTyp  as word ' -1 wildcard 0 disk 1 print 2 com 3 ipc
       ignor1  as word
       ignor2  as word
    end type
    
    '---Routinen--------------------------------------------------------------------
    
    function RedirIsDriveRemote (drive as string) local public as integer
       dim drv as local byte
       if len(drive) then
          drv = ascii(ucase$(drive))-64 ' keine Gültigkeitsprüfung
       end if
       ! pushf                      ;
       ! mov   ax, &h4409           ;
       ! mov   bl, drv              ;
       ! int   &h21                 ;
       ! jc    RedirIsDriveRemoteEX ;
       ! mov   ax, dx               ;
       ! mov   cl, 12               ;
       ! shr   ax, cl               ;
       ! and   ax, 1                ;
       ! neg   ax                   ;
    redirIsDriveRemoteEX:           '
       ! neg   ax                   ;
       ! mov   function,ax          ;
       ! popf                       ;
    end function
    
    '-------------------------------------------------------------------------------
    
    function RedirGetItem (byval Index  as integer,_ ' E: Index von 0...n
                                 Lokal  as string ,_ ' A: Lokaler Ressourcename
                                 Remote as string ,_ ' A: UNC-Name \\server\share
                                 DevTyp as integer,_ ' A: Einheitentyp 3=Prt 4=Disk 0=?
                                 Connct as integer _ ' A: ConnState 0=Ok 1=Disc >2=Err
                          ) public as integer  ' : 0=Ok 18=Eof n=Err -1=invEntry
    
       ' Holt Eintrag #Index aus der Redirektionsliste in die Variablen.
       ' Ergebnis: 0 = Ok, Eintrag gelesen
       '          -1 = ungültiger Eintrag? (BH <> 0,1,2)
       '           n = Betriebssystemfehlercode aus AX (18 = Ende der Liste)
       ' Wegen Aufwärtskompatibilität bleibt die merkwürde Rückgabekonvention.
    
       dim lkl as local asciiz*%lenlocal
       dim rmt as local asciiz*%lenremote
       DevTyp = 0 ' Vorbesetzung; 3=Drucker,4=Disk,0=undefined/Error
    
       ! pushf                  ;
       ! push  ds               ;
       ! push  si               ;
       ! push  di               ;
       ! mov   ax, ss           ;
       ! lea   bx, lkl          ; Adresse von 'lkl' über SS:BX
       ! mov   si, bx           ;
       ! mov   ds, ax           ; in DS:SI laden
       ! lea   bx, rmt          ; Adresse von 'rmt' über SS:BX
       ! mov   di, bx           ;
       ! mov   es, ax           ; in ES I laden
       ! mov   ax, &h5f02       ;
       ! mov   bx, Index        ;
       ! push  bp               ; wird laut INTLIST-Doku zerstört?
       ! int   &h21             ;
       ! pop   bp               ;
       ! jc    RedirGetItemEX   ;
       ! mov   ax, -1           ;
       ! cmp   bh, 2            ;
       ! jg    RedirGetItemEX   ;
       ! xor   ax, ax           ;
       ! les   si, DevTyp       ;
       ! mov   es:[si], bl      ;
       ! les   si, Connct       ;
       ! mov   es:[si], bh      ;
    RedirGetItemEX:             '
       ! pop   di               ;
       ! pop   si               ;
       ! pop   ds               ;
       ! popf                   ;
       ! mov   function, ax     ;
       Lokal  = lkl
       Remote = rmt
    
    end function
    
    '-------------------------------------------------------------------------------
    
    function RedirGetInfo (Resrc  as string ,_ ' E: Lokaler/Entfernter Rsrc-Name
                           State  as integer _ ' A: Verbindungs-Status
                          ) public as string   '  : Entfernter/lokaler Rsrc-Name
    
       ' Durchsucht mittels RedirGetItem die Redirektionsliste, bis ein zum
       ' lokalen/entfernten Ressource-Namen passender Eintrag gefunden wird, und
       ' gibt den passenden Remote/Lokal-Namen zurück, sowie den Linkstatus.
       ' Der EinheitenTYP interessiert hier nicht, da der Einheitenname ja als
       ' Eingabeparameter dient, der Typ mithin also bekannt sein dürfte.
       ' Der Eingabeparameter wird nicht überprüft, lediglich vor dem Vergleich
       ' in Großbuchstaben umgewandelt. Liefert Leerstring, wenn kein passender
       ' Eintrag gefunden wird. Ab v1.10 ist Funktion auch zu Ermittlung des
       ' lokalen Namens passend zum angegebenen entfernten Namen verwendbar.
    
       dim i    as local integer
       dim locl as local string
       dim rmte as local string
       dim temp as local string
       dim func as local integer
       temp = ucase$(extract$(Resrc,":"))
       if len(temp) = 1 then
          if RedirIsDriveRemote(temp) = 0 then
             exit function
          end if
          temp = temp+":"
       end if
       do
          func = redirGetItem(i,locl,rmte,0,State)
          if func = 0 then ' gültiger Redirektionseintrag
             if left$(temp,2) = "\\" then
                swap locl,rmte
             end if
             if temp = locl then
                function = rmte
                exit function
             end if
          elseif func = 18 then ' End_of_List
             exit function
          elseif func <> -1 then
             exit function
          end if ' nur bei -1 (=ungültiges Element): weitersuchen
          incr i
       loop
    end function
    
    '-------------------------------------------------------------------------------
    
    function RedirGetList (Lokal(1)  as string, _ ' A: Lokale Ressourcenamen
                           Remote(1) as string, _ ' A: UNC-Namen \\server\share
                           DevTyp(1) as integer,_ ' A: Devicetypen 3=Prt 4=Disk 0=?
                           Connct(1) as integer _ ' A: ConnStates 0=Ok 1=Disc >2=Err
                          ) public as integer     '  : Anzahl Array-Elemente
    
       ' Dies ist eine Art High-Level-Aufruf der Enumeratefunktion RedirGetItem,
       ' um dem Hauptprogramm das Hantieren mit eigenen Schleifen zu ersparen.
       ' Wenn Rückgabewert < 0, ist Fehler aufgetreten, sonst Anzahl Elemente.
       ' Es können nicht mehr Infos geliefert werden, als in die Arrays passen
       ' (der größte gemeinsame untere Index und der kleinste gemeinsame obere
       ' Arrayindex begrenzen die Anzahl der zurückgebbarer Elemente).
    
       dim i     as local integer
       dim LstIx as local integer
       dim HIndx as local integer
       dim LIndx as local integer
       dim Rc    as local integer
    
       HIndx = min%(ubound(Lokal(1)) ,_
                    ubound(Remote(1)),_
                    ubound(DevTyp(1)),_
                    ubound(Connct(1)))
       LIndx = max%(lbound(Lokal(1)) ,_
                    lbound(Remote(1)),_
                    lbound(DevTyp(1)),_
                    lbound(Connct(1)))
    
       for i=LIndx to HIndx
          rc = RedirGetItem(LstIx,Lokal(i),Remote(i),DevTyp(i),Connct(i))
          incr LstIx
          if rc then
             if rc = 18 then
                exit for
             elseif rc <> -1 then
                function = -rc
                exit function
             end if
          end if
       next
       function = LstIx-1
    
    end function
    
    '-------------------------------------------------------------------------------
    
    function RedirAdd (Lokal  as string,_ ' E: Lokaler Ressourcename
                       Remote as string,_ ' E: Entfernter Res.name (\\server\share)
                       PassWd as string _ ' E: Passwort wahlweise
                      ) public as integer '  : 0=Ok, n=Betriebssystemcode
    
       ' Fügt einen Eintrag in die Redirektionstabelle ein (NET USE...)
    
       dim Lkl as local asciiz*%lenlocal
       dim Rmt as local asciiz*%lenremote
       dim ll  as local integer
    
       Lkl = Lokal
       ll  = len(Lkl)
       Rmt = Remote+chr$(0)+ucase$(PassWd)
    
       ! pushf                  ;
       ! push  ds               ;
       ! push  si               ;
       ! push  di               ;
       ! push  bp               ; eines dieser Register wird
       ! push  ss               ; von WIN95 zerstört (DOS ok)
       ! mov   ax, ss           ;
       ! lea   bx, lkl          ; Adresse von 'lkl' über SS:BX
       ! mov   si, bx           ;
       ! mov   ds, ax           ; in DS:SI laden
       ! lea   bx, rmt          ; Adresse von 'rmt' über SS:BX
       ! mov   di, bx           ;
       ! mov   es, ax           ; in ES I laden
       ! mov   bl, 4            ; Defaultresourcetyp = 4 = Disk
       ! cmp   ll, 3            ; ShareTYP automatisch anhand von Länge(Lokal) prüfen
       ! jb    RedirAdd1        ; ok
       ! mov   bl, 3            ; Resourcetyp = 3 = Print
    RedirAdd1:                  '
       ! mov   ax, &h5f03       ;
       ! xor   cx, cx           ;
       ! int   &h21             ;
       ! jc    RedirAddEX       ;
       ! xor   ax, ax           ;
    RedirAddEX:                 '
       ! pop   ss               ;
       ! pop   bp               ;
       ! pop   di               ;
       ! pop   si               ;
       ! pop   ds               ;
       ! popf                   ;
       ! mov   function, ax     ;
    
    end function
    
    '-------------------------------------------------------------------------------
    
    function RedirDel (Lokal as string) public as integer
    
       ' Löscht einen Eintrag aus der Redirektionstabelle (NET USE.../DELETE)
       ' Es erfolgen keinerlei Fehlerprüfungen. Zurückgeliefert wird 0=Ok oder
       ' n=Betriebssystemfehlercode.
    
       dim Lkl as local asciiz*%lenremote ' Angabe von \\unc ist auch möglich
    
       Lkl = Lokal
    
       ! pushf                  ;
       ! push  ds               ;
       ! push  si               ;
       ! push  bp               ; eines dieser Register wird
       ! push  ss               ; von WIN95 zerstört (DOS ok)
       ! mov   ax, ss           ;
       ! lea   bx, lkl          ; Adresse von 'lkl' über SS:BX
       ! mov   si, bx           ;
       ! mov   ds, ax           ; in DS:SI laden
       ! mov   ax, &h5f04       ;
       ! int   &h21             ;
       ! jc    RedirDelEX       ;
       ! xor   ax, ax           ;
    RedirDelEX:                 '
       ! pop   ss               ;
       ! pop   bp               ;
       ! pop   si               ;
       ! pop   ds               ;
       ! popf                   ;
       ! mov   function, ax     ;
    
    end function
    
    '-------------------------------------------------------------------------------
    
    function RedirAddLM (Lokal  as string ,_ ' E: Lokaler Ressoucename
                         Remote as string ,_ ' E: Entfernter Res.name \\srv\share
                         UseTyp as integer,_ ' E: -1=Wildcrd 0=Dsk 1=Prt 2=Com 3=IPC
                         PassWd as string  _ ' E: Ressourcen-Password wahlweise
                        ) public as integer  '  :
    
       ' Fügt einen Eintrag in die Redirektionstabelle mit einer undokumentierten
       ' Funktion vom Microsoft-LAN MANAGER ein. Im Unterschied zu RedirAdd wird
       ' beim Weglassen des Schutzwortes das mit NET LOGON definierte Schutzwort
       ' verwendet, d.h. die Angabe desselben ist nicht zwingend notwendig.
       ' Um die Übergabe eines leeren Schutzwortes zu erzwingen, chr(0) übergeben.
       ' Es erfolgen keinerlei Fehlerprüfungen. Zurückgeliefert wird 0=Ok oder
       ' n=Betriebssystemfehlercode.
       ' Der Aufruf klappt nur, wenn schon angemeldet. Falls nicht, wird immer
       ' RC(0) geliefert (Passwort egal), aber nichts aufgeführt.
    
       dim Rmot as local string       ' dynamische Strings, da keine Längen-
       dim Pswd as local string       ' begrenzungendokumentiert sind
       dim Parm as local UseInfo1Type
       dim lp   as local integer
    
       Rmot        = Remote+chr$(0)
       Pswd        = ucase$(PassWd)+chr$(0)
       lp          = len(Parm)
       Parm.Locl   = Lokal
       Parm.pRmot  = strptr32(Rmot)
       Parm.UseTyp = UseTyp
       if len(PassWd) then
          Parm.pPswd = strptr32(Pswd)
       end if
    
       ! pushf                  ;
       ! push  ds               ;
       ! push  di               ;
       ! push  bp               ; zur
       ! push  ss               ; Sicherheit
       ! mov   ax, ss           ;
       ! lea   bx, parm         ; Adresse der Parameterstruktur
       ! mov   di, bx           ; über SS:BX
       ! mov   es, ax           ; in ES I laden
       ! mov   ax, &h5f47       ;
       ! mov   bx, 1            ;
       ! mov   cx, lp           ;
       ! int   &h21             ;
       ! jc    RedirAddLMEX     ;
       ! xor   ax, ax           ;
    RedirAddLMEX:               '
       ! pop   ss               ;
       ! pop   bp               ;
       ! pop   di               ;
       ! pop   ds               ;
       ! popf                   ;
       ! mov   function, ax     ;
    
    end function
    
    '---(Aliasname für einige alte Module, die diesen Namen erwarten)---------------
    
    function RedirTrueName alias "fullfilename" (raw as string) local public as string
    
       dim   temp as local string
       dim outbuf as local asciiz*%lenbuf ' ACHTUNG: lange Buffer wg.
       dim  inbuf as local asciiz*%lenbuf ' Windows 95
    
       ' ACHTUNG: Windows95 löst Netzwerklaufwerke nicht mehr vernünftig auf.
       ' Daher ist hier ein Zugriff auf die Redirektionsliste vorgeschaltet.
       if len(raw) then
          ' Prüfen, ob ein REMOTE Laufwerk (NET USE) angegeben wurde (dies tut
          ' redirGetInfo implizit). Wenn ja, \\UNC-Namen zurückliefern und fertig.
          if left$(raw,2) = "\\" then
             function = raw
             exit function
          else
             temp = redirGetInfo(raw,0)
             if len(temp) then
                function = temp+mid$(raw,3)
                exit function
             end if
          end if
       end if
    
       ' Ansonsten wird ein LOKALER Pfad verwendet.
       ' ACHTUNG: Wird an Truename lediglich ein LW:-Buchstabe übergeben, liefert
       '          die Funktion einen Leerstring zurück, daher wird in diesem Fall
       '          ein '.' angehängt. Ungültige Laufwerke führen zur Rückgabe eines
       '          Leerstrings, nicht jedoch ungültige Pfade in gültigen Laufwerken.
       '          W95: wenn NICHTS angegeben wird, wird nur LW: zurückgegeben,
       '          daher wird hier '.' reingemogelt.
       '          W95: '...' und '....' sind auch möglich, aber '.....' führt
       '          nicht zu einem Fehler, sondern zur Rückgabe von <Lw:.....>.
       ' Siehe auch Dokus in DOS7FS1.
       if ( len(raw) = 2 and ascii(raw,2) = 58 ) or (len(raw) = 0) then
          inbuf = raw+"."
       else
          inbuf = raw
       end if
    
       ! pushf                  ;
       ! push  ds               ; PowerBasic benutzt das Datensegment!
       ! push  di               ;
       ! push  si               ;
       ! mov   cx, &h0001       ; CH=SUBST-Expansion-Flag CL=Steuerung Short/LongFN
       ! mov   ax, ss           ;  (0=SUBST nicht auflösen, 1=Shortfns liefern)
       ! mov   ds, ax           ;
       ! mov   es, ax           ;
       ! lea   si, inbuf        ; Adresse(Eingabe) in DS:SI
       ! lea   di, outbuf       ; Adresse(Ausgabe) in ES I
       ! mov   ax, &h7160       ; NEUE Funktion
       ! stc                    ; Carryflag setzen für sicheren Fehlertrap
       ! int   &h21             ;
       ! jc    rdTruename01     ; Aufruf gescheitert -> ALTE Version versuchen
       ! xor   ax,ax            ; Signal Ok, wird leider nicht von DOS erledigt
       ! jmp   rdTruenameEX     ; und raus
    rdTruename01:               '
    '  ! cmp   ax, &h7100       ; sonst wahrscheinlicher Fehlergrund = DOS-Ver < 7
    '  ! jne   rdTruenameEX     ; anderer Fehler aus neuer Version -> Abbruch
       ! xor   cx, cx           ;
       ! mov   ax, &h6000       ; passende ALTE Funktion aufrufen (undokumentiert)
       ! int   &h21             ;
       ! jc    rdTruenameEX     ; Aufruf gescheitert -> raus
       ! xor   ax,ax            ; wird leider nicht von DOS erledigt
    rdTruenameEX:               '
       ! pop   si               ;
       ! pop   di               ;
       ! pop   ds               ; Errorcode befindet sich in AX=Funktionsergebnis
       ! popf                   ; (PowerBASIC erwartet gelöschtes DirectionFlag)
       function = outbuf        ' ACHTUNG: Hier ist das Ergebnis ein String
    
    end function
    
    '===============================================================================
    ------------------
Working...
X