delphi常用函数库.txt

delphi常用的函数库 再不用绞尽脑汁想一些已经存在的函数了

 StrPCopy(zCurDir, WorkDir); 
 FillChar(StartupInfo, SizeOf(StartupInfo), #0); 
 StartupInfo.cb := SizeOf(StartupInfo); 

 StartupInfo.dwFlags := STARTF_USESHOWWINDOW; 
 StartupInfo.wShowWindow := Visibility; 
 if not CreateProcess(nil, 
  zAppName,              { pointer to command line string } 
  nil,                { pointer to process security attributes } 
  nil,                { pointer to thread security attributes } 
  False,               { handle inheritance flag } 
  Create_NEW_CONSOLE or        { creation flags } 
  NORMAL_PRIORITY_CLASS, 
  nil,                { pointer to new environment block } 
  nil,                { pointer to current directory name } 
  StartupInfo,            { pointer to STARTUPINFO } 
  ProcessInfo) then 
  Result := -1            { pointer to PROCESS_INF } 

 else 
 begin 
  WaitforSingleObject(ProcessInfo.hProcess, INFINITE); 
  GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result)); 
 end; 
end; 

// 应用程序路径 
function AppPath: string; 
begin 
 Result := ExtractFilePath(Application.ExeName); 
end; 

// 取Windows系统目录 
function GetWindowsDir: string; 
var 
 Buf: array[0..MAX_PATH] of Char; 
begin 
 GetWindowsDirectory(Buf, MAX_PATH); 
 Result := AddDirSuffix(Buf); 
end; 

// 取临时文件目录 
function GetWinTempDir: string; 
var 
 Buf: array[0..MAX_PATH] of Char; 
begin 
 GetTempPath(MAX_PATH, Buf); 
 Result := AddDirSuffix(Buf); 
end; 

// 目录尾加'\'修正 
function AddDirSuffix(Dir: string): string; 
begin 
 Result := Trim(Dir); 
 if Result = '' then Exit; 
 if Result[Length(Result)] <> '\' then Result := Result + '\'; 
end; 

function MakePath(Dir: string): string; 
begin 
 Result := AddDirSuffix(Dir); 
end; 

// 判断文件是否正在使用 
function IsFileInUse(FName: string): Boolean; 
var 
 HFileRes: HFILE; 
begin 
 Result := False; 
 if not FileExists(FName) then 
  Exit; 
 HFileRes := CreateFile(PChar(FName), GENERIC_READ or GENERIC_WRITE, 0, 
  nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); 
 Result := (HFileRes = INVALID_HANDLE_VALUE); 
 if not Result then 
  CloseHandle(HFileRes); 
end; 

// 取文件长度 
function GetFileSize(FileName: string): Integer; 
var 
 FileVar: file of Byte; 
begin 
  
 try 
  AssignFile(FileVar, FileName); 
  Reset(FileVar); 
  Result := FileSize(FileVar); 
  CloseFile(FileVar); 
 except 
  Result := 0; 
 end; 
  
end; 

// 设置文件时间 
function SetFileDate(FileName: string; CreationTime, LastWriteTime, 
LastAccessTime: 
 TFileTime): Boolean; 
var 
 FileHandle: Integer; 
begin 
 FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone); 
 if FileHandle > 0 then 
 begin 
  SetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime); 
  FileClose(FileHandle); 
  Result := True; 
 end 
 else 
  Result := False; 
end; 

// 取文件时间 
function GetFileDate(FileName: string; var CreationTime, LastWriteTime, 
LastAccessTime: 
 TFileTime): Boolean; 
var 
 FileHandle: Integer; 
begin 
 FileHandle := FileOpen(FileName, fmOpenRead or fmShareDenyNone); 
 if FileHandle > 0 then 
 begin 
  GetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime); 
  FileClose(FileHandle); 
  Result := True; 
 end 
 else 
  Result := False; 
end; 

// 取得与文件相关的图标 
// FileName: e.g. "e:\hao\a.txt" 
// 成功则返回True 
function GetFileIcon(FileName: string; var Icon: TIcon): Boolean; 
var 
 SHFileInfo: TSHFileInfo; 
 h: HWND; 
begin 
 if not Assigned(Icon) then 
  Icon := TIcon.Create; 
 h := SHGetFileInfo(PChar(FileName), 
  0, 
  SHFileInfo, 
  SizeOf(SHFileInfo), 
  SHGFI_ICON or SHGFI_SYSICONINDEX); 
 Icon.Handle := SHFileInfo.hIcon; 
 Result := (h <> 0); 
