Netzlaufwerk

Alle Fragen um die Programmierung, die sich sonst nicht kategorisieren lassen. Von Makro bis Codeblock, von IF bis ENDIF

Moderator: Moderatoren

Antworten
Benutzeravatar
Muecke
1000 working lines a day
1000 working lines a day
Beiträge: 623
Registriert: Di, 24. Okt 2006 7:19
Wohnort: Samstagern CH
Hat sich bedankt: 3 Mal
Danksagung erhalten: 9 Mal
Kontaktdaten:

Netzlaufwerk

Beitrag von Muecke »

Hallo

auf dem PC werden die Netzlaufwerke verbunden, an denen
man nur dies sieht
Test(\\server01) (T:)

Ist es möglich mit einer Function solch einem Netzlaufwerk
auszulesen, damit man die IP bekommt und das Directory(ww)
\\192.168.195.10\ww\Test

Schöne Grüsse
Thomas
ramses
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2513
Registriert: Mi, 28. Jul 2010 17:16
Hat sich bedankt: 12 Mal
Danksagung erhalten: 77 Mal

Re: Netzlaufwerk

Beitrag von ramses »

Hallo Thomas

das geht nur über einige Umwege. Etwa so:

Code: Alles auswählen

#include "DLL.CH"
#include "common.ch"
PROCEDURE Main

