(200)高分求解,取得桌面路径的代码有时行有时不行?(200分)

  • 主题发起人 HaiChengruo
  • 开始时间
H

HaiChengruo

Unregistered / Unconfirmed
GUEST, unregistred user!
函数GetDirectry用于取得桌面路径, 可有时行有时不行。请各位大虾帮忙看看代码哪里有误。
Function GetDirectry(handle:HWND;PromtStr:String):String;
var
m_strInitDir, szDirectory:pchar;
m_iImageIndex:integer;
hr:HRESULT;
chOlePath:pwidechar;
pchEaten:DWORD;
dwAttributes:DWORD;
pDesktopFolder:IShellFolder;
browseInfo:_BROWSEINFO;
// lpItemList:****EMID;
lpItemList:pITEMIDLIST;
lpM:IMalloc;
begin
// chOlePath:=nil;
m_strInitDir:=StrAlloc(255*sizeof(char));
szDirectory:=StrAlloc(255*sizeof(char));
new(chOlePath);
// new(lpItemList);
ZeroMemory(Pointer(@browseInfo),sizeof(browseInfo));
hr:= SHGetMalloc(lpM);
if (FAILED(hr) ) then exit;
hr:=SHGetDesktopFolder(pDesktopFolder);
if (FAILED(hr) ) then exit;
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, m_strInitDir, -1,chOlePath, MAX_PATH);
hr:= pDesktopFolder.ParseDisplayName(handle,
nil,
chOlePath,
pchEaten,
lpItemList,
dwAttributes);
if (FAILED(hr)) then
begin
lpM.Free(lpItemList);
lpM._Release;
exit;
end;
browseInfo.pidlRoot:=nil;//lpItemList;
browseInfo.hwndOwner:=0;
browseInfo.pszDisplayName:=szDirectory;
browseInfo.lpszTitle:=pchar(PromtStr);
browseInfo.ulFlags:= BIF_RETURNFSANCESTORS and BIF_RETURNONLYFSDIRS;
browseInfo.lParam:=0;

lpItemList:=SHBrowseForFolder(browseInfo);
if (lpItemList= nil) then
begin
exit;;
end;
//szDirectory.ReleaseBuffer();
m_iImageIndex:= browseInfo.iImage;
if (SHGetPathFromIDList(lpItemList,szDirectory)) then
begin
// Get the selected directory name
// szDirectory.ReleaseBuffer();
end;
lpM.Free(lpItemList);
lpM:=nil;
Result:=String(szDirectory);
StrDispose(m_strInitDir);
StrDispose(szDirectory);
Dispose(chOlePath);
end;
 
我测试过了,可以送分了
unit Unit1;
{$WEAKPACKAGEUNIT ON}

interface

uses
ActiveX,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShlObj;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


procedure StrResetLength(var S: AnsiString);
begin
SetLength(S, StrLen(PChar(S)));
end;

function PidlToPath(IdList: PItemIdList): string;
begin
SetLength(Result, MAX_PATH);
if SHGetPathFromIdList(IdList, PChar(Result)) then
StrResetLength(Result)
else
Result := '';
end;

function PidlFree(var IdList: PItemIdList): Boolean;
var
Malloc: IMalloc;
begin
Result := False;
if IdList = nil then
Result := True
else
begin
if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then
begin
Malloc.Free(IdList);
IdList := nil;
Result := True;
end;
end;
end;

function GetSpecialFolderLocation(const Folder: Integer): string;
var
FolderPidl: PItemIdList;
begin
if Succeeded(SHGetSpecialFolderLocation(0, Folder, FolderPidl)) then
begin
Result := PidlToPath(FolderPidl);
PidlFree(FolderPidl);
end
else
Result := '';
end;
function GetCommonDesktopdirectoryFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COMMON_DESKTOPDIRECTORY);
end;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage('桌面路径为:'+GetCommonDesktopdirectoryFolder);
end;

end.
 
uses ShlObj, ActiveX, ComObj;

ItemIDList : PItemIDList;
logfilename : array[0..512] of Char;
savefilename : String;


SHGetSpecialFolderLocation(handle,CSIDL_DESKTOP,ItemIDList);
SHGetPathFromIDList(ItemIDList,logfilename);
savefilename := string(logfilename);
 
顺便再送你几个函数--和我上面贴的配合使用
function GetProgramsFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_PROGRAMS);
end;

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

function GetPersonalFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_PERSONAL);
end;

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

function GetFavoritesFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_FAVORITES);
end;

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

function GetStartupFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_STARTUP);
end;

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

function GetRecentFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_RECENT);
end;

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

function GetSendToFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_SENDTO);
end;

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

function GetStartmenuFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_STARTMENU);
end;

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

function GetDesktopDirectoryFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_DESKTOPDIRECTORY);
end;

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

function GetNethoodFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_NETHOOD);
end;

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

function GetFontsFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_FONTS);
end;

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

function GetCommonStartmenuFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COMMON_STARTMENU);
end;

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

function GetCommonProgramsFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COMMON_PROGRAMS);
end;

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

function GetCommonStartupFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COMMON_STARTUP);
end;

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

function GetCommonDesktopdirectoryFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COMMON_DESKTOPDIRECTORY);
end;

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

// TODOC
// From: Jean-Fabien Connault
// Descr: Application data for all users. A typical path is C:/Documents and Settings/All Users/Application Data.
// Note: requires shell v 5.00 up

function GetCommonAppdataFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COMMON_APPDATA);
end;

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

function GetAppdataFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_APPDATA);
end;

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

function GetPrinthoodFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_PRINTHOOD);
end;

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

function GetCommonFavoritesFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COMMON_FAVORITES);
end;

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

function GetTemplatesFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_TEMPLATES);
end;

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

function GetInternetCacheFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_INTERNET_CACHE);
end;

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

function GetCookiesFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_COOKIES);
end;

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

function GetHistoryFolder: string;
begin
Result := GetSpecialFolderLocation(CSIDL_HISTORY);
end;
 
谢了!!!
 
to 山泉
在win2k下测试,好像不对。
 
顶部