⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 usysfunc.pas

📁 一个小程序
💻 PAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
// 名称:	ShowDesktop
// 说明:	显示Windows桌面图标
// 参数：  	无
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure ShowDesktop;
var
  hDesktop: THandle;
begin
  hDesktop := FindWindow('Progman', nil);
  ShowWindow(hDesktop, SW_RESTORE);
end;

//=======================================================================
// 名称:	HideTaskbar
// 说明:	隐藏Windows桌面任务栏
// 参数：  	无
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure HideTaskbar;
begin
  ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE);
end;

//=======================================================================
// 名称:	ShowTaskbar
// 说明:	显示Windows桌面任务栏
// 参数：  	无
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure ShowTaskbar;
begin
  ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_RESTORE);
end;

//=======================================================================
// 名称:	GetStationID
// 说明:	取得计算机名称
// 参数：  	无
// 返回：   String: 计算机名称
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetStationID: string;
var
  cname: array[0..MAX_COMPUTERNAME_LENGTH] of char;
  len: DWORD;
begin
  len := MAX_COMPUTERNAME_LENGTH + 1; // include '#0'
  if GetComputerName(cname, len) then
    Result := StrPas(cname);
end;

//=======================================================================
// 名称:	GetStationIp
// 说明:	取得计算机IP
// 参数：  	无
// 返回：   String: 计算机IP
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetStationIp:string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe :PHostEnt;
  pptr : PaPInAddr;
  GInitData : TWSADATA;
  pcname:string;
begin
  pcname :=GetStationID; //绕了个弯子，先得到机器名称，然后再得到IP地址
  WSAStartup($101, GInitData);
  Result := '';
  phe :=GetHostByName(pchar(pcname));
  pptr := PaPInAddr(Phe^.h_addr_list);
  result:=StrPas(inet_ntoa(pptr^[0]^));
  WSACleanup;
end;

//=======================================================================
// 名称:	DelayMSec
// 说明:	延迟指定毫秒数的时间
// 参数：  	iSleepTime: Integer
//          	指定毫秒数
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure DelayMSec(iSleepTime: Integer);
var
  i: Integer;
  time1: TTimeStamp;
begin
  time1 := DateTimeToTimeStamp(Time);
  i := time1.Time;
  while time1.time < (i + iSleepTime) do
  begin
    time1 := DateTimeToTimeStamp(time);
    Application.ProcessMessages;
  end;
end;

//=======================================================================
// 名称:	IsValidDateStr
// 说明:	确认日期字符串是否正确
// 参数：  	sDate: String
//          	日期字符串
// 返回：   Boolean
//				True: 合法或空串
//				False： 不合法
// 编程: 	张新民，2008.12.11
//=======================================================================
function IsValidDateStr(sDate: string): Boolean;
var
  td: TDateTime;
begin
  if (Trim(sDate) = '') then
  begin
    Result := True;
    exit;
  end;

  try
    td := StrToDate(sDate);
    sDate := FormatDateTime('yyyy/mm/dd', td);
    Result := True;
  except
    Result := False;
  end;
end;

//=======================================================================
// 名称:	IsValidTimeStr
// 说明:	确认时间字符串是否正确
// 参数：  	sTime: String
//          	时间字符串
// 返回：   Boolean
//				True: 合法或空串
//				False： 不合法
// 编程: 	张新民，2008.12.11
//=======================================================================
function IsValidTimeStr(sTime: string): Boolean;
var
  td: TDateTime;
begin
  if (Trim(sTime) = '') then
  begin
    Result := True;
    exit;
  end;

  try
    td := StrToTime(sTime);
    sTime := FormatDateTime('hh:ss:nn', td);
    Result := True;
  except
    Result := False;
  end;
end;

//=======================================================================
// 名称:	IsWindowsLowVersion
// 说明:	判断windows版本信息
// 返回：   Boolean
//				True: 95/98
//				False： 2000或更高
// 编程: 	张新民，2008.12.11
//=======================================================================
function IsWindowsLowVersion: boolean;
var
  OsInfo: OSVERSIONINFO;
  SS, TmpSS, VerInfo: string;
