Entwickler-Ecke
Windows API - SHSetFolderPath?
Christian213 - 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 - 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?
Delete - 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 - 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
Delete - 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.
Delphi-Quelltext
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 - So 16.09.12 11:59
Hallo hathor,
Perfekt! - Genau so etwas habe ich gesucht!
1000 Dank! :-)
Gruß,
Christian
glotzer - 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.
Delete - So 16.09.12 20:02
Das ist doch scheissegal, Du Oberlehrer!
"function DirectoryExists ( const DirectoryName : string ) : Boolean;"
Delphi-Quelltext
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; |
Narses - 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
Christian213 - 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
Delete - Mo 17.09.12 16:25
Delphi-Quelltext
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 - 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 - 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.
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!