Delphi操作Windows功能

先说几个容易混淆的概念:
Directory(目录):物理磁盘上存在的真实文件夹
Folder(文件夹):除真实的文件夹外,还包括“计算机”“回收站”“控制面板”等虚拟夹,范围比Directory更大
path(路径):则是指文件或文件夹的完整路径

同相容易混淆的几个概念:
当前用户根目录(HOMEDRIVE)
当前用户目录(USERPROFILE)
当前用户路径(HOMEPATH)
程序安装默认目录(PROGRAMFILES)

取得当前用户名(echo %USERNAME%):

var
  p:PChar;
begin
  GetMem(p,200);
  GetUserName(P,200);
  Result:=StrPas(P);
end;

指定的目录如果不存在
if not DirectoryExists(‘c:\jhDBBack’) then

获取本机主机名(无需winSock):

procedure TMainForm.tmrMonitorTimer(Sender: TObject);
var
  ComputerName:array[0..MAX_COMPUTERNAME_LENGTH+1] of char; //保留计算机名的缓冲区
  Buffer:Dword; // 缓冲区大小
  sComputerName:string;//计算机名
begin
  Buffer:=MAX_COMPUTERNAME_LENGTH+1;
  if GetComputerName(@ComputerName,Buffer)   then
    begin
      sComputerName:=ComputerName;
    end
  else
    begin
      sComputerName:='';
    end;
  ShowMessage(sComputerName);
end;

判断某个文件是否已被打开:

procedure TForm1.Label1DblClick(Sender: TObject);
var
  sFile:String;
  iHandle:Integer;
begin
  sFile:=ExtractFilePath(Application.ExeName)+'WeeklySO.xlsx';
  iHandle:= FileOpen(xlFile,fmShareExclusive);
  if(iHandle < 0) then
    showmessage('文件打开中')
  else showmessage('没有打开');
  FileClose(iHandle);	//试完后要关闭否则sFile文件无法操作
end;

获取远程网卡MAC地址(不同的操作系统可能不同):

function TfmregSetup.GetSerMac(sIP:String):String;
var
 myIP:ulong;
 myMac:Array[0..5] of byte;
 myMacLength:uLong;
 r:integer;
begin
 result:='';
 myIP:=inet_addr(pChar(sIP));
 myMacLength:=length(myMac);
 r:=sendArp(myIP,0,@myMac,@myMacLength);
 if r=0 then
  result:=format('%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x',[myMac[0],myMac[1],myMac[2],myMac[3],myMac[4],myMac[5]]);
end;

关闭外部应用程序(例如ERP升级)

uses ShellAPI

function Tfmuperp.updComplete;
var
  hErp:Hwnd;
  sList:TStringList;
  iI:Integer;
  sfosCopy:TShFileOpStruct;
begin
  Result:=false;
  //关闭主进程sEndProc进程的显示名称-非程序文件名
  hErp:=FindWindow(nil,PChar(sEndProc));
  if hErp<>0 then Sendmessage(hErp,wm_close,0,0);
  sleep(2000);
  //将文件清单|转为列表逐个考贝
  //可以把子目录考贝
  FillChar(sfosCopy,SizeOf(TshFileOpStruct),#0);
  sfosCopy.Wnd:=Handle;
  sfosCopy.wFunc:=FO_Copy;
  sfosCopy.fFlags:=FOF_SILENT or FOF_NOCONFIRMATION;
  sList:=TStringList.Create();
  sList.Text:=StringReplace(sUpdFile,'|',char(13)+char(10),[rfReplaceAll]);
  for iI:=0 to sList.Count-1 do
  begin
    sfosCopy.pFrom:=pChar(sFromPath + sList[iI] + #0 + #0);
    sfosCopy.pTo:=pChar(sAppPath);
    ShFileOperation(sfosCopy);
  end;
  sList.Free;
  Result:=true;
end;

获取windows版本信息:

Procedure Tform1.Button1Click(sender:TObject);
Var
OSVI:OSVERSIONINFO;
begin
OSVI.dwOSversioninfoSize:=Sizeof(OSVERSIONINFO);
GetVersionEx(OSVI);
label1.Caption:=IntToStr(OSVI.dwMinorVersion)+’,’
+IntToStr(OSVI.dwMinorVersion)+’,’
+IntToStr(OSVI.dwBuildNumber)+’,’
+IntToStr(OSVI.dwPlatformId)+’,’
+OSVI.szCSDVersion;
end;
end.

获取CPU信息:

procedure TForm1.Button1Click(Sender: TObject);
Var
SysInfo:SYSTEM_INFO;
begin
GetSystemInfo(Sysinfo);
Edit1.Text:=’系统中有’+IntToStr(Sysinfo.dwNumberOfProcessors)+’个CPU’
      +’,类型为’+IntToStr(Sysinfo.dwProcessorType);
end;
end.

获取内存信息:

procedure TForm1.Button1Click(Sender: TObject);
Var
MemInfo:MEMORYSTATUS;
begin
MemInfo.dwLength:=sizeof(MEMORYSTATUS);
GlobalMemoryStatus(MemInfo);
memo1.Lines.Add(IntToStr(MemInfo.dwMemoryLoad)+’%的内存正在使用’) ;
memo1.Lines.Add(’物理内存共有’+IntToStr(MemInfo.dwTotalPhys)+’字节’);
memo1.Lines.Add(’可使用的物理内存有’+IntToStr(MemInfo.dwAvailPhys)+’字节’);
memo1.Lines.Add(’交换文件总大小为’+IntToStr(MemInfo.dwTotalPageFile)+’字节’) ;
memo1.Lines.Add(’尚可交换文件大小为’+IntToStr(MemInfo.dwAvailPageFile)+’字节’);
memo1.Lines.Add(’总虚拟内存有’+IntToStr(MemInfo.dwTotalVirtual)+’字节’);
memo1.Lines.Add(’未用虚拟内存有’+IntToStr(MemInfo.dwAvailVirtual)+’字节’);
end;
end.

windows 的区域信息:

function TForm1.GetLocaleInformation(Flag: Integer): String;
var
    pcLCA: Array[0..20] of Char;
begin
   if( GetLocaleInfo(LOCALE_SYSTEM_DEFAULT,Flag,pcLCA,19) <= 0 ) then 
   begin    
        pcLCA[0] := #0; 
   end; 
   Result := pcLCA;  
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
    ShowMessage(GetLocaleInformation(LOCALE_SENGLANGUAGE)); 
end;

发表评论