delphi环境下的一些自定义函数

{
的所有方法都只是在DELPHI7下通过编译;
极少部分通过具体应用;
}
unit Unit2;

interface

uses Windows, SysUtils, ShellAPI, Messages, Classes, Forms, Controls, ComCtrls,
     Dialogs, Graphics, Registry, winsock, ComObj, WinInet;//,FileCtrl;
     //{$IFDEF Delphi6},Variants{$EndIf};

type
  TMyClass = class
  private
    procedure CleanDirectoryProc(sFileName: string; var bContinue: Boolean);
  end;

  TEnumDirectoryFileProc = procedure (Filename: string; var bContinue: Boolean) of object;

type
  Tpub = class
    private

    public
    //求不定个数的整数的和;
    function  GetIntSum(const  a:  array  of  Integer):  Integer;
    //把小写阿拉伯数字转成大写
    function ConvertSmallNumToBig(SmallNum: real):string;

    //取得系统路径;
    function PathGetSystemPath: string;
    //路径最后没有’/’则加’/’
    function PathWithSlash(const Path: string): string;
    //取得Windows路径
    function PathGetWindowsPath: string;
    //移动文件夹
    procedure FileMoveDirectory(sDir, tDir:string;AHandle:Thandle);
    //删除给定路径及以下的所有路径和文件
    procedure FileDeleteDirectory(sDir: string);overload;
    //删除给定路径及以下的所有路径和文件 用WinApi
    procedure FileDeleteDirectory(AHandle: THandle;const ADirName: string);overload;
    //删除给定路径及以下的所有路径和文件 到回收站
    procedure FileDeleteDirectoryToCycle(AHandle: THandle;const ADirName: string);
    //取得路径最后部分和其他部分 如d:aaaa result:=aa  sPath:=d:aa
    function PathGetLeafDir(var sPath: string): string;
    //路径最后有’/’则去’/’
    function PathWithoutSlash(const Path: string): string;

    //拷贝一个文件,封装CopyFile
    procedure FileCopyFile(const sSrcFile, sDstFile: string);
    //取得当前应用程序的路径
    function PathExeDir(FileName: string = ”): string;
    //使鼠标变忙和恢复正常
    procedure DoBusy(Busy: Boolean);

    //系统处理起
    //提示窗口
    procedure MsgBox(const Msg: string);
    //询问窗口 带’是’,’否’按钮
    function  MsgYesNoBox(const Msg: string): Boolean;
    //询问窗口 带’是’,’否,’取消’按钮//返回值smbYes,smbNo,smbCancel
    function  MsgYesNoCancelBox(const Msg: string): Integer;

    //网络起
    //得到本机的局域网Ip地址
    Function NetGetLocalIp(var LocalIp:string): Boolean;
    //通过Ip返回机器名
    Function NetGetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;
    //获取网络中SQLServer列表
    Function NetGetSQLServerList(var List: Tstringlist): Boolean;
    //获取网络中的工作组
    Function NetGetGroupList(var List: TStringList): Boolean;
    //获取工作组中所有计算机
    Function NetGetUsers(GroupName: string; var List: TStringList): Boolean;
    //判断Ip协议有没有安装   这个函数有问题
    Function NetIsIPInstalled : boolean;
    //检测机器是否上网
    Function NetInternetConnected: Boolean;

    //EMail起
    function CheckMailAddress(Text: string): boolean;
    //EMail止

    end;

  var
    Pub: TPub;

implementation

{ Tpub }

procedure MyFileCopyDirectory(sDir, tDir:string;AHandle:Thandle;Flag: integer = 0);
var
  fromdir,todir{,dirname}:pchar;
  SHFileOpStruct:TSHFileOpStruct;
