Netzwerkordnerzugriff

[HolgerX]

Hmm..

Kann Dir nur Auszüge geben:

Delphi-Quellcode:

function IsLocalPath(const Path:string):boolean;
var
  i : cardinal;
begin
  i := GetDriveType(pchar(copy(path,1,2)));
  result := (i = DRIVE_FIXED) or
    (i = DRIVE_CDROM) or
    (i = DRIVE_RAMDISK) or
    (i = DRIVE_REMOVABLE);
end;


function Logout(Path:String):Cardinal;
begin
  result := NO_ERROR;
  if length(path) > 0 then begin
    if path[1] = '\' then begin
      path := ExcludeTrailingPathDelimiter(ExpandUNCFileName(Trim(path)));
      // Windows-Share LogOff
      result := WNetCancelConnection2(pchar(Path),CONNECT_UPDATE_PROFILE,true);

      // NetWare-Server LogOff nur mit dem Server-Namen!
      path := '\\' + ExtractServerName(path);
      WNetCancelConnection2(pchar(copy(Path,3,length(path)-2)),CONNECT_UPDATE_PROFILE,true);
    end else begin
      result := WNetCancelConnection2(pchar(Path),CONNECT_UPDATE_PROFILE,true);
    end;
  end;
end;


function Logon(Drive, Path, User, Password:String; TemporaryOnly : boolean):Cardinal;
var
  NetRes : TNetResource;
  tempres : Cardinal;
  dwFlags : Cardinal;
begin
  if islocalpath(path) then
    tempres := NO_ERROR //No need to logon
  else begin
    path := ExcludeTrailingPathDelimiter(ExpandUNCFileName(Trim(path)));

    // Windows-Share login
    NetRes.dwScope := RESOURCE_GLOBALNET;
    NetRes.dwDisplayType := RESOURCEDISPLAYTYPE_SHARE;//RESOURCEDISPLAYTYPE_GENERIC;
    NetRes.dwUsage := RESOURCEUSAGE_CONNECTABLE;
    NetRes.lpComment := '';

    // Nur diese Angaben sind notwendig..
    NetRes.dwType := RESOURCETYPE_DISK; // RESOURCETYPE_ANY;
    NetRes.lpLocalName := pchar(Drive);
    NetRes.lpRemoteName := pchar(path);
    NetRes.lpProvider := '';


    if TemporaryOnly then
      dwFlags := CONNECT_TEMPORARY // 0
    else
      dwFlags := CONNECT_UPDATE_PROFILE;

    // CONNECT_UPDATE_RECENT ?

    if User = '' then
      tempres := WNetAddConnection2(NetRes, nil, nil, dwFlags)
    else
      tempres := WNetAddConnection2(NetRes, pchar(Password), pchar(User), dwFlags);
  end;
  result := tempres;
end;

Verbindung herstellen / LW Mappen:

Delphi-Quellcode:

procedure TForm1.ButtonAddNetUseClick(Sender: TObject);
var
  err : DWORD;
begin
  err := Logon(EditLocalDrive.Text, EditShare.Text,EditUser.Text,EditPassword.Text,true);
  if err <> 0 then
    ShowMessage(IntToStr(err) + ' - ' + SysErrorMessage(err));
end;

Öffen des UNC-PFades im Explorer:

  ShellExecute(self.Handle, nil, PChar(AUNCPath),nil,nil,SW_SHOW);

(Erstellt mit D6, eventuell Anpassungen an UniCode notwendig)

[Moombas]

Hat immens geholfen (auch das mit der errorabfrage kannte ich bisher so nicht).

Allerdings taucht bei mir aktuell immer der Error 42 auf (trotz Verbindung & ohne text). Laut Windows gibt es diesen Fehler als Systemfehler auch nicht

Edit: Hat sich erledigt. Fehler gefunden.


Vielen Dank HolgerX

[Luckie]

Verrätst du uns auch woran es lag?

[Moombas]

Ich hatte den Code mit dem error

Delphi-Quellcode:

 if err <> 0 then
    ShowMessage(IntToStr(err) + ' - ' + SysErrorMessage(err));

auch auf die shellexecute angewendet, was dann zu der besagten Fehlermeldung führte. Diesen habe ich wieder entfernt und somit läuft es nun ohne Fehlermeldung.

So richtig konnte ich zur 42 zwar nichts finden, aber einige meinten 42 = success also alles gut. Da es aber keine eindeutige Aussage gab, habe ich ihn halt ganz entfernt anstatt die 42 auszuschließen.

[jaenicke]

IIRC sind Rückgabewerte über 32 kein Fehler. In der Doku sehe ich die Information allerdings nicht.

[Aviator]

Zitat von jaenicke:

IIRC sind Rückgabewerte über 32 kein Fehler. In der Doku sehe ich die Information allerdings nicht.

Ich helfe dir dann mal

Allerdings habe ich direkt im MSDN nachgeschaut und nicht in der Delphi Doku.

Zitat von MSDN:

Return Value
Type: HINSTANCE

