fmxutils.pas

该程序用D5编译

unit FmxUtils;

interface

uses SysUtils, Windows, Classes, Consts,ShlObj;

type
  EInvalidDest = class(EStreamError);
  EFCantMove = class(EStreamError);

  type OSType=(osUnknown,osWin9x{osWin95,osWin98,osWin98se,osWinme},osWinnt4,osWin2k,osWinxp);

//procedure CopyFile(const FileName, DestName: string);
//procedure MoveFile(const FileName, DestName: string);
function GetFileSize(const FileName: string): LongInt;
function FileDateTime(const FileName: string): TDateTime;
function HasAttr(const FileName: string; Attr: Word): Boolean;
function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
function GetFileIconIndex(FileName:string):integer;{ 获取图标的序号函数 }
function GetDirectorySize(path: string): Integer;{文件夹大小}

//Copy the file use shell
function Win_CopyFile(fFROM,fTO:String):boolean;
//Delete the file use shell
function Win_DelFile(DelFile:String):boolean;

procedure GetFileProperty(f:string; handle: THandle);
procedure CopyToClipBoard(FileName:string; Handle: THandle);

function IsLegalIP(IP:string):boolean;

function GetOSVersion : OSType;

function ShowSearchHostDialog: boolean;

implementation

uses Forms,  ActiveX, ComObj, CommCtrl, ShellAPI,FileCtrl;

const
  SInvalidDest = 'Destination %s does not exist';
  SFCantMove = 'Cannot move file %s';

//zw
function GetFileIconIndex(FileName:string):integer;{ 获取图标的序号函数 }
var
  Ext:String;
  FileInfo: TSHFileInfo;
begin
  Ext:=FileName;
  {Result:=}ShGetFileInfo(Pchar(Ext), 0, FileInfo,SizeOf(FileInfo),
          SHGFI_SMALLICON {or SHGFI_LARGEICON} or SHGFI_SYSICONINDEX or SHGFI_TYPENAME);
  Result:=FileInfo.iIcon;  { 返回获取的图标序号 }
end;

{ GetFileSize function }
{
  Returns the size of the named file without opening the file.  If the file
  doesn't exist, returns -1.
}

function GetFileSize(const FileName: string): LongInt;
var
  SearchRec: TSearchRec;
begin
  try
    if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
      Result := SearchRec.Size
    else Result := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;

function FileDateTime(const FileName: string): System.TDateTime;
begin
  Result := FileDateToDateTime(FileAge(FileName));
end;

function HasAttr(const FileName: string; Attr: Word): Boolean;
var
 FileAttr: Integer;
begin
  FileAttr := FileGetAttr(FileName);
  if FileAttr = -1 then FileAttr := 0;
  Result := (FileAttr and Attr) = Attr;
end;

function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
{var
  zFileName, zParams, zDir: array[0..79] of Char; }
begin
  {Result := ShellExecute(Application.MainForm.Handle, nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd); }
  Result := ShellExecute(Application.MainForm.Handle, nil,
    pchar(FileName),pchar(Params),pchar(DefaultDir), ShowCmd);
end;

//Copy the file use shell
function Win_CopyFile(fFROM,fTO:String):boolean;
var
  FData : TShFileOpStruct;
begin
   fTo:=fTo+#0#0;
   fFrom:=fFrom+#0#0;
   Fdata.pFrom := PChar(fFrom);
   fdata.pTo := PChar(fTo);
   fdata.wFunc := FO_COPY ;
   FData.Wnd := application.Handle ;
   fData.lpszProgressTitle := '正在复制';
   fData.fFlags := FOF_ALLOWUNDO OR FOF_NOCONFIRMMKDIR;// or FOF_SILENT ;
   result:=ShFileOperation( FData ) = 0  ;
end;

function Win_DelFile(DelFile:String):boolean;
var
  FData : TShFileOpStruct;
begin

  DelFile := DelFile + #0#0;
  With FData do
  begin
    Wnd:=0;
    wFunc:=FO_DELETE;
    pFrom:=Pchar(DelFile);
    pTo:=nil;
    fFlags:=FOF_ALLOWUNDO; //+FOF_NOCONFIRMATION+FOF_NOERRORUI;//标志表明允许恢复，无须确认并不显示出错信息
    hNameMappings:=nil;
    lpszProgressTitle:='正在删除...';
    fAnyOperationsAborted:=False;
  end;
  result:=SHFileOperation(FData) = 0;

end;

