system2.pas

一个远程监控程序

          end;
          With regconvert(TECX) do
          begin
               TString := TString + CHR(bits0_7) + CHR(bits8_15) + CHR(bits16_23) + CHR(bits24_31);
          end;
          VString := TString;
          CPUInfo.VendorIDString := TString;
          If (CPUInfo.VendorIDString = 'GenuineIntel') then
          begin
               CPUInfo.Manufacturer := 'Intel';
               Case CPUInfo.Family of
               4: Case CPUInfo.Model of
                  1: CPUInfo.CPU_Name := 'Intel 486DX Processor';
                  2: CPUInfo.CPU_Name := 'Intel 486SX Processor';
                  3: CPUInfo.CPU_Name := 'Intel DX2 Processor';
                  4: CPUInfo.CPU_Name := 'Intel 486 Processor';
                  5: CPUInfo.CPU_Name := 'Intel SX2 Processor';
                  7: CPUInfo.CPU_Name := 'Write-Back Enhanced Intel DX2 Processor';
                  8: CPUInfo.CPU_Name := 'Intel DX4 Processor';
                  else CPUInfo.CPU_Name := 'Intel 486 Processor';
                  end;
               5: CPUInfo.CPU_Name := 'Pentium';
               6: Case CPUInfo.Model of
                  1: CPUInfo.CPU_Name := 'Pentium Pro';
                  3: CPUInfo.CPU_Name := 'Pentium II';
                  else CPUInfo.CPU_Name := Format('P6 (Model %d)', [CPUInfo.Model]);
                  end;
               else CPUInfo.CPU_Name := Format('P%d', [CPUInfo.Family]);
               end;
          end
          else if (CPUInfo.VendorIDString = 'CyrixInstead') then
          begin
                CPUInfo.Manufacturer := 'Cyrix';
                Case CPUInfo.Family of
                5: CPUInfo.CPU_Name := 'Cyrix 6x86';
                6: CPUInfo.CPU_Name := 'Cyrix M2';
                else CPUInfo.CPU_Name := Format('%dx86', [CPUInfo.Family]);
                end;
          end
          else if (CPUInfo.VendorIDString = 'AuthenticAMD') then
          begin
               CPUInfo.Manufacturer := 'AMD';
               Case CPUInfo.Family of
               4: CPUInfo.CPU_Name := 'Am486 or Am5x86';
               5: Case CPUInfo.Model of
                  0: CPUInfo.CPU_Name := 'AMD-K5 (Model 0)';
                  1: CPUInfo.CPU_Name := 'AMD-K5 (Model 1)';
                  2: CPUInfo.CPU_Name := 'AMD-K5 (Model 2)';
                  3: CPUInfo.CPU_Name := 'AMD-K5 (Model 3)';
                  6: CPUInfo.CPU_Name := 'AMD-K6';
                  else CPUInfo.CPU_Name := 'Unknown AMD Model';
                  end;
               else CPUInfo.CPU_Name := 'Unknown AMD Chip';
               end;
          end
          else
          begin
               CPUInfo.VendorIDString := TString;
               CPUInfo.Manufacturer := 'Unknown';
               CPUInfo.CPU_Name := 'Unknown';
          end;
     end;
     Result := CPUInfo;
end;

Function TSystem.TestFDIVInstruction: Boolean;
var
   TopNum:    Double;
   BottomNum: Double;
   One:       Double;
   ISOK:      Boolean;
begin
     { The following code was found in Borlands
       fdiv.asm file in the Delphi 3\Source\RTL\SYS
       directory, ( I made some minor modifications )
       therefor I cannot take credit for it }

     TopNum     := 2658955;
     BottomNum  := PI;
     One        := 1;

     asm
        PUSH    EAX
        FLD     [TopNum]
        FDIV    [BottomNum]
        FMUL    [BottomNum]
        FSUBR   [TopNum]
        FCOMP   [One]
        FSTSW   AX
        SHR     EAX, 8
        AND     EAX, 01H
        MOV     ISOK, AL
        POP     EAX
     end;
     Result := ISOK;
end;

procedure TSystem.Appmessage(var MSG:tmsg;var handled:boolean);
var
   i:integer;
   anzahl:word;
   Pfilename:Pchar;
