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 [img]http://www.powerbasic.com/support/forums/biggrin.gif[/img]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 [img]http://www.powerbasic.com/support/forums/biggrin.gif[/img]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 [img]http://www.powerbasic.com/support/forums/biggrin.gif[/img]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 [img]http://www.powerbasic.com/support/forums/biggrin.gif[/img]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 '===============================================================================