end; 

// 文件时间转本地时间 
function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime; 
var 
 STime: TSystemTime; 
begin 
 FileTimeToLocalFileTime(FTime, FTime); 
 FileTimeToSystemTime(FTime, STime); 
 Result := STime; 
end; 

// 本地时间转文件时间 
function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime; 
var 
 FTime: TFileTime; 
begin 
 SystemTimeToFileTime(STime, FTime); 
 LocalFileTimeToFileTime(FTime, FTime); 
 Result := FTime; 
end; 

// 创建备份文件 
function CreateBakFile(FileName, Ext: string): Boolean; 
var 
 BakFileName: string; 
begin 
 BakFileName := FileName + '.' + Ext; 
 Result := CopyFile(PChar(FileName), PChar(BakFileName), False); 
end; 

// 删除整个目录 
function Deltree(Dir: string): Boolean; 
var 
 sr: TSearchRec; 
 fr: Integer; 
begin 
 if not DirectoryExists(Dir) then 
 begin 
  Result := True; 
  Exit; 
 end; 
 fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr); 
 try 
  while fr = 0 do 
  begin 
   if (sr.Name <> '.') and (sr.Name <> '..') then 
   begin 
    if sr.Attr and faDirectory = faDirectory then 
     Result := Deltree(AddDirSuffix(Dir) + sr.Name) 
    else 
     Result := DeleteFile(AddDirSuffix(Dir) + sr.Name); 
    if not Result then 
     Exit; 
   end; 
   fr := FindNext(sr); 
  end; 
 finally 
  FindClose(sr); 
 end; 
 Result := RemoveDir(Dir); 
end; 

// 取文件夹文件数 
function GetDirFiles(Dir: string): Integer; 
var 
 sr: TSearchRec; 
 fr: Integer; 
begin 
 Result := 0; 
 fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr); 
 while fr = 0 do 
 begin 
  if (sr.Name <> '.') and (sr.Name <> '..') then 
   Inc(Result); 
  fr := FindNext(sr); 
 end; 
 FindClose(sr); 
end; 

var 
 FindAbort: Boolean; 

// 查找指定目录下文件 
procedure FindFile(const Path: string; const FileName: string = '*.*'; 
 Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True); 
var 
 APath: string; 
 Info: TSearchRec; 
 Succ: Integer; 
begin 
 FindAbort := False; 
 APath := MakePath(Path); 
 try 
  Succ := FindFirst(APath + FileName, faAnyFile - faVolumeID, Info); 
  while Succ = 0 do 
  begin 
   if (Info.Name <> '.') and (Info.Name <> '..') then 
   begin 
    if (Info.Attr and faDirectory) <> faDirectory then 
    begin 
     if Assigned(Proc) then 
      Proc(APath + Info.FindData.cFileName, Info, FindAbort); 
    end 
    else if bSub then 
     FindFile(APath + Info.Name, FileName, Proc, bSub, bMsg); 
   end; 
   if bMsg then Application.ProcessMessages; 
   if FindAbort then Exit; 
   Succ := FindNext(Info); 
  end; 
 finally 
  FindClose(Info); 
 end; 
end; 

{ 功能说明：查找一个路径下的所有文件。 
 参数：path:路径, filter:文件扩展名过滤, FileList:文件列表, ContainSubDir:是否包含子目录} 
procedure 
FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean); 
var 
 FSearchRec,DSearchRec:TSearchRec; 
 FindResult:shortint; 
begin 
 FindResult:=FindFirst(path+Filter,sysutils.faAnyFile,FSearchRec); 

 try 
 while FindResult=0 do 
 begin 
  FileList.Add(FSearchRec.Name); 
  FindResult:=FindNext(FSearchRec); 
 end; 
  
 if ContainSubDir then 
 begin 
  FindResult:=FindFirst(path+Filter,faDirectory,DSearchRec); 
  while FindResult=0 do 
  begin 
   if ((DSearchRec.Attr and faDirectory)=faDirectory) 
    and (DSearchRec.Name<>'.') and (DSearchRec.Name<>'..') then 
    FindFileList(Path,Filter,FileList,ContainSubDir); 
    FindResult:=FindNext(DSearchRec); 
  end; 
 end; 
 finally 
  FindClose(FSearchRec); 
 end; 
end; 
  
//返回一文本文件的行数 
function Txtline(const txt: string): integer; 
var 
 F : TextFile; 
 StrLine : string; 
 line : Integer; 
