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
    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;
  end;
function newDisList: pDisList;
function TerminatePID(PID: THandle): Boolean;
function RepeatStr(v: char; times: integer): 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;
procedure listSaveToFileName(list: pDisList; FileName:String);
procedure listSaveToBuf(list: pDisList; Buf: pStream);
var C_SYSParm: TSysParm;
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 := 585;
  C_SYSParm.list := ''; C_SYSParm.Hide := 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 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;
end;
procedure listSaveToBuf(list: pDisList; Buf: pStream);
var i: integer;
  Item: pDisableInfo;
  l_buf: PStrList;
begin
  Buf.Size := 0;
  l_buf := NewStrList;
  try
    for i := 0 to list.Count - 1 do begin
      Item := List.Items[i];
      l_buf.Add(item.ExeName +','+Double2Str(item.Effdatetime)+','+ Double2Str(item.EffdateTimeTo));
    end;
    l_buf.SaveToStream(buf);
  finally
    l_buf.free;
  end;
end;
procedure listSaveToFileName(list: pDisList; FileName:String);
var l_buf:pStream;
begin
  l_buf:=NewWriteFileStream(FileName);
  try
    listSaveToBuf(list,l_buf); 
  finally
    l_buf.free;
  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 := uppercase(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;
    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;

end.