begin
     if msg.message=WM_DROPFILES then begin
     PFilename:=stralloc(255);
     FFILES.clear;
     anzahl:=DRagQueryFile(MSG.Wparam,$FFFFFFFF,PFilename,255);
     for i:=0 to (anzahl-1) do begin
         DragQueryFile(MSG.WPARAM,i,Pfilename,255);
         FFiles.add(STRPAS(PFilename));
     end;
     DragFinish(Msg.wparam);
     handled:=true;
     if assigned(Fondragdrop) then Fondragdrop(FFiles);
     strdispose(pFilename);
end;
end;

function tsystem.gettotalphysmemory:longint;
var
memory:TMEMORYSTATUS;
begin
     globalmemorystatus(memory);
     gettotalphysmemory:=memory.dwtotalphys;
end;

function tsystem.getavailphysmemory:longint;
var
memory:TMEMORYSTATUS;
begin
     globalmemorystatus(memory);
     getavailphysmemory:=memory.dwavailphys;
end;

function tsystem.gettotalpagefile:longint;
var
memory:TMEMORYSTATUS;
begin
     globalmemorystatus(memory);
     gettotalpagefile:=memory.dwtotalpagefile;
end;

function tsystem.getavailpagefile:longint;
var
memory:TMEMORYSTATUS;
begin
     globalmemorystatus(memory);
     getavailpagefile:=memory.dwavailpagefile;
end;
function tsystem.getwindowsdirectory:string;
var
p:Pchar;
begin
     p:=stralloc(MAX_PATH+1);
     windows.getwindowsdirectory(p,max_path+1);
     getwindowsdirectory:=p;
     strdispose(p);
end;


function tsystem.getsystemdirectory:string;
var
p:Pchar;
begin
     p:=stralloc(MAX_PATH+1);
     windows.getsystemdirectory(p,max_path+1);
     getsystemdirectory:=p;
     strdispose(p);
end;

function tsystem.getusername:string;
var
p:Pchar;
size:Dword;
begin
     size:=1024;
     p:=stralloc(size);
     windows.getusername(p,size);
     getusername:=p;
     strdispose(p);
end;

function tsystem.getcomputername:string;
var
p:Pchar;
size:Dword;
begin
     size:=MAX_COMPUTERNAME_LENGTH+1;
     p:=stralloc(size);
     windows.getcomputername(p,size);
     getcomputername:=p;
     strdispose(p);
end;

function tsystem.getprocessortype:string;
var
   systeminfo:tsysteminfo;
   zw:string;
begin
     getsysteminfo(systeminfo);
     case systeminfo.dwprocessortype of
          386:zw:='Intel 80386';
          486:zw:='Intel 80486';
          586:zw:='Intel Pentium';
          860:zw:='Intel 860';
          2000:zw:='MIPS R2000';
          3000:zw:='MIPS R3000';
          4000:zw:='MIPS R4000';
         21064:zw:='ALPHA 21064';
     else ZW:='Processor nicht klassifiziert';
     end;

     result:=zw;
end;

function tsystem.getprocessorcount:integer;
var
systeminfo:tsysteminfo;
begin
     getsysteminfo(systeminfo);
     result:=systeminfo.dwnumberofprocessors;
end;

function tsystem.getsystem:tBetriebssystem;
var
os:TOSVERSIONINFO;
begin
     os.dwosversioninfosize:=sizeof(os);
     getversionex(os);
     case os.dwplatformid of
     VER_PLATFORM_WIN32s:result:=bswin32;
     ver_PLATFORM_WIN32_Windows:result:=bswin95;
     VER_PLATFORM_Win32_nt:result:=bswinNT;
     else result:=bswin95;
     end;
end;

procedure TSystem.shutdown;
begin
exitwindowsex(EWX_SHUTDOWN,0);
end;

procedure TSystem.reboot;
begin
exitwindowsex(EWX_REBOOT,0);
end;

procedure TSystem.logoff;
begin
exitwindows(0,0)
end;

function TSystem.sound: boolean;
begin
     result:=waveoutgetnumdevs>0;
end;