If the function succeeds, it returns a value greater than 32. If the function fails, it returns an error value that indicates the cause of the failure. The return value is cast as an HINSTANCE for backward compatibility with 16-bit Windows applications. It is not a true HINSTANCE, however. It can be cast only to an int and compared to either 32 or the following error codes below.

Quelle: https://docs.microsoft.com/en-us/win...-shellexecutea

Hervorhebung durch mich.

[Moombas]

Bei der Umstellung auf Lazarus habe ich hier nun ein Problem, ich rufe den logon in Lazarus wie folgt auf:

Delphi-Quellcode:

  
  //IPC wird vorher definiert, entspricht der IP-Adresse des anderen PC's
  Path := widestring('\\' + IPC + '\c$');
  err  := Logon('', Path, 'username', 'password', true);  
  if (err <> 0) then
  begin
    ShowMessage(IntToStr(err) + ' - ' + SysErrorMessage(err));
  end;

Erhalte aber immer einen Fehler:

Delphi-Quellcode:

//Netzlaufwerk verbinden
function TTools.Logon(Drive: String; Path: WideString; User, Password:String; TemporaryOnly : boolean):Cardinal;
var
  NetRes  : TNetResource;
  tempres : Cardinal;
  dwFlags : Cardinal;
begin
  if islocalpath(String(Path)) then
  begin
    tempres := NO_ERROR; //No need to logon
  end else
  begin
    path := ExcludeTrailingPathDelimiter(ExpandUNCFileName(Trim(path)));

    // Windows-Share login
    NetRes.dwScope := RESOURCE_GLOBALNET;
    NetRes.dwDisplayType := RESOURCEDISPLAYTYPE_SHARE;//RESOURCEDISPLAYTYPE_GENERIC;
    NetRes.dwUsage := RESOURCEUSAGE_CONNECTABLE;
    NetRes.lpComment := '';

    // Nur diese Angaben sind notwendig..
    NetRes.dwType := RESOURCETYPE_DISK; // RESOURCETYPE_ANY;
    NetRes.lpLocalName := PChar(Drive);
    NetRes.lpRemoteName := PChar(path);
    NetRes.lpProvider := '';

    if TemporaryOnly then
    begin
      dwFlags := CONNECT_TEMPORARY; // 0
    end else
    begin
      dwFlags := CONNECT_UPDATE_PROFILE;
    end;

    // CONNECT_UPDATE_RECENT ?
    if User = '' then
    begin
      tempres := WNetAddConnection2(NetRes, nil, nil, dwFlags);
    end else
    begin
      tempres := WNetAddConnection2(NetRes, PChar(Password), PChar(User), dwFlags);   //FEHLER, Passwort und Benutzernamen passen
    end;
  end;
  result := tempres;
end;

Die Fehlermeldung ist (aus meiner Sicht) wenig aussagend: Projekt Workstation hat Exception-Klasse >>External: SIGSEGV<< ausgelöst.

Evtl. habe ich die Ursache gefunden, jedoch noch keine Lösung.

path := ExcludeTrailingPathDelimiter(ExpandUNCFileName(Trim(path))); Sorgt dafür das "path" leer ist, ab "ExpandUNCFileName" das sollte wohl eher nicht so sein.

[HolgerX]

Hmm..

Mal ganz blöd gefragt:
Welches TNetResource \ WNetAddConnection2 wird verwendet?

TNetResourceA + WNetAddConnection2A
TNetResourceW + WNetAddConnection2W

Hier solltest Du besser expliziet angeben, welches der beiden verwendet wird und dann am besten auch gleich

TNetResourceW + WNetAddConnection2W


Du castes mal einen WideString mit PChar
NetRes.lpRemoteName := PChar(path);
und mal den Lazarus UTF8 string
tempres := WNetAddConnection2(NetRes, PChar(Password), PChar(User), dwFlags);


Besser

Delphi-Quellcode:

function TTools.Logon(Drive: String; Path: WideString; User, Password:WideString; TemporaryOnly : boolean):Cardinal;
var
  NetRes : TNetResourceW;
..

NetRes.lpRemoteName := PWideChar(path);

..

begin
      tempres := WNetAddConnection2W(NetRes, nil, nil, dwFlags);
    end else
    begin
      tempres := WNetAddConnection2W(NetRes, PWideChar(Password), PWideChar(User), dwFlags);
    end;

[Moombas]

Ok, damit läuft er schon mal scheinbar durch aber verbindet sich nicht.

Wie oben erwähnt, denke ich das "path" dennoch nicht leer sein sollte nach
ExcludeTrailingPathDelimiter(ExpandUNCFileName(Trim(path))); .
Sobald er ExpandUNCFileName macht, ist path leer, Trim(path) funktioniert also noch.

[HolgerX]

Hmm..

könnte es sein, das ExpandUNCFileName nur dann was zurück gibt, wenn es was zu expandieren hat?

Wenn path bereits UNC ist, dann kommt wohl ein Leerstring zurück...

Zitat:

Delphi-Quellcode:

 //IPC wird vorher definiert, entspricht der IP-Adresse des anderen PC's
  Path := widestring('\\' + IPC + '\c$');