自己寫的一個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.