begin
  GetMem(fromdir,length(sDir)+2);
  try
    GetMem(todir,length(tdir)+2);
    try
      FIllchar(fromdir^,length(sDir)+2,0);
      FIllchar(todir^,length(tDir)+2,0);
      strcopy(fromdir,pchar(sDir));
      strcopy(todir,pchar(tDir));
      with SHFileOpStruct  do
      begin
        wnd := AHandle;
        if Flag = 1 then
          WFunc := FO_MOVE
        else
          WFunc := FO_COPY;
        //该参数指明shFileOperation函数将执行目录的拷贝
        pFrom:=fromdir;
        pTO:=todir;
        fFlags:=FOF_NOCONFIRMATION OR FOF_RENAMEONCOLLISION;
        fAnyOperationsAborted:=false;
        hnamemappings:=nil;
        lpszprogresstitle:=nil;
      end;
      if shFileOperation(SHFileOpStruct)<>0 then
        Raiselastwin32Error;
    finally
      FreeMem(todir,length(tDir)+2);
    end;
  finally
    FreeMem(fromdir,length(sDir)+2);
  end;
end;

procedure EnumDirectoryFiles(sDir, SMASK: string; Attr: Integer; EnumDirectoryFileProc: TEnumDirectoryFileProc);
var
  SearchRec: TSearchRec;
  Status   : Integer;
  bContinue: Boolean;
begin
  sDir := Pub.PathWithSlash(sDir);

  // traverse child directories
  Status := FindFirst(sDir + ‘*.*’, faDirectory, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.name <> ‘.’) and (SearchRec.name <> ‘..’) then
        EnumDirectoryFiles(sDir + SearchRec.name, SMASK, Attr, EnumDirectoryFileProc);

      Status := FindNext(SearchRec);
    end;
  finally
    SysUtils.FindClose(SearchRec);
  end;

  // exam each valid file and invoke the callback func
  Status := FindFirst(sDir + SMASK, faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and Attr <> 0) and (FileExists(sDir + SearchRec.name) or DirectoryExists(sDir + SearchRec.name)) and
        not ((SearchRec.Attr and faDirectory <> 0) and ((SearchRec.name = ‘.’) or (SearchRec.name = ‘..’))) then
      begin
        bContinue := True;
        EnumDirectoryFileProc(sDir + SearchRec.name, bContinue);
        if not bContinue then Break;
      end;

      Status := FindNext(SearchRec);
    end;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;

procedure Tpub.FileDeleteDirectory(sDir: string);
begin
  //if not MsgYesNoBox(‘确信要删除该目录及以下所有文件夹和文件吗?’) then exit;
  with TMyClass.Create do
    try
      EnumDirectoryFiles(sDir, ‘*.*’, faAnyFile, CleanDirectoryProc);
    finally
      Free;
    end;
  RMDir(sDir);
end;

procedure Tpub.FileCopyFile(const sSrcFile, sDstFile: string);
begin
  if AnsiCompareFileName(sSrcFile, sDstFile) <> 0 then
    CopyFile(PChar(sSrcFile), PChar(sDstFile), False);
end;

procedure Tpub.FileDeleteDirectory(AHandle: THandle;
  const ADirName: string);
var
  SHFileOpStruct:TSHFileOpStruct;
  DirName: PChar;
  BufferSize: Cardinal;
begin
  // 调用shFileOperation函数可以实现对目录的拷贝、移动、重命名或删除操作
  BufferSize := length(ADirName) + 2;
  GetMem(DirName,BufferSize);
  try
    FIllChar(DirName^, BufferSize, 0);
    StrCopy(DirName,PChar(ADirName));
    with SHFileOpStruct  do
    begin
      Wnd := AHandle;
      WFunc := FO_DELETE;
      pFrom := DirName;
      pTO := nil;
      fFlags := FOF_ALLOWUNDO;

      fAnyOperationsAborted := false;
      hNameMappings := nil;
      lpszProgressTitle := nil;
    end;
    if SHFileOperation(SHFileOpStruct) <> 0 then
      Raiselastwin32Error;
  finally
    FreeMem(DirName,BufferSize);
  end;
end;

procedure TPub.FileDeleteDirectoryToCycle(AHandle: THandle;const ADirName: string);
var
  SHFileOpStruct:TSHFileOpStruct;
  DirName: PChar;
  BufferSize: Cardinal;
  aa: string;
begin
  // 调用shFileOperation函数可以实现对目录的拷贝、移动、重命名或删除操作
  if not DirectoryExists(ADirName) then
  begin
    aa := ADirName;
    MsgBox(‘不存在文件夹“’ + PathGetLeafDir(aa) + ‘”,删除失败!’);
    exit;
  end;
  BufferSize := length(ADirName) + 2;
  GetMem(DirName,BufferSize);
  try
    FIllChar(DirName^, BufferSize, 0);
    StrCopy(DirName,PChar(ADirName));
    with SHFileOpStruct  do
    begin
      Wnd := AHandle;
      WFunc := FO_DELETE;
      pFrom := DirName;
      pTO := nil;
      fFlags := FOF_ALLOWUNDO;

      fAnyOperationsAborted:=false;
      hNameMappings:=nil;
      lpszProgressTitle:=nil;
    end;
    if SHFileOperation(SHFileOpStruct) <> 0 then
      Raiselastwin32Error;
  finally
    FreeMem(DirName,BufferSize);
  end;
end;

procedure Tpub.FileMoveDirectory(sDir, tDir: string; AHandle: Thandle);
begin
  // 调用shFileOperation函数可以实现对目录的拷贝、移动、重命名或删除操作
  if not DirectoryExists(sDir) then
  begin
    MsgBox(‘不存在源路径“’ + sDir + ‘”,移动数据失败!’);
    exit;
  end;
  if DirectoryExists(tDir) then
  begin
    if  Pub.MsgYesNoBox(‘已存在该文件夹确信要覆盖吗?’) then
      FileDeleteDirectory(tDir)
    else exit;
  end else
  if not MsgYesNoBox(‘不存在目标路径“’ + tDir + ‘”,要创建吗?’) then exit;

  ForceDirectories(tDir);
  MyFileCopyDirectory(sDir, tDir, AHandle, 1);
end;

procedure Tpub.MsgBox(const Msg: string);
begin
  Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONINFORMATION);
end;

function Tpub.MsgYesNoBox(const Msg: string): Boolean;
begin
  Result := Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONQUESTION or
    MB_YESNO or MB_DEFBUTTON1) = IDYES;
end;

function Tpub.PathGetLeafDir(var sPath: string): string;
begin
  sPath := PathWithoutSlash(sPath);
  Result := ExtractFileName(sPath);
  sPath := ExtractFilePath(sPath);
end;

function Tpub.PathGetSystemPath: string;
var
  Buf: array[0..255] of Char;
begin
  GetSystemDirectory(@Buf, 255);
  Result := PathWithSlash(StrPas(@Buf));
end;

function Tpub.PathGetWindowsPath: string;
var
  Buf: array[0..255] of Char;
begin
  GetWindowsDirectory(@Buf, 255);
  Result := PathWithSlash(StrPas(@Buf));
end;

function Tpub.PathWithoutSlash(const Path: string): string;
begin
  if (Length(Path) > 0) and (Path[Length(Path)] = ”) then Result := Copy(Path, 1, Length(Path) – 1)
  else Result := Path;
end;

function TPub.PathWithSlash(const Path: string): string;
begin
  Result := Path;
  if (Length(Result) > 0) and (Result[Length(Result)] <> ”) then Result := Result + ”;
end;

function Tpub.PathExeDir(FileName: string): string;
begin
  Result := ExtractFilePath(ParamStr(0)) + FileName;
end;

function Tpub.MsgYesNoCancelBox(const Msg: string): Integer;
begin
  Result := Application.MessageBox(PChar(Msg),
    PChar(Application.Title), MB_ICONQUESTION or MB_YESNOCANCEL or MB_DEFBUTTON1)
end;

procedure Tpub.DoBusy(Busy: Boolean);
var
  Times: Integer;
