Autor |
Beitrag |
Christian213
Beiträge: 66
Erhaltene Danke: 3
Win XP, Win 7 64Bit
Lazarus 1.0.10
|
Verfasst: Do 13.09.12 08:38
Hallo,
ich suche eine Möglichkeit, per Win-API den Pfad eine "Special Folders" setzen zu können.
Laut MSDN gibt es eine Funktion "SHSetFolderPath", leider habe ich keine Idee wie ich dies in Delphi nutzen kann?!
msdn.microsoft.com/e...47%28v=vs.85%29.aspx
Dieser Thread hier hilft mir leider nicht weiter, da der Code umvollständig ist: www.entwickler-ecke....ight=shsetfolderpath
Wer kann mir hier einen Tipp geben? Danke!
Gruß,
Christian
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Do 13.09.12 09:49
|
|
Christian213
Beiträge: 66
Erhaltene Danke: 3
Win XP, Win 7 64Bit
Lazarus 1.0.10
|
Verfasst: Do 13.09.12 11:23
Hallo,
Danke für die Antwort.
Das hilft mir leider nicht viel weiter, denn ich will den Wert nicht auslesen sondern setzen.
Gruß,
Christian
|
|
vagtler
Beiträge: 96
Erhaltene Danke: 24
Delphi 2010, C# (VS 2012), Objective-C, Java
|
Verfasst: Do 13.09.12 15:37
Naja, da kann man ja schon sehen, wie das Lesen mittels Import einer WinAPI-Funktion realisiert wurde.
Das zu adaptieren müsste doch möglich sein, oder?
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Do 13.09.12 16:45
@Christian213
Bevor man ein Directory erstellt, muss man doch erst mal fragen, ob es nicht schon existiert!!!
An Deiner Antwort sehe ich, dass Du nichts verstanden hast...und den Sourcecode nicht gelesen hast!
|
|
Christian213
Beiträge: 66
Erhaltene Danke: 3
Win XP, Win 7 64Bit
Lazarus 1.0.10
|
Verfasst: Sa 15.09.12 17:25
Hallo,
erstmal Danke für die Antworten!
vagtler hat folgendes geschrieben : | Naja, da kann man ja schon sehen, wie das Lesen mittels Import einer WinAPI-Funktion realisiert wurde.
Das zu adaptieren müsste doch möglich sein, oder? |
Die Routine zum Auslesen habe ich ja bereits, sie funktioniert ja auch.
Nur das Setzen will irgendwie nicht.
hathor hat folgendes geschrieben : | @Christian213
Bevor man ein Directory erstellt, muss man doch erst mal fragen, ob es nicht schon existiert!!!
An Deiner Antwort sehe ich, dass Du nichts verstanden hast...und den Sourcecode nicht gelesen hast! |
Ich wundere mich gerade, was Du alles aus meinen Worten deuten kannst
Aber ich habe das Gefühl, Du hast mein Problem nicht verstanden:
Ich will kein Directory erstellen, sondern eine Systemvariable auf einen anderen Pfad setzen.
Die API-Funktion heißt ja auch SHSetFolderPath und nicht SHCreateFolderPath.
Also das, was man in einer Commandshell mittels "set USERPROFILE=..." machen kann, nur halt per WinAPI aus einem Programm heraus.
Das Problem vor dem ich stehe, ist dass die Funktion SHSetFolderPath nicht direkt über den Namen zur Verfügung steht.
Ich hatte es mit einer Funktionsdefinition versucht:
function SHSetFolderPath(Clsid : dWord; hToken : THandle; dwFlags : dWord; pszPath : pChar) : boolean; stdcall; external 'shell32.dll' index 231;
Wenn ich die Funktion später mit Werten fütter, bekomme ich Access Violation... Hier stehe ich nun auf dem Schlauch.
Gruß,
Christian
Gruß,
Christian
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Sa 15.09.12 22:18
Endlich habe ich verstanden, was Du willst!
Im Beispiel weist Button1 der Konstanten CSIDL_FAVORITES den Pfad C:\PROG-1 zu.
Da diese Zuweisung aber auch nach Programmende erhalten bleibt, muss man erst den ursprünglichen Pfad speichern, um den am Ende wieder zuweisen zu können - falls erwünscht...
Existiert der Pfad nicht, wird kein Fehler angezeigt - die vorhergehende Zuweisung wird gelöscht!
Man muss also vorher auf DirectoryExists() prüfen und evtl. das DIR erzeugen!
Button2 erstellt die gesamte Specialfolder-Liste, die aktuell auf dem PC vorhanden ist.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComObj, ActiveX, ShellAPI, ShlObj; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private
public
end;
var Form1: TForm1;
implementation
{$R *.dfm}
function GetSpecialFolder(hWindow: HWND; Folder: Integer): String; var pMalloc: IMalloc; pidl: PItemIDList; Path: PChar; begin if (SHGetMalloc(pMalloc) <> S_OK) then begin MessageBox(hWindow, 'Couldn''t get pointer to IMalloc interface.','SHGetMalloc(pMalloc)', 16); Exit; end; SHGetSpecialFolderLocation(hWindow, Folder, pidl); GetMem(Path, MAX_PATH); SHGetPathFromIDList(pidl, Path); Result := Path; FreeMem(Path); pMalloc.Free(pidl); end;
procedure TForm1.Button1Click(Sender: TObject); var FLibHandle: THandle; path:WideString; SHSetFolderPath: FUNCTION (csidl:integer; hToken:THANDLE; dwFlags: DWORD; pszPath: LPCTSTR):HRESULT;stdcall; begin FLibHandle := LoadLibrary('Shell32.dll'); SHSetFolderPath := GetProcAddress(FLibHandle, pchar(Ord(232))); path:='C:\PROG-1'; if DirectoryExists(path) = false then mkdir(path); if assigned(SHSetFolderPath) then try if not SUCCEEDED(SHSetFolderPath(CSIDL_FAVORITES, 0, 0, pchar(path)))then Windows.beep(1000,100); finally end; if FLibHandle <> 0 then FreeLibrary(FLibHandle); end;
procedure TForm1.Button2Click(Sender: TObject); var i : Integer; begin for i := 0 to 63 do Memo1.Lines.add(IntToStr(i)+' : '+ GetSpecialFolder(Form1.Handle,i)); end;
end. |
|
|
Christian213
Beiträge: 66
Erhaltene Danke: 3
Win XP, Win 7 64Bit
Lazarus 1.0.10
|
Verfasst: So 16.09.12 11:59
Hallo hathor,
Perfekt! - Genau so etwas habe ich gesucht!
1000 Dank!
Gruß,
Christian
|
|
glotzer
Beiträge: 393
Erhaltene Danke: 49
Win 7
Lazarus
|
Verfasst: So 16.09.12 12:09
hathor hat folgendes geschrieben : |
Delphi-Quelltext 1:
| if DirectoryExists(path) = false then mkdir(path); | |
Böse!
Das sollte if not DirectoryExists(path) then mkdir(path); sein.
_________________ ja, ich schreibe grundsätzlich alles klein und meine rechtschreibfehler sind absicht
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: So 16.09.12 20:02
Das ist doch scheissegal, Du Oberlehrer!
"function DirectoryExists ( const DirectoryName : string ) : Boolean;"
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60:
| function DirectoryExists(const Directory: string): Boolean; var Code: Integer; begin Code := GetFileAttributes(PChar(Directory)); Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); end;
function DirectoryExists(const Directory: string; FollowLink: Boolean = True): Boolean; var Code: Cardinal; Handle: THandle; LastError: Cardinal; begin Result := False; Code := GetFileAttributes(PChar(Directory));
if Code <> INVALID_FILE_ATTRIBUTES then begin if faSymLink and Code = 0 then Result := faDirectory and Code <> 0 else begin if FollowLink then begin Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); if Handle <> INVALID_HANDLE_VALUE then begin CloseHandle(Handle); Result := faDirectory and Code <> 0; end; end else if faDirectory and Code <> 0 then Result := True else begin Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); if Handle <> INVALID_HANDLE_VALUE then begin CloseHandle(Handle); Result := False; end else Result := True; end; end; end else begin LastError := GetLastError; Result := (LastError <> ERROR_FILE_NOT_FOUND) and (LastError <> ERROR_PATH_NOT_FOUND) and (LastError <> ERROR_INVALID_NAME) and (LastError <> ERROR_BAD_NETPATH); end; end; |
|
|
glotzer
Beiträge: 393
Erhaltene Danke: 49
Win 7
Lazarus
|
Verfasst: So 16.09.12 20:32
hathor hat folgendes geschrieben : | Das ist doch scheissegal, Du Oberlehrer! |
Oh nein ist es nicht.
www.delphi-treff.de/...che-anfaengerfehler/
_________________ ja, ich schreibe grundsätzlich alles klein und meine rechtschreibfehler sind absicht
|
|
Narses
Beiträge: 10181
Erhaltene Danke: 1254
W10ent
TP3 .. D7pro .. D10.2CE
|
Verfasst: Mo 17.09.12 15:43
Moin!
hathor hat folgendes geschrieben : | Das ist doch scheissegal, Du Oberlehrer! |
Also ich bin schon etwas ... verwundert ... sowas von einem langjährigen Community-Mitglied lesen zu müssen. Ich hoffe, dass bleibt ein verbaler "Ausrutscher", dieser Tonfall ist in der EE nicht erwünscht!
Da glotzer obendrein in der Sache Recht hat, halte ich eine Entschuldigung für angemessen.
cu
Narses
_________________ There are 10 types of people - those who understand binary and those who don´t.
Für diesen Beitrag haben gedankt: glotzer, vagtler
|
|
Christian213
Beiträge: 66
Erhaltene Danke: 3
Win XP, Win 7 64Bit
Lazarus 1.0.10
|
Verfasst: Mo 17.09.12 15:45
Hallo,
klappt leider doch irgendwie noch nicht. Da ich das Ganze als Funktion brauchte, habe ich es wie folgt umgesetzt:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20:
| function SetFolderPath(Csidl : Integer; Path : AnsiString) : boolean;
type TSHSetFolderPath = function (Csidl : Integer; hToken : THandle; dwFlags : Dword; pszPath : LPctstr) : HResult; stdcall;
var FLibHandle : THandle; SHSetFolderPath : TSHSetFolderPath; begin Result := false; FLibHandle := LoadLibrary('shell32.dll'); SHSetFolderPath := TSHSetFolderPath(GetProcAddress(FLibHandle, pChar(Ord(232)))); if assigned(SHSetFolderPath) then try if not SUCCEEDED(SHSetFolderPath(Csidl, 0, 0, pChar(Path))) then Result := false; finally Result := true; end; if (FLibHandle <> 0) then FreeLibrary(FLibHandle); end; |
Das Kapseln mittels der Typedefinition brauchte ich, da ich es unter Lazarus kompilieren will.
Es fliegt zwar kein Fehler, aber der übergebene Pfad wird auch nicht gesetzt. Habe es mit verschienden CSIDL-Werten und Pfaden versucht.
Hat jemand eine Idee?
Gruß
Christian
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Mo 17.09.12 16:25
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38:
| function DirectoryExists2(const Directory: string): Boolean; var Code: Cardinal; begin Code := GetFileAttributes(PChar(Directory)); Result := (Code <> INVALID_FILE_ATTRIBUTES) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); end;
function SetFolderPath(CSIDL : Integer; PATH : WideString) : boolean; var FLibHandle: THandle; SHSetFolderPath: FUNCTION (csidl:integer; hToken:THANDLE; dwFlags: DWORD; pszPath: LPCTSTR):HRESULT;stdcall; begin FLibHandle := LoadLibrary('Shell32.dll'); SHSetFolderPath := GetProcAddress(FLibHandle, pchar(Ord(232))); if not DirectoryExists2(path) then mkdir(path);
if assigned(SHSetFolderPath) then try if not SUCCEEDED(SHSetFolderPath(CSIDL, 0, 0, pchar(PATH)))then BEGIN Result := false; Windows.beep(1000,100); END else begin Result := true; end; finally end; if FLibHandle <> 0 then FreeLibrary(FLibHandle); end;
procedure TForm1.Button3Click(Sender: TObject); begin SetFolderPath(CSIDL_PERSONAL, 'C:\HATHOR-5'); end; |
|
|
Christian213
Beiträge: 66
Erhaltene Danke: 3
Win XP, Win 7 64Bit
Lazarus 1.0.10
|
Verfasst: Mo 17.09.12 19:00
Hallo nochmal,
Kommand zurück - es funktioniert doch!
Mir war nicht bewusst, dass manche "SpecialFolders" erfordern, dass man sich ab- und wieder anmeldet bevor die neuen Einstellungen greifen.
Oder kann das OS irgendwie dazu bewegen, die neuen Pfade sofort zu benutzen??
Wie auch immer, Problem gelöst - vielen Dank nochmal
Gruß,
Christian
|
|
Gerd Kayser
Beiträge: 632
Erhaltene Danke: 121
Win 7 32-bit
Delphi 2006/XE
|
Verfasst: Mo 17.09.12 22:56
Christian213 hat folgendes geschrieben : | Oder kann das OS irgendwie dazu bewegen, die neuen Pfade sofort zu benutzen?? |
Werf mal einen Blick auf die Message WM_SETTINGCHANGE. Eventuell löst das Dein Problem. Ich kann es nur nicht testen, weil ich nach dem Einbau einer SSD-Platte noch einige Tage mit dem Aufsetzen meines Rechners beschäftigt sein werde.
|
|
|