fmxutils.pas

最好的局域网搜索软件

unit FmxUtils;

interface

uses SysUtils, Windows, Classes, Consts, ShlObj, WinSock;

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;

function ZwFtpGetFileSize(url: string): integer;

implementation

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

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;

//====================================
// 单独的一个函数，和上面的无关
//------------------------------------
function ZwFtpGetFileSize(url: string): integer;
var
  WsaData: TWsadata;
  err, len: integer;
  SvrAddr, FilePath: string;
  UsrName, PassWord: string;
  CmdSocket: integer;
  CmdAddrIn: TSockAddrIn;
  Buf: array[0..1023] of char;
  GuessSucceed: boolean;
  i: integer;
  s, pwd: string;

  procedure RecvReply(var Buf: array of char);
  var
    len: integer;
  begin
    len := Recv(CmdSocket, Buf, 1024, 0);
    Buf[len] := #0;
  end;

  procedure SendCmd(Content: string);
  begin
    Content := Content +#13+#10;
    Send(CmdSocket, Content[1], length(Content), 0);
  end;

  function GetCode(s: string): string;
  var
    i: integer;
    buf: array[0..255] of char;
  begin
    while s[4] = '-' do
    begin
      RecvReply(buf);
      s := buf;
      i := pos(#13+#10, s);
      while (i <> length(s)-1)and(i<>0) do
      begin
        delete(s, 1, i+1);
        i := pos(#13+#10, s);
      end;
    end;
    i := pos(' ', s);
    result := copy(s, 1, i-1);
  end;

  function GetRemoteSize2(str: string): integer;
  var
    i: integer;
    s: string;
  begin
    s := str;
    i := pos(' ', s);
    Delete(s, 1, i);
    s := trim(s);
    result := strtoint(s);
  end;

  {
  in: url: 'ftp://x.x.x.x/aabb/ccdd/c.txt'
  out: FptSvr: x.x.x.x
  out: FtpDir: /aabb/ccdd/c.txt
  }
  procedure FtpUrl2AddrPath(url: string; var FtpSvr, FilePath: string);
  var
    s: string;
    i: integer;
  begin
    s := url;
    delete(s, 1, 6);
    i := pos('/', s);
    if i = 0 then
    begin
      FtpSvr := s;
      FilePath := '';
    end
    else
    begin
      FtpSvr := copy(s, 1, i-1);
      delete(s, 1, i-1);
      FilePath := s;
    end;
  end;

  function GetPwd(str: string): string;
  var
    i: integer;
    s: string;
  begin
    i := pos('"', str);
    delete(str, 1, i);
    i := pos('"', str);
    s := copy(str, 1, i-1);
    result := s;
  end;
  
begin
  FtpUrl2AddrPath(url, SvrAddr, FilePath);
  ConfigForm.GiveFtpUserPassWord(SvrAddr, UsrName, PassWord);

  WSAStartup($0101,WSAData);
  
  CmdSocket := socket(AF_INET, SOCK_STREAM,IPPROTO_IP);

  if (CmdSocket = INVALID_SOCKET) then
  begin
    Windows.MessageBox(0, pchar(inttostr(WSAGetLastError())+'  Socket创建失败'), '错误', mb_ok);
    CloseSocket(CmdSocket);
    result := -1;
    exit;
  end;

  CmdAddrIn.sin_addr.s_addr:=inet_addr(PChar(SvrAddr));
  CmdAddrIn.sin_family := AF_INET;
  CmdAddrIn.sin_port :=htons(21);
  err:=connect(CmdSocket,CmdAddrIn, SizeOf(CmdAddrIn));

  //RecvReply(Buf);
  len := Recv(CmdSocket, Buf, 1024, 0);
  Buf[len] := #0;

  SendCmd('USER '+UsrName);
  RecvReply(Buf);
  if (GetCode(buf) <> '331'){and(GetCode(buf) <> '220')} then
  begin
    result := -1;
    exit;
  end;

  SendCmd('PASS '+PassWord);
  RecvReply(Buf);
  if GetCode(buf) <> '230' then
  begin
    //------------------------guess-------------------------
    GuessSucceed := false;

    for i := 0 to ConfigForm.lvFtpMountList.Items.Count-1 do
    begin
      s := ConfigForm.lvFtpMountList.Items[i].Caption;
      if s =  '*' then
      begin
        UsrName := ConfigForm.lvFtpMountList.Items[i].SubItems[0];
        //PassWord := ConfigForm.lvFtpMountList.Items[i].SubItems[1];
        PassWord := ConfigForm.FtpPassList.Strings[i];

        SendCmd('USER '+UsrName);
        RecvReply(Buf);
        if (GetCode(buf) = '331') then
        begin
          SendCmd('PASS '+PassWord);
          RecvReply(Buf);
          if GetCode(buf) = '230' then
          begin
            GuessSucceed := true;
            break;
          end;
        end;
      end;
    end;
    //------------------------------------------------------
    if (not GuessSucceed) then
    begin
      result := -1;
      exit;
    end;
  end;

  SendCmd('PWD');
  RecvReply(Buf);
  if GetCode(buf) <> '257' then
  begin
    result := -1;
    exit;
  end;
  pwd := GetPwd(Buf);
  ///ShowMessage(pwd);
  if pwd <> '/' then FilePath := pwd + FilePath;

  SendCmd('SIZE '+FilePath);
  RecvReply(Buf);
  if GetCode(buf) = '213' then
    result := GetRemoteSize2(buf);

  CloseSocket(CmdSocket);
end;
//====================================

end.