begin
  Times := 0;
  if Busy then
  begin
    Inc(Times);
    if Times = 1 then Screen.Cursor := crHourGlass;
  end else
  begin
    dec(Times);
    if Times = 0 then Screen.Cursor := crDefault;
  end;
end;

{=================================================================
  功  能: 返回本机的局域网Ip地址
  参  数: 无
  返回值: 成功:  True, 并填充LocalIp   失败:  False
  备 注:
  版 本:
     1.0  2002/10/02 21:05:00
=================================================================}
function Tpub.NetGetLocalIp(var LocalIp: string): Boolean;
var
    HostEnt: PHostEnt;
    Ip: string;
    addr: pchar;
    Buffer: array [0..63] of char;
    GInitData: TWSADATA;
begin
  Result := False;
  try
    WSAStartup(2, GInitData);
    GetHostName(Buffer, SizeOf(Buffer));
    HostEnt := GetHostByName(buffer);
    if HostEnt = nil then Exit;
    addr := HostEnt^.h_addr_list^;
    ip := Format(‘%d.%d.%d.%d’, [byte(addr [0]),
          byte (addr [1]), byte (addr [2]), byte (addr [3])]);
    LocalIp := Ip;
    Result := True;
  finally
    WSACleanup;
  end;
end;

{=================================================================
  功  能: 通过Ip返回机器名
  参  数:
          IpAddr: 想要得到名字的Ip
  返回值: 成功:  机器名   失败:  ”
  备 注:
    inet_addr function converts a string containing an Internet
    Protocol dotted address into an in_addr.
  版 本:
    1.0  2002/10/02 22:09:00
=================================================================}
function TPub.NetGetNameByIPAddr(IPAddr : String;var MacName:String): Boolean;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  WSAData: TWSAData;
begin
  Result := False;
  if IpAddr = ” then exit;
  try
    WSAStartup(2, WSAData);
    SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
    HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
    if HostEnt <> nil then
      MacName := StrPas(Hostent^.h_name);
    Result := True;
  finally
    WSACleanup;
  end;
end;

{=================================================================
  功  能: 返回网络中SQLServer列表
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List  失败 False
  备 注:
  版 本:
    1.0  2002/10/02 22:44:00
=================================================================}
Function TPub.NetGetSQLServerList(var List: Tstringlist): boolean;
var
   i: integer;
   SQLServer: Variant;
   ServerList: Variant;
begin
  Result := False;
  List.Clear;
  try
    SQLServer := CreateOleObject(‘SQLDMO.Application’);
    ServerList := SQLServer.ListAvailableSQLServers;
    for i := 1 to Serverlist.Count do
      list.Add (Serverlist.item(i));
    Result := True;
  Finally
    SQLServer.free;
    ServerList.free;
  end;
end;

{=================================================================
  功  能: 返回网络中的工作组
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List 失败: False;
  备  注:
  版  本:
     1.0  2002/10/03 08:00:00
=================================================================}
Function TPub.NetGetGroupList( var List : TStringList ) : Boolean;
type
  TNetResourceArray = ^TNetResource;//网络类型的数组
Var
  NetResource: TNetResource;
  Buf: Pointer;
  Count,BufSize,Res: DWORD;
  lphEnum: THandle;
  p: TNetResourceArray;
  i,j: SmallInt;
  NetworkTypeList: TList;