?  getInfoFromServerLWPath( "G:\", .t., .t.  )   // ---> { UNC-Pfad, DNS-Hostname, IP-Adresse, MacAdresse }

                                                //     {"\\Unix-Server1\daten\daten0\", "Unix-Server1", "192.168.10.6", "00:50:56:00:00:06"}

wait
quit

return


//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
function getInfoFromServerLWPath( cPath, lMacAdress, lErrorDisp, cError )
local nLen := 15000
local cbuffer := space(nLen)
local a, t, ret_val := {"","","",""}
local e := 0

  default  cPath to curdrive()+":\", lMacAdress to .f., lErrorDisp to .t.

  do while e < 5
     cError := ""
     e++
     if ( a := wsastartup(0x0202, @cBuffer ) ) != 0
        cError := "WSAStartUp Fehler: "+alltrim(str(a))
        loop
     endif
     if ( a :=  WnetGetUniversalNameA( cPath+chr(0), 1, @cBuffer, nLen  ) ) != 0
        cError := "getInfoFromServerLWPath, WnetGetUniversalnameA Fehler: "+ var2char(a)
     else
        t := substr( cBuffer, at("\\",cBuffer) )
        a := at("\",t,3)
        if a = 0
           cError := "Serververzeichnis nicht gefunden (getInfoFromServerLWPath)"
        else
           ret_val[1] := left(t, at(chr(0),t)-1)
           if  ( t := GetHostStructByName( substr(t,3,a-3)+chr(0), @cError ) ) != NIL
              ret_val[3] := socketInetNtoA( t[5,1] )
              ret_val[2] := t[1]
           endif
        endif
     endif
     if empty(cError) .and. lMacAdress
            ret_val[4] :=  getMacFromIPAdress( ret_val[3], @cError, lErrorDisp )
     endif
     wsaCleanup()
     if empty(cError)
         exit
     endif
  enddo
  if !empty(cError)
       if lErrorDisp
          msgbox(cError+";"+var2char(ret_val),"Fehler")
       endif
  endif

return(ret_val)


//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
function getMacFromIPAdress( cIP, cError, lErrorDisp )
local ret_val := "", a
local cMac := space(10), nClen := 10
local cIPSrc := 0

    default lErrorDisp to .t.

    cError := ""
    if !empty(cIP)
        if ( a := inet_addr( cIP ) ) <= 0
            cError := "IP, Format ungltig"
        else
            a := SendArp( a, cIPSrc, @cMac, @nClen )
            if a = 67
                cError := "IP nicht vorhanden"
            elseif a = 111
                cError := "ICPM Ping blocked"
            elseif a != 0
                cError := "Error"
            else
                for a = 1 to 6
                    ret_val += Dez2Hex(asc(substr( cMac, a, 1)), 2) +iif(a=6,"",":")
                next
            endif
        endif
    endif
    if !empty(cError) .and. lErrorDisp
           msgbox("(getMacFromIPAdress) " + cError, "Fehler")
    endif

 return(ret_val)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function  GetHostStructByName( cHostName, cError )
local a, nPtr, ret_val := {nil,nil,nil,nil,nil}

    cError := ""
    if (nPtr := gethostbyname(cHostName+chr(0))) = 0
        a := WSAGetLastError()
        cError := "getInfoFromServerLWPath, gethostStructByName Fehler: " + var2char(a)
        return(nil)
    endif

    ret_val[1] := stringof(bin2u( stringof(nPtr,4) ))
    ret_val[2] := getCArray( bin2u(stringof(nPtr+4,4)) )
    ret_val[3] := bin2w(stringof(nPtr+8,2))
    ret_val[4] := bin2w(stringof(nPtr+10,2))
    ret_val[5] := getCArray( bin2u(stringof(nPtr+12,4)), ret_val[4], {|x|bin2u(x)} )

return(ret_val)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function  getCArray( nPtr, nLen, bConvert )
local i, ret_val := {}

    default bConvert TO {|x|x}

    do while (i := bin2u(stringof(nPtr,4))) > 0
        aadd(ret_val, eval(bConvert, stringof(i, nLen)))
        nPtr += 4
    enddo

return(ret_val)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function stringof( nPtr)
local cBuffer := space(lstrlen(nPtr))

    lstrcpy( @cBuffer,nPtr)

return(cBuffer)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function Dez2Hex( nDez, nLen )
local ret_val := ""

   do while nDeZ > 0
      ret_val := "0123456789ABCDEF"[nDez%16+1] + ret_val
      nDez := int(nDez/16)
   enddo

return( padl(ret_val,nLen,"0") )


//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------


DLLFUNCTION inet_addr( cIP )                          USING STDCALL from wsock32.DLL
DLLFUNCTION SendARP( cIPdest, cIPSrc, @cMac, @nClen ) USING STDCALL from IPHLPAPI.DLL
DLLFUNCTION WSAStartup( nVersionRequested, @cWsaData) USING STDCALL from Ws2_32.dll
DLLFUNCTION WSACleanup()                              USING STDCALL from Ws2_32.dll
DLLFUNCTION gethostbyname(cHost)                      USING STDCALL from Ws2_32.dll
DLLFUNCTION WSAGetLastError()                         USING STDCALL from Ws2_32.dll

DLLFUNCTION WNetGetUniversalNameA( cLocalPath, nInfoLevel, @cBuffer, @nLen )  USING STDCALL from mpr.dll

DLLFUNCTION lstrlen( nPtr )                           USING STDCALL from Kernel32
DLLFUNCTION lstrcpy( @cBuffer,nPtr )                  USING STDCALL from Kernel32



Verbessungen und Erweiterungen sind natürlich von jedermann willkommen.....
Valar Morghulis

Gruss Carlo
Benutzeravatar
Muecke
1000 working lines a day
1000 working lines a day
Beiträge: 623
Registriert: Di, 24. Okt 2006 7:19
Wohnort: Samstagern CH
Hat sich bedankt: 3 Mal
Danksagung erhalten: 9 Mal
Kontaktdaten:

Re: Netzlaufwerk

Beitrag von Muecke »

Hallo Carlo

Besten Dank

DLLFUNCTION WNetGetUniversalNameA( cLocalPath, nInfoLevel, @cBuffer, @nLen ) USING STDCALL FROM mpr.dll

die mpr.dll finde ich wo


Schöne Grüsse
Thomas
ramses
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2513
Registriert: Mi, 28. Jul 2010 17:16
Hat sich bedankt: 12 Mal
Danksagung erhalten: 77 Mal

Re: Netzlaufwerk

Beitrag von ramses »

Hallo Thomas

alle angegebenen DLL's sind System-Dlls von Windows die musst, besser DARFST du nicht suchen bezw. an andere Orte kopieren!
Die findet das Programm über die gesetzte PATH Variable von selbst!
Valar Morghulis

Gruss Carlo
Benutzeravatar
Muecke
1000 working lines a day
1000 working lines a day
Beiträge: 623
Registriert: Di, 24. Okt 2006 7:19
Wohnort: Samstagern CH
Hat sich bedankt: 3 Mal
Danksagung erhalten: 9 Mal
Kontaktdaten:

Re: Netzlaufwerk

Beitrag von Muecke »

Die Frage kam , weil beim kompilieren Hinweis kam Fehler

Ich suche morgen mal weiter

Schöne Grüsse
Thomas
ramses
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2513
Registriert: Mi, 28. Jul 2010 17:16
Hat sich bedankt: 12 Mal
Danksagung erhalten: 77 Mal

Re: Netzlaufwerk

Beitrag von ramses »

Hallo Thomas

die MPR.DLL ist eine System-DLL von Windows und befindet sich im Ordner c:\windows\system32 Dieses Verzeichnis ist in der PATH Variable enthalten. Wenn dir diese DLL fehlt musst du deine Windows Installaton mit den dazu vorhandenen Tools prüfen.
Valar Morghulis

Gruss Carlo
ramses
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2513
Registriert: Mi, 28. Jul 2010 17:16
Hat sich bedankt: 12 Mal
Danksagung erhalten: 77 Mal

Re: Netzlaufwerk

Beitrag von ramses »

Hallo Thomas

wollte dir dein Compliler evtl sagen dass du die erwähne DLLFUNCTION bereits definiert hast. (Diese müssen im ganzen Code einmalig sein.)
Versuche mal nachfolgenden Code.
Der verwendet dllcall() und ist leichter zu handhaben.


Code: Alles auswählen

#include "DLL.CH"
#include "common.ch"



PROCEDURE Main


?  getInfoFromServerLWPath( "G:\", .t., .t.  )   // ---> { UNC-Pfad, DNS-Hostname, IP-Adresse, MacAdresse }

                                                //     {"\\Unix-Server1\daten\daten0\", "Unix-Server1", "192.168.10.6", "00:50:56:00:00:06"}

wait
quit

return


//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
function getInfoFromServerLWPath( cPath, lMacAdress, lErrorDisp, cError )
local nLen := 15000
local cbuffer := space(nLen)
local a, t, ret_val := {"","","",""}
local e := 0

  default  cPath to curdrive()+":\", lMacAdress to .f., lErrorDisp to .t.

  do while e < 5
     cError := ""
     e++
     if ( a := dllcall("Ws2_32.dll", DLL_STDCALL, "WSAStartup", 0x0202, @cBuffer ) ) != 0
        cError := "WSAStartUp Fehler: "+alltrim(str(a))
        loop
     endif
     if ( a := dllcall("mpr.dll", DLL_STDCALL,"WNetGetUniversalNameA", cPath+chr(0), 1, @cBuffer, @nLen  ) ) != 0
        cError := "getInfoFromServerLWPath, WnetGetUniversalnameA Fehler: "+ var2char(a)
     else
        t := substr( cBuffer, at("\\",cBuffer) )
        a := at("\",t,3)
        if a = 0
           cError := "Serververzeichnis nicht gefunden (getInfoFromServerLWPath)"
        else
           ret_val[1] := left(t, at(chr(0),t)-1)
           if  ( t := GetHostStructByName( substr(t,3,a-3)+chr(0), @cError ) ) != NIL
              ret_val[3] := socketInetNtoA( t[5,1] )
              ret_val[2] := t[1]
           endif
        endif
     endif
     if empty(cError) .and. lMacAdress
            ret_val[4] :=  getMacFromIPAdress( ret_val[3], @cError, lErrorDisp )
     endif
     dllcall("Ws2_32.dll", DLL_STDCALL,  "WSACleanup" )
     if empty(cError)
         exit
     endif
  enddo
  if !empty(cError)
       if lErrorDisp
          msgbox(cError+";"+var2char(ret_val),"Fehler")
       endif
  endif

return(ret_val)


//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
function getMacFromIPAdress( cIP, cError, lErrorDisp )
local ret_val := "", a
local cMac := space(10), nClen := 10
local cIPSrc := 0

    default lErrorDisp to .t.

    cError := ""
    if !empty(cIP)
        if ( a := dllcall("wsock32.dll", DLL_STDCALL, "inet_addr", cIP ) ) <= 0
            cError := "IP, Format ungltig"
        else
            a := dllcall("IPHLPAPI.DLL", DLL_STDCALL, "SendARP", a, cIPSrc, @cMac, @nClen )
            if a = 67
                cError := "IP nicht vorhanden"
            elseif a = 111
                cError := "ICPM Ping blocked"
            elseif a != 0
                cError := "Error"
            else
                for a = 1 to 6
                    ret_val += Dez2Hex(asc(substr( cMac, a, 1)), 2) +iif(a=6,"",":")
                next
            endif
        endif
    endif
    if !empty(cError) .and. lErrorDisp
           msgbox("(getMacFromIPAdress) " + cError, "Fehler")
    endif

 return(ret_val)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function  GetHostStructByName( cHostName, cError )
local a, nPtr, ret_val := {nil,nil,nil,nil,nil}

    cError := ""
    if (nPtr := dllcall("Ws2_32.dll", DLL_STDCALL,  "gethostbyname", cHostName+chr(0))) = 0
        cError := "getInfoFromServerLWPath, gethostStructByName Fehler: " + var2char(a)
        return(nil)
    endif

    ret_val[1] := stringof(bin2u( stringof(nPtr,4) ))
    ret_val[2] := getCArray( bin2u(stringof(nPtr+4,4)) )
    ret_val[3] := bin2w(stringof(nPtr+8,2))
    ret_val[4] := bin2w(stringof(nPtr+10,2))
    ret_val[5] := getCArray( bin2u(stringof(nPtr+12,4)), ret_val[4], {|x|bin2u(x)} )

return(ret_val)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function  getCArray( nPtr, nLen, bConvert )
local i, ret_val := {}

    default bConvert TO {|x|x}

    do while (i := bin2u(stringof(nPtr,4))) > 0
        aadd(ret_val, eval(bConvert, stringof(i, nLen)))
        nPtr += 4
    enddo

return(ret_val)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function stringof( nPtr)
local cBuffer := space( dllcall("Kernel32.dll", DLL_STDCALL,"lstrlen", nPtr ) )

    dllcall("Kernel32.dll", DLL_STDCALL,"lstrcpy", @cBuffer,nPtr)

return(cBuffer)

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
static function Dez2Hex( nDez, nLen )
local ret_val := ""

   do while nDeZ > 0
      ret_val := "0123456789ABCDEF"[nDez%16+1] + ret_val
      nDez := int(nDez/16)
   enddo

return( padl(ret_val,nLen,"0") )


//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
Valar Morghulis

Gruss Carlo
Benutzeravatar
Muecke
1000 working lines a day
1000 working lines a day
Beiträge: 623
Registriert: Di, 24. Okt 2006 7:19
Wohnort: Samstagern CH
Hat sich bedankt: 3 Mal
Danksagung erhalten: 9 Mal
Kontaktdaten:

Re: Netzlaufwerk

Beitrag von Muecke »

Hallo Carlo

Genau das war es.
War bereits vorhanden.
Function TIP TOP

Danke

Schöne Grüsse
Thomas
Antworten