DELPHI 控制台程序获取系统信息-木庄网络博客

本文整理自网络，侵删。
 

// 经过整理的DELPHI控制台程序，体积小，功能不少。呵呵  --XIAO 2013.5
program Console;

{$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 ----- xiao@Redcock 2013.5 ----');
  Writeln('');
  Write('按回车键退出(Press Enter to Exit)...');
  Readln;
end.
DELPHI 控制台程序获取系统信息

相关推荐

评论
