communit.pas

采用Delphi7+Oracle. 该软件是由交警人员对各个路口闯红灯违法照片进行有效保存

unit CommUnit;
//得到浏览文件目录
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ShlObj,ActiveX;
  
function   SelectDirCB(Wnd:   HWND;   uMsg:   UINT;   lParam,   lpData:   LPARAM):   Integer   stdcall;
function   SelectDirectory(const   Caption:   string;   const   Root:   WideString;
      var   Directory:   string;   Owner:   THandle):   Boolean;

implementation
///-----------------------------------------------------------------------------
function   SelectDirCB(Wnd:   HWND;   uMsg:   UINT;   lParam,   lpData:   LPARAM):   Integer   stdcall;
begin
      if   (uMsg   =   BFFM_INITIALIZED)   and   (lpData   <>   0)   then
          SendMessage(Wnd,   BFFM_SETSELECTION,   Integer(True),   lpdata);
      result   :=   0;
end;
///-----------------------------------------------------------------------------
function   SelectDirectory(const   Caption:   string;   const   Root:   WideString;
      var   Directory:   string;   Owner:   THandle):   Boolean;
var
      WindowList:   Pointer;
      BrowseInfo:   TBrowseInfo;   
      Buffer:   PChar;
      RootItemIDList,   ItemIDList:   PItemIDList;
      ShellMalloc:   IMalloc;
      IDesktopFolder:   IShellFolder;
      Eaten,   Flags:   LongWord;
begin
      Result   :=   False;
      if   not   DirectoryExists(Directory)   then   
          Directory   :=   '';   
      FillChar(BrowseInfo,   SizeOf(BrowseInfo),   0);   
      if   (ShGetMalloc(ShellMalloc)   =   S_OK)   and   (ShellMalloc   <>   nil)   then   
      begin   
          Buffer   :=   ShellMalloc.Alloc(MAX_PATH);   
          try   
              RootItemIDList   :=   nil;
              if   Root   <>   ''   then   
              begin   
                  SHGetDesktopFolder(IDesktopFolder);   
                  IDesktopFolder.ParseDisplayName(Application.Handle,   nil,   
                      POleStr(Root),   Eaten,   RootItemIDList,   Flags);   
              end;   
              with   BrowseInfo   do   
              begin   
                  hwndOwner   :=   Owner;   //Application.Handle;
                  pidlRoot   :=   RootItemIDList;   
                  pszDisplayName   :=   Buffer;   
                  lpszTitle   :=   PChar(Caption);   
                  ulFlags   :=   BIF_RETURNONLYFSDIRS;   
                  if   Directory   <>   ''   then   
                  begin
                      lpfn:= SelectDirCB;
                      lParam:=Integer(PChar(Directory));
                  end;
              end;
              WindowList   :=   DisableTaskWindows(0);   
              try   
                  ItemIDList   :=   ShBrowseForFolder(BrowseInfo);   
              finally   
                  EnableTaskWindows(WindowList);   
              end;   
              Result   :=     ItemIDList   <>   nil;
              if   Result   then
              begin   
                  ShGetPathFromIDList(ItemIDList,   Buffer);   
                  ShellMalloc.Free(ItemIDList);   
                  Directory   :=   Buffer;   
              end;
          finally   
              ShellMalloc.Free(Buffer);   
          end;
      end;
end;

end.