u_otherpublicpack.pas

软件功能：下载一个网站上所有的彩铃！ 铃声下载完后

//Procedure WMNCHitTest(Var msg:TWMNCHitTest);Message WM_NCHITTEST;
//Procedure WndProc(Var Msg:TMessage);OverRide;
//Procedure WMSysCommand(Var Message:TMessage);Message WM_SysCommand;
{Procedure WMNCHitTest(Var msg:TWMNCHitTest);
Begin
  Inherited;
  If MSG.Result:=HTClient Then
    MSG.Result:=HTCaption;
End;

Procedure WndProc(Var Msg:TMessage);
Var
  CursorPoint:TPoint;
  PopMenu:TPopupMenu;
Begin
  Case Msg.Msg Of
    WM_USER+1://在鼠标点击托盘图标时进行处理
    Case Msg.LParam Of
      WM_RBUTTONDOWN:
      Begin
        GetCursorPos(CursorPoint);
        PopMenu.Popup(CursorPoint.X,CursorPoint.Y);
      End;
      WM_LBUTTONDOWN:
      Begin
        GetCursorPos(CursorPoint);
        PopMenu.Popup(CursorPoint.X,CursorPoint.Y);
      End;
    End;
  End;
  Inherited;
End;

Procedure WMSysCommand(Var Message:TMessage);
Begin
  If Message.WParam=SC_MINIMIZE Then
  Begin
    Beep();
    Inherited;
  End
  Else
  Begin
    DefWindowProc(Handle,Message.Msg,Message.WParam,Message.LParam);
  End;
End;
}
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,U_RecordStruct;

//初始设置Combobox的数据(从0至MaxNumberValue)对象值
Procedure SetNumberValue(Combobox:TCombobox;MaxNumberValue:Integer);
//复制当前目录下所有的文件或子目录到另外一个目录下
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 MouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;x,y:Integer);
Procedure MouseMove(Sender:TObject;Shift:TShiftState;x,y:Integer);
Procedure MouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;x,y:Integer);
//进行数据读配制
Procedure WriteConfig(IniSetFileName:String;Section:String;Ident:String;Value:String);
Procedure WriteConfigInt(IniSetFileName:String;Section:String;Ident:String;Value:Integer);
//添加MEMO信息
Procedure AddMemoMsg(Memo:TMemo;Str,FileName:String;MaxLineAmount:Integer);
//INI文件读配置
Function ReadConfig(IniSetFileName,SectionName,ValueName:String):String;
Function ReadConfigInt(IniSetFileName,SectionName,ValueName:String):Integer;
//制作定时器
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;
//复制文本文件内容
Procedure CopyTextFile(SourceFileName,TargetFileName:String);OverLoad;
//复制文本文件内容
Procedure CopyTextFile(Var SourceFile,DestectFile:TextFile);OverLoad;
//统计文本文件内容
Function CountFileLines(FileName:String): Integer;OverLoad;
//统计文本文件内容
Function CountFileLines(Var MakeFile:TextFile):Integer;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;

//初始设置Combobox的数据(从0至MaxNumberValue)对象值
Procedure SetNumberValue(Combobox:TCombobox;MaxNumberValue:Integer);
Var
  NumberIndex:Integer;
Begin
  If MaxNumberValue=-1 Then
    Exit;
  For NumberIndex:=0 To MaxNumberValue Do
  Begin
    If Length(IntToStr(NumberIndex))=1 Then
      Combobox.Items.Add('0'+IntToStr(NumberIndex))
    Else
      Combobox.Items.Add(IntToStr(NumberIndex));
 End;
End;
//复制当前目录下所有的文件或子目录到另外一个目录下
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 MouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;x,y:Integer);
Var
  CaptureFlag:Bool;
  MouseDownSpot:TPoint;
Begin
  If ssRight In Shift Then
  Begin
    If Sender Is TEdit Then
      SetCapture((Sender As TEdit).Handle);
    If Sender Is TComboBox Then
      SetCapture((Sender As TComboBox).Handle);
    If Sender Is TDateTimePicker Then
      SetCapture((Sender As TDateTimePicker).Handle);
    If Sender Is TMemo Then
      SetCapture((Sender As TMemo).Handle);
    If Sender Is TButton Then
      SetCapture((Sender As TButton).Handle);
    If Sender Is TBitBtn Then
      SetCapture((Sender As TBitBtn).Handle);
    CaptureFlag:=True;
    MouseDownSpot.X:=x;
    MouseDownSpot.Y:=y;
  End;
End;
Procedure MouseMove(Sender:TObject;Shift:TShiftState;x,y:Integer);
Var
  CaptureFlag:Bool;
  MouseDownSpot:TPoint;
Begin
  If CaptureFlag Then
  Begin
    If Sender Is TEdit Then
    Begin
      (Sender As TEdit).Left:=(Sender As TEdit).Left - MouseDownSpot.X + x;
      (Sender As TEdit).Top:=(Sender As TEdit).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TComboBox Then
    Begin
      (Sender As TComboBox).Left:=(Sender As TComboBox).Left - MouseDownSpot.X + x;
      (Sender As TComboBox).Top:=(Sender As TComboBox).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TDateTimePicker Then
    Begin
      (Sender As TDateTimePicker).Left:=(Sender As TDateTimePicker).Left - MouseDownSpot.X + x;
      (Sender As TDateTimePicker).Top:=(Sender As TDateTimePicker).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TMemo Then
    Begin
      (Sender As TMemo).Left:=(Sender As TMemo).Left - MouseDownSpot.X + x;
      (Sender As TMemo).Top:=(Sender As TMemo).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TButton Then
    Begin
      (Sender As TButton).Left:=(Sender As TButton).Left - MouseDownSpot.X + x;
      (Sender As TButton).Top:=(Sender As TButton).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TBitBtn Then
    Begin
      (Sender As TBitBtn).Left:=(Sender As TBitBtn).Left - MouseDownSpot.X + x;
      (Sender As TBitBtn).Top:=(Sender As TBitBtn).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TSpeedButton Then
    Begin
      (Sender As TSpeedButton).Left:=(Sender As TSpeedButton).Left - MouseDownSpot.X + x;
      (Sender As TSpeedButton).Top:=(Sender As TSpeedButton).Top - MouseDownSpot.Y + y;
    End;
  End;
End;
Procedure MouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;x,y:Integer);
Var
  CaptureFlag:Bool;
  MouseDownSpot:TPoint;
Begin
  If CaptureFlag Then
  Begin
    ReleaseCapture;
    CaptureFlag:=False;
    If Sender Is TEdit Then
    Begin
      (Sender As TEdit).Left:=(Sender As TEdit).Left - MouseDownSpot.X + x;
      (Sender As TEdit).Top:=(Sender As TEdit).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TComboBox Then
    Begin
      (Sender As TComboBox).Left:=(Sender As TComboBox).Left - MouseDownSpot.X + x;
      (Sender As TComboBox).Top:=(Sender As TComboBox).Top - MouseDownSpot.Y + y;
    End;
    If Sender Is TDateTimePicker Then
    Begin
      (Sender As TDateTimePicker).Left:=(Sender As TDateTimePicker).Left - MouseDownSpot.X + x;
      (Sender As TDateTimePicker).Top:=(Sender As TDateTimePicker).Top - MouseDownSpot.Y + y;