main.pas

三層源碼,DELPHI寫的三層源碼,三層源碼,

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, SysTray, AppEvnts, ImgList, xpButton;

const cm_restore  = wm_user + $1100;

type
  Tmainform = class(TForm)
    StatusBar1: TStatusBar;
    SysTray1: TSysTray;
    ApplicationEvents1: TApplicationEvents;
    ImageList2: TImageList;
    xpButton4: TxpButton;
    xpButton5: TxpButton;
    Memo1: TMemo;
    Bevel1: TBevel;
    procedure SysTray1IconDoubleClick(Sender: TObject;
      Button: TMouseButton; X, Y: Integer);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure xpButton4Click(Sender: TObject);
    procedure xpButton5Click(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure FormShow(Sender: TObject);
  private
    procedure checksocketapp;
    procedure logmemoonchange(sender: Tobject);
    { Private declarations }
  public
    procedure createparams(var params: tcreateparams); override;
    procedure restorerequest(var message: tmessage); message cm_restore;

    { Public declarations }
  end;

var
  mainform: Tmainform;

implementation
uses shareunit,registry;
{$R *.DFM}

procedure Tmainform.createparams(var params: tcreateparams);
begin
  inherited;
  Params.winclassname := 'slserver';
end;

procedure Tmainform.restorerequest(var message: tmessage);
begin
  if isiconic(application.handle) = true then application.restore else application.bringtofront;
end;

procedure Tmainform.SysTray1IconDoubleClick(Sender: TObject;
  Button: TMouseButton; X, Y: Integer);
begin
  systray1.ShowMainForm;
end;

procedure Tmainform.ApplicationEvents1Minimize(Sender: TObject);
begin
  systray1.HideMainForm;
end;

procedure Tmainform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  freeandnil(pubbitmap);
  application.Terminate;
end;

procedure Tmainform.FormCreate(Sender: TObject);
begin
  checksocketapp;
  pubbitmap := tbitmap.create;
  logmemo.onchange:=logmemoonchange;
  imagelist2.GetBitmap(nx, pubbitmap);
  datapath := extractfilepath(application.exename);
  statusbar1.panels.items[3].text := getip(getmycomputer);
end;

procedure Tmainform.FormDblClick(Sender: TObject);
begin
  if nx = 2 then nx := 0 else nx := nx + 1;
  imagelist2.GetBitmap(nx, pubbitmap);
  repaint;
end;

procedure Tmainform.FormPaint(Sender: TObject);
begin
  formonpaint(self);
end;

procedure tmainform.checksocketapp;
var handle: hwnd; reg: tregistry;
  path: string;
begin
  path := extractfilepath(application.exename);
  handle := findwindow(nil, 'scktsrvr');
  if not (handle > 0) then
    begin
    reg := tregistry.Create;
    reg.RootKey := HKEY_LOCAL_MACHINE;

    reg.OpenKey('SYSTEM\CurrentControlSet\Services',true);
    if not reg.KeyExists('SocketServer') then
       winexec(pchar(path+'scktsrvr /install'),0);
    reg.OpenKey('SocketServer',true);
    reg.writestring('ImagePath',path+'scktsrvr.exe');
    reg.WriteString('Description','Borland Socket Connect Server');
    reg.CloseKey;
    reg.free;
    
    winexec(pchar(path + 'scktsrvr'), 0);
    application.Terminate;
    end;
end;

procedure Tmainform.xpButton4Click(Sender: TObject);
begin
  logmemo.Clear;
end;

procedure Tmainform.xpButton5Click(Sender: TObject);
begin
  with tsavedialog.Create(nil) do
  try
    defaultext := 'txt';
    filter := '文本文件(TXT)|*.txt';
    if execute then
      logmemo.SaveToFile(filename);
  finally
    free;
  end;
end;

procedure Tmainform.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
begin
logmemo.Add(E.Message);
end;

procedure Tmainform.logmemoonchange(sender: Tobject);
begin
statusbar1.panels.items[1].Text := inttostr(clientsum);
if memo1.Showing then
  memo1.Lines.Assign(logmemo);
end;

procedure Tmainform.FormShow(Sender: TObject);
begin
memo1.Lines.Assign(logmemo);
end;

end.