Tweet
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
'===============================================================================