//弹出属性对话框
procedure GetFileProperty(f:string; handle: THandle{just use form's handle});
var SEI:PSHELLEXECUTEINFOA;
begin
   getmem(sei,sizeof(sei^));
   With SEI^ do
   begin
     cbSize := sizeof(SEI^);
     fMask := SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI;
     wnd := handle;
     lpVerb := 'properties';
     lpFile :=pchar(f);  //你自己的文件名
     lpParameters := nil;
     lpDirectory := nil;
     nShow := 0;
     hInstApp := hInstance;
     lpIDList := nil;
   End;
 ShellExecuteEX(SEI);
 freemem(sei);
end;

function GetDirectorySize(Path: String): Integer; //eg. Path = 'c:\temp\'
var
  SR: TSearchRec;
begin
  Result := 0;
  if path[length(path)]<>'\' then path:=path+'\';
  if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr = faDirectory) then
      Result := Result + GetDirectorySize(Path+Sr.Name+'\')
    else
      Result := Result + Sr.Size;
    while FindNext(sr) = 0 do
      if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr = faDirectory) then
        Result := Result + GetdirectorySize(Path+Sr.Name+'\')
      else
        Result := Result + Sr.Size;
    SysUtils.FindClose(sr);
  end;
end;

procedure CopyToClipBoard(FileName:string; Handle: THandle{just use form's handle});
var
  DataHandle: THandle;
  DataPointer: PDROPFILES;
begin
  DataHandle := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE,SizeOf(DROPFILES)+2+Length(FileName));
  DataPointer := PDROPFILES(GlobalLock(DataHandle));
  FillChar(DataPointer^,SizeOf(DROPFILES)+2+Length(FileName),0);

  DataPointer.pFiles:=SizeOf(DROPFILES);
  DataPointer.pt:=Point(0,0);
  DataPointer.fNC:=False;
  DataPointer.fWide:=False;
  Move(FileName[1],Pointer(Integer(DataPointer)+SizeOf(DROPFILES))^,Length(FileName));
  GlobalUnlock(DataHandle);
  OpenClipboard(Handle);
  EmptyClipboard;
  SetClipboardData(CF_HDROP, DataHandle);
  CloseClipboard;
end;

function IsLegalIP(IP:string):boolean;
var
  i, j, l: integer;
  ips: array [1..4] of string;
begin

  i:=1;
  for l:=1 to 4 do ips[l]:='';
  for j:=1 to length(ip) do
    if ip[j]<>'.' then
    begin
      if (ip[j]<'0')or(ip[j]>'9') then
      begin
        //showmessage(ip[j]);
        Result:=false;
        exit;
      end;
      ips[i]:=ips[i]+ip[j]
    end
    else inc(i);

  if (i<>4)
      or((strtoint(ips[1])>255)or(strtoint(ips[1])<0))  //originally is <1
      or((strtoint(ips[2])>255)or(strtoint(ips[2])<0))
      or((strtoint(ips[3])>255)or(strtoint(ips[3])<0))
      or((strtoint(ips[4])>255)or(strtoint(ips[4])<0))
  then Result:= false else Result:= true;

end;

function GetOSVersion : OSType;
var
  osVerInfo : TOSVersionInfo;
  majorVer, minorVer : Integer;
begin

  //Result := osUnknown;
  osVerInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
  if ( GetVersionEx( osVerInfo ) ) then
  begin
    majorVer := osVerInfo.dwMajorVersion;
    minorVer := osVerInfo.dwMinorVersion;
    case ( osVerInfo.dwPlatformId ) of
      VER_PLATFORM_WIN32_NT : { Windows NT/2000 }
      begin
        if ( majorVer <= 4 ) then
        Result := osWinnt4
        else
        if ( ( majorVer = 5 ) and ( minorVer= 0 ) ) then
        Result := osWin2k
        else
        if ( ( majorVer = 5) and ( minorVer = 1 ) ) then
        Result := osWinxp
        else
        Result := OsUnknown;
      end;
      VER_PLATFORM_WIN32_WINDOWS : { Windows 9x/ME }
      begin
        {
        If ( ( majorVer = 4 ) And ( minorVer = 0 ) ) Then
        Result := osWin95
        Else If ( ( majorVer = 4 ) And ( minorVer = 10 ) ) Then 
        Begin
          If ( osVerInfo.szCSDVersion[ 1 ] = 'A' ) Then
          Result := osWin98se
          Else
          Result := osWin98;
        End 
        Else If ( ( majorVer = 4) And ( minorVer = 90 ) ) Then
        Result := OsWinME
        Else
        Result := OsUnknown;
        }
        Result:= osWin9x;
      end;
      else
      Result := OsUnknown;
    end; //end of case
  end else
  Result := OsUnknown;

end;

//------------------------------------------
function SHFindComputer(pidlRoot: PItemIDList; pidlSavedSearch: PItemIDList): Boolean;
 stdcall; external 'Shell32.dll' index 91;
//----------------------------------------------

function ShowSearchHostDialog: boolean;
var pidlRoot: PItemIDList;
    pidlSavedSearch: PItemIDList;
begin
  pidlRoot:=nil;  //just remove warning;
  pidlSavedSearch:=nil; //just remove warning;
  result := SHFindComputer(pidlRoot,pidlSavedSearch);
end;

end.