服务端主窗口

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TlHelp32, ExtCtrls, DB, DBClient, Grids, DBGrids,
  ADODB, Provider, AppEvnts;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    QryPooling: TADOQuery;
    DataSetProvider1: TDataSetProvider;
    ClientDataSet1: TClientDataSet;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
  private
    { Private declarations }
    function GetPoolingData: OleVariant;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses AdoconnectPool;

{$R *.dfm}

function GetDirFiles(sPath: string): TStringList;
var
  SearchRec: TSearchRec;
  iFound: Integer;
  sList: TStringList;
begin
  sList := TStringList.Create;
  if Pos('*.', sPath) = 0 then
    iFound := FindFirst(sPath + '*.*', faAnyFile - faDirectory, SearchRec)
  else
    iFound := FindFirst(sPath, faAnyFile - faDirectory, SearchRec);
  while iFound = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and
      (SearchRec.Attr <> faDirectory) then
      sList.Add(SearchRec.Name);
    iFound := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  Result:= sList;
end;

function FindProcess(AFileName: string): boolean;
var
  hSnapshot: THandle;//用于获得进程列表
  lppe: TProcessEntry32;//用于查找进程
  Found: Boolean;//用于判断进程遍历是否完成
begin
  try        
    Result :=False;
    hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);//获得系统进程列表
    lppe.dwSize := SizeOf(TProcessEntry32);//在调用Process32First API之前，需要初始化lppe记录的大小
    Found := Process32First(hSnapshot, lppe);//将进程列表的第一个进程信息读入ppe记录中
    while Found do
    begin
      if ((UpperCase(ExtractFileName(lppe.szExeFile))=UpperCase(AFileName)) or (UpperCase(lppe.szExeFile )=UpperCase(AFileName))) then
      begin
        Result :=True;
      end;
      Found := Process32Next(hSnapshot, lppe);//将进程列表的下一个进程信息读入lppe记录中
    end;
  except
    Result :=False;
    Exit;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if not FindProcess('scktsrvr.exe') then
    WinExec('scktsrvr.exe', SW_SHOWNORMAL);
  Self.DoubleBuffered :=True;
  DBGrid1.DoubleBuffered :=True;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Application.MessageBox('Is sure close the system?', PChar(Application.Title), MB_YESNO +
    MB_ICONQUESTION) = IDYES then
  begin
    CanClose := True;
  end
  else
    CanClose := False;
end;

function TForm1.GetPoolingData: OleVariant;
begin
  Result := null;
  QryPooling.ConnectionString := AdoconnectPool.g_ini.ReadString('ado','connstr','');
  QryPooling.Close;
  QryPooling.SQL.Clear;
  QryPooling.SQL.Text := 'select poolingType, maxNum, createdNum, usedNum from sys_pooling';
  QryPooling.Open;
  if QryPooling.Active and not QryPooling.IsEmpty then
  begin
    Result := DataSetProvider1.Data;
    QryPooling.Close;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ClientDataSet1.Data := GetPoolingData;
  ClientDataSet1.IndexFieldNames := 'poolingType';   // set primary key
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if Msg.message = 8888 then   // pooling state
  begin
    case Msg.wParam of
      11:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOConnection']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.FieldByName('createdNum').AsInteger := ClientDataSet1.FieldByName('createdNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      12:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOConnection']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger -1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      13:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOConnection']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      21:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOQuery']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('createdNum').AsInteger := ClientDataSet1.FieldByName('createdNum').AsInteger +1;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      22:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOQuery']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger -1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      23:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOQuery']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      31:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOStoredProc']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('createdNum').AsInteger := ClientDataSet1.FieldByName('createdNum').AsInteger +1;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      32:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOStoredProc']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger -1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      33:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['ADOStoredProc']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      41:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['DatasetProvider']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('createdNum').AsInteger := ClientDataSet1.FieldByName('createdNum').AsInteger +1;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      42:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['DatasetProvider']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger -1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      43:
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['DatasetProvider']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      51:                 // createNew
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['COMThread']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('createdNum').AsInteger := ClientDataSet1.FieldByName('createdNum').AsInteger +1;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      52:
      begin           // unlock
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['COMThread']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger -1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;
      53:                   // indexof
      begin
        ClientDataSet1.DisableControls;
        ClientDataSet1.FindKey(['COMThread']);
        ClientDataSet1.Edit;
        ClientDataSet1.FieldByName('usedNum').AsInteger := ClientDataSet1.FieldByName('usedNum').AsInteger +1;
        ClientDataSet1.Post;
        ClientDataSet1.EnableControls;
      end;     
    end;
  end else inherited;
end;

end.