begin 
 AssignFile(F, txt); 
 Reset(F); 
 Line := 0; 
 while not SeekEof(f) do 
 begin 
  if SeekEoln(f) then 
   Readln; 
  Readln(F, StrLine); 
  if SeekEof(f) then 
   break 
  else 
   inc(Line); 
 end; 
 CloseFile(F); 
 Result := Line; 
end; 

//Html文件转化成文本文件 
function Html2Txt(htmlfilename: string): string; 
var Mystring:TStrings; 
  s,lineS:string; 
  line,Llen,i,j:integer; 
  rloop:boolean; 
begin 
  rloop:=False; 
  Mystring:=TStringlist.Create; 
  s:=''; 
  Mystring.LoadFromFile(htmlfilename); 
  line:=Mystring.Count; 
  try 
   for i:=0 to line-1 do 
     Begin 
      lineS:=Mystring[i]; 
      Llen:=length(lineS); 
      j:=1; 
      while (j<=Llen)and(lineS[j]=' ')do 
      begin 
        j:=j+1; 
        s:=s+' '; 
      End; 
      while j<=Llen do 
      Begin 
        if lineS[j]='<'then 
         rloop:=True; 
         if lineS[j]='>'then 
           Begin 
            rloop:=False; 
            j:=j+1; 
            continue; 
           End; 
         if rloop then 
           begin 
            j:=j+1; 
            continue; 
           end 
         else 
          s:=s+lineS[j]; 
           j:=j+1; 
      End; 
      s:=s+#13#10; 
     End; 
  finally 
   Mystring.Free; 
  end; 
  result:=s; 
end; 

// 文件打开方式 
function OpenWith(const FileName: string): Integer; 
begin 
 Result := ShellExecute(Application.Handle, 'open', 'rundll32.exe', 
  PChar('shell32.dll,OpenAs_RunDLL ' + FileName), '', SW_SHOW); 
end; 

//▎============================================================▎// 
//▎===================⑤扩展的对话框函数=======================▎// 
//▎============================================================▎// 

// 显示提示窗口 
procedure InfoDlg(Mess: string; Caption: string; Flags: Integer); 
begin 
 Application.MessageBox(PChar(Mess), PChar(Caption), Flags); 
end; 

// 显示提示确认窗口 
function InfoOk(Mess: string; Caption: string): Boolean; 
begin 
 Result := Application.MessageBox(PChar(Mess), PChar(Caption), 
  MB_OK + MB_ICONINFORMATION) = IDOK; 
end; 

// 显示错误窗口 
procedure ErrorDlg(Mess: string; Caption: string); 
begin 
 Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONSTOP); 
end; 

// 显示警告窗口 
procedure WarningDlg(Mess: string; Caption: string); 
begin 
 Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONWARNING); 
end; 

// 显示查询是否窗口 
function QueryDlg(Mess: string; Caption: string): Boolean; 
begin 
 Result := Application.MessageBox(PChar(Mess), PChar(Caption), 
  MB_YESNO + MB_ICONQUESTION) = IDYES; 
end; 

//窗体渐变 
procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool); 
var 
 pOSVersionInfo : OSVersionInfo; 
begin 
 pOSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo); 
 GetVersionEx(pOSVersionInfo); 
 if pOSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then 
 begin 
  if IsSetAni then 
   AnimateWindow(Sender.Handle,444,AW_HIDE or AW_BLEND); 
 end 
 else 
  if IsSetAni then 
  begin 
   AnimateWindow(Sender.Handle,444,AW_HIDE or AW_CENTER); 
  end; 
end; 

//▎============================================================▎// 
//▎====================⑥ 系统功能函数 =======================▎// 
//▎============================================================▎// 

// 移动鼠标到控件 
procedure MoveMouseIntoControl(AWinControl: TControl); 
var 
 rtControl: TRect; 
begin 
 rtControl := AWinControl.BoundsRect; 
 MapWindowPoints(AWinControl.Parent.Handle, 0, rtControl, 2); 
 SetCursorPos(rtControl.Left + (rtControl.Right - rtControl.Left) div 2, 
  rtControl.Top + (rtControl.Bottom - rtControl.Top) div 2); 
end; 

// 动态设置分辨率 
function DynamicResolution(x, y: WORD): Boolean; 
var 
 lpDevMode: TDeviceMode; 
begin 
 Result := EnumDisplaySettings(nil, 0, lpDevMode); 
 if Result then 
 begin 
  lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT; 
  lpDevMode.dmPelsWidth := x; 
  lpDevMode.dmPelsHeight := y; 
  Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;