servermain_unit.pas

货源代理管理系统 同样是DELPHI7下的

unit ServerMain_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ADODB, DB, ImgList, ToolWin, Buttons;

type
  TfrmMainServer = class(TForm)
    ListView1: TListView;
    MainMenu1: TMainMenu;
    N8: TMenuItem;
    mmStartSocket: TMenuItem;
    N6: TMenuItem;
    mmExit: TMenuItem;
    N1: TMenuItem;
    mmDBSetup: TMenuItem;
    ADOConn: TADOConnection;
    imglstSmall: TImageList;
    N3: TMenuItem;
    ToolBar1: TToolBar;
    mmS: TMenuItem;
    mmN: TMenuItem;
    mmL: TMenuItem;
    mmD: TMenuItem;
    sbtnReport: TSpeedButton;
    sbtnIcon: TSpeedButton;
    sbtnSmallIcon: TSpeedButton;
    sbtnList: TSpeedButton;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ToolButton6: TToolButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    imglstLarge: TImageList;
    mmSendMsg: TMenuItem;
    N4: TMenuItem;
    ToolButton4: TToolButton;
    SpeedButton1: TSpeedButton;
    procedure mmExitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mmStartSocketClick(Sender: TObject);
    procedure mmDBSetupClick(Sender: TObject);
    procedure sbtnReportClick(Sender: TObject);
    procedure sbtnListClick(Sender: TObject);
    procedure sbtnSmallIconClick(Sender: TObject);
    procedure sbtnIconClick(Sender: TObject);
    procedure mmSendMsgClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMainServer: TfrmMainServer;

implementation

uses LogisticsServer_Unit;

{$R *.dfm}

procedure TfrmMainServer.mmExitClick(Sender: TObject);
var
  i: Integer;
  aHwnd: HWnd;
begin
  if Application.MessageBox('确定要退出服务器吗?','提示', MB_OKCANCEL) = IDOK then
  begin
    for i := 0 to ListView1.Items.Count - 1 do
    begin
      WinExec(Pchar('NET SEND ' + ListView1.Items[i].Caption + ' 服务器马上要重启请保存数据退出!'), 0);
    end;
    aHwnd := FindWindow(nil, 'scktsrvr');
    if aHwnd <> 0 then
      SendMessage(aHwnd, WM_CLOSE, 0, 0);
    Application.Terminate;
  end
  else
    Exit;
end;

procedure TfrmMainServer.FormShow(Sender: TObject);
var
  aHwnd: HWnd;
begin
{-----打开数据库连接-----------------------}
  ADOConn.ConnectionString := '';
  ADOConn.Close;
  ADOConn.ConnectionString := 'FILE NAME=' + ExtractFileDir(Application.Exename) + '\ConfigData.UDL';
  ADOConn.Open;
{------检测Socket服务是否启动-------------------}
  aHwnd := FindWindow(nil, 'scktsrvr');
  if aHwnd = 0 then
    WinExec(Pchar(ExtractFilePath(Application.ExeName) + 'scktsrvr.exe'), 0);
end;

procedure TfrmMainServer.mmStartSocketClick(Sender: TObject);
var
  aHwnd: HWnd;
begin
  aHwnd := FindWindow(nil, 'scktsrvr');
  if aHwnd = 0 then
    WinExec(Pchar(ExtractFilePath(Application.ExeName) + 'scktsrvr.exe'), 0);
end;

procedure TfrmMainServer.mmDBSetupClick(Sender: TObject);
begin
  ADOConn.ConnectionString := '';
  ADOConn.Connected := False;
  ADOConn.ConnectionString := PromptDataSource(Application.Handle, ADOConn.ConnectionString);
  ADOConn.Connected := True;
end;

procedure TfrmMainServer.sbtnReportClick(Sender: TObject);
begin
  ListView1.ViewStyle := vsReport;
end;

procedure TfrmMainServer.sbtnListClick(Sender: TObject);
begin
  ListView1.ViewStyle := vsList;
end;

procedure TfrmMainServer.sbtnSmallIconClick(Sender: TObject);
begin
  ListView1.ViewStyle := vsSmallIcon;
end;

procedure TfrmMainServer.sbtnIconClick(Sender: TObject);
begin
  ListView1.ViewStyle := vsIcon;
end;

procedure TfrmMainServer.mmSendMsgClick(Sender: TObject);
var
  msgStr: string;
  i: Integer;
begin
  if InputQuery('消息标题', '输入发送内容：     ', msgStr) then
    for i := 0 to ListView1.Items.Count - 1 do
    begin
      WinExec(Pchar('NET SEND ' + ListView1.Items[i].Caption + '  ' + msgStr), 0);
    end;
end;

end.