begin
    //获得操作系统信息
  OsInfo.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);
  GetVersionEx(OsInfo);
  case OsInfo.dwPlatformId of
    VER_PLATFORM_WIN32S: SS := 'Windows 3.x';
    VER_PLATFORM_WIN32_WINDOWS: SS := 'Windows 95/98';
    VER_PLATFORM_WIN32_NT: SS := 'Windows NT';
  end;
  TmpSS := string(OsInfo.szCSDVersion);
  VerInfo := SS + ' ' + IntToStr(OsInfo.dwMajorVersion) + '.' + IntToStr(OsInfo.dwMinorVersion) + '.' + IntToStr((OsInfo.dwBuildNumber shl 16) shr 16) + '.' + TmpSS;
  Result := SS = 'Windows 95/98';
end;
//关闭计算机
procedure PcShutDown;
var
  hToken: THandle;
  tkp: TOKEN_PRIVILEGES;
  ReturnLength: DWord;
begin
  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, nil, 0);
  if IsWindowsLowVersion then
      ExitWindowsEx(EWX_SHUTDOWN, 0) //98关机
  else
  begin //2000下关机
    if (not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_ALL_ACCESS or TOKEN_QUERY, hToken)) then //获取优先权
      application.Terminate;
    LookupPrivilegeValuew(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    AdjustTokenPrivileges(hToken, FALSE, tkp, 0, nil, ReturnLength);
    ExitWindowsEx(EWX_POWEROFF, 0);
  end;
end;
//=======================================================================
// 名称:	DirConcat
// 说明:    联接两个路径字符串
// 参数：	sPath: TFileName
//				第一个路径
//			sSubDir：TFileName
//				第二个路径
// 返回：	TFileName：联接后的路径
// 编程: 	张新民，2008.12.11
//=======================================================================
function DirConcat(sPath, sSubDir: TFileName): TFileName;
var
  fullPath: TFileName;
begin
  fullPath := sPath;
  if (Length(fullPath) > 0) and (fullPath[Length(fullPath)] <> '\')
  and (fullPath[Length(fullPath)] <> ':') then
    fullPath := Concat(fullPath, '\');
  Result := ConCat(fullPath, sSubDir);
end;

//=======================================================================
// 名称:	DirExists
// 说明:    判断给定的目录是否存在
// 参数：	sPath: TFileName
//				目录的路径
// 返回：	Boolean
//				True-目录存在，False-目录不存在
// 编程: 	张新民，2008.12.11
//=======================================================================
function DirExists(sPath: TFileName): Boolean;
var
  searchRec: TSearchRec;
begin
  Result := (FindFirst(DirConcat(sPath, '*.*'), faDirectory, searchRec) = 0);
  FindClose(searchRec);
end;

//=======================================================================
// 名称:	SubDirExists
// 说明:    判断给定目录的一个子目录是否存在
// 参数：	sPath: TFileName
//				目录的路径
//			sDirName: TFileName
//				子目录名称或路径
// 返回：	Boolean
//				True-子目录存在，False-子目录不存在
// 编程: 	张新民，2008.12.11
//=======================================================================
function SubDirExists(sPath: TFileName; sDirName: TFileName): Boolean;
begin
  Result := DirExists(DirConCat(sPath, sDirName));
end;

//=======================================================================
// 名称:	MyFileExists
// 说明:    判断给定目录下的一个文件是否存在
// 参数：	sPath: TFileName
//				目录的路径
//			sFileName: TFileName
//				文件名称或路径
// 返回：	Boolean
//				True-文件存在，False-文件不存在
// 编程: 	张新民，2008.12.11
//=======================================================================
function MyFileExists(sPath: TFileName; sFileName: TFileName): Boolean;
begin
  Result := FileExists(DirConcat(sPath, sFileName));
end;

//=======================================================================
// 名称:	DelDir
// 说明:    删除一个目录
// 参数：	sDirName: TFileName
//				目录的路径
// 返回：	Boolean
//				True-删除成功，False-删除失败
// 编程: 	张新民，2008.12.11
//=======================================================================
function DelDir(sDirName: TFileName): Boolean;
var
  searchRec: TSearchRec;
  dosError: Integer;
begin
  Result := False;
{$I-}
  sDirName := ExpandFileName(sDirName);
  if not DirExists(sDirName) then
  begin
    Result := True;
    Exit;
  end;

  if sDirName[length(sDirName)] = '\' then
    sDirName := copy(sDirName, 1, length(sDirName) - 1);
  dosError := FindFirst(sDirName + '\*.*', faAnyFile, searchRec);
  while dosError = 0 do
  begin
    if (searchRec.Name[1] <> '.') then
    begin
      if (searchRec.Attr and faDirectory = faDirectory) then
      begin
          // 存在子目录，不能删除
        Exit;
      end
      else
        DeleteFile(sDirName + '\' + searchRec.Name);
    end;
    dosError := FindNext(searchRec);
  end;
  RmDir(sDirName);
  FindClose(searchRec);

  if IOResult <> 0 then
    Exit;
{$I+}

  Result := True;
end;

//=======================================================================
// 名称:	DelTree
// 说明:    删除一个目录树
// 参数：	sDirName: TFileName
//				目录的路径
// 返回：	Boolean
//				True-删除成功，False-删除失败
// 编程: 张新民，2008.12.11
//=======================================================================
function DelTree(sDirName: TFileName): Boolean;
var
  searchRec: TSearchRec;
  dosError: Integer;
begin
  Result := False;
{$I-}
  sDirName := ExpandFileName(sDirName);
  if not DirExists(sDirName) then
  begin
    Result := True;
    Exit;
  end;

  if sDirName[length(sDirName)] = '\' then
    sDirName := copy(sDirName, 1, length(sDirName) - 1);
  dosError := FindFirst(sDirName + '\*.*', faAnyFile, searchRec);
  while dosError = 0 do
  begin
    if (searchRec.Name[1] <> '.') then
    begin
      if (searchRec.Attr and faDirectory = faDirectory) and (searchRec.Name[1] <> '.') then
        DelTree(sDirName + '\' + searchRec.Name)
      else
        DeleteFile(sDirName + '\' + searchRec.Name);
    end;
    dosError := FindNext(searchRec);
  end;
  RmDir(sDirName);
  FindClose(searchRec);

  if IOResult <> 0 then
    Exit;
{$I+}

  Result := True;
end;

//=======================================================================
// 名称:	FileCopy
// 说明:    文件拷贝
// 参数：	sSourFileName: TFileName
//				源文件路径名
//			sDestFileName: TFileName
//				目标文件路径名
// 返回：	Boolean
//				True-拷贝成功，False-拷贝失败
// 编程: 	张新民，2008.12.11
//=======================================================================
function FileCopy(const sSourFileName, sDestFileName: TFileName): Boolean;
begin
  Result := CopyFile(pchar(sSourFileName), pchar(sDestFileName), false);
end;

//=======================================================================
// 名称:	GetFileSizeBytes
// 说明:    获得一个文件的大小字节数
// 参数：	sFileName: TFileName
//				文件路径名
// 返回：	Integer: 文件字节数
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetFileSizeBytes(const sFileName: TFileName): Integer;
var
  f: file of Byte;
begin
{$I+}
  try
    try
      AssignFile(f, sFileName);
      Reset(f);
      Result := FileSize(f);
    finally
      CloseFile(f);
    end;
  except
    Result := -1;
  end;
end; 

//----------------------------------------------------//
//                  procedure mydel                   //
//  可以使用文件通配符，删除指定的一批文件。          //
//例如:mydel('*.*'),mydel('*.db')等。                 //
//  张新民，2008.12.11                                //
//----------------------------------------------------//
procedure MyDel(const filenames: string);
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -