Delphi控制台获取系统信息

program Project2;

{$APPTYPE CONSOLE}

uses
Windows,SysUtils,TLHelp32;  
{$R *.RES}
    
function GetWinDir: string; 
var
   Buf: array[0..MAX_PATH] of char; 
begin
   GetSystemDirectory(Buf, MAX_PATH); 
   Result := Buf; 
   if Result[Length(Result)] <> '\' then Result := Result + '\'; 
end; 
    
//取本机的计算机名 
function ComputerName: string; 
  var
  FStr: PChar; 
  FSize: Cardinal; 
begin
  FSize := 255; 
  GetMem(FStr, FSize); 
  GetComputerName(FStr, FSize); 
  Result := FStr; 
  FreeMem(FStr); 
end; 
//取Windows登录用户名 
function WinUserName: string; 
  var
  FStr: PChar; 
  FSize: Cardinal; 
begin
  FSize := 255; 
  GetMem(FStr, FSize); 
  GetUserName(FStr, FSize); 
  Result := FStr; 
  FreeMem(FStr); 
end; 
    
//获取系统所有驱动器 
procedure UpdateDrivers; 
var
 i: Char; 
 d: String; 
begin
d := ' '; 
for i:='A' to 'Z' do  //从A盘到Z盘检测 
 begin
  if (GetDriveType(Pchar(i+':\')) = 3) or (GetDriveType(Pchar(i+':\')) = 2) then //3是固定驱动器 2是U盘 
   d:= d + i + ':  '; 
 end; 
Writeln(d); 
end; 
    
//获取系统所有进程 
procedure UpdateProcess; //USES TLHELP32 
var
 jubing : hwnd;//句柄 
 fprocessentry32 : TProcessEntry32; //结构类型的变量 
 zhenjia : Boolean;   //返回一个布尔值（用来判断是否找到进程信息） 
 processid : dword; //储存找到的进程ID 
 mingcheng,ss : string; //储存找到的进程名称 
 i : Integer; 
begin
i := 0; 
ss := ''; 
jubing := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);   //获得进程快照句柄 
fprocessentry32.dwSize := sizeof(fprocessentry32); //给TProcessEntry32结构的第一个参数赋值（也可以理解为把这个结构的第一个参数初始化） 
zhenjia := Process32First(jubing,fprocessentry32); //使用 Process32First函数取得第一个进程的信息 
while zhenjia = true do //如果 Process32First函数执行成功也就是说找到进程列表里的第一个进程时开始循环 
  begin
   zhenjia := Process32Next(jubing,FprocessEntry32); //取得第下一个进程信息 
   mingcheng := fprocessentry32.szExeFile; //取得一个进程的名称 
   ProcessID := FProcessEntry32.th32ProcessID; 
   ss :=Format(' %-2s',[IntToStr(i+1)])+'.'+Format(' %-20s',[mingcheng])+' PID:'+Format(' %-6s',[IntToStr(ProcessID)]); 
   if i mod 2 = 0 then
    Write(ss) 
   else Writeln(ss); 
   inc(i); 
  end; 
end; 
    
//通过API函数获得版本信息 
procedure SysVersion; 
var
  osinfo:OSVERSIONINFO; 
begin
  osinfo.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO); 
  GetVersionEx(osinfo); 
  if osinfo.dwPlatformId =2 then
  Writeln('Windows, 版本 ' +IntToStr(osinfo.dwMajorVersion)+'.'+IntToStr(osinfo.dwMinorVersion) 
    +' (内部版本号 '+IntToStr(osinfo.dwBuildNumber)+': '+osinfo.szCSDVersion+')'); 
end; 
    
//通过API函数获得内存信息 
procedure SysMemory; 
var
 ms: TMemoryStatus;
begin
 GlobalMemoryStatus(ms); 
 Writeln(Format(' Windows 的物理内存：%s',[FormatFloat('#,###" KB',ms.dwTotalPhys/1024)])); 
 Writeln(Format(' Windows 的可用内存：%s',[FormatFloat('#,###" KB',ms.dwAvailPhys/1024)]) 
  +Format(', 系统资源使用率：%d%%',[ms.dwMemoryLoad])); 
end; 
    
//------------begin------------------------- 
begin
  Writeln(''); 
  Writeln('----- 这是一个带图标和版本信息的 Delphi 控制台程序 ------'); 
  Writeln('       如果不要图标和版本信息，则可以让文件更小巧'); 
  Writeln(''); 
  Writeln('1. 当前时间是      ： ' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Now)); 
  Writeln('2. 本程序文件名    ： ' + ExpandFileName(ParamStr(0))); 
  Writeln('3. 系统目录是      ： ' + GetWinDir); 
  Writeln('4. 本机计算机名是  ： ' + ComputerName); 
  Writeln('5. 本机登录用户名是： ' + WinUserName); 
  Write('6. 当前系统有以下驱动器（硬盘和U盘）：'); 
  UpdateDrivers; //所有驱动器 
  Writeln('7. 当前系统有以下进程：'); 
  UpdateProcess; //所有进程 
  Writeln(''); 
  Write('8. 当前操作系统为：'); 
  SysVersion;  //操作系统信息 
  Writeln('9. 当前系统内存信息为：'); 
  SysMemory; 
  Writeln('--------------------------------------------'); 
  Writeln(' 当前时间是： ' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Now)); 
  Writeln(''); 
  Writeln('---- Powered by Delphi 7 ----- 2013.12 ----'); 
  Writeln(''); 
  Write('按回车键退出(Press Enter to Exit)...'); 
  Readln;
end.

 

 

转载于:https://www.cnblogs.com/qqook/p/3479331.html