自己写的一个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.