clientfrm.pas

Asta For d2006 自己修改版 经典中间件 速度超快

unit ClientFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls,  Menus, StdCtrls, Buttons,
  AstaStringLine, ScktComp, AstaCustomSocket, AstaClientSocket,
  AstaRemote_Client,ASTARemConMessages;


type

  TClientForm = class(TForm)
    StatPanel: TPanel;
    StatusBar1: TStatusBar;
    ScrollBox1: TScrollBox;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Connect1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Disconnect1: TMenuItem;
    View1: TMenuItem;
    RefreshComplete1: TMenuItem;
    UpdateChanges1: TMenuItem;
    ResponseTimer: TTimer;
    Options1: TMenuItem;
    ServerPause1: TMenuItem;
    N005sec1: TMenuItem;
    N010sec1: TMenuItem;
    N050sec1: TMenuItem;
    N100sec1: TMenuItem;
    N200sec1: TMenuItem;
    N500sec1: TMenuItem;
    LogList: TListBox;
    Splitter1: TSplitter;
    N2: TMenuItem;
    Log1: TMenuItem;
    CommStat1: TMenuItem;
    N3: TMenuItem;
    Shutdown1: TMenuItem;
    Special1: TMenuItem;
    FocusServerWindow1: TMenuItem;
    BitmapFormat1: TMenuItem;
    Color4: TMenuItem;
    Gray4: TMenuItem;
    Gray8: TMenuItem;
    Color24: TMenuItem;
    Default1: TMenuItem;
    WaitImage: TImage;
    CompressionLevel1: TMenuItem;
    Level0: TMenuItem;
    Level1: TMenuItem;
    Level9: TMenuItem;
    ServerPriority1: TMenuItem;
    Critical1: TMenuItem;
    Highest1: TMenuItem;
    AboveNormal1: TMenuItem;
    Normal1: TMenuItem;
    BelowNormal1: TMenuItem;
    Lowest1: TMenuItem;
    Idle1: TMenuItem;
    N4: TMenuItem;
    ScaleImage1: TMenuItem;
    ProcessList1: TMenuItem;
    N5: TMenuItem;
    FileList1: TMenuItem;
    Panel1: TPanel;
    SendCRBut: TSpeedButton;
    SendBut: TSpeedButton;
    SendPanel: TPanel;
    SendEdit: TEdit;
    Help1: TMenuItem;
    About1: TMenuItem;
    StatBarMenu: TMenuItem;
    FullScreen1: TMenuItem;
    CL: TRemoteControlClient;
    Level2: TMenuItem;
    Level3: TMenuItem;
    Level4: TMenuItem;
    Level5: TMenuItem;
    Level6: TMenuItem;
    Level7: TMenuItem;
    Level8: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Exit1Click(Sender: TObject);
    procedure Connect1Click(Sender: TObject);
    procedure Disconnect1Click(Sender: TObject);
    procedure UpdateChanges1Click(Sender: TObject);
    procedure ResponseTimerTimer(Sender: TObject);
    procedure PauseChange(Sender: TObject);
    procedure SendButClick(Sender: TObject);
    procedure SendCRButClick(Sender: TObject);
    procedure Log1Click(Sender: TObject);
    procedure CommStat1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Shutdown1Click(Sender: TObject);

    procedure ColorClick(Sender: TObject);
    procedure CompClick(Sender: TObject);
    procedure PriorityClick(Sender: TObject);
    procedure ScaleImage1Click(Sender: TObject);
    procedure ProcessList1Click(Sender: TObject);
    procedure SendPanelResize(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure StatBarMenuClick(Sender: TObject);
    procedure FullScreen1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word;
      Shift: TShiftState);
    procedure FocusServerWindow1Click(Sender: TObject);
    procedure RefreshComplete1Click(Sender: TObject);
    procedure SetStat(Sender: TObject; index: integer; msg: string);
    procedure FileList1Click(Sender: TObject);
    procedure ShowProc(Sender: TObject; Data: string);
    procedure ShowDriveList(Sender: TObject; Data: string);
    procedure ShowFileList(Sender: TObject; Data: string);
    procedure ShowDirList(Sender: TObject; Data: string);
    procedure StopAnim(Sender: TObject);
    procedure StartAnim(Sender: TObject);
    procedure Log(Sender: TObject);
    procedure MChangeSoketClick(Sender: TObject);
  protected
    t1: DWORD;
    Anim: integer;
    ProcForm: TForm;
    FileForm: TForm;
    BeforeFull: TRect;
    procedure SendText(const Text: string);
    procedure EnableButs;
    procedure EnableInput;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    procedure UpdateLogVis;
  public
  end;

