u_otherpublicpack.pas

SQL的应用

Unit U_OtherPublicPack;

Interface
Uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Menus,
  Dialogs,Buttons,StdCtrls,Mask,ExtCtrls,ADODB,QControls,ComCtrls,IniFiles,CheckLst,
  ShellAPI,DateUtils,ComObj,Math,DBGrids;

//复制当前目录下所有的文件或子目录到另外一个目录下
Function CopyFileOfCurrentDir(SourceFilePath,DestinctFilePath:String):Boolean;
//删除当前目录下所有的文件
Function DeleteFileOfCurrentDir(FilePath:String):Boolean;
//删除当前目录下所有的子目录
Function DeleteCurrentDir(FilePath:String):Boolean;
//随着窗体大小的改变而调整窗体上的各控件的位置与大小
Procedure SetFormSize(Panel:TPanel;WidthOne,HeightOne,SetWidth,SetHeight:Integer);Overload;
//随着窗体大小的改变而调整窗体上的各控件的位置与大小
Procedure SetFormSize(Panel:TPanel;WidthOne,HeightOne,SetWidth,SetHeight,LabelSize:Integer);Overload;
Procedure SetToolIcon(IconData:TNotifyIconData;WndHandle:Hwnd;ID:Uint;Flag:Integer;Icon:HIcon;Tip:String);
Procedure AMDToolIcon(IconData:TNotifyIconData;Option:Integer);

//进行数据读配制
Procedure WriteConFig(IniSetFileName:String;Section:String;Ident:String;Value:String);
//添加MEMO信息
Procedure AddMemoMsg(Memo:TMemo;Str,FileName:String;MaxLineAmount:Integer);
//INI文件读配置
Function ReadConfig(IniSetFileName,SectionName,ValueName:String):String;
//制作定时器
procedure WaitForTimer(StartDateTime,EndDateTime:String;Option:Integer);
//Option为1表示在一定的日期范围内2表示在一天的范围内3表示在一定的时间内
//生成EXCEL文件
Procedure FileMakeProc(Memo:TMemo;SourceFileName,DestectFileName:String;ReportApp,ReportWorkBook:Variant);
//清空文件内容
Procedure ClearTextFile(FileName:string);OverLoad;
//清空文件内容
Procedure ClearTextFile(Var MakeFile:TextFile);OverLoad;
//添加文本文件内容
Procedure AppendTextFile(FileName,Str:String);OverLoad;
//添加文本文件内容
Procedure AppendTextFile(Var MakeFile:TextFile;Str:String);OverLoad;
//判断窗体是否存在
Function FormIsExist(Form:TForm;FormName:String):Boolean;OverLoad;
//判断窗体是否存在
Function FormIsExist(Form:TForm;Var MDIFormIndex:Integer;FormName:String):Boolean;OverLoad;
//判断窗体是否存在
Function FormIsExist(Form:TForm;FormName:String;Tag:Integer):Boolean;OverLoad;
//判断窗体是否存在
Function FormIsExist(Form:TForm;Var MDIFormIndex:Integer;FormName:String;Tag:Integer):Boolean;OverLoad;
//从选择框列表中获取相关的值(FieldType为1字符串为0整形或浮点，ValueType为1是String为2是Name为3是Value
Function GetValuesFromList(FieldName,OperatorSign,LogicSign:String;FieldType:Integer;ValueType:Integer;CheckListBox:TCheckListBox):String;
//全选列表框中所有选项
Procedure SelectAllListItem(ListBox:TCheckListBox);
//反选列表框中所有选项
Procedure UnSelectListItem(ListBox:TCheckListBox);

Implementation
    Uses U_DBPublicPack,U_StringPublicPack;

//复制当前目录下所有的文件或子目录到另外一个目录下
Function CopyFileOfCurrentDir(SourceFilePath,DestinctFilePath:String):Boolean;
Var
  FileSearchRec:TSearchRec;
  SoureFileName,DestinctFileName,FileName:String;
  Err,Count:Integer;
