自编函数:处理中文日期 、处理BDE数据库别名、查找目录文件...

                            
unit   ConvertToCn;   
   
  interface  
   
  uses   Controls,   Sysutils;  
   
  const  
      DigitCn:   WideString   =   '零壹贰叁肆伍陆柒捌玖拾';  
   
      function   Day(const   Value:   TDateTime):   Integer;  
      function   Month(const   Value:   TDateTime):   Integer;  
      function   Year(const   Value:   TDateTime):   Integer;  
   
      function   DatePart(const   dpName:   String;   const   Value:   TDateTime):   Integer;  
   
      function   DateToCn(const   Value:   TDate):   String;  
      function   TimeToCn(const   Value:   TTime):   String;  
      function   DateTimeToCn(const   Value:   TDateTime):   String;  
   
  implementation  
   
  function   Day(const   Value:   TDateTime):   Integer;  
  begin  
      Result   :=   DatePart('dd',   Value);  
  end;  
   
  function   Month(const   Value:   TDateTime):   Integer;  
  begin  
      Result   :=   DatePart('mm',   Value);  
  end;  
   
  function   Year(const   Value:   TDateTime):   Integer;  
  begin  
      Result   :=   DatePart('yyyy',   Value);  
  end;  
   
  function   DatePart(const   dpName:   String;   const   Value:   TDateTime):   Integer;  
  begin  
      Result   :=   StrToInt(FormatDateTime(dpName,   Value));  
  end;  
   
  procedure   AddYearMonthDayCn(var   Value:   String);  
  begin  
      Insert('年',   Value,   9);  
      Insert('月',   Value,   15);  
      Value   :=   Value   +   '日';      
  end;  
   
  procedure   FixMonthPart(var   Value:   String;   const   AMonth:   Integer);  
  begin  
      if   AMonth   <   10   then  
          Delete(Value,   11,   2)  
      else   begin  
          Insert('拾',   Value,   13);  
          if   AMonth   =   10   then  
          begin  
              Delete(Value,   11,   2);  
              Delete(Value,   13,   2);  
          end;  
      end;  
  end;  
   
  procedure   FixDayPart(var   Value:   String;   const   ADay:   Integer);  
  begin  
      if   ADay   <   10   then  
          Delete(Value,   Length(Value)-5,   2)  
      else   begin  
          Insert('拾',   Value,   Length(Value)-3);  
          if   ADay   Mod   10   =   0   then  
              Delete(Value,   Length(Value)-3,   2);  
   
          if   ADay   =   10   then  
              Delete(Value,   Length(Value)-5,   2);  
      end;  
  end;  
   
  function   DateToCn(const   Value:   TDate):   String;  
  var  
      I:   Integer;  
  begin  
      Result   :=   FormatDateTime('yyyymmdd',   Value);  
   
      for   I   :=   0   to   9   do  
          Result   :=   StringReplace(Result,   IntToStr(I),   DigitCn[I+1],   [rfReplaceAll]);  
   
      AddYearMonthDayCn(Result);  
      FixMonthPart(Result,   Month(Value));  
      FixDayPart(Result,   Day(Value));  
  end;  
   
  function   TimeToCn(const   Value:   TTime):   String;  
  begin  
   
  end;  
   
  function   DateTimeToCn(const   Value:   TDateTime):   String;  
  begin  
   
  end;  
   
  end.  
  -----------------------------------------------------------------  
  unit   FilesManage;  
   
  interface  
   
  uses   SysUtils,   FileCtrl,   Classes;  
   
      function   SearchFiles(const   SearchPath:   String;   const   FileName:   String;   List:   TStrings):   Boolean;  
   
  implementation  
   
  function   IsDirectory(const   Name:   String):   Boolean;  
  begin  
      Result   :=   DirectoryExists(Name);  
  end;  
   
  function   IsDot(const   Name:   String):   Boolean;  
  begin  
      Result   :=   (Name   =   '.')or(Name   =   '..');  
  end;  
   
  function   SearchFiles(const   SearchPath:   String;   const   FileName:   String;   List:   TStrings):   Boolean;  
  var  
      Attr:   Integer;  
      F:   TSearchRec;  
  begin  
      Attr   :=   faAnyFile;  
      if   FindFirst(SearchPath   +   '\'   +   FileName,   Attr,   F)   =   0   then  
      begin  
          if   not   IsDot(F.Name)   then  
              List.Add(SearchPath   +   '\'   +   F.Name);  
   
          while   FindNext(F)   =   0   do  
          begin  
              if   not   IsDot(F.Name)   then  
                  List.Add(SearchPath   +   '\'   +   F.Name);  
              if   not   IsDot(F.Name)and   IsDirectory(SearchPath   +'\'+   F.Name)   then  
              begin  
                  SearchFiles(SearchPath   +'\'+   F.Name,   FileName,   List)  
              end;  
   
          end;  
          FindClose(F);  
      end;  
      Result   :=   True;  
  end;  
   
  end.  
  --------------------------------------------------------------------  
  unit   AliasManage;  
   
  interface  
   
  uses  
      DBTables,   Classes,   Windows;  
   
  const  
      ADD_ALIAS_HELP_TEXT   =  
          '函数原形:'+#13+  
          '                                         function   AddAlias(const   AliasName,   UserName,   ServerName,   DatabaseName:   String):   Boolean;'+#13+#13+  
          '参数说明:'+#13+  
          '                                         AliasName:新建别名名称'+#13+  
          '                                         UserName:用户名名称'+#13+  
          '                                         ServerName:服务器名称'+#13+  
          '                                         DatabaseName:数据库名称'+#13+#13+  
          '返回值说明:'+#13+  
          '                                         创建成功返回True,否则返回False'+#13+#13+  
          '技术支持:'+#13+  
          '                                         WWW:http://CoolSlob.8u8.com'+#13+                                          
          '                                         Email:CoolSlob@163.com';  
   
   
      procedure   AddAliasHelp;  
      function   AddAlias(const   AliasName,   UserName,  
                                      ServerName,   DatabaseName:   String):   Boolean;   overload;  
      function   AddAlias(const   AliasName,   UserName,  
                                            ServerName,   DatabaseName,   EnableBCD:   String):   Boolean;   overload;  
   
      function   DeleteAlias(const   AliasName:   String):   Boolean;  
      function   AliasExists(const   AliasName:   String):   Boolean;  
   
  implementation  
   
  procedure   AddAliasHelp;  
  begin  
      MessageBox(GetFocus,   PChar(ADD_ALIAS_HELP_TEXT),   'AddAlias   Help...',  
          MB_ICONINFORMATION);  
  end;  
   
  function   AddAlias(const   AliasName,   UserName,  
                                      ServerName,   DatabaseName:   String):   Boolean;   overload;  
  var  
      vSession:   TSession;  
      vParams:   TStringList;  
  begin  
      vSession   :=   TSession.Create(nil);  
      vSession.Name   :=   'AliasManage';  
      vSession.SessionName   :=   'AliasManage';  
      vParams   :=   TStringList.Create;  
      try  
          vParams.Add('User   Name='   +   UserName);  
          vParams.Add('Server   Name='   +   ServerName);  
          vParams.Add('Database   Name='   +   DatabaseName);  
          try  
              vSession.AddAlias(AliasName,   'MSSQL',   vParams);  
              vSession.SaveConfigFile;  
              Result   :=   True;  
          except  
              Result   :=   False;  
          end;  
      finally  
          vParams.Free;  
          vSession.Destroy;  
      end;  
  end;  
   
  function   AddAlias(const   AliasName,   UserName,  
                                      ServerName,   DatabaseName,   EnableBCD:   String):   Boolean;   overload;  
  var  
      vSession:   TSession;  
      vParams:   TStringList;  
  begin  
      vSession   :=   TSession.Create(nil);  
      vSession.Name   :=   'AliasManage';  
      vSession.SessionName   :=   'AliasManage';  
      vParams   :=   TStringList.Create;  
      try  
          vParams.Add('User   Name='   +   UserName);  
          vParams.Add('Server   Name='   +   ServerName);  
          vParams.Add('Database   Name='   +   DatabaseName);  
          vParams.Add('Enable   BCD='   +   EnableBCD);  
          try  
              vSession.AddAlias(AliasName,   'MSSQL',   vParams);  
              vSession.SaveConfigFile;  
              Result   :=   True;  
          except  
              Result   :=   False;  
          end;  
      finally  
          vParams.Free;  
          vSession.Destroy;  
      end;  
  end;  
   
  function   DeleteAlias(const   AliasName:   String):   Boolean;  
  var  
      vSession:   TSession;  
  begin  
      vSession   :=   TSession.Create(nil);  
      vSession.Name   :=   'AliasManage';  
      vSession.SessionName   :=   'AliasManage';  
      try  
          try  
              vSession.DeleteAlias(AliasName);  
              vSession.SaveConfigFile;  
              Result   :=   True;  
          except  
              Result   :=   False;  
          end;  
      finally  
          vSession.Destroy;  
      end;  
  end;  
   
  function   AliasExists(const   AliasName:   String):   Boolean;  
  var  
      vSession:   TSession;  
      vAliasList:   TStringList;  
  begin  
      vSession   :=   TSession.Create(nil);  
      vAliasList   :=   TStringList.Create;  
      vSession.Name   :=   'AliasManage';  
      vSession.SessionName   :=   'AliasManage';  
      try  
          try  
              Result   :=   vSession.IsAlias(AliasName);  
              vSession.GetAliasNames(vAliasList);  
              if   vAliasList.IndexOf(AliasName)   <   0   then  
                  Result   :=   False  
              else  
                  Result   :=   True;  
          except  
              Result   :=   False;  
          end;  
      finally  
          vAliasList.Free;  
          vSession.Destroy;  
      end;  
  end;  
   
   
  end.  
 

查看回复