Begin
  Result := False;
  NetworkTypeList := TList.Create;
  List.Clear;
  //获取整个网络中的文件资源的句柄,lphEnum为返回名柄
  Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                       RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
  if Res <> NO_ERROR then exit;//Raise Exception(Res);//执行失败
  //获取整个网络中的网络类型信息
  Count := $FFFFFFFF;//不限资源数目
  BufSize := 8192;//缓冲区大小设置为8K
  GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
  Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
     //资源列举完毕                    //执行失败
  if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
  P := TNetResourceArray(Buf);
  for i := 0 to Count – 1 do//记录各个网络类型的信息
  begin
    NetworkTypeList.Add(p);
    Inc(P);
  end;
  Res := WNetCloseEnum(lphEnum);//关闭一次列举
  if Res <> NO_ERROR then exit;
  for j := 0 to NetworkTypeList.Count-1 do //列出各个网络类型中的所有工作组名称
  begin//列出一个网络类型中的所有工作组名称
    NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息
    //获取某个网络类型的文件资源的句柄,NetResource为网络类型信息,lphEnum为返回名柄
    Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                        RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
    if Res <> NO_ERROR then break;//执行失败
    while true do//列举一个网络类型的所有工作组的信息
    begin
      Count := $FFFFFFFF;//不限资源数目
      BufSize := 8192;//缓冲区大小设置为8K
      GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
      //获取一个网络类型的文件资源信息,
      Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
          //资源列举完毕                   //执行失败
      if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR)  then break;
      P := TNetResourceArray(Buf);
      for i := 0 to Count – 1 do//列举各个工作组的信息
      begin
        List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称
        Inc(P);
      end;
    end;
    Res := WNetCloseEnum(lphEnum);//关闭一次列举
    if Res <> NO_ERROR then break;//执行失败
  end;
  Result := True;
  FreeMem(Buf);
  NetworkTypeList.Destroy;
End;

{=================================================================
  功  能: 列举工作组中所有的计算机
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List 失败: False;
  备  注:
  版  本:
     1.0  2002/10/03 08:00:00
=================================================================}
Function TPub.NetGetUsers(GroupName: string; var List: TStringList): Boolean;
type
  TNetResourceArray = ^TNetResource;//网络类型的数组
Var
  i: Integer;
  Buf: Pointer;
  Temp: TNetResourceArray;
  lphEnum: THandle;
  NetResource: TNetResource;
  Count,BufSize,Res: DWord;
begin
  Result := False;
  List.Clear;
  FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
  NetResource.lpRemoteName := @GroupName[1];//指定工作组名称
  NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组)
  NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
  NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息
  //获取指定工作组的网络资源句柄
  Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                        RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
  if Res <> NO_ERROR then Exit; //执行失败
  while True do//列举指定工作组的网络资源
  begin
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
    //获取计算机名称
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
    if (Res <> NO_ERROR) then Exit;//执行失败
    Temp := TNetResourceArray(Buf);
    for i := 0 to Count – 1 do//列举工作组的计算机名称
    begin
      //获取工作组的计算机名称,+2表示删除”\”,如\wangfajun=>wangfajun
      List.Add(Temp^.lpRemoteName + 2);
      inc(Temp);
    end;
  end;
  Res := WNetCloseEnum(lphEnum);//关闭一次列举
  if Res <> NO_ERROR then exit;//执行失败
  Result := True;
  FreeMem(Buf);
end;

{=================================================================
  功  能: 判断Ip协议有没有安装
  参  数: 无
  返回值: 成功:  True 失败: False;
  备 注:   该函数还有问题
  版 本:
     1.0  2002/10/02 21:05:00
=================================================================}
Function TPub.NetIsIPInstalled : boolean;
var
  WSData: TWSAData;
  ProtoEnt: PProtoEnt;
begin
  Result := True;
  try
    if WSAStartup(2,WSData) = 0 then
    begin
      ProtoEnt := GetProtoByName(‘IP’);
      if ProtoEnt = nil then
        Result := False
    end;
  finally
    WSACleanup;
  end;
end;

{=================================================================
  功  能:  检测计算机是否上网
  参  数:  无
  返回值:  成功:  True  失败: False;
  备 注:   uses Wininet
  版 本:
     1.0  2002/10/07 13:33:00
=================================================================}
function TPub.NetInternetConnected: Boolean;
const
  // local system uses a modem to connect to the Internet.
  INTERNET_CONNECTION_MODEM      = 1;
  // local system uses a local area network to connect to the Internet.
  INTERNET_CONNECTION_LAN        = 2;
  // local system uses a proxy server to connect to the Internet.
  INTERNET_CONNECTION_PROXY      = 4;
  // local system’s modem is busy with a non-Internet connection.
  INTERNET_CONNECTION_MODEM_BUSY = 8;