begin
  FileName:='*.*';//任何文件
  ChDir(Pchar(SourceFilePath));//改变当前文件目录
  Err:=FindFirst(FileName,$37{FaAnyFile},FileSearchRec);
  //在当前文件目录下搜索文件名为FileName的第一个文件（Err<>0）
  While (Err=0) Do
  Begin
    Application.ProcessMessages;//返回主函数，释放内存
    If FileSearchRec.Name[1]<>'.' Then
    Begin
      If (FileSearchRec.Attr And FaDirectory)=0 Then//判断是不是目录
      Begin
        Try
          If DestinctFilePath[Length(DestinctFilePath)]<>'\' Then
            DestinctFilePath:=DestinctFilePath+'\';
          If SourceFilePath[Length(SourceFilePath)]<>'\' Then
            SourceFilePath:=SourceFilePath+'\';
          SoureFileName:=SourceFilePath+FileSearchRec.Name;
          DestinctFileName:=DestinctFilePath+ExtractFileName(SoureFileName);
          CopyFile(Pchar(SoureFileName),Pchar(DestinctFileName),True);
          //True碰到文件名相同的不覆盖原文件，False碰到文件名相同的则覆盖原文件
        Except
        End;
      End;
      If (FileSearchRec.Attr And FaDirectory)=16 Then
      Begin
        SourceFilePath:=ExpandFileName(FileSearchRec.Name);
        If DestinctFilePath[Length(DestinctFilePath)]<>'\' Then
          DestinctFilePath:=DestinctFilePath+'\';
        DestinctFilePath:=DestinctFilePath+FileSearchRec.Name;//设置目标路径
        Try
          CreateDir(DestinctFilePath);//创建目录
        Except
        End;
        ChDir(SourceFilePath);//设置当前目录路径
        CopyFileOfCurrentDir(SourceFilePath,DestinctFilePath);//复制当前目录下文件
        ChDir('..');//返回上一级目录
        Count:=Length(DestinctFilePath)-1;
        While DestinctFilePath[Count]<>'\' Do
        Begin
          Dec(Count);
        End;
        DestinctFilePath:=Copy(DestinctFilePath,1,Count-1);//获取上一级目录路径
      End;
    End;
    Err:=FindNext(FileSearchRec);//查询下一个文件
  End;
  FindClose(FileSearchRec);
End;
//删除当前目录下所有的文件
Function DeleteFileOfCurrentDir(FilePath:String):Boolean;
Var
  FileSearchRec:TSearchRec;
  FileName:String;
  Err,Count:Integer;
begin
  FileName:='*.*';//任何文件
  ChDir(Pchar(FilePath));//改变当前文件目录
  Err:=FindFirst(FileName,$37{FaAnyFile},FileSearchRec);
  //在当前文件目录下搜索文件名为FileName的第一个文件（Err<>0）
  While (Err=0) Do
  Begin
    Application.ProcessMessages;//返回主函数，释放内存
    If FileSearchRec.Name[1]<>'.' Then
    Begin
      If (FileSearchRec.Attr And FaDirectory)=0 Then//判断是不是目录
      Begin
        Try
          If FilePath[Length(FilePath)]<>'\' Then
            FilePath:=FilePath+'\';
          DeleteFile(Pchar(FilePath+FileSearchRec.Name));
          //删除文件
        Except
        End;
      End;
      If (FileSearchRec.Attr And FaDirectory)=16 Then
      Begin
        FilePath:=ExpandFileName(FileSearchRec.Name);
        ChDir(FilePath);//设置当前目录路径
        DeleteFileOfCurrentDir(FilePath);//删除当前目录下的文件（递归调用）
        ChDir('..');//返回上一级目录
      End;
    End;
    Err:=FindNext(FileSearchRec);//搜索下一个文件
  End;
  FindClose(FileSearchRec);//关闭文件查询对象
End;
//删除当前目录下所有的子目录
Function DeleteCurrentDir(FilePath:String):Boolean;
Var
  FileSearchRec:TSearchRec;
  FileName:String;
  Err,Count:Integer;
begin
  FileName:='*.*';//任何文件
  ChDir(Pchar(FilePath));//改变当前文件目录
  Err:=FindFirst(FileName,$37{FaAnyFile},FileSearchRec);
  //在当前文件目录下搜索文件名为FileName的第一个文件（Err<>0）
  While (Err=0) Do
  Begin
    Application.ProcessMessages;//返回主函数，释放内存
    If FileSearchRec.Name[1]<>'.' Then
    Begin
      If (FileSearchRec.Attr And FaDirectory)=0 Then//判断是不是目录
      Begin
        Try
          If FilePath[Length(FilePath)]<>'\' Then
            FilePath:=FilePath+'\';
          DeleteFile(Pchar(FilePath+FileSearchRec.Name));//删除文件（递归调用）
          //删除文件
        Except
        End;
      End;
      If (FileSearchRec.Attr And FaDirectory)=16 Then
      Begin
        FilePath:=ExpandFileName(FileSearchRec.Name);//获取文件目录路径名称
        ChDir(FilePath);//设置当前目录
        DeleteCurrentDir(FilePath);//删除当前目录（递归调用）
        RmDir(Pchar(FilePath));//删除目录（FilePath）
        ChDir('..');//返回上一级目录
        RmDir(Pchar(FilePath));//删除目录（FilePath）
      End;
    End;
    Err:=FindNext(FileSearchRec);//查询下一个文件或目录
  End;
  FindClose(FileSearchRec);
