uglobal.~pas

以前用delphi+kol写的监视工具

unit uglobal;

interface
{$IFDEF KOL_MCK}
uses Windows, Messages, ShellAPI, KOL{$IFNDEF KOL_MCK}, mirror, Classes,
  mckObjs, Controls, mckCtrls, {$ENDIF};
{$ELSE}
{$I uses.inc}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
mirror;
{$ENDIF}
type
  TsrvUserInfo = record
    _Type: string[2];
    userName: string[25];
    IP: string[19];
    host: string[25];
    lport: string[5];
    stTime: string[10];
  end;

  TdisableInfo = record
    ExeName: string[50];
    Effdatetime: Tdatetime;
    EffdateTimeTo: Tdatetime;
  end;
  pDisableInfo = ^TdisableInfo;
  TDisList = object(TListEx)
  private
  public
    procedure AddItem(Exename: string; dtfm: Tdatetime = 0; dtto: Tdatetime =
      0);
    procedure DeleteItem(ExeName: string);
    procedure ClearItems;
    destructor Destroy; virtual;
  end;
  pDisList = ^TDisList;
  TSysParm = record
    srv: string;
    Port: integer;
    lPort: integer;
    list: string; //disable list file;
    Hide: Boolean;
    Exit:Boolean;
  end;
function newDisList: pDisList;
function TerminatePID(PID: THandle): Boolean;
function RepeatStr(v: char; times: integer): string;
function _ComputerName: string;
function _UserName: string;
procedure getSysparm;
procedure listLoadFromFile(FileName: string; var list: pDisList);
procedure listLoadFromBuf(Buf: pStream; var list: pDisList); overload;
procedure listLoadFromBuf(Buf: pStrList; var list: pDisList); overload;
const G_Title='WPolicy 1.01 beta [KOL] - power by rock';
var C_SYSParm: TSysParm;
  m_RegisterServiceProcess: function(dwProcessID, dwType: Integer): Integer;
    stdcall;
implementation

procedure TDisList.ClearItems;
var p: pDisableInfo;
begin
  while count > 0 do begin
    p := pDisableInfo(Items[0]);
    Dispose(p);
    Delete(0);
  end;
end;

procedure TDisList.DeleteItem(ExeName: string);
var i: integer;
  p: pDisableInfo;
begin
  for i := 0 to Count - 1 do begin
    p := pDisableInfo(Items[i]);
    if Trim(p.ExeName) = ExeName then begin
      Dispose(p);
      Delete(i);
      break;
    end;
  end;
end;

procedure TDisList.AddItem(Exename: string; dtfm: Tdatetime = 0; dtto: Tdatetime
  = 0);
var p: pDisableInfo;
begin
  new(p);
  p^.ExeName := Exename;
  p^.Effdatetime := dtfm;
  p^.EffdateTimeTo := dtto;
  Add(p);
end;

destructor TdisList.Destroy;
begin
  ClearItems;
  inherited Destroy;
end;

function newDisList: pDisList;
begin
  new(Result, Create);
  Result.fList := NewList;
  Result.fObjects := NewList;

end;

function TerminatePID(PID: THandle): Boolean;
var ProcHandle: Thandle;
begin
  ProcHandle := OpenProcess(1, FALSE, DWORD(PID));
  if ProcHandle <> 0 then begin
    if TerminateProcess(ProcHandle, $FFFFFFFF) then begin
      WaitForSingleObject(ProcHandle, INFINITE);
      result := true;
    end;
  end
  else
    Result := false;
end;

function RepeatStr(v: char; times: integer): string;
var i: integer;
begin
  SetLength(result, times);
  for i := 1 to times do
    result[i] := v;
end;

procedure getSysparm;
var i: integer;
  s: string;