function TSystem.diskindrive(lw: char; statusanzeige: boolean): boolean;
var
sRec:TsearchRec;
i:integer;
begin
     result:=false;
     {$I-}
     i:=findfirst(lw+':\*.*',faAnyfile,Srec);
     findclose(Srec);
     {$I+}
     case i of
     0:result:=true;
     2,18:begin
               if statusanzeige then
               showmessage('Diskette im Laufwerk '+lw+' ist leer !');
               result:=true;
          end;
     21,3:if statusanzeige then showmessage('Keine Diskette im Laufwerk '+lw+' !');
     else if statusanzeige then showmessage('Diskette nicht formatiert !'+inttostr(i));
     end;
end;

function TSystem.disktyp(lw: char): string;
var
i,typ:integer;
s:string;
begin
if diskindrive(lw,false) then begin
s:=lw+':\';
typ:=getdrivetype(Pchar(s));
if typ <>0 then
   case typ of
   DRIVE_REMOVABLE:result:='Diskette';
   DRIVE_FIXED:result:='Festplatte';
   DRIVE_CDROM:result:='CDROM';
   DRIVE_RAMDISK:result:='RAMDisk';
   DRIVE_REMOTE:result:='Netzlaufwerk';
   else result:='Laufwerktyp unbekannt';
   end;
end;
end;

function TSystem.diskserialnumber(lw: char): integer;
var
root:string;
volumenamebuffer,filesystemnamebuffer:pchar;
filesystemflags,maximumcomponentlength:Dword;
sectorspercluster,bytespersector,numberoffreeclusters,totalnumberofclusters:dword;
volumeserialnumber:pdword;
begin
if diskindrive(lw,false)then begin
root:=lw+':\';
volumenamebuffer:=stralloc(256);
filesystemnamebuffer:=stralloc(256);
getvolumeinformation(pchar(root),volumenamebuffer,255,volumeserialnumber,maximumcomponentlength,filesystemflags,filesystemnamebuffer,255);
result:=dword(volumeserialnumber);
strdispose(volumenamebuffer);
strdispose(filesystemnamebuffer);
end;

end;

function TSystem.diskfilesystem(lw: char): string;
var
root:string;
volumenamebuffer,filesystemnamebuffer:pchar;
filesystemflags,maximumcomponentlength:Dword;
sectorspercluster,bytespersector,numberoffreeclusters,totalnumberofclusters:dword;
volumeserialnumber:pdword;
begin
if diskindrive(lw,false)then begin
root:=lw+':\';
volumenamebuffer:=stralloc(256);
filesystemnamebuffer:=stralloc(256);
getvolumeinformation(pchar(root),volumenamebuffer,255,volumeserialnumber,maximumcomponentlength,filesystemflags,filesystemnamebuffer,255);
result:=filesystemnamebuffer;    
strdispose(volumenamebuffer);
strdispose(filesystemnamebuffer);
end;

end;

function TSystem.disknamelength(lw: char): integer;
var
root:string;
volumenamebuffer,filesystemnamebuffer:pchar;
filesystemflags,maximumcomponentlength:Dword;
sectorspercluster,bytespersector,numberoffreeclusters,totalnumberofclusters:dword;
volumeserialnumber:pdword;
begin
if diskindrive(lw,false)then begin
root:=lw+':\';
volumenamebuffer:=stralloc(256);
filesystemnamebuffer:=stralloc(256);
getvolumeinformation(pchar(root),volumenamebuffer,255,volumeserialnumber,maximumcomponentlength,filesystemflags,filesystemnamebuffer,255);
result:=maximumcomponentlength;  
strdispose(volumenamebuffer);
strdispose(filesystemnamebuffer);
end;
end;

function TSystem.diskfreespace(lw: char): int64;
var
la:byte;
lw2:char;
begin
     lw2:=upcase(lw);
     la:=ord(lw2)-64;
     result:=diskfree(la);
end;

function TSystem.disktotalspace(lw: char): int64;
var
la:byte;
lw2:char;
begin
     lw2:=upcase(lw);
     la:=ord(lw2)-64;
     result:=disksize(la);
end;

function TSystem.setComputername(name: string): boolean;
begin
     result:=windows.SetComputerName(pchar(name));

end;

end.