End;
//随着窗体大小的改变而调整窗体上的各控件的位置与大小
Procedure SetFormSize(Panel:TPanel;WidthOne,HeightOne,SetWidth,SetHeight:Integer);
Var
  CountOne,CountTwo:Integer;
Begin
  For CountOne:=0 To Panel.ControlCount-1 Do
  Begin
    If Not(Panel.Controls[CountOne] Is TLabel) Then
    Begin
      If Not (Panel.Controls[CountOne] Is TGroupBox) Then
        Panel.Controls[CountOne].Left:=Round(Panel.Controls[CountOne].Left*SetWidth/WidthOne-80*(SetWidth/WidthOne-1));
      Panel.Controls[CountOne].Width:=Round(Panel.Controls[CountOne].Width*SetWidth/WidthOne+80*(SetWidth/WidthOne-1));
    End;
    If (Panel.Controls[CountOne] is TLabel) Then
    Begin
      Panel.Controls[CountOne].Left:=Round(Panel.Controls[CountOne].Left*SetWidth/WidthOne);
    End;
  End;
End;
//随着窗体大小的改变而调整窗体上的各控件的位置与大小
Procedure SetFormSize(Panel:TPanel;WidthOne,HeightOne,SetWidth,SetHeight,LabelSize:Integer);
Var
  CountOne,CountTwo:Integer;
Begin
  For CountOne:=0 To Panel.ControlCount-1 Do
  Begin
    If Not(Panel.Controls[CountOne] Is TLabel) Then
    Begin
      If Not (Panel.Controls[CountOne] Is TGroupBox) Then
        Panel.Controls[CountOne].Left:=Round(Panel.Controls[CountOne].Left*SetWidth/WidthOne-LabelSize*(SetWidth/WidthOne-1));
      Panel.Controls[CountOne].Width:=Round(Panel.Controls[CountOne].Width*SetWidth/WidthOne+LabelSize*(SetWidth/WidthOne-1));
    End;
    If (Panel.Controls[CountOne] is TLabel) Then
    Begin
      Panel.Controls[CountOne].Left:=Round(Panel.Controls[CountOne].Left*SetWidth/WidthOne);
    End;
  End;
End;
Procedure SetToolIcon(IconData:TNotifyIconData;WndHandle:Hwnd;ID:Uint;Flag:Integer;Icon:HIcon;Tip:String);
Begin
  IconData.cbSize:=SizeOf(IconData);
  IconData.Wnd:=WndHandle;
  IconData.uID:=ID;
  Case Flag Of
    0: IconData.uFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
    1: IconData.uFlags:=NIF_MESSAGE;
    2: IconData.uFlags:=NIF_ICON;
    3: IconData.uFlags:=NIF_TIP;
    4: IconData.uFlags:=NIF_MESSAGE+NIF_ICON;
    5: IconData.uFlags:=NIF_MESSAGE+NIF_TIP;
    6: IconData.uFlags:=NIF_ICON+NIF_TIP;
  End;
  IconData.uCallbackMessage:=WM_USER+1;
  IconData.hIcon:=Icon;
  StrPCopy(IconData.szTip,Tip);
End;

Procedure AMDToolIcon(IconData:TNotifyIconData;Option:Integer);
Begin
  Case Option Of
    0: Shell_NotifyIcon(NIM_ADD,@IconData);
    1: Shell_NotifyIcon(NIM_MODIFY,@IconData);
    2: Shell_NotifyIcon(NIM_DELETE,@IconData);
  End;
End;


//进行数据读配制
Procedure WriteConFig(IniSetFileName:String;Section:String;Ident:String;Value:String);
Var
  IniHandle: TIniFile;
Begin
  Try
    IniHandle:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniSetFileName);
    With IniHandle Do
    Begin
      IniHandle.WriteString(Section,Ident,Value);
      IniHandle.free;
    End;
  Except
    MessageDLG('写配置文件错误!',Mterror,[mbok],0);
  End;
End;
//添加MEMO信息
Procedure AddMemoMsg(Memo:TMemo;Str,FileName:String;MaxLineAmount:Integer);