implementationuses activex,comobj,shlobj;{$R *.dfm}function ResolveLink(const ALinkfile: String): String;varlink: IShellLink;storage: IPersistFile;filedata: TWin32FindData;buf: Array[0..MAX_PATH] of Char;widepath: WideString;beginOleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, link));OleCheck(link.QueryInterface(IPersistFile, storage));widepath := ALinkFile;Result := 'unable to resolve link';If Succeeded(storage.Load(@widepath[1], STGM_READ)) ThenIf Succeeded(link.Resolve(GetActiveWindow, SLR_NOUPDATE)) ThenIf Succeeded(link.GetPath(buf, sizeof(buf), filedata, SLGP_UNCPRIORITY)) ThenResult := buf;storage := nil;link:= nil;end;// 用法:procedure TForm1.Button1Click(Sender: TObject);beginShowMessage(ResolveLink('C:\delphi 7.lnk'));end;end.
procedure SetFileDateTime(const Tf:string); { 设置文件时间,Tf表示目标文件路径和名称 } var Dt1,Dt2:Integer; Fs:TFileStream; Fct,Flt:TFileTime; begin Dt1:=DateTimeToFileDate( Trunc(Form1.DateTimePicker1.Date) + Frac(Form1.DateTimePicker2.Time)); Dt2:=DateTimeToFileDate( Trunc(Form1.DateTimePicker3.Date) + Frac(Form1.DateTimePicker4.Time)); { 转换用户输入在DataTimePicker中的信息 } try FS := TFileStream.Create(Tf, fmOpenReadWrite); try if DosDateTimeToFileTime(LongRec(DT1).Hi, LongRec(DT1).Lo, Fct) and LocalFileTimeToFileTime(Fct, Fct) and DosDateTimeToFileTime(LongRec(DT2).Hi, LongRec(DT2).Lo, Flt) and LocalFileTimeToFileTime(Flt, Flt) then SetFileTime(FS.Handle, @Fct, @Flt, @Flt); { 设置文件时间属性 } finally FS.Free; end; except MessageDlg(日期修改操作失败!, mtError, [mbOk], 0); { 因为目标文件正在被使用等原因而导致失败 } end; end;
Procedure NewTxt;Var F : Textfile;Begin AssignFile(F, 'c:\ek.txt'); {将文件名与变量 F 关联} ReWrite(F); {创建一个新的文件并命名为 ek.txt} Writeln(F, '将您要写入的文本写入到一个 .txt 文件'); Closefile(F); {关闭文件 F}End;Procedure OpenTxt;Var F : Textfile;Begin AssignFile(F, 'c:\ek.txt'); {将文件名与变量 F 关联} Append(F); {以编辑方式打开文件 F } Writeln(F, '将您要写入的文本写入到一个 .txt 文件'); Closefile(F); {关闭文件 F}End;Procedure ReadTxt;Var F : Textfile; str : String;Begin AssignFile(F, 'c:\ek.txt'); {将文件名与变量 F 关联} Reset(F); {打开并读取文件 F } Readln(F, str); ShowMessage('文件有:' +str + '行。'); Closefile(F); {关闭文件 F}End;
function DelFile(sDir,fExt: string): Boolean;varhFindfile: HWND;FindFileData: WIN32_FIND_DATA;sr: TSearchRec;beginsDir:= sDir + '\';hFindfile:= FindFirstFile(pchar(sDir + fExt), FindFileData);if hFindFile <> NULL thenbegindeletefile(sDir + FindFileData.cFileName);while FindNextFile(hFindFile, FindFileData) <> FALSE dodeletefile(sDir + FindFileData.cFileName);end;sr.FindHandle:= hFindFile;FindClose(sr);end;function getAppPath : string;varstrTmp : string;beginstrTmp := ExtractFilePath(ExtractFilePath(application.Exename));if strTmp[length(strTmp)] <> '\' thenstrTmp := strTmp + '\';result := strTmp;end;
USES MMSYSTEM Procedure PlayResSound(RESName:String;uFlags:Integer); var hResInfo,hRes:Thandle; lpGlob:Pchar; BeginhResInfo:=FindResource(HInstance,PChar(RESName),MAKEINTRESOURCE('WAVEFILE'));if hResInfo = 0 thenbeginmessagebox(0,'未找到资源。',PChar(RESName),16);exit;end;hRes:=LoadResource(HInstance,hResinfo);if hRes = 0 thenbeginmessagebox(0,'不能装载资源。',PChar(RESName),16);exit;end;lpGlob:=LockResource(hRes);if lpGlob=Nil thenbeginmessagebox(0,'资源损坏。',PChar(RESName),16);exit;end;uFlags:=snd_Memory or uFlags;SndPlaySound(lpGlob,uFlags);UnlockResource(hRes);FreeResource(hRes); End;
type// indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelperTFileTimes = (ftLastAccess, ftLastWrite, ftCreation);function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean;varHandle: THandle;FileTime: TFileTime;SystemTime: TSystemTime;beginResult := False;Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil,OPEN_EXISTING, 0, 0);if Handle <> INVALID_HANDLE_VALUE thentry//SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime), SystemTime);SysUtils.DateTimeToSystemTime(DateTime, SystemTime);if Windows.SystemTimeToFileTime(SystemTime, FileTime) thenbegincase Times offtLastAccess:Result := SetFileTime(Handle, nil, @FileTime, nil);ftLastWrite:Result := SetFileTime(Handle, nil, nil, @FileTime);ftCreation:Result := SetFileTime(Handle, @FileTime, nil, nil);end;end;finallyCloseHandle(Handle);end;end;//--------------------------------------------------------------------------------------------------function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean;beginResult := SetFileTimesHelper(FileName, DateTime, ftLastAccess);end;//--------------------------------------------------------------------------------------------------function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean;beginResult := SetFileTimesHelper(FileName, DateTime, ftLastWrite);end;//--------------------------------------------------------------------------------------------------function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean;beginResult := SetFileTimesHelper(FileName, DateTime, ftCreation);end;---------------------------------------------------------------------- 2006-2-16 19:27:57 获取文件修改时间varfhandle:Thandle;s:String;beginfhandle:=fileopen('f:\abc.txt',0);trys:=datetimetostr(filedatetodatetime(filegetdate(fhandle)));finallyfileclose(fhandle);end;showMessage(s);end; 2006-2-16 19:28:32 获得和相应扩展文件名关联的应用程序的名字关键词:扩展名 关联程序名 uses{$IFDEF WIN32}Registry; {We will get it from the registry}{$ELSE}IniFiles; {We will get it from the win.ini file}{$ENDIF}{$IFNDEF WIN32}const MAX_PATH = 144;{$ENDIF}function GetProgramAssociation (Ext : string) : string;var{$IFDEF WIN32}reg: TRegistry;s : string;{$ELSE}WinIni : TIniFile;WinIniFileName : array[0..MAX_PATH] of char;s : string;{$ENDIF}begin{$IFDEF WIN32}s := '';reg := TRegistry.Create;reg.RootKey := HKEY_CLASSES_ROOT;if reg.OpenKey('.' + ext + '\shell\open\command',false) <> false then begin{The open command has been found}s := reg.ReadString('');reg.CloseKey;end else begin{perhaps thier is a system file pointer}if reg.OpenKey('.' + ext,false) <> false then begins := reg.ReadString('');reg.CloseKey;if s <> '' then begin{A system file pointer was found}if reg.OpenKey(s + '\shell\open\command',false) <> false then{The open command has been found}s := reg.ReadString('');reg.CloseKey;end;end;end;{Delete any command line, quotes and spaces}if Pos('%', s) > 0 thenDelete(s, Pos('%', s), length(s));if ((length(s) > 0) and(s[1] = '"')) thenDelete(s, 1, 1);if ((length(s) > 0) and(s[length(s)] = '"')) thenDelete(s, Length(s), 1);while ((length(s) > 0) and((s[length(s)] = #32) or(s[length(s)] = '"'))) doDelete(s, Length(s), 1);{$ELSE}GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));StrCat(WinIniFileName, '\win.ini');WinIni := TIniFile.Create(WinIniFileName);s := WinIni.ReadString('Extensions',ext,'');WinIni.Free;{Delete any command line}if Pos(' ^', s) > 0 thenDelete(s, Pos(' ^', s), length(s));{$ENDIF}result := s;end;procedure TForm1.Button1Click(Sender: TObject);beginShowMessage(GetProgramAssociation('gif'));end; 2006-2-16 19:29:21 删除目录里的文件但保留目录关键词:删除文件 uses Windows, Classes, ShellAPI; const FOF_DEFAULT_IDEAL = FOF_MULTIDESTFILES + FOF_RENAMEONCOLLISION + FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_FILESONLY + FOF_NOCONFIRMMKDIR + FOF_NOERRORUI + FOF_SIMPLEPROGRESS; FOF_DEFAULT_DELTREE = FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_NOERRORUI; FOF_DEFAULT_COPY = FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOERRORUI + FOF_MULTIDESTFILES; FOF_DEFAULT_DELFILES = FOF_DEFAULT_DELTREE; function ShellDeleteFiles( hWnd : THandle ; const DirName : string; Flags : FILEOP_FLAGS; WinTitle : PChar ) : integer; {---------------------------------------------------------------------------------------------} {Apaga arquivos/Diretorios atraves do shell do windows} //Notas: Ver comentario sobre o uso de duplo #0 nos parametros de Origem e destino var FileOpShell : TSHFileOpStruct; Oper : array[0..1024] of char; begin if WinTitle <> nil then begin Flags:=Flags + FOF_SIMPLEPROGRESS; end; with FileOpShell do begin wFunc:=FO_DELETE; pFrom:=Oper; pTo:=Oper; //pra garantir a rapadura! fFlags:=Flags; lpszProgressTitle:=WinTitle; Wnd:=hWnd; hNameMappings:=nil; fAnyOperationsAborted:=False; end; StrPCopy( Oper, DirName ); StrCat(Oper, PChar( ExtractFileName( FindFirstChildFile( DirName )) ) ); Result:=0; try while Oper <> EmptyStr do begin Result:=ShFileOperation( FileOpShell ); if FileOpShell.fAnyOperationsAborted then begin Result:=ERROR_REQUEST_ABORTED; break; end else begin if Result <> 0 then begin Break; end; end; StrPCopy(Oper, FindFirstChildFile( DirName ) ); end; except Result:=ERROR_EXCEPTION_IN_SERVICE; end; end;
2006-2-16 19:34:28 如何判断一个文件是不是正在被使用关键词:文件状态 function IsFileInUse(FileName: TFileName): Boolean; var HFileRes: HFILE; begin Result := False; if not FileExists(FileName) then Exit; HFileRes := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (HFileRes = INVALID_HANDLE_VALUE); if not Result then CloseHandle(HFileRes); end; 2006-2-16 19:36:03 检查文件是否为文本文件关键词:文本文件 Function isAscii(Nomefile: String): Boolean; constSett=2048;vari: Integer;F: file;a: Boolean;TotSize, IncSize, ReadSize: Integer;c: Array[0..Sett] of byte;beginIf FileExists(NomeFile) thenbegin{$I-}AssignFile(F, NomeFile);Reset(F, 1);TotSize:=FileSize(F);IncSize:=0;a:=true;while (IncSize<TotSize) and (a=true) dobeginReadSize:=Sett;If IncSize+ReadSize>TotSize then ReadSize:=TotSize-IncSize;IncSize:=IncSize+ReadSize;BlockRead(F, c, ReadSize);For i := 0 to ReadSize-1 do // IterateIf (c[i]<32) and (not (c[i] in [9, 10, 13, 26])) then a:=False;end; // whileCloseFile(F);{$I+}If IOResult<>0 then Result:=Falseelse Result:=a;end;end;procedure TForm1.Button1Click(Sender: TObject);beginif OpenDialog1.Execute thenbeginif isAscii(OpenDialog1.FileName) thenbeginShowMessage('ASCII File');end;end;end; 2006-2-16 19:37:30 查找所有文件关键词:查找所有文件 procedure findall(disk,path: String; var fileresult: Tstrings); varfpath: String;fs: TsearchRec;beginfpath:=disk+path+'\*.*';if findfirst(fpath,faAnyFile,fs)=0 thenbeginif (fs.Name<>'.')and(fs.Name<>'..') thenif (fs.Attr and faDirectory)=faDirectory thenfindall(disk,path+'\'+fs.Name,fileresult)elsefileresult.add(disk+strpas(strupper(pchar(path)))+'\'+strpas(strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');while findnext(fs)=0 dobeginif (fs.Name<>'.')and(fs.Name<>'..') thenif (fs.Attr and faDirectory)=faDirectory thenfindall(disk,path+'\'+fs.Name,fileresult)elsefileresult.add(disk+strpas(strupper(pchar(path)))+'\'+strpas(strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');end;end;findclose(fs);end;procedure DoSearchFile(Path: string; Files: TStrings = nil);varInfo: TSearchRec;procedure ProcessAFile(FileName: string);beginif Assigned(PnlPanel) thenPnlPanel.Caption := FileName;Label2.Caption := FileName;end;function IsDir: Boolean;beginwith Info doResult := (Name <> '.') and (Name <> '..') and ((attr and fadirectory) = fadirectory);end;function IsFile: Boolean;beginResult := not ((Info.Attr and faDirectory) = faDirectory);end;beginPath := IncludeTrailingBackslash(Path);tryif FindFirst(Path + '*.*', faAnyFile, Info) = 0 thenif IsFile thenProcessAFile(Path + Info.Name)else if IsDir then DoSearchFile(Path + Info.Name);while FindNext(Info) = 0 dobeginif IsDir thenDoSearchFile(Path + Info.Name)else if IsFile thenProcessAFile(Path + Info.Name);Application.ProcessMessages;if QuitFlag then Break;Sleep(100);end;finallyFindClose(Info);end;end;
// wnhoo_zzz.pasunit wnhoo_zzz;interfaceusesWindows,Forms,SysUtils,Classes,zlib,Registry,INIFILES, Dialogs, shlobj;typepass=string[20];typeTmyzip = classprivate{ private declarations here}protected{ protected declarations here }publicprocedure regzzz;procedure ys_file(infileName, outfileName: string;password:pass;isjm:boolean;ysbz:integer);function jy_file(infileName: string;password:pass=''):boolean;procedure zjywj(var filename:string);constructor Create;destructor Destroy; override;{ public declarations here }published{ published declarations here }end;implementationconstructor Tmyzip.Create;begininherited Create; // 初始化继承下来的部分end;//#####################################################//原文件加密procedure jm_File(vfile:string;var Target:TMemoryStream;password:pass;isjm:boolean);{vfile:加密文件target:加密后输出目标流 》》》password:密码isjm:是否加密-------------------------------------------------------------加密后文件SIZE=原文件SIZE+[INI加密压缩信息文件]的SIZE+存储[INI加密压缩信息文件]的大小数据类型的SIZE---------------------------------------------------------------}vartmpstream,inistream:TFileStream;FileSize:integer;inifile:TINIFILE;filename:string;begin//打开需要 [加密压缩文件]tmpstream:=TFileStream.Create(vFile,fmOpenread or fmShareExclusive);try//向 [临时加密压缩文件流] 尾部写入 [原文件流]Target.Seek(0,soFromEnd);Target.CopyFrom(tmpstream,0);//取得文件路径 ,生成 [INI加密压缩信息文件]filename:=ExtractFilePath(paramstr(0))+'tmp.in_';inifile:=TInifile.Create(filename);inifile.WriteString('file1','filename',ExtractFileName(vFile));inifile.WriteString('file1','password',password);inifile.WriteInteger('file1','filesize',Target.Size);inifile.WriteDateTime('file1','fileDate',now());inifile.WriteBool('file1','isjm',isjm);inifile.Free ;//读入 [INI加密压缩信息文件流]inistream:=TFileStream.Create(filename,fmOpenread or fmShareExclusive);try//继续在 [临时加密压缩文件流] 尾部加入 [INI加密压缩信息文件]inistream.Position :=0;Target.Seek(0,sofromend);Target.CopyFrom(inistream,0);//计算当前 [INI加密压缩信息文件] 的大小FileSize:=inistream.Size ;//继续在 [临时加密文件尾部] 加入 [INI加密压缩信息文件] 的SIZE信息Target.WriteBuffer(FileSize,sizeof(FileSize));finallyinistream.Free ;deletefile(filename);end;finallytmpstream.Free;end;end;//**************************************************************//流压缩procedure ys_stream(instream, outStream: TStream;ysbz:integer);{instream: 待压缩的已加密文件流outStream 压缩后输出文件流ysbz:压缩标准}varys: TCompressionStream;begin//流指针指向头部inStream.Position := 0;//压缩标准的选择case ysbz of1: ys := TCompressionStream.Create(clnone,OutStream);//不压缩2: ys := TCompressionStream.Create(clFastest,OutStream);//快速压缩3: ys := TCompressionStream.Create(cldefault,OutStream);//标准压缩4: ys := TCompressionStream.Create(clmax,OutStream); //最大压缩elseys := TCompressionStream.Create(clFastest,OutStream);end;try//压缩流ys.CopyFrom(inStream, 0);finallyys.Free;end;end;//*****************************************************************//流解压procedure jy_Stream(instream, outStream: TStream);{instream :原压缩流文件outStream:解压后流文件}varjyl: TDeCompressionStream;buf: array[1..512] of byte;sjread: integer;begininStream.Position := 0;jyl := TDeCompressionStream.Create(inStream);tryrepeat//读入实际大小sjRead := jyl.Read(buf, sizeof(buf));if sjread > 0 thenOutStream.Write(buf, sjRead);until (sjRead = 0);finallyjyl.Free;end;end;//**************************************************************//实现关联注册procedure Tmyzip.regzzz;varreg: TRegistry;beginreg := TRegistry.Create;reg.RootKey := HKEY_CLASSES_ROOT;reg.OpenKey('.zzz', true);reg.WriteString('', 'myzip');reg.CloseKey;reg.OpenKey('myzip\shell\open\command', true);//用于打开.zzz文件的可执行程序reg.WriteString('', '"' + application.ExeName + '" "%1"');reg.CloseKey;reg.OpenKey('myzip\DefaultIcon',true);//取当前可执行程序的图标为.zzz文件的图标reg.WriteString('',''+application.ExeName+',0');reg.Free;//立即刷新SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);end;//压缩文件procedure Tmyzip.ys_file(infileName, outfileName: string;password:pass;isjm:boolean;ysbz:integer);{infileName://需要压缩加密的文件outfileName://压缩加密后产生的文件password://解压密码ysbz://压缩标准}varinstream:TMemoryStream; //文件加密后的临时流outStream: TFileStream; //压缩输出文件流begin//创建 [文件加密后的临时流]instream:=TMemoryStream.Create;//文件加密jm_file(infileName,instream,password,isjm);//创建压缩输出文件流outStream := TFileStream.create(outFIleName, fmCreate);try//[文件加密后的临时流] 压缩ys_stream(instream,OutStream,ysbz);finallyOutStream.free;instream.Free ;end;end;//解压文件function Tmyzip.jy_file(infileName: string;password:pass=''):boolean;varinStream,inistream,filestream_ok: TFileStream;{instream://解压文件名称inistream://INI临时文件流filestream_ok://解压OK的文件}outStream:tmemorystream; //临时内存流inifile:TINIFILE; //临时INI文件FileSize:integer; //密码文件的SIZEresultvalue:boolean;//返回值begintryinStream := TFileStream.create(inFIleName, fmOpenRead);tryoutStream := tmemorystream.create;tryjy_stream(insTream,OutStream);//生成临时INI文件inistream:=TFileStream.create(ExtractFilePath(paramstr(0))+'tmp.in_', fmCreate);try//指向存储解码信息的INTEGER型变量位置OutStream.Seek(-sizeof(FileSize),sofromend);//读入变量信息OutStream.ReadBuffer(FileSize,sizeof(FileSize));//指向解码信息位置OutStream.Seek(-(FileSize+sizeof(FileSize)),sofromend);//将解码信息读入INI流中inistream.CopyFrom(OutStream,FileSize);//释放INI文件流inistream.Free ;//读入INI文件信息inifile:=TINIFILE.Create(ExtractFilePath(paramstr(0))+'tmp.in_');resultvalue:=inifile.ReadBool('file1','isjm',false);if resultvalue thenbeginif inifile.ReadString ('file1','password','')=trim(password) thenresultvalue:=trueelseresultvalue:=false;endelseresultvalue:=true;if resultvalue thenbeginfilestream_ok:=TFileStream.create(ExtractFilePath(paramstr(1))+inifile.ReadString('file1','filename','wnhoo.zzz'),fmCreate);tryOutStream.Position :=0;filestream_ok.CopyFrom(OutStream,inifile.ReadInteger('file1','filesize',0));finallyfilestream_ok.Free ;end;end;inifile.Free;finally//删除临时INI文件deletefile(ExtractFilePath(paramstr(0))+'tmp.in_');end;//finallyOutStream.free;end;finallyinStream.free;end;exceptresultvalue:=false ;end;result:=resultvalue;end; //自解压创建procedure tmyzip.zjywj(var filename:string);varmyRes: TResourceStream;//临时存放自解压EXE文件myfile:tfilestream;//原文件流xfilename:string;//临时文件名称file_ok:tmemorystream; //生成文件的内存流filesize:integer; //原文件大小beginif FileExists(filename) thenbegin//创建内存流file_ok:=tmemorystream.Create ;//释放资源文件-- 自解压EXE文件myRes := TResourceStream.Create(Hinstance, 'myzjy', Pchar('exefile'));//将原文件读入内存myfile:=tfilestream.Create(filename,fmOpenRead);trymyres.Position:=0;file_ok.CopyFrom(myres,0);file_ok.Seek(0,sofromend);myfile.Position:=0;file_ok.CopyFrom(myfile,0);file_ok.Seek(0,sofromend);filesize:=myfile.Size;file_ok.WriteBuffer(filesize,sizeof(filesize));file_ok.Position:=0;xfilename:=ChangeFileExt(filename,'.exe') ;file_ok.SaveToFile(xfilename);finallymyfile.Free ;myres.Free ;file_ok.Free ;end;DeleteFile(filename);filename:=xfilename;end;end;//#####################################################destructor Tmyzip.Destroy;begininherited Destroy;end;end.
unit Unit1;interfaceusesWindows, Messages, FileCtrl,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ComCtrls, StdCtrls, ImgList, ExtCtrls;typeTForm1 = class(TForm)TreeView: TTreeView;Button3: TButton;procedure Button3Click(Sender: TObject);private{ Private declarations }publicprocedure CreateDirectoryTree(RootDir, RootCaption: string);end;varForm1: TForm1;implementation{$R *.DFM}procedure TForm1.CreateDirectoryTree(RootDir, RootCaption: string);procedure AddSubDirToTree(RootNode: TTreeNode);varSearchRec: TSearchRec;Path: string;Found: integer;beginPath := PChar(RootNode.Data) + '\*.*';Found := FindFirst(Path, faAnyFile, SearchRec);while Found = 0 dobeginif (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') thenAddSubDirToTree(TreeView.Items.AddChildObject(RootNode, SearchRec.Name,PChar(PChar(RootNode.Data) + '\' + SearchRec.Name)));Found := FindNext(SearchRec);end;FindClose(SearchRec);end;begin//TreeView.Items.Clear;AddSubDirToTree(TreeView.Items.AddObject(nil, RootCaption, PChar(RootDir)));end;procedure TForm1.Button3Click(Sender: TObject);vari:integer;abc:Tstrings;s:string;beginabc:=TStringlist.Create;for i:=0 to 23 do begins := Chr(65+i)+':\';// if GetDriveType(PChar(s))= DRIVE_cdrom thenif directoryexists(s) thenbegins:=copy(s,0,2) ;abc.Add(s);end;end;for i:=0 to abc.Count-1 doBEGINS:=abc.strings[i];CreateDirectoryTree(S, '['+s+'\]');ENDend;end. 2006-2-16 19:40:27 文件或目录转换成TreeView关键词:treeview 下面的这个函数就可以了: procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode; IncludeFiles:Boolean);varSearchRec : TSearchRec;ItemTemp : TTreeNode;beginwith Tree.Items dotryBeginUpdate;if Directory[Length(Directory)] <> ' then Directory := Directory + ';if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 thenbeginrepeatif (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') thenbeginif (SearchRec.Attr and faDirectory > 0) thenRoot := AddChild(Root, SearchRec.Name);ItemTemp := Root.Parent;DirToTreeView(Tree, Directory + SearchRec.Name, Root, IncludeFiles);Root := ItemTemp;endelse if IncludeFiles thenif SearchRec.Name[1] <> '.' thenAddChild(Root, SearchRec.Name);until FindNext(SearchRec) <> 0;FindClose(SearchRec);end;finallyEndUpdate;end;end; 2006-2-16 19:40:58 如何判断一目录是否共享关键词:判断 共享目录 共享文件夹 Shell编程---如何判断一目录是否共享?下面函数要额外引用 ShlObj, ComObj, ActiveX 单元。function TForm1.IfFolderShared(FullFolderPath: string): Boolean;//将TStrRet类型转换为字符串function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag:string=''): string;varP: PChar;begincase StrRet.uType ofSTRRET_CSTR:SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));STRRET_OFFSET:beginP := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);end;STRRET_WSTR:if Assigned(StrRet.pOleStr) thenResult := StrRet.pOleStrelseResult := '';end;{ This is a hack bug fix to get around Windows Shell Controls returningspurious "?"s in date/time detail fields }if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) thenResult := StringReplace(Result,'?','',[rfReplaceAll]);end;//返回Desktop的IShellFolder接口function DesktopShellFolder: IShellFolder;beginOleCheck(SHGetDesktopFolder(Result));end;//返回IDList去掉第一个ItemID后的IDListfunction NextPIDL(IDList: PItemIDList): PItemIDList;beginResult := IDList;Inc(PChar(Result), IDList^.mkid.cb);end;//返回IDList的长度function GetPIDLSize(IDList: PItemIDList): Integer;beginResult := 0;if Assigned(IDList) thenbeginResult := SizeOf(IDList^.mkid.cb);while IDList^.mkid.cb <> 0 dobeginResult := Result + IDList^.mkid.cb;IDList := NextPIDL(IDList);end;end;end;//取得IDList中ItemID的个数function GetItemCount(IDList: PItemIDList): Integer;beginResult := 0;while IDList^.mkid.cb <> 0 dobeginInc(Result);IDList := NextPIDL(IDList);end;end;//创建一ItemIDList对象function CreatePIDL(Size: Integer): PItemIDList;varMalloc: IMalloc;beginOleCheck(SHGetMalloc(Malloc));Result := Malloc.Alloc(Size);if Assigned(Result) thenFillChar(Result^, Size, 0);end;//返回IDList的一个内存拷贝function CopyPIDL(IDList: PItemIDList): PItemIDList;varSize: Integer;beginSize := GetPIDLSize(IDList);Result := CreatePIDL(Size);if Assigned(Result) thenCopyMemory(Result, IDList, Size);end;//返回AbsoluteID最后一个ItemID,即此对象相对于父对象的ItemIDfunction RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;beginResult := AbsoluteID;while GetItemCount(Result) > 1 doResult := NextPIDL(Result);Result := CopyPIDL(Result);end;//将IDList的最后一个ItemID去掉,即得到IDList的父对象的ItemIDprocedure StripLastID(IDList: PItemIDList);varMarkerID: PItemIDList;beginMarkerID := IDList;if Assigned(IDList) thenbeginwhile IDList.mkid.cb <> 0 dobeginMarkerID := IDList;IDList := NextPIDL(IDList);end;MarkerID.mkid.cb := 0;end;end;//判断返回值Flag中是否包含属性Elementfunction IsElement(Element, Flag: Integer): Boolean;beginResult := Element and Flag <> 0;end;varP: Pointer;NumChars, Flags: LongWord;ID, NewPIDL, ParentPIDL: PItemIDList;ParentShellFolder: IShellFolder;beginResult := false;NumChars := Length(FullFolderPath);P := StringToOleStr(FullFolderPath);//取出该目录的绝对ItemIDListOleCheck(DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags));if NewPIDL <> nil thenbeginParentPIDL := CopyPIDL(NewPIDL);StripLastID(ParentPIDL); //得到该目录上一级目录的ItemIDListID := RelativeFromAbsolute(NewPIDL); //得到该目录相对于上一级目录的ItemIDList//取得该目录上一级目录的IShellFolder接口OleCheck(DesktopShellFolder.BindToObject(ParentPIDL, nil, IID_IShellFolder,Pointer(ParentShellFolder)));if ParentShellFolder <> nil thenbeginFlags := SFGAO_SHARE;//取得该目录的属性OleCheck(ParentShellFolder.GetAttributesOf(1, ID, Flags));if IsElement(SFGAO_SHARE, Flags) then Result := true;end;end;end;
联系客服