begin
  C_SYSParm.srv := ''; C_SYSParm.Port := 0; C_SYSParm.lPort :=0;// 585;
  C_SYSParm.list := ''; C_SYSParm.Hide := False;
  C_SYSParm.Exit :=false;
  for i := 1 to ParamCount do begin
    if ParamStr(i) <> '' then begin
      if copy(ParamStr(i), 1, 5) = '-srv:' then begin
        s := ParamStr(i); delete(s, 1, 5);
        C_SYSParm.srv := s;
      end;
      if copy(ParamStr(i), 1, 6) = '-port:' then begin
        s := ParamStr(i); delete(s, 1, 6);
        C_SYSParm.Port := str2int(s);
      end;
      if copy(ParamStr(i), 1, 7) = '-lport:' then begin
        s := ParamStr(i); delete(s, 1, 7);
        C_SYSParm.lPort := str2int(s);
      end;
      if ParamStr(i)='-exit' then
        C_SYSParm.Exit :=true;
      if copy(ParamStr(i), 1, 5) = '-hide' then
        C_SYSParm.Hide := true;
      if copy(ParamStr(i), 1, 6) = '-list:' then begin
        s := ParamStr(i); delete(s, 1, 6);
        C_SYSParm.list := s;
      end;
    end;
  end;
  if ((C_SYSParm.srv ='') and (C_SYSParm.Port <>0)) or
     ((C_SYSParm.srv <>'') and (C_SYSParm.Port =0)) then begin
     ShowMessage ('Invalid Parameter!');
     halt;
  end;
end;

procedure listLoadFromBuf(Buf: pStream; var list: pDisList); overload;
var l_buf: pStrList;
begin
  l_buf := NewStrList;
  try
    buf.Position := 0;
    l_buf.LoadFromStream(buf, false);
    listLoadFromBuf(l_buf, list);
  finally
    l_buf.free;
  end;
end;

procedure listLoadFromBuf(Buf: pStrList; var list: pDisList); overload;
var
  p: pDisableInfo;
  sk, i: integer;
  zs: string;
begin
  list.ClearItems;
  for i := 0 to buf.Count - 1 do begin
    new(p);
    if pos(',', buf.Items[i]) = 0 then begin
      p^.ExeName := buf.items[i];
      p^.Effdatetime := 0; p^.EffdateTimeTo := 0;
    end
    else begin
      zs := buf.Items[i];
      sk := pos(',', zs);
      p^.ExeName := copy(zs, 1, sk - 1);
      delete(zs, 1, sk);
      sk := pos(',', zs);
      if sk = 0 then begin
        p^.Effdatetime := str2int(zs);
        p^.EffdateTimeTo := 0;
      end
      else begin
        p^.Effdatetime := str2int(copy(zs, 1, sk - 1));
        delete(zs, 1, sk);
        p^.EffdatetimeTo := str2int(zs);
      end;
    end;
    p^.ExeName := uppercase(p^.ExeName);
    list.Add(p);
  end;
end;

procedure listLoadFromFile(FileName: string; var list: pDisList);
var l_f: PStrListEx;
begin
  l_f := NewStrListEx;
  try
    l_f.LoadFromFile(FileName);
    listLoadFromBuf(l_f, list);
  finally
    l_f.Free;
  end;
end;

function _UserName: string;
var buf: array[0..25] of char;
  size: Cardinal;
begin
  if GetUserName(buf, size) then
    result := string(buf)
  else
    result := 'error';
end;

function _ComputerName: string;
var buf: array[0..255] of char;
  size: Cardinal;
begin
  GetComputerName(buf, size);
  result := string(buf);
end;
var l_mhdl: Thandle;
initialization
  if (WinVer <> wvNT) and (Winver <> wvXP) and (Winver <> wvY2K) then begin
    try
      l_mhdl := GetModuleHandle(pchar('KERNEL32.DLL'));
      m_RegisterServiceProcess := getprocaddress(l_mhdl,
        pchar('RegisterServiceProcess'));
    except
      @m_RegisterServiceProcess := nil;
    end;
  end
  else
    @m_RegisterServiceProcess := nil;
  // @m_RegisterServiceProcess := nil;  
end.