var
  dwConnectionTypes : DWORD;
begin
  dwConnectionTypes := INTERNET_CONNECTION_LAN+INTERNET_CONNECTION_MODEM
    +INTERNET_CONNECTION_PROXY;
  //Result := InternetGetConnectedState(@dwConnectionTypes, 1);
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

function Tpub.CheckMailAddress(Text: string): boolean;
var
  Index: integer;
  lp: integer;
begin
  Result := false;
  if ((length(trim(Text)) > 20) or (Pos(‘.’, Text) < 4))
    or (Pos(‘.HTM’, UpperCase(Text)) > 0) or (Pos(‘.HTML’, UpperCase(Text)) > 0)
    or (Pos(‘.ASP’, UpperCase(Text)) > 0) or (Pos(‘.JSP’, UpperCase(Text)) > 0) then exit;
  for lp := 1 to length(Text) do
    if (Ord(Text[lp]) > $80) and (Text[lp] <> ‘@’) then exit;
  if (Pos(‘.’, Text) < Pos(‘@’, Text) + 1) then exit;
  Index := Pos(‘@’, Text);
  if (Index < 2) or (Index >= Length(Text))  then exit;
  Result := true;
end;

function Tpub.ConvertSmallNumToBig(SmallNum: real): string;
var
  dx,dy,nn,cccc,dd,c,cc,lc:string;
  n,iii:integer;
begin
  dx:=’壹贰叁肆伍陆柒捌玖’;
  dy:=’分角圆拾佰仟万拾佰仟亿拾佰’;
  nn:=floattostr(strtofloat(Format(‘%.2f’,[SmallNum]))*100);
  n:=length(nn);
  cccc:=’整’;
  for iii:=1 to n do
  begin
    dd:=copy(dy,iii*2-1,2);
    c:=copy(nn,n-iii+1,1);
    if c<>’0′ then
    begin
      cc:=copy(dx,(strtoint(c)*2 – 1),2);
      cccc:=trim(cc)+trim(dd)+trim(cccc);
    end
    else
    begin
      lc:=copy(trim(cccc),1,2);
      if ((iii=3) or (iii=7) or (iii=11)) then
      begin
        cccc:=trim(dd) + trim(cccc);
        continue;
      end;
      if ((lc<>’零’) and (LC<>’整’) and (LC<>’亿’) and (LC<>’万’) and (LC<>’元’)) then
        cccc:=’零’+cccc;
    end;
  end;
  result := cccc;
end;

function Tpub.GetIntSum(const a: array of Integer): Integer;
var  
   i:  Integer;  
begin  
   result  :=  0;  
   for  i  :=  Low(a)  to  High(a)  do  
       result  :=  result  +  a[i];  
end;  

{ TMyClass }

procedure TMyClass.CleanDirectoryProc(sFileName: string;
  var bContinue: Boolean);
var
  Attr: Integer;
begin
  Attr := FileGetAttr(sFileName);
  Attr := (not faReadOnly) and Attr; // Turn off ReadOnly attribute
  Attr := (not faHidden) and Attr;   // Turn off Hidden attribute
  FileSetAttr(sFileName, Attr);

  if Attr and faDirectory <> 0 then
    RMDir(sFileName)
  else
    SysUtils.DeleteFile(sFileName);
end;

initialization
  Pub := TPub.Create;

finalization
  Pub.Free;

end.

本文固定链接: http://www.ccsbbs.com.cn/archives/6416.html | 极限手指

该日志由 极限手指 于2013年04月11日发表在 Delphi 分类下, 你可以发表评论,并在保留原文地址及作者的情况下引用到你的网站或博客。
原创文章转载请注明: delphi环境下的一些自定义函数 | 极限手指

delphi环境下的一些自定义函数:等您坐沙发呢!

发表评论

您必须 [ 登录 ] 才能发表留言!