var
  ClientForm: TClientForm;

implementation

uses ConnectDlg, ProcListDlg,FilesDlg, About, FsTopDlg;

{$R *.DFM}



{ TClientForm }

procedure TClientForm.FormShow(Sender: TObject);
begin
  if not Timer1.Enabled then
    Timer1.Enabled := True;
  UpdateLogVis;
end;


procedure TClientForm.Timer1Timer(Sender: TObject);
var
  f: TForm;
begin
  Timer1.Enabled := False;
  f := Self;
  with ClientConnectForm do 
  begin
    Left := (f.Left + f.Width div 2) - Width div 2;
    Top := (f.Top + f.Height div 2) - Height div 2;
    if ShowModal = mrOk then
    begin
      cl.Port := StrToInt(PortEdit.Text);
      cl.Adress := ServerCombo.Text;
      cl.Password := PassEdit.Text;
      cl.RefreshOnStartUP := StartScreenBox.Checked;
      cl.Start;
    end;
  end;
  EnableButs;
end;

procedure TClientForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Disconnect1Click(nil);
end;

procedure TClientForm.SetStat(Sender: TObject; index: integer; msg: string);
begin
  FSTopForm.StatLabel.Caption := msg;
  StatusBar1.Panels[index].Text := msg;
  Update;
end;

procedure TClientForm.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TClientForm.Connect1Click(Sender: TObject);
begin
  Timer1Timer(nil);
  EnableButs;
end;


procedure TClientForm.Disconnect1Click(Sender: TObject);
begin
  cl.Stop;
  EnableButs;
end;

procedure TClientForm.UpdateChanges1Click(Sender: TObject);
begin
  cl.UpdateScreen;
end;

procedure TClientForm.ResponseTimerTimer(Sender: TObject);
var
  bm: TBitmap;
  x, y: integer;
begin
  // Icon Animation
  WaitImage.Hint := Format('Wait: %3.1n seconds', [(GetTickCount - t1) / 1000.0]);
  bm := TBitmap.Create;
  bm.Width := WaitImage.Width;
  bm.Height := WaitImage.Height;

  Anim := Anim + 1;
  Anim := Anim and 31;
  for x := -1 to 1 do
    for y := -1 to 1 do
      bm.Canvas.Draw(Anim + x * 32, Anim + y * 32, Application.Icon);

  WaitImage.Picture.Assign(bm);
  bm.Free;
end;

procedure TClientForm.SendButClick(Sender: TObject);
begin
  SendText(SendEdit.Text);
end;

procedure TClientForm.SendCRButClick(Sender: TObject);
begin
  SendText(SendEdit.Text + #13);
end;

procedure TClientForm.SendText(const Text: string);
begin
  cl.sendtext(Text);
end;


procedure TClientForm.Log1Click(Sender: TObject);
begin
  Log1.Checked := not Log1.Checked;

  UpdateLogVis;
end;

procedure TClientForm.UpdateLogVis;
begin
  LogList.Visible := Log1.Checked;
  Splitter1.Visible := Log1.Checked;

  if Log1.Checked then
    LogList.Left := Splitter1.Left - 1;
end;

procedure TClientForm.Log(Sender: TObject);
begin
  if loglist.items.Count>20000 then
     begin
       loglist.Clear;
       loglist.items.Add('Clear Log');
     end;
  LogList.ItemIndex := LogList.Items.Add(cl.log);
end;

procedure TClientForm.CommStat1Click(Sender: TObject);
begin
  CommStat1.Checked := not CommStat1.Checked;
  StatPanel.Visible := CommStat1.Checked;
end;

procedure TClientForm.EnableButs;
var
  b: boolean;
begin
  b := cl.enable;
  Connect1.Enabled := not b;
  Disconnect1.Enabled := b;
end;

procedure TClientForm.FormCreate(Sender: TObject);
begin
{  cl := TRemoteControlClient.Create(nil);
  cl.Parent := ScrollBox1;
  cl.Visible := True;
  cl.startAnim := startAnim;
  cl.StopAnim := StopAnim;
  Cl.StatusString := setstat;
  cl.OnDriveList := ShowDriveList;
  cl.OnFilesList := ShowFileList;
  cl.OnProcesList := ShowProc;
  cl.OnDirectoryList := ShowDirList;
  cl.AddLog := Log;
  }
  cl.Top:=0;
  cl.Left:=0;
  cl.Picture.Assign(cl.Picture.Graphic);  // To trigger the Autosize property
  EnableButs;
  StopAnim(self);
  EnableInput;
end;

procedure TClientForm.Shutdown1Click(Sender: TObject);
begin
  Close;
  Application.MainForm.Close;
end;

procedure TClientForm.EnableInput;
var
  b: boolean;
begin
  b := cl.EnableInput;

  SendBut.Enabled := b;
  SendCRBut.Enabled := b;
  //   Image1.Enabled := b;
  Special1.Enabled := b;
  // Options1.Enabled := b;
end;

procedure TClientForm.StopAnim(Sender: TObject);
var
  bmp: TBitmap;
begin
  Screen.Cursor := crDefault;
  ResponseTimer.Enabled := False;
  // Stat[2] := 'Not Waiting';

  bmp := TBitmap.Create;
  bmp.Width := WaitImage.Width;
  bmp.Height := WaitImage.Height;
  bmp.Canvas.Draw(2, 2, Application.Icon);
  WaitImage.Picture.Assign(bmp);
  bmp.Free;

  EnableInput;
end;

procedure TClientForm.StartAnim(Sender: TObject);
begin
  Anim := 2;
  ResponseTimer.Enabled := True;
  // Stat[2] := 'Waiting';
  t1 := GetTickCount;
  Screen.Cursor := crAppStart;
  EnableInput;
end;

procedure TClientForm.WMSysCommand(var Message: TWMSysCommand);
begin
  if (Message.CmdType and $FFF0 = SC_MINIMIZE) then
    Application.Minimize
  else
    inherited;
end;



procedure TClientForm.PauseChange(Sender: TObject);
var
  d: integer;
begin
  d := 0;
  (Sender as TMenuItem).Checked := True;

  if Sender = N005sec1 then d := 50;
  if Sender = N010sec1 then d := 100;
  if Sender = N050sec1 then d := 500;
  if Sender = N100sec1 then d := 1000;
  if Sender = N200sec1 then d := 2000;
  if Sender = N500sec1 then d := 5000;
  cl.pausechange(d);
end;

procedure TClientForm.ColorClick(Sender: TObject);
var
  vm: TViewMode;

begin
  (Sender as TMenuItem).Checked := True;

  vm := vmDefault;
  if Sender = Color4 then vm := vmColor4;
  if Sender = Gray4 then vm := vmGray4;
  if Sender = Gray8 then vm := vmGray8;
  if Sender = Color24 then vm := vmColor24;
  if Sender = Default1 then vm := vmDefault;
  cl.ViewMode := vm;
end;

procedure TClientForm.CompClick(Sender: TObject);
var
  cm: Integer;
begin
  (Sender as TMenuItem).Checked := True;
  cm := 0;
  if Sender = level0 then cm := 0;
  if Sender = level1 then cm := 1;
  if Sender = level2 then cm := 2;
  if Sender = level3 then cm := 3;
  if Sender = level4 then cm := 4;
  if Sender = level5 then cm := 5;
  if Sender = level6 then cm := 6;
  if Sender = level7 then cm := 7;
  if Sender = level8 then cm := 8;
  if Sender = level9 then cm := 9;
  cl.Compresion := cm;
end;

procedure TClientForm.PriorityClick(Sender: TObject);
var
  x: integer;
begin
  (Sender as TMenuItem).Checked := True;

  x := THREAD_PRIORITY_NORMAL;

  if Sender = Critical1 then x := THREAD_PRIORITY_TIME_CRITICAL;
  if Sender = Highest1 then x := THREAD_PRIORITY_HIGHEST;
  if Sender = AboveNormal1 then x := THREAD_PRIORITY_ABOVE_NORMAL;
  if Sender = Normal1 then x := THREAD_PRIORITY_NORMAL;
  if Sender = BelowNormal1 then x := THREAD_PRIORITY_BELOW_NORMAL;
  if Sender = Lowest1 then x := THREAD_PRIORITY_LOWEST;
  if Sender = Idle1 then x := THREAD_PRIORITY_IDLE;
  cl.PRIORITY := x;
end;


procedure TClientForm.ScaleImage1Click(Sender: TObject);
begin
  ScaleImage1.Checked := not ScaleImage1.Checked;
  cl.ScaleClient := ScaleImage1.Checked;
  if ScaleImage1.Checked then
  begin
    cl.AutoSize := False;
    cl.Stretch := True;
    cl.Align := alClient;
  end 
  else 
  begin
    cl.AutoSize := True;
    cl.Stretch := False;
    cl.Align := alNone;
    cl.Picture.Assign(cl.Picture.Graphic);  // To trigger the Autosize property
  end;
end;

procedure TClientForm.ProcessList1Click(Sender: TObject);
begin
  cl.Proceslist;
end;

procedure TClientForm.SendPanelResize(Sender: TObject);
begin
  SendEdit.Width := SendPanel.ClientWidth - 8;
end;

procedure TClientForm.About1Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

procedure TClientForm.StatBarMenuClick(Sender: TObject);
begin
  StatBarMenu.Checked := not StatBarMenu.Checked;
  StatusBar1.Visible := StatBarMenu.Checked;
end;

procedure TClientForm.FullScreen1Click(Sender: TObject);
begin
  if BorderStyle = bsSizeable then 
  begin
    BeforeFull := BoundsRect;
    Menu := nil;
    Left := 0;
    Top := 0;
    Width := Screen.Width;
    Height := Screen.Height;
    BorderStyle := bsNone;
    StatPanel.Visible := False;
    StatusBar1.Visible := False;
    ScrollBox1.BorderStyle := bsNone;
    FSTopForm.Show;
  end 
  else 
  begin
    BoundsRect := BeforeFull;
    Menu := MainMenu1;
    BorderStyle := bsSizeable;
    StatPanel.Visible := True;
    StatusBar1.Visible := True;
    ScrollBox1.BorderStyle := bsSingle;
    FSTopForm.Hide;
  end;
end;

procedure TClientForm.FormKeyDown(Sender: TObject; var Key: word;
  Shift: TShiftState);
begin
  // If in Full-Screen mode, do an extra check for Hot-Keys on the popup menu
  if BorderStyle = bsNone then 
  begin
    FSTopForm.CheckShortCut(Key, Shift);
  end;
end;

procedure TClientForm.FocusServerWindow1Click(Sender: TObject);
begin
  cl.FocusServerWindow;
end;

procedure TClientForm.RefreshComplete1Click(Sender: TObject);
begin
  cl.refresh;
end;

procedure TClientForm.FileList1Click(Sender: TObject);
begin
  cl.getDrive('');
end;

procedure TClientForm.ShowProc(Sender: TObject; Data: string);
begin
  if ProcForm = nil then
    ProcForm := TProcListForm.Create(Self);
  (ProcForm as TProcListForm).SetList(Data);
  ProcForm.Show;
end;


procedure TClientForm.ShowDriveList(Sender: TObject; Data: string);
begin
  if FileForm = nil then
    FileForm := TFilesForm.Create(Self);
  (FileForm as TFilesForm).SetDriveList(Data);
  FileForm.Show;
end;

procedure TClientForm.ShowFileList(Sender: TObject; Data: string);
begin
  (FileForm as TFilesForm).SetFileData(Data);
end;

procedure TClientForm.ShowDirList(Sender: TObject; Data: string);
begin
  (FileForm as TFilesForm).SetDirData(Data);
  FileForm.Show;
end;

procedure TClientForm.MChangeSoketClick(Sender: TObject);
begin
end;

{
procedure TClientForm.CLDecrypt(Sender: TObject; var S: String);
var
  i:integer;
begin
  for i:=1 to length(s) do
    s[i]:=chr(ord(s[i]) XOR $0E);
end;


procedure TClientForm.CLEncrypt(Sender: TObject; var S: String);
var
  i:integer;
begin
  for i:=1 to length(s) do
    s[i]:=chr(ord(s[i]) XOR